From: Andreas Gerler Date: Wed, 21 May 2025 12:46:14 +0000 (+0200) Subject: updaet iter2 X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=ba3f20635d1f32af4809521c4820287fbad55dda;p=emacsconfig.git updaet iter2 --- diff --git a/elpa/iter2-20221104.1938/iter2-autoloads.el b/elpa/iter2-20221104.1938/iter2-autoloads.el deleted file mode 100644 index 5a297a9f..00000000 --- a/elpa/iter2-20221104.1938/iter2-autoloads.el +++ /dev/null @@ -1,28 +0,0 @@ -;;; iter2-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- -;; Generated by the `loaddefs-generate' function. - -;; This file is part of GNU Emacs. - -;;; Code: - -(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) - - - -;;; Generated autoloads from iter2.el - -(register-definition-prefixes "iter2" '("iter2-")) - -;;; End of scraped data - -(provide 'iter2-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; iter2-autoloads.el ends here diff --git a/elpa/iter2-20221104.1938/iter2-pkg.el b/elpa/iter2-20221104.1938/iter2-pkg.el deleted file mode 100644 index 2d82184f..00000000 --- a/elpa/iter2-20221104.1938/iter2-pkg.el +++ /dev/null @@ -1,14 +0,0 @@ -(define-package "iter2" "20221104.1938" "Reimplementation of Elisp generators" - '((emacs "25.1")) - :commit "5ea6ba6effc4b71e7a4aed16b3f42408f9064c01" :authors - '(("Paul Pogonyshev" . "pogonyshev@gmail.com")) - :maintainers - '(("Paul Pogonyshev" . "pogonyshev@gmail.com")) - :maintainer - '("Paul Pogonyshev" . "pogonyshev@gmail.com") - :keywords - '("elisp" "extensions") - :url "https://github.com/doublep/iter2") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/iter2-20221104.1938/iter2.el b/elpa/iter2-20221104.1938/iter2.el deleted file mode 100644 index e853ac4d..00000000 --- a/elpa/iter2-20221104.1938/iter2.el +++ /dev/null @@ -1,920 +0,0 @@ -;;; iter2.el --- Reimplementation of Elisp generators -*- lexical-binding: t -*- - -;;; Copyright (C) 2017-2022 Paul Pogonyshev - -;; Author: Paul Pogonyshev -;; Maintainer: Paul Pogonyshev -;; Version: 1.5snapshot -;; Keywords: elisp, extensions -;; Homepage: https://github.com/doublep/iter2 -;; Package-Requires: ((emacs "25.1")) - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation, either version 3 of -;; the License, or (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see http://www.gnu.org/licenses. - - -;;; Commentary: - -;; Fully compatible fast reimplementation of `generator' built-in -;; Emacs package. This library provides `iter2-defun` and -;; `iter2-lambda` forms that can be used in place of `iter-defun` and -;; `iter-lambda`. All other functions and macros (e.g. `iter-yield`, -;; `iter-next`) are intentionally not duplicated: just use the -;; original ones. - - -;;; Code: - -;; For `iter-yield' etc. from the original `generator' package. -(require 'generator) -(require 'macroexp) -(require 'subr-x) - -(require 'bytecomp) -;; See the usage below. -(defvar byte-compile-bound-variables) - - -(defgroup iter2 nil - "Reimplementation of Elisp generators" - :group 'lisp) - -(defcustom iter2-detect-nested-lambda-yields nil - "If non-nil, detect non-working yields in nested lambdas. -Due to the way `iter2' (or original `generator', for that matter) -works, it is impossible to yield from nested lambdas: only from -the main function. Such `iter-yield' invocations will fail at -runtime. - -When this variable is set, `iter2' tries to detect such problems -during conversion. However, this test is not enabled by default -because it might, in principle, give false positives if you never -call said lambda. It also negatively affects performance. - -On the other hand, this might be useful, as it is very easy to -accidentally try to yield from a macro-generated lambda, e.g.: - - # Replace each element with what `iter-yield' returns. Not - # obvious that this form will not work. - (setf list (--map (iter-yield it) list))" - :type 'boolean - :group 'iter2) - - -(defvar iter2-generate-tracing-functions nil - "Set to non-nil to always generate tracing functions. -Normally, only `iter2-tracing-defun' and `iter2-tracing-lambda' -will do this. But if this flag is set, `iter2-defun' and -`iter2-lambda' will behave similarly.") - -(defvar iter2-tracing-print-level t - "Value used for `print-level' when tracing generator functions. -If set to t, value of `print-level' at the time of tracing is -preserved. Otherwise, it is overwritten with the value of this -variable.") - -(defvar iter2-tracing-print-length t - "Value used for `print-length' when tracing generator functions. -If set to t, value of `print-length' at the time of tracing is -preserved. Otherwise, it is overwritten with the value of this -variable.") - -(defvar iter2-tracing-function #'iter2-log-message - "Function called to trace iterator execution. -The function must accept the same arguments as built-in -`message', but is not restricted in what it does with the -messages. If the value is nil, tracing is disabled even for -iterator functions that are supposed to trace.") - - -(defvar iter2--tracing-depth 0) - -(defvar iter2--value nil) -(defvar iter2--continuations nil) -(defvar iter2--cleanups nil) -(defvar iter2--stack nil) -(defvar iter2--yielding nil) -(defvar iter2--done nil) -(defvar iter2--stack-state nil) -(defvar iter2--catcher nil) -(defvar iter2--cleanups-used nil) -(defvar iter2--converter-depth 0) - - -(defmacro iter2-defun (name arglist &rest body) - "Create a generator function NAME. -When called, generator returns an iterator object. Successive -values can be retrieved from an iterator using `iter-next'. - -From generator perspective, BODY is executed whenever a new -iterator object is created. At each point `iter-yield' is called -in the body, evaluation stops, and is resumed at exactly the same -point with the same state (both local and global variables) if -`iter-next' is used to query another value. - -Iterator objects must be closed with `iter-close' unless they are -fully exhausted, i.e. signal `iter-end-of-sequence'. Calling -`iter-close' on an exhausted iterator object or even several -times is not an error." - (declare (debug defun) (indent 2) (doc-string 3)) - (let ((parsed-body (macroexp-parse-body body))) - `(defun ,name ,arglist - ,@(car parsed-body) - ,(iter2--convert-function-body (cdr parsed-body) iter2-generate-tracing-functions)))) - -(defmacro iter2-lambda (arglist &rest body) - "Create an anonymous generator function. -See `iter2-defun' for details." - (declare (debug lambda) (indent 1) (doc-string 2)) - (let ((parsed-body (macroexp-parse-body body))) - `(lambda ,arglist - ,@(car parsed-body) - ,(iter2--convert-function-body (cdr parsed-body) iter2-generate-tracing-functions)))) - -(defmacro iter2-tracing-defun (name arglist &rest body) - "Create a tracing generator function NAME. -See `iter2-defun' for details." - (declare (debug defun) (indent 2) (doc-string 3)) - (let ((iter2-generate-tracing-functions t)) - (macroexpand-1 `(iter2-defun ,name ,arglist ,@body)))) - -(defmacro iter2-tracing-lambda (arglist &rest body) - "Create a tracing anonymous generator function NAME. -See `iter2-defun' for details." - (declare (debug lambda) (indent 1) (doc-string 2)) - (let ((iter2-generate-tracing-functions t)) - (macroexpand-1 `(iter2-lambda ,arglist ,@body)))) - -(defun iter2--literalp (x) - "Determine if X involves no evaluation." - (if (atom x) - (or (not (symbolp x)) - (memq x '(nil t)) - (keywordp x)) - ;; Don't check for wrong forms here: just let it fail later in such a case. - (memq (car x) '(quote function)))) - -(defun iter2--literal-or-variable-p (x) - (or (atom x) (memq (car x) '(quote function)))) - -;; During byte-compilation, function `special-variable-p' won't give intended results for -;; variables declared in the file being compiled. E.g. byte-compiler itself used (pre-29) -;; to use `byte-compile-not-lexical-var-p' to decide how to compile let-bindings. Of -;; course, they had to remove the function, even if it wass not private according to Elisp -;; naming conventions. It seems we still can use variable `byte-compile-bound-variables' -;; at least. -(defun iter2--special-variable-p (var &optional warn) - (cond ((boundp 'byte-compile-bound-variables) - (or (special-variable-p var) (memq var byte-compile-bound-variables))) - (t - (when warn - (warn "Variable `byte-compile-bound-variables' is missing, special variable bindings in byte-compiled `iter2-defun' might misbehave")) - (special-variable-p var)))) - -(defmacro iter2--convert-progn (forms) - (declare (debug (form))) - `(iter2--convert-form (macroexp-progn ,forms))) - -(defmacro iter2--add-converted-form (place converted-form) - (declare (debug (place form))) - `(setf ,place (nconc (reverse (macroexp-unprogn ,converted-form)) ,place))) - -(defmacro iter2--finish-chunk (converted-chunks converted &rest next-chunk-forms) - (declare (debug (place place &rest form))) - `(setf ,converted-chunks (cons (macroexp-progn (nreverse ,converted)) ,converted-chunks) - ,converted ,(when next-chunk-forms `(list ,@next-chunk-forms)))) - -(defun iter2--convert-function-body (body &optional tracing) - (unless lexical-binding - (error "Generator functions require lexical binding")) - (let* ((iter2-generate-tracing-functions tracing) - (iter2--value (make-symbol "$value")) - (iter2--continuations (make-symbol "$continuations")) - (iter2--cleanups (make-symbol "$cleanups")) - (iter2--stack (make-symbol "$stack")) - (iter2--yielding (make-symbol "$yielding")) - (iter2--done (make-symbol "$done")) - (iter2--stack-state (make-symbol "$stack-state")) - (iter2--catcher (make-symbol "$catcher")) - (iter2--cleanups-used nil) - (apply-debugger (lambda (&rest forms) forms))) - (pcase body - (`((edebug-enter ,edebug-name ,edebug-args (function (lambda () . ,real-body)))) - ;; This is a hack, but since Emacs code (Edebug in this case) is pretty stable, I'm - ;; sure it will keep working. The idea is to invoke `edebug-enter' not when the - ;; function is first called (this creates and returns an iterator object and - ;; doesn't involve user code at all), but instead when it receives control after - ;; `iter-next' or `iter-yield' call. This also solves the issue with form - ;; conversion: normally `iter2--convert-form' doesn't recurse into nested lambdas. - (setq body real-body - apply-debugger (lambda (&rest forms) `((edebug-enter ,edebug-name ,edebug-args (function (lambda () ,@forms)))))))) - ;; Need to convert the body now, since this affects at least `iter2--cleanups-used'. - (let ((converted (iter2--convert-progn body))) - `(let (,iter2--continuations - ,@(when iter2--cleanups-used (list iter2--cleanups)) - ,iter2--stack - ,iter2--yielding) - ;; Must not be moved to `let' above, since the lambda accesses the other - ;; variables declared there. - (setq ,iter2--continuations (list (lambda (,iter2--value) ,@(macroexp-unprogn (iter2--merge-continuation-form converted))))) - (lambda (operation value) - (cond ((eq operation :next) - ,@(funcall apply-debugger - ;; Rewritten in a somewhat weird form to maximize performance. - `(while (progn (setq value ,(iter2--continuation-invocation-form 'value `(or (pop ,iter2--continuations) - (signal 'iter-end-of-sequence value)))) - (not ,iter2--yielding))) - `(setq ,iter2--yielding nil) - `value)) - ((eq operation :close) - ,@(funcall apply-debugger - (if iter2--cleanups-used - `(let ((cleanups ,iter2--cleanups)) - (setq ,iter2--continuations nil - ,iter2--cleanups nil - ,iter2--stack nil) - (if cleanups - (iter2--do-clean-up cleanups))) - `(setq ,iter2--continuations nil - ,iter2--stack nil)))) - (t (error "Unknown iterator operation %S" operation)))))))) - -(defsubst iter2--do-macroexpand (form) - ;; Prevent `macroexpand' from expanding macros for which we have special handling. - (macroexpand form '((save-match-data . nil)))) - -;; Returns (CONVERTED-FORM . CONTINUATION-FORM) -;; -;; if CONVERTED-FORM never yields, CONTINUATION-FORM is nil. CONTINUATION-FORM itself -;; never yields. -;; -;; Since this function is recursive, it can certainly run out of stack -;; on complicated forms if not byte-compiled. -(defun iter2--convert-form (form) - (if (atom form) - ;; Speed optimizations, also simplifies debugging a bit. - (cons form nil) - (let ((body (macroexp-unprogn form)) - can-yield - converted - converted-chunks) - (while body - (let ((form (iter2--do-macroexpand (pop body)))) - ;; Simplify certain forms, rewrite certain others using - ;; special forms that we handle below. - (while (let ((rewritten-form - (pcase form - (`(and) t) - (`(or) nil) - (`(,(or 'and 'or) ,only-condition) (iter2--do-macroexpand only-condition)) - (`(cond) nil) - (`(cond (,only-condition)) (iter2--do-macroexpand only-condition)) - (`(cond (,only-condition . ,body)) `(if ,only-condition ,(macroexp-progn body))) - (`(,(or 'let 'let*) () . ,let-body) (setq body (append (cdr let-body) body)) (iter2--do-macroexpand (car let-body))) - (`(,(or 'progn 'inline)) nil) - (`(,(or 'progn 'inline 'prog1) ,only-form) (iter2--do-macroexpand only-form)) - (`(,(or 'progn 'inline) ,first . ,others) (setq body (append others body)) (iter2--do-macroexpand first)) - (`(prog1 ,value . ,rest) (if body - ;; This value is not going to be used anyway, - ;; so just inline this into `body'. - (progn (setq body (append rest body)) (iter2--do-macroexpand value)) - ;; Do nothing. - form)) - (`(prog2 ,first ,second . ,others) `(prog1 (progn ,first ,second) ,@others)) - (`(unwind-protect ,body-form) (iter2--do-macroexpand body-form)) - (`(condition-case ,_ ,body-form) (iter2--do-macroexpand body-form)) - (_ form)))) - (if (eq form rewritten-form) - nil - (setq form rewritten-form)))) - (pcase form - - ;; Handle nested lambdas; optionally check them for yields. - (`(function (lambda ,_lambda-args . ,lambda-body)) - ;; Could write a faster function here, but probably not performance-critical. - (when (and iter2-detect-nested-lambda-yields (cdr (iter2--convert-progn lambda-body))) - (error "Nested anonymous function %S yields, which will fail at runtime" (cadr form))) - (push form converted)) - - ;; Handle quoting ('_ and #'_): just pass it through. - (`(,(or 'quote 'function) ,_) - (push form converted)) - - ;; Handle (and CONDITIONS...) and (or CONDITIONS...). - (`(,(and (or 'and 'or) operator) . ,conditions) - (let (plain-conditions) - (while conditions - (let* ((converted-condition (iter2--convert-form (pop conditions))) - (converted-condition-form (car converted-condition))) - (if (cdr converted-condition) - (progn - (if conditions - (let ((converted-continuation (iter2--convert-form `(,operator ,(cdr converted-condition) ,@conditions)))) - (setq converted-condition-form `(progn ,(iter2--continuation-adding-form (list (iter2--merge-continuation-form converted-continuation))) - ,@(macroexp-unprogn converted-condition-form)))) - (setq converted-condition-form (iter2--merge-continuation-form converted-condition))) - (when plain-conditions - (setq converted-condition-form `(,operator ,@(nreverse plain-conditions) ,converted-condition-form))) - (iter2--add-converted-form converted converted-condition-form) - (setq can-yield t - conditions nil)) - (push converted-condition-form plain-conditions)))) - (unless can-yield - (push `(,operator ,@(nreverse plain-conditions)) converted)))) - - ;; Handle (if CONDITION THEN [ELSE...]). - (`(if ,condition ,then . ,else) - (let ((converted-condition (iter2--convert-form condition)) - (converted-then (iter2--convert-form then)) - (converted-else (iter2--convert-progn else))) - (if (cdr converted-condition) - (progn (iter2--add-converted-form converted (car converted-condition)) - (iter2--finish-chunk converted-chunks converted - `(if ,(cdr converted-condition) - ,(iter2--merge-continuation-form converted-then) - ,@(when else (macroexp-unprogn (iter2--merge-continuation-form converted-else)))))) - (push `(if ,(car converted-condition) - ,(iter2--merge-continuation-form converted-then) - ,@(when else (macroexp-unprogn (iter2--merge-continuation-form converted-else)))) - converted)) - (setq can-yield (or (cdr converted-then) (cdr converted-else))))) - - ;; Handle (cond [CLAUSES...]). - (`(cond . ,clauses) - (let (converted-clauses - conditions-can-yield) - (while clauses - (let* ((clause (pop clauses)) - (converted-condition (iter2--convert-form (car clause))) - (converted-condition-form (car converted-condition)) - (clause-body (cdr clause))) - (if (cdr converted-condition) - (let ((converted-continuation (iter2--convert-form `(cond (,(cdr converted-condition) ,@clause-body) ,@clauses)))) - (setq converted-condition-form `(progn ,(iter2--continuation-adding-form (list (iter2--merge-continuation-form converted-continuation))) - ,@(macroexp-unprogn converted-condition-form))) - (when converted-clauses - (setq converted-condition-form `(cond ,@(nreverse converted-clauses) (t ,@(macroexp-unprogn converted-condition-form))))) - (iter2--add-converted-form converted converted-condition-form) - (setq conditions-can-yield t - clauses nil)) - (let ((converted-body (when clause-body (iter2--convert-progn clause-body)))) - (push `(,(car converted-condition) ,@(when clause-body (macroexp-unprogn (iter2--merge-continuation-form converted-body)))) - converted-clauses) - (when (cdr converted-body) - (setq can-yield t)))))) - (if conditions-can-yield - (setq can-yield t) - (push `(cond ,@(nreverse converted-clauses)) converted)))) - - ;; Handle (while CONDITION [WHILE-BODY...]). - (`(while ,condition . ,while-body) - (let* ((converted-condition (iter2--convert-form condition)) - (converted-while-body (when while-body (iter2--convert-progn while-body)))) - (if (or (cdr converted-condition) (cdr converted-while-body)) - (let ((special-empty-body (and (null while-body) (eq (cdr converted-condition) iter2--value)))) - (when while-body - (setq converted-while-body (iter2--merge-continuation-form converted-while-body))) - (if (cdr converted-condition) - ;; Condition yields; whether body yields too is not relevant. - (let ((inner-form `(if ,(cdr converted-condition) - (progn (setq ,iter2--continuations (cons (car ,iter2--stack) ,iter2--continuations)) - ,@(macroexp-unprogn (if special-empty-body (car converted-condition) converted-while-body))) - (setq ,iter2--stack (cdr ,iter2--stack))))) - (push (iter2--continuation-adding-form (list (if special-empty-body - inner-form - `(progn ,(iter2--continuation-adding-form (list inner-form)) - ,@(macroexp-unprogn (car converted-condition))))) - iter2--stack) - converted)) - ;; Only body yields. - (push (iter2--continuation-adding-form (list `(if ,(car converted-condition) - (progn (setq ,iter2--continuations (cons (car ,iter2--stack) ,iter2--continuations)) - ,@(macroexp-unprogn converted-while-body)) - (setq ,iter2--stack (cdr ,iter2--stack)))) - iter2--stack) - converted)) - (push (iter2--continuation-invocation-form special-empty-body `(car ,iter2--stack)) converted) - (setq can-yield t)) - ;; Nothing yields, the simplest case. - (push `(while ,(car converted-condition) ,@(when while-body (macroexp-unprogn (car converted-while-body)))) converted)))) - - ;; Handle (let (BINDINGS) LET-BODY) and (let* (BINDINGS) LET-BODY). - (`(,(and (or 'let 'let*) let-kind) ,bindings . ,let-body) - (let ((plain-let (eq let-kind 'let)) - converted-bindings - catcher-outer-bindings - catcher-inner-bindings - ;; The rest are unused for `let*'. - next-continuation-bindings - values-to-save-on-stack - (num-stack-values 0)) - (while bindings - (let* ((binding (pop bindings)) - var - value) - (pcase binding - ((pred symbolp) - (setq var binding)) - (`(,(and (pred symbolp) variable)) - (setq var variable)) - (`(,(and (pred symbolp) variable) ,value-form) - (setq var variable - value value-form)) - (_ - (error "Erroneous binding %S" binding))) - (let ((special (iter2--special-variable-p var)) - (literal (iter2--literalp value))) - (cond (literal - (push binding converted-bindings) - (when plain-let - (push binding next-continuation-bindings))) - ((eq value iter2--stack-state) - ;; This is our private internal flag that means "take a - ;; previously computed value from the stack". Stack is only - ;; used for plain `let', never for `let*'. - (push `(,var (pop ,iter2--stack)) converted-bindings) - (push `(,var ,iter2--stack-state) next-continuation-bindings) - (setq num-stack-values (1+ num-stack-values))) - (t - (let* ((converted-value (iter2--convert-form value)) - (converted-value-form (car converted-value))) - (if (cdr converted-value) - (progn (if (or plain-let (null converted-bindings)) - ;; Yielding before anything is bound. - (progn (when values-to-save-on-stack - (push (iter2--stack-adding-form (nreverse values-to-save-on-stack)) converted)) - (iter2--add-converted-form converted converted-value-form) - (iter2--finish-chunk converted-chunks converted - (iter2--merge-continuation-form (iter2--convert-form `(,let-kind (,@(nreverse next-continuation-bindings) - (,var ,(cdr converted-value)) - ,@bindings) - ,@let-body))))) - ;; We need to bind already converted values now. - (push (iter2--let*-yielding-form catcher-outer-bindings catcher-inner-bindings - (iter2--merge-continuation-form (iter2--convert-form `(let* ((,var ,iter2--value) ,@bindings) ,@let-body))) - (iter2--merge-continuation-form converted-value)) - converted)) - (setq bindings nil - can-yield t)) - (push `(,var ,converted-value-form) converted-bindings) - (when plain-let - (push `(,var ,iter2--stack-state) next-continuation-bindings) - (push converted-value-form values-to-save-on-stack)))))) - (if (or literal (not special)) - (push (car converted-bindings) (if special catcher-inner-bindings catcher-outer-bindings)) - (let ((private-storage-var (make-symbol (format "$%s" (symbol-name var))))) - (push `(,private-storage-var ,(nth 1 (car converted-bindings))) catcher-outer-bindings) - (push `(,var ,private-storage-var) catcher-inner-bindings))) - ;; This is a marker we use to separate bindings for different - ;; catchers for `let*'. - (when (and special (not plain-let)) - (push nil catcher-outer-bindings))))) - (unless can-yield - (when (> num-stack-values 1) - (push (iter2--stack-head-reversing-form num-stack-values) converted)) - (let* ((converted-let-body (iter2--convert-progn let-body)) - (converted-let-body-form (iter2--merge-continuation-form converted-let-body))) - (if (or (null (cdr converted-let-body)) (null catcher-inner-bindings)) - (progn (push `(,let-kind (,@(nreverse converted-bindings)) ,@(macroexp-unprogn converted-let-body-form)) converted) - (setq can-yield (cdr converted-let-body))) - ;; Let body yields and we have special (dynamic) bindings. - (push (if plain-let - `(let (,@(nreverse catcher-outer-bindings)) - ,(iter2--catcher-continuation-adding-form `(let (,@(nreverse catcher-inner-bindings)) - (prog1 ,(iter2--continuation-invocation-form iter2--value) - (unless (eq ,iter2--continuations ,iter2--done) - (push ,iter2--catcher ,iter2--continuations)))) - converted-let-body-form)) - (iter2--let*-yielding-form catcher-outer-bindings catcher-inner-bindings converted-let-body-form)) - converted) - (setq can-yield t)))))) - - ;; Handle (prog1 VALUE [BODY...]). - (`(prog1 ,value . ,rest) - (let ((converted-value (iter2--convert-form value)) - (converted-rest (iter2--convert-progn rest))) - (if (or (cdr converted-value) (cdr converted-rest)) - (progn (when (cdr converted-value) - (iter2--add-converted-form converted (car converted-value)) - (iter2--finish-chunk converted-chunks converted)) - (if (cdr converted-rest) - (progn (push `(push ,(or (cdr converted-value) (car converted-value)) ,iter2--stack) converted) - (iter2--add-converted-form converted (car converted-rest)) - (iter2--finish-chunk converted-chunks converted `(pop ,iter2--stack))) - (push `(prog1 ,(cdr converted-value) ,@rest) converted))) - (push `(prog1 ,(car converted-value) ,@(macroexp-unprogn (car converted-rest))) converted)))) - - ;; Handle (unwind-protect BODY-FORM CLEANUP-FORMS...). - (`(unwind-protect ,body-form . ,cleanup-forms) - (let ((converted-body-form (iter2--convert-form body-form)) - (converted-cleanup-forms (iter2--convert-progn cleanup-forms))) - (when (cdr converted-cleanup-forms) - (error "Yielding from cleanup forms in `unwind-protect' is not allowed: %S" cleanup-forms)) - (if (cdr converted-body-form) - (progn - (push `(setq ,iter2--cleanups (cons (lambda () ,@(macroexp-unprogn (car converted-cleanup-forms))) ,iter2--cleanups)) converted) - ;; No need to use private variable names as we don't include any user code. - (push (iter2--catcher-continuation-adding-form `(let (result) - (unwind-protect - (prog1 ,(iter2--continuation-invocation-form iter2--value) - (setq result (if (eq ,iter2--continuations ,iter2--done) ,iter2--yielding 'continuing))) - (if result - (push (if (eq result t) - ;; Completed body, but yielded. Clean up when control is regained. - (lambda (,iter2--value) ,(iter2--cleanup-invocation-body) ,iter2--value) - ;; Continuing. Re-add self. - ,iter2--catcher) - ,iter2--continuations) - ;; Either exited non-locally, or completed body and haven't yielded. - ,(iter2--cleanup-invocation-body)))) - (iter2--merge-continuation-form converted-body-form)) - converted) - (setq can-yield t - iter2--cleanups-used t)) - (push `(unwind-protect ,(car converted-body-form) ,@(macroexp-unprogn (car converted-cleanup-forms))) converted)))) - - ;; Handle (catch TAG BODY). - (`(catch ,tag . ,catch-body) - (let* ((converted-tag (iter2--convert-form tag)) - (converted-tag-form (car converted-tag))) - (when (cdr converted-tag) - (iter2--add-converted-form converted converted-tag-form) - (iter2--finish-chunk converted-chunks converted) - (setq converted-tag-form (cdr converted-tag))) - (let ((converted-catch-body (iter2--convert-progn catch-body))) - (if (cdr converted-catch-body) - (let ((literal-tag (iter2--literalp converted-tag-form))) - ;; No need to use private variable names as we don't include any user code. - (push (iter2--catcher-continuation-adding-form `(let (completed-normally) - (prog1 (catch ,(if literal-tag converted-tag-form 'tag) - (prog1 ,(iter2--continuation-invocation-form iter2--value) - (setq completed-normally t) - (unless (eq ,iter2--continuations ,iter2--done) - (push ,iter2--catcher ,iter2--continuations)))) - (unless completed-normally - (setq ,iter2--continuations ,iter2--done - ,iter2--stack ,iter2--stack-state)))) - (iter2--merge-continuation-form converted-catch-body) - `(,iter2--stack-state ,iter2--stack) - (unless literal-tag `(tag ,converted-tag-form))) - converted) - (setq can-yield t)) - (push `(catch ,converted-tag-form ,@(macroexp-unprogn (car converted-catch-body))) converted))))) - - ;; Handle (condition-case VAR BODY-FORM HANDLERS...). - (`(condition-case ,var ,body-form . ,handlers) - (let ((converted-body (iter2--convert-form body-form)) - converted-handlers) - (dolist (handler handlers) - (pcase handler - (`(,condition . ,handler-body) - (let ((converted-handler (iter2--convert-progn handler-body))) - (push `(,condition ,@(macroexp-unprogn (iter2--merge-continuation-form converted-handler))) converted-handlers) - (when (cdr converted-handler) - (setq can-yield t)))) - (_ - (error "Invalid `condition-case' error handler: %S" handler)))) - (setq converted-handlers (nreverse converted-handlers)) - (if (cdr converted-body) - (progn (push (iter2--catcher-continuation-adding-form `(condition-case ,var - (prog1 ,(iter2--continuation-invocation-form iter2--value) - (unless (eq ,iter2--continuations ,iter2--done) - (push ,iter2--catcher ,iter2--continuations))) - ,@(mapcar (lambda (handler) - `(,(car handler) - (setq ,iter2--continuations ,iter2--done ,iter2--stack ,iter2--stack-state) - ,@(cdr handler))) - converted-handlers)) - (iter2--merge-continuation-form converted-body) - `(,iter2--stack-state ,iter2--stack)) - converted) - (setq can-yield t)) - (push `(condition-case ,var ,(car converted-body) ,@converted-handlers) converted)))) - - ;; Handle (iter-yield VALUE). - (`(iter-yield . ,rest) - (unless (and (consp rest) (null (cdr rest))) - (error "Form `iter-yield' must be used with exactly one argument: %S" form)) - (let* ((converted-value (iter2--convert-form (car rest))) - (converted-value-form (car converted-value))) - (when iter2-generate-tracing-functions - (setq converted-value-form `(let ((,iter2--value ,converted-value-form)) - (iter2--do-trace "yielding %S" ,iter2--value) - ,iter2--value))) - (when (cdr converted-value) - (iter2--add-converted-form converted converted-value-form) - (iter2--finish-chunk converted-chunks converted) - (setq converted-value-form (cdr converted-value))) - (if (iter2--literal-or-variable-p converted-value-form) - (progn (push `(setq ,iter2--yielding t) converted) - (push converted-value-form converted)) - ;; It might be unsafe to set yielding flag first: what if the value - ;; form exits non-locally? - (push `(prog1 ,converted-value-form (setq ,iter2--yielding t)) converted)) - (setq can-yield t))) - - ;; Handle `save-excursion'. - (`(save-excursion . ,body) - (let ((converted-body (iter2--convert-progn body))) - (if (cdr converted-body) - (progn (push (iter2--catcher-continuation-adding-form `(save-excursion - ;; Byte compiler gives a dumb warning here, - ;; suggesting to use `with-current-buffer'. - (with-no-warnings (set-buffer buffer)) - (goto-char point) - (prog1 ,(iter2--continuation-invocation-form iter2--value) - (unless (eq ,iter2--continuations ,iter2--done) - (setq buffer (current-buffer) - point (point)) - (push ,iter2--catcher ,iter2--continuations)))) - (iter2--merge-continuation-form converted-body) - '(buffer (current-buffer)) - '(point (point))) - converted) - (setq can-yield t)) - (push `(save-excursion ,@(macroexp-unprogn (car converted-body))) converted)))) - - ;; Handle `save-current-buffer'. - (`(save-current-buffer . ,body) - (let ((converted-body (iter2--convert-progn body))) - (if (cdr converted-body) - (progn (push (iter2--catcher-continuation-adding-form `(save-current-buffer - (set-buffer buffer) - (prog1 ,(iter2--continuation-invocation-form iter2--value) - (unless (eq ,iter2--continuations ,iter2--done) - (setq buffer (current-buffer)) - (push ,iter2--catcher ,iter2--continuations)))) - (iter2--merge-continuation-form converted-body) - '(buffer (current-buffer))) - converted) - (setq can-yield t)) - (push `(save-current-buffer ,@(macroexp-unprogn (car converted-body))) converted)))) - - ;; Handle `save-restriction'. - (`(save-restriction . ,body) - (let ((converted-body (iter2--convert-progn body))) - (if (cdr converted-body) - (progn (push (iter2--catcher-continuation-adding-form `(save-restriction - (narrow-to-region point-min point-max) - (prog1 ,(iter2--continuation-invocation-form iter2--value) - (unless (eq ,iter2--continuations ,iter2--done) - (setq point-min (point-min) - point-max (point-max)) - (push ,iter2--catcher ,iter2--continuations)))) - (iter2--merge-continuation-form converted-body) - '(point-min (point-min)) - '(point-max (point-max))) - converted) - (setq can-yield t)) - (push `(save-restriction ,@(macroexp-unprogn (car converted-body))) converted)))) - - ;; Handle `save-match-data' macro: not a special form, but without special - ;; handling doesn't produce intended results in generator functions. - (`(save-match-data . ,body) - (let ((converted-body (iter2--convert-progn body))) - (if (cdr converted-body) - (progn (push (iter2--catcher-continuation-adding-form `(save-match-data - (set-match-data match-data) - (prog1 ,(iter2--continuation-invocation-form iter2--value) - (unless (eq ,iter2--continuations ,iter2--done) - (match-data nil match-data) - (push ,iter2--catcher ,iter2--continuations)))) - (iter2--merge-continuation-form converted-body) - '(match-data (match-data))) - converted) - (setq can-yield t)) - (push `(save-match-data ,@(macroexp-unprogn (car converted-body))) converted)))) - - ;; Handle `with-no-warnings': while not a special form, it requires special handling. - (`(with-no-warnings . ,body) - (let ((converted-body (iter2--convert-progn body))) - (push `(with-no-warnings ,@(macroexp-unprogn (iter2--merge-continuation-form converted-body))) converted) - (setq can-yield (cdr converted-body)))) - - ;; Handle all other non-atomic forms. - (`(,name . ,arguments) - ;; Several special forms are handled more-or-less like function calls. - (when (and (special-form-p name) (not (memq name '(setq setq-default throw)))) - (error "Special form %S incorrect or not supported" form)) - (let (converted-arguments - next-continuation-arguments - arguments-to-save-on-stack - (num-stack-arguments 0)) - (while arguments - (let ((argument (pop arguments))) - (cond ((eq argument iter2--stack-state) - ;; This is our private internal flag that means "take a - ;; previously computed value from the stack". - (push `(pop ,iter2--stack) converted-arguments) - (push iter2--stack-state next-continuation-arguments) - (setq num-stack-arguments (1+ num-stack-arguments))) - ((or (iter2--literalp argument) (and (memq name '(setq setq-default)) (= (% (length converted-arguments) 2) 0))) - (push argument converted-arguments) - (push argument next-continuation-arguments)) - (t - (let ((converted-argument (iter2--convert-form argument))) - (if (cdr converted-argument) - (progn (when arguments-to-save-on-stack - (push (iter2--stack-adding-form (nreverse arguments-to-save-on-stack)) converted)) - (iter2--add-converted-form converted (car converted-argument)) - (push `(,name ,@(nreverse next-continuation-arguments) ,(cdr converted-argument) ,@arguments) body) - (setq arguments nil - can-yield t)) - (push (car converted-argument) converted-arguments) - (push iter2--stack-state next-continuation-arguments) - (push (car converted-argument) arguments-to-save-on-stack))))))) - (unless can-yield - (when (> num-stack-arguments 1) - (push (iter2--stack-head-reversing-form num-stack-arguments) converted)) - (push (cons name (nreverse converted-arguments)) converted)))) - - (_ - (push form converted))) - (when can-yield - (iter2--finish-chunk converted-chunks converted) - (setq can-yield nil)))) - - (setq converted (nreverse converted)) - (if converted-chunks - (progn (setq converted-chunks (nreverse converted-chunks)) - (cons (if (cdr converted-chunks) - `(progn ,(iter2--continuation-adding-form (reverse (cdr converted-chunks))) - ,@(macroexp-unprogn (car converted-chunks))) - (car converted-chunks)) - (if converted (macroexp-progn converted) iter2--value))) - (cons (macroexp-progn converted) nil))))) - -(defun iter2--convert-form-tracer (function form) - (let ((result (funcall function form))) - (if (or (atom form) (null iter2-tracing-function)) - result - (let ((indentation (make-string (* iter2--converter-depth 4) ? )) - (iter2--converter-depth (1+ iter2--converter-depth))) - (funcall iter2-tracing-function "%s" (replace-regexp-in-string "^" indentation (format "FORM: %s" (iter2--pp-to-string form 60 6)) t t)) - (funcall iter2-tracing-function "%s" (replace-regexp-in-string "^" indentation (format "--->: %s\n+: %s" - (iter2--pp-to-string (car result) 60 6) - (iter2--pp-to-string (cdr result) 60 6)) - t t)) - result)))) - -(defun iter2--pp-to-string (object &optional max-single-line-length indent-by) - (let* ((print-quoted t) - (string (prin1-to-string object))) - (when (and max-single-line-length (> (length string) max-single-line-length)) - (setq string (string-trim-right (pp-to-string object)))) - (when (and indent-by (> indent-by 0)) - (setq string (replace-regexp-in-string "\n" (concat "\n" (make-string indent-by ? )) string t t))) - string)) - -(defun iter2--debug-converter (enable) - (if enable - (advice-add #'iter2--convert-form :around #'iter2--convert-form-tracer) - (advice-remove #'iter2--convert-form #'iter2--convert-form-tracer))) - -(defun iter2--continuation-invocation-form (value &optional lambda) - (if iter2-generate-tracing-functions - `(let ((function ,(or lambda `(pop ,iter2--continuations)))) - (iter2--do-trace "invoking %S with value %S" function ,value) - (let ((iter2--tracing-depth (1+ iter2--tracing-depth))) - (funcall function ,value))) - `(funcall ,(or lambda `(pop ,iter2--continuations)) ,value))) - -(defun iter2--cleanup-invocation-body () - (if iter2-generate-tracing-functions - `(let ((function (pop ,iter2--cleanups))) - (iter2--do-trace "cleaning up using %S" function) - (funcall function)) - `(funcall (pop ,iter2--cleanups)))) - -(defun iter2--merge-continuation-form (converted &optional var) - (let ((converted-form (car converted)) - (continuation-form (cdr converted))) - (if (and continuation-form (not (eq continuation-form iter2--value))) - `(progn ,(iter2--continuation-adding-form (list continuation-form) var) ,@(macroexp-unprogn converted-form)) - converted-form))) - -(defun iter2--continuation-adding-form (new-continuations &optional var) - (let ((value (or var iter2--continuations))) - (while new-continuations - (setq value `(cons (lambda (,iter2--value) ,@(macroexp-unprogn (pop new-continuations))) ,value))) - `(setq ,(or var iter2--continuations) ,value))) - -(defun iter2--catcher-continuation-adding-form (catcher-body next-continuation &rest additional-catcher-outer-bindings) - `(setq ,iter2--continuations - (cons (let ((,iter2--done ,iter2--continuations) - ,@(delq nil additional-catcher-outer-bindings) - ,iter2--catcher) - (setq ,iter2--catcher (lambda (,iter2--value) ,@(macroexp-unprogn catcher-body)))) - (cons (lambda (,iter2--value) ,@(macroexp-unprogn next-continuation)) - ,iter2--continuations)))) - -(defun iter2--let*-yielding-form (catcher-outer-bindings catcher-inner-bindings continuation &optional form-before-continuation) - (let (main-bindings) - (while (and catcher-outer-bindings (car catcher-outer-bindings)) - (push (pop catcher-outer-bindings) main-bindings)) - (setq catcher-outer-bindings (cdr catcher-outer-bindings)) - (let ((form `(,(iter2--continuation-adding-form (list continuation)) - ,@(when form-before-continuation (macroexp-unprogn form-before-continuation))))) - (setq form (if main-bindings `(let* (,@main-bindings) ,@form) `(progn ,@form))) - (while catcher-inner-bindings - (let (outer-bindings) - (while (and catcher-outer-bindings (car catcher-outer-bindings)) - (push (pop catcher-outer-bindings) outer-bindings)) - (setq catcher-outer-bindings (cdr catcher-outer-bindings)) - (setq form (iter2--catcher-continuation-adding-form `(let (,(pop catcher-inner-bindings)) - (prog1 ,(iter2--continuation-invocation-form iter2--value) - (unless (eq ,iter2--continuations ,iter2--done) - (push ,iter2--catcher ,iter2--continuations)))) - form)) - (when outer-bindings - (setq form `(let* (,@outer-bindings) - ,form))))) - form))) - -(defun iter2--stack-adding-form (new-elements) - (let ((value iter2--stack)) - (while new-elements - (setq value `(cons ,(pop new-elements) ,value))) - `(setq ,iter2--stack ,value))) - -(defun iter2--stack-head-reversing-form (n) - (pcase n - (2 `(iter2--reverse-stack-head-2 ,iter2--stack)) - (3 `(iter2--reverse-stack-head-3 ,iter2--stack)) - (_ `(setq ,iter2--stack (iter2--reverse-stack-head-n ,iter2--stack ,(1- n)))))) - - -;; Internal helpers for generated functions. - -(defun iter2--do-clean-up (cleanups) - (if (cdr cleanups) - (unwind-protect - (funcall (car cleanups)) - (iter2--do-clean-up (cdr cleanups))) - (funcall (car cleanups)))) - -(defun iter2--reverse-stack-head-2 (stack) - (let ((x (car stack)) - (link-2 (cdr stack))) - (setcar stack (car link-2)) - (setcar link-2 x))) - -(defun iter2--reverse-stack-head-3 (stack) - (let ((x (car stack)) - (link-3 (cddr stack))) - (setcar stack (car link-3)) - (setcar link-3 x))) - -(defun iter2--reverse-stack-head-n (stack n-1) - (let* ((last-head-cons (nthcdr n-1 stack)) - (stack-tail (cdr last-head-cons))) - (setcdr last-head-cons nil) - (nconc (nreverse stack) stack-tail))) - -(defun iter2--do-trace (format-string &rest arguments) - (when iter2-tracing-function - (let ((print-level (if (eq iter2-tracing-print-level t) print-level iter2-tracing-print-level)) - (print-length (if (eq iter2-tracing-print-length t) print-length iter2-tracing-print-length))) - (apply iter2-tracing-function (concat "%siter2: " format-string) (cons (make-string (* iter2--tracing-depth 4) ? ) arguments))))) - - -(defun iter2-log-message (format-string &rest arguments) - "Like built-in `message', but only write to `*Messages*' buffer." - (let ((inhibit-message (or inhibit-message (not noninteractive)))) - (apply #'message format-string arguments))) - - -;; Make sure that we are still compatible with `generator'. I couldn't make it work like -;; I wanted with fewer `eval's. -(eval-after-load 'iter2 - (eval `(unless (let* ((it (funcall (iter2-lambda () (iter-yield 1))))) - (and (equal (iter-next it) 1) (condition-case error (progn (iter-next it 2) nil) (iter-end-of-sequence (equal (cdr error) 2))))) - (warn "Compatibility of `iter2' with `generator' package appears broken; please report this to maintainer (Emacs version: %s)" (emacs-version))) - t)) - -;; Issue a warning if compatibility is broken yet again. -(iter2--special-variable-p nil t) - - -;; Work around missing Edebug specification for `iter-do' macro on older Emacs versions. -(when (and (fboundp 'iter-do) (null (get 'iter-do 'edebug-form-spec))) - (put 'iter-do 'edebug-form-spec '((symbolp form) body))) - -;; Integrate into Imenu. -(add-to-list 'lisp-imenu-generic-expression - (list nil (concat "^\\s-*(iter2-defun\\s-+\\(" lisp-mode-symbol-regexp "\\)") 1)) - - -(provide 'iter2) - -;;; iter2.el ends here diff --git a/elpa/iter2-20250209.1516/iter2-autoloads.el b/elpa/iter2-20250209.1516/iter2-autoloads.el new file mode 100644 index 00000000..5a297a9f --- /dev/null +++ b/elpa/iter2-20250209.1516/iter2-autoloads.el @@ -0,0 +1,28 @@ +;;; iter2-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from iter2.el + +(register-definition-prefixes "iter2" '("iter2-")) + +;;; End of scraped data + +(provide 'iter2-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; iter2-autoloads.el ends here diff --git a/elpa/iter2-20250209.1516/iter2-pkg.el b/elpa/iter2-20250209.1516/iter2-pkg.el new file mode 100644 index 00000000..0d1b6a33 --- /dev/null +++ b/elpa/iter2-20250209.1516/iter2-pkg.el @@ -0,0 +1,10 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "iter2" "20250209.1516" + "Reimplementation of Elisp generators." + '((emacs "25.1")) + :url "https://github.com/doublep/iter2" + :commit "632232b5ee627bf5d299db0b7714b3b687a0124c" + :revdesc "632232b5ee62" + :keywords '("elisp" "extensions") + :authors '(("Paul Pogonyshev" . "pogonyshev@gmail.com")) + :maintainers '(("Paul Pogonyshev" . "pogonyshev@gmail.com"))) diff --git a/elpa/iter2-20250209.1516/iter2.el b/elpa/iter2-20250209.1516/iter2.el new file mode 100644 index 00000000..c5044c04 --- /dev/null +++ b/elpa/iter2-20250209.1516/iter2.el @@ -0,0 +1,1011 @@ +;;; iter2.el --- Reimplementation of Elisp generators -*- lexical-binding: t -*- + +;;; Copyright (C) 2017-2025 Paul Pogonyshev + +;; Author: Paul Pogonyshev +;; Maintainer: Paul Pogonyshev +;; Package-Version: 20250209.1516 +;; Package-Revision: 632232b5ee62 +;; Keywords: elisp, extensions +;; Homepage: https://github.com/doublep/iter2 +;; Package-Requires: ((emacs "25.1")) + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of +;; the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see http://www.gnu.org/licenses. + + +;;; Commentary: + +;; Fully compatible fast reimplementation of `generator' built-in +;; Emacs package. This library provides `iter2-defun` and +;; `iter2-lambda` forms that can be used in place of `iter-defun` and +;; `iter-lambda`. Form `iter2-next` is a replacement for `iter-next` +;; (see its documentation for the reasons), though `iter-next` will +;; work too. +;; +;; Other functions and macros (`iter-yield`, `iter-yield-from`, +;; `iter-do` and `iter-close`) are intentionally not duplicated: just +;; use the ones from the original package. + + +;;; Code: + +;; For `iter-yield' etc. from the original `generator' package. +(require 'generator) +(require 'macroexp) +(require 'subr-x) + +(require 'bytecomp) +;; See the usage below. +(defvar byte-compile-bound-variables) + + +(defgroup iter2 nil + "Reimplementation of Elisp generators" + :group 'lisp) + +(defcustom iter2-detect-nested-lambda-yields nil + "If non-nil, detect non-working yields in nested lambdas. +Due to the way `iter2' (or original `generator', for that matter) +works, it is impossible to yield from nested lambdas: only from +the main function. Such `iter-yield' invocations will fail at +runtime. + +When this variable is set, `iter2' tries to detect such problems +during conversion. However, this test is not enabled by default +because it might, in principle, give false positives if you never +call said lambda. It also negatively affects performance. + +On the other hand, this might be useful, as it is very easy to +accidentally try to yield from a macro-generated lambda, e.g.: + + # Replace each element with what `iter-yield' returns. Not + # obvious that this form will not work. + (setf list (--map (iter-yield it) list))" + :type 'boolean + :group 'iter2) + + +(defvar iter2-generate-tracing-functions nil + "Set to non-nil to always generate tracing functions. +Normally, only `iter2-tracing-defun' and `iter2-tracing-lambda' +will do this. But if this flag is set, `iter2-defun' and +`iter2-lambda' will behave similarly.") + +(defvar iter2-tracing-print-level t + "Value used for `print-level' when tracing generator functions. +If set to t, value of `print-level' at the time of tracing is +preserved. Otherwise, it is overwritten with the value of this +variable.") + +(defvar iter2-tracing-print-length t + "Value used for `print-length' when tracing generator functions. +If set to t, value of `print-length' at the time of tracing is +preserved. Otherwise, it is overwritten with the value of this +variable.") + +(defvar iter2-tracing-function #'iter2-log-message + "Function called to trace iterator execution. +The function must accept the same arguments as built-in +`message', but is not restricted in what it does with the +messages. If the value is nil, tracing is disabled even for +generator functions that are supposed to trace.") + + +(defvar iter2--tracing-depth 0) + +(defvar iter2--value nil) +(defvar iter2--continuations nil) +(defvar iter2--cleanups nil) +(defvar iter2--stack nil) +(defvar iter2--yielding nil) +(defvar iter2--done nil) +(defvar iter2--stack-state nil) +(defvar iter2--catcher nil) +(defvar iter2--cleanups-used nil) +(defvar iter2--converter-depth 0) + + +(defmacro iter2-defun (name arglist &rest body) + "Create a generator function NAME. +When called, generator returns an iterator object. Successive +values can be retrieved from an iterator using `iter-next'. + +From generator perspective, BODY is executed whenever a new +iterator object is created. At each point `iter-yield' is called +in the body, evaluation stops, and is resumed at exactly the same +point with the same state (both local and global variables) if +`iter-next' is used to query another value. + +Iterator objects must be closed with `iter-close' unless they are +fully exhausted, i.e. signal `iter-end-of-sequence'. Calling +`iter-close' on an exhausted iterator object or even several +times is not an error." + (declare (debug defun) (indent 2) (doc-string 3)) + (let ((parsed-body (macroexp-parse-body body))) + `(defun ,name ,arglist + ,@(car parsed-body) + ,(iter2--convert-function-body (cdr parsed-body) iter2-generate-tracing-functions)))) + +(defmacro iter2-lambda (arglist &rest body) + "Create an anonymous generator function. +See `iter2-defun' for details." + (declare (debug lambda) (indent 1) (doc-string 2)) + (let ((parsed-body (macroexp-parse-body body))) + `(lambda ,arglist + ,@(car parsed-body) + ,(iter2--convert-function-body (cdr parsed-body) iter2-generate-tracing-functions)))) + +(defmacro iter2-tracing-defun (name arglist &rest body) + "Create a tracing generator function NAME. +See `iter2-defun' for details." + (declare (debug defun) (indent 2) (doc-string 3)) + (let ((iter2-generate-tracing-functions t)) + (macroexpand-1 `(iter2-defun ,name ,arglist ,@body)))) + +(defmacro iter2-tracing-lambda (arglist &rest body) + "Create a tracing anonymous generator function NAME. +See `iter2-defun' for details." + (declare (debug lambda) (indent 1) (doc-string 2)) + (let ((iter2-generate-tracing-functions t)) + (macroexpand-1 `(iter2-lambda ,arglist ,@body)))) + + +(defmacro iter2-next (iterator &optional yield-result) + "Similar to `iter-next', but can inject errors into the ITERATOR. +Can only be used with `iter2' iterators, not those of original +`generator' package (`iter-next' works with either, but has less +functionality). + +If form YIELD-RESULT exits nonlocally (using `signal', `throw' or +any derived mechanism), this nonlocal exit is “injected” into the +generator function. It then works as if the exit was triggered +by the last issued `(iter-yield ...)' form. If the function has +an appropriate `condition-case' or `catch' handler, the control +is subsequently transferred to it. + +If YIELD-RESULT never exits nonlocally, behavior of this macro is +identical to that of `iter-next' (with the exception that the +iterator must be created with `iter2')." + `(funcall ,iterator :iter2-next (lambda () ,@(macroexp-unprogn yield-result)))) + + +(defun iter2--literalp (x) + "Determine if X involves no evaluation." + (if (atom x) + (or (not (symbolp x)) + (memq x '(nil t)) + (keywordp x)) + ;; Don't check for wrong forms here: just let it fail later in such a case. + (memq (car x) '(quote function)))) + +(defun iter2--literal-or-variable-p (x) + (or (atom x) (memq (car x) '(quote function)))) + +;; During byte-compilation, function `special-variable-p' won't give intended results for +;; variables declared in the file being compiled. E.g. byte-compiler itself used (pre-29) +;; to use `byte-compile-not-lexical-var-p' to decide how to compile let-bindings. Of +;; course, they had to remove the function, even if it wass not private according to Elisp +;; naming conventions. It seems we still can use variable `byte-compile-bound-variables' +;; at least. +(defun iter2--special-variable-p (var &optional warn) + (cond ((boundp 'byte-compile-bound-variables) + (or (special-variable-p var) (memq var byte-compile-bound-variables))) + (t + (when warn + (warn "Variable `byte-compile-bound-variables' is missing, special variable bindings in byte-compiled `iter2-defun' might misbehave")) + (special-variable-p var)))) + +(defmacro iter2--convert-progn (forms) + (declare (debug (form))) + `(iter2--convert-form (macroexp-progn ,forms))) + +(defmacro iter2--add-converted-form (place converted-form) + (declare (debug (place form))) + `(setf ,place (nconc (reverse (macroexp-unprogn ,converted-form)) ,place))) + +(defmacro iter2--finish-chunk (converted-chunks converted &rest next-chunk-forms) + (declare (debug (place place &rest form))) + `(setf ,converted-chunks (cons (macroexp-progn (nreverse ,converted)) ,converted-chunks) + ,converted ,(when next-chunk-forms `(list ,@next-chunk-forms)))) + +(defsubst iter2--identity-bind (value) + "Create an `identity'-like function and bind it with given VALUE." + (lambda () value)) + +(defun iter2--convert-function-body (body &optional tracing) + (unless lexical-binding + (error "Generator functions require lexical binding")) + (let* ((iter2-generate-tracing-functions tracing) + (iter2--value (make-symbol "$value")) + (iter2--continuations (make-symbol "$continuations")) + (iter2--cleanups (make-symbol "$cleanups")) + (iter2--stack (make-symbol "$stack")) + (iter2--yielding (make-symbol "$yielding")) + (iter2--done (make-symbol "$done")) + (iter2--stack-state (make-symbol "$stack-state")) + (iter2--catcher (make-symbol "$catcher")) + (iter2--cleanups-used nil) + (apply-debugger (lambda (&rest forms) forms))) + (pcase body + (`((edebug-enter ,edebug-name ,edebug-args (function (lambda () . ,real-body)))) + ;; This is a hack, but since Emacs code (Edebug in this case) is pretty stable, I'm + ;; sure it will keep working. The idea is to invoke `edebug-enter' not when the + ;; function is first called (this creates and returns an iterator object and + ;; doesn't involve user code at all), but instead when it receives control after + ;; `iter-next' or `iter-yield' call. This also solves the issue with form + ;; conversion: normally `iter2--convert-form' doesn't recurse into nested lambdas. + (setq body real-body + apply-debugger (lambda (&rest forms) `((edebug-enter ,edebug-name ,edebug-args (function (lambda () ,@forms)))))))) + ;; Need to convert the body now, since this affects at least `iter2--cleanups-used'. + (let ((converted (iter2--convert-progn body))) + `(let (,iter2--continuations + ,@(when iter2--cleanups-used (list iter2--cleanups)) + ,iter2--stack + ,iter2--yielding) + ;; Must not be moved to `let' above, since the lambda accesses the other + ;; variables declared there. + (setq ,iter2--continuations (list (lambda (,iter2--value) ,@(macroexp-unprogn (iter2--merge-continuation-form converted))))) + (lambda (operation value) + (cond ((or (eq operation :iter2-next) ; Make it faster for our own extension. + (when (eq operation :next) ; But keep it compatible with `generator'. + (setq value (iter2--identity-bind value)) + ;; This t is only to make byte-compiled code a bit more efficient, because otherwise + ;; (as of Emacs 29) it doesn't understand that this branch is always truthy. + t)) + ,@(funcall apply-debugger + ;; Rewritten in a somewhat weird form to maximize performance. + `(while (progn (setq value ,(iter2--continuation-invocation-form 'value `(or (pop ,iter2--continuations) + (signal 'iter-end-of-sequence (funcall value))))) + (not ,iter2--yielding)) + (setq value (iter2--identity-bind value))) + `(setq ,iter2--yielding nil) + `value)) + ((eq operation :close) + ,@(funcall apply-debugger + (if iter2--cleanups-used + `(let ((cleanups ,iter2--cleanups)) + (setq ,iter2--continuations nil + ,iter2--cleanups nil + ,iter2--stack nil) + (if cleanups + (iter2--do-clean-up cleanups))) + `(setq ,iter2--continuations nil + ,iter2--stack nil)))) + (t (error "Unknown iterator operation %S" operation)))))))) + +(defsubst iter2--do-macroexpand (form) + ;; Prevent `macroexpand' from expanding macros for which we have special handling. + (macroexpand form '((save-match-data . nil)))) + +;; Returns (CONVERTED-FORM . CONTINUATION-FORM) +;; +;; if CONVERTED-FORM never yields, CONTINUATION-FORM is nil. CONTINUATION-FORM itself +;; never yields. +;; +;; Since this function is recursive, it can certainly run out of stack +;; on complicated forms if not byte-compiled. +(defun iter2--convert-form (form) + (if (atom form) + ;; Speed optimizations, also simplifies debugging a bit. + (cons form nil) + (let ((body (macroexp-unprogn form)) + can-yield + converted + converted-chunks) + (while body + (let ((form (iter2--do-macroexpand (pop body)))) + ;; Simplify certain forms, rewrite certain others using + ;; special forms that we handle below. + (while (let ((rewritten-form + (pcase form + (`(and) t) + (`(or) nil) + (`(,(or 'and 'or) ,only-condition) (iter2--do-macroexpand only-condition)) + (`(cond) nil) + (`(cond (,only-condition)) (iter2--do-macroexpand only-condition)) + (`(cond (,only-condition . ,body)) `(if ,only-condition ,(macroexp-progn body))) + (`(,(or 'let 'let*) () . ,let-body) (setq body (append (cdr let-body) body)) (iter2--do-macroexpand (car let-body))) + (`(,(or 'progn 'inline)) nil) + (`(,(or 'progn 'inline 'prog1) ,only-form) (iter2--do-macroexpand only-form)) + (`(,(or 'progn 'inline) ,first . ,others) (setq body (append others body)) (iter2--do-macroexpand first)) + (`(prog1 ,value . ,rest) (if body + ;; This value is not going to be used anyway, + ;; so just inline this into `body'. + (progn (setq body (append rest body)) (iter2--do-macroexpand value)) + ;; Do nothing. + form)) + (`(prog2 ,first ,second . ,others) `(prog1 (progn ,first ,second) ,@others)) + (`(unwind-protect ,body-form) (iter2--do-macroexpand body-form)) + (`(condition-case ,_ ,body-form) (iter2--do-macroexpand body-form)) + (_ form)))) + (if (eq form rewritten-form) + nil + (setq form rewritten-form)))) + (pcase form + + ;; Handle nested lambdas; optionally check them for yields. + (`(function (lambda ,_lambda-args . ,lambda-body)) + ;; Could write a faster function here, but probably not performance-critical. + (when (and iter2-detect-nested-lambda-yields (cdr (iter2--convert-progn lambda-body))) + (error "Nested anonymous function %S yields, which will fail at runtime" (cadr form))) + (push form converted)) + + ;; Handle quoting ('_ and #'_): just pass it through. + (`(,(or 'quote 'function) ,_) + (push form converted)) + + ;; Handle (and CONDITIONS...) and (or CONDITIONS...). + (`(,(and (or 'and 'or) operator) . ,conditions) + (let (plain-conditions) + (while conditions + (let* ((converted-condition (iter2--convert-form (pop conditions))) + (converted-condition-form (car converted-condition))) + (if (cdr converted-condition) + (progn + (if conditions + (let ((converted-continuation (iter2--convert-form `(,operator ,(cdr converted-condition) ,@conditions)))) + (setq converted-condition-form `(progn ,(iter2--continuation-adding-form (list (iter2--merge-continuation-form converted-continuation))) + ,@(macroexp-unprogn converted-condition-form)))) + (setq converted-condition-form (iter2--merge-continuation-form converted-condition))) + (when plain-conditions + (setq converted-condition-form `(,operator ,@(nreverse plain-conditions) ,converted-condition-form))) + (iter2--add-converted-form converted converted-condition-form) + (setq can-yield t + conditions nil)) + (push converted-condition-form plain-conditions)))) + (unless can-yield + (push `(,operator ,@(nreverse plain-conditions)) converted)))) + + ;; Handle (if CONDITION THEN [ELSE...]). + (`(if ,condition ,then . ,else) + (let ((converted-condition (iter2--convert-form condition)) + (converted-then (iter2--convert-form then)) + (converted-else (iter2--convert-progn else))) + (if (cdr converted-condition) + (progn (iter2--add-converted-form converted (car converted-condition)) + (iter2--finish-chunk converted-chunks converted + `(if ,(cdr converted-condition) + ,(iter2--merge-continuation-form converted-then) + ,@(when else (macroexp-unprogn (iter2--merge-continuation-form converted-else)))))) + (push `(if ,(car converted-condition) + ,(iter2--merge-continuation-form converted-then) + ,@(when else (macroexp-unprogn (iter2--merge-continuation-form converted-else)))) + converted)) + (setq can-yield (or (cdr converted-then) (cdr converted-else))))) + + ;; Handle (cond [CLAUSES...]). + (`(cond . ,clauses) + (let (converted-clauses + conditions-can-yield) + (while clauses + (let* ((clause (pop clauses)) + (converted-condition (iter2--convert-form (car clause))) + (converted-condition-form (car converted-condition)) + (clause-body (cdr clause))) + (if (cdr converted-condition) + (let ((converted-continuation (iter2--convert-form `(cond (,(cdr converted-condition) ,@clause-body) ,@clauses)))) + (setq converted-condition-form `(progn ,(iter2--continuation-adding-form (list (iter2--merge-continuation-form converted-continuation))) + ,@(macroexp-unprogn converted-condition-form))) + (when converted-clauses + (setq converted-condition-form `(cond ,@(nreverse converted-clauses) (t ,@(macroexp-unprogn converted-condition-form))))) + (iter2--add-converted-form converted converted-condition-form) + (setq conditions-can-yield t + clauses nil)) + (let ((converted-body (when clause-body (iter2--convert-progn clause-body)))) + (push `(,(car converted-condition) ,@(when clause-body (macroexp-unprogn (iter2--merge-continuation-form converted-body)))) + converted-clauses) + (when (cdr converted-body) + (setq can-yield t)))))) + (if conditions-can-yield + (setq can-yield t) + (push `(cond ,@(nreverse converted-clauses)) converted)))) + + ;; Handle (while CONDITION [WHILE-BODY...]). + (`(while ,condition . ,while-body) + (let* ((converted-condition (iter2--convert-form condition)) + (converted-while-body (when while-body (iter2--convert-progn while-body)))) + (if (or (cdr converted-condition) (cdr converted-while-body)) + ;; One special case is optimized: if there is no `while' body and the condition yields as + ;; its last operator. + (let ((special-empty-body (and (null while-body) (equal (cdr converted-condition) `(funcall ,iter2--value))))) + (when while-body + (setq converted-while-body (iter2--merge-continuation-form converted-while-body))) + (if (cdr converted-condition) + ;; Condition yields; whether body yields too is not relevant. + (let ((inner-form `(if ,(cdr converted-condition) + (progn (setq ,iter2--continuations (cons (car ,iter2--stack) ,iter2--continuations)) + ,@(macroexp-unprogn (if special-empty-body (car converted-condition) converted-while-body))) + (setq ,iter2--stack (cdr ,iter2--stack))))) + (push (iter2--continuation-adding-form (list (if special-empty-body + inner-form + `(progn ,(iter2--continuation-adding-form (list inner-form)) + ,@(macroexp-unprogn (car converted-condition))))) + iter2--stack) + converted)) + ;; Only body yields. + (push (iter2--continuation-adding-form (list `(if ,(car converted-condition) + (progn (setq ,iter2--continuations (cons (car ,iter2--stack) ,iter2--continuations)) + ,@(macroexp-unprogn converted-while-body)) + (setq ,iter2--stack (cdr ,iter2--stack)))) + iter2--stack) + converted)) + ;; Initial value is important in some cases, see above. + (push (iter2--continuation-invocation-form (when special-empty-body '(lambda () t)) `(car ,iter2--stack)) converted) + (setq can-yield t)) + ;; Nothing yields, the simplest case. + (push `(while ,(car converted-condition) ,@(when while-body (macroexp-unprogn (car converted-while-body)))) converted)))) + + ;; Handle (let (BINDINGS) LET-BODY) and (let* (BINDINGS) LET-BODY). + (`(,(and (or 'let 'let*) let-kind) ,bindings . ,let-body) + (let ((plain-let (eq let-kind 'let)) + converted-bindings + catcher-outer-bindings + catcher-inner-bindings + catcher-value-storing-forms + ;; The rest are unused for `let*'. + next-continuation-bindings + values-to-save-on-stack + (num-stack-values 0)) + (while bindings + (let* ((binding (pop bindings)) + var + value) + (pcase binding + ((pred symbolp) + (setq var binding)) + (`(,(and (pred symbolp) variable)) + (setq var variable)) + (`(,(and (pred symbolp) variable) ,value-form) + (setq var variable + value value-form)) + (_ + (error "Erroneous binding %S" binding))) + (let ((special (iter2--special-variable-p var)) + (literal (iter2--literalp value))) + (cond (literal + (push binding converted-bindings) + (when plain-let + (push binding next-continuation-bindings))) + ((eq value iter2--stack-state) + ;; This is our private internal flag that means "take a + ;; previously computed value from the stack". Stack is only + ;; used for plain `let', never for `let*'. + (push `(,var (pop ,iter2--stack)) converted-bindings) + (push `(,var ,iter2--stack-state) next-continuation-bindings) + (setq num-stack-values (1+ num-stack-values))) + (t + (let* ((converted-value (iter2--convert-form value)) + (converted-value-form (car converted-value))) + (if (cdr converted-value) + (progn (if (or plain-let (null converted-bindings)) + ;; Yielding before anything is bound. + (progn (when values-to-save-on-stack + (push (iter2--stack-adding-form (nreverse values-to-save-on-stack)) converted)) + (iter2--add-converted-form converted converted-value-form) + (iter2--finish-chunk converted-chunks converted + (iter2--merge-continuation-form (iter2--convert-form `(,let-kind (,@(nreverse next-continuation-bindings) + (,var ,(cdr converted-value)) + ,@bindings) + ,@let-body))))) + ;; We need to bind already converted values now. + (push (iter2--let*-yielding-form catcher-outer-bindings catcher-inner-bindings catcher-value-storing-forms + (iter2--merge-continuation-form (iter2--convert-form `(let* ((,var (funcall ,iter2--value)) ,@bindings) ,@let-body))) + (iter2--merge-continuation-form converted-value)) + converted)) + (setq bindings nil + can-yield t)) + (push `(,var ,converted-value-form) converted-bindings) + (when plain-let + (push `(,var ,iter2--stack-state) next-continuation-bindings) + (push converted-value-form values-to-save-on-stack)))))) + (if special + (let ((private-storage-var (make-symbol (format "$%s" (symbol-name var))))) + (push `(,private-storage-var ,(nth 1 (car converted-bindings))) catcher-outer-bindings) + (push `(,var ,private-storage-var) catcher-inner-bindings) + (push `(setq ,private-storage-var ,var) catcher-value-storing-forms)) + (push (car converted-bindings) catcher-outer-bindings)) + ;; This is a marker we use to separate bindings for different + ;; catchers for `let*'. + (when (and special (not plain-let)) + (push nil catcher-outer-bindings))))) + (unless can-yield + (when (> num-stack-values 1) + (push (iter2--stack-head-reversing-form num-stack-values) converted)) + (let* ((converted-let-body (iter2--convert-progn let-body)) + (converted-let-body-form (iter2--merge-continuation-form converted-let-body))) + (if (or (null (cdr converted-let-body)) (null catcher-inner-bindings)) + (progn (push `(,let-kind (,@(nreverse converted-bindings)) ,@(macroexp-unprogn converted-let-body-form)) converted) + (setq can-yield (cdr converted-let-body))) + ;; Let body yields and we have special (dynamic) bindings. + (push (if plain-let + `(let (,@(nreverse catcher-outer-bindings)) + ,(iter2--catcher-continuation-adding-form `(let (,@(nreverse catcher-inner-bindings)) + (prog1 (unwind-protect + ,(iter2--continuation-invocation-form iter2--value) + ,@(nreverse catcher-value-storing-forms)) + (unless (eq ,iter2--continuations ,iter2--done) + (push ,iter2--catcher ,iter2--continuations)))) + converted-let-body-form)) + (iter2--let*-yielding-form catcher-outer-bindings catcher-inner-bindings catcher-value-storing-forms converted-let-body-form)) + converted) + (setq can-yield t)))))) + + ;; Handle (prog1 VALUE [BODY...]). + (`(prog1 ,value . ,rest) + (let ((converted-value (iter2--convert-form value)) + (converted-rest (iter2--convert-progn rest))) + (if (or (cdr converted-value) (cdr converted-rest)) + (progn (when (cdr converted-value) + (iter2--add-converted-form converted (car converted-value)) + (iter2--finish-chunk converted-chunks converted)) + (if (cdr converted-rest) + (progn (push `(push ,(or (cdr converted-value) (car converted-value)) ,iter2--stack) converted) + (iter2--add-converted-form converted (car converted-rest)) + (iter2--finish-chunk converted-chunks converted + ;; See comments about `iter2-next' elsewhere. + `(pop ,iter2--stack) `(funcall ,iter2--value))) + (push `(prog1 ,(cdr converted-value) ,@rest) converted))) + (push `(prog1 ,(car converted-value) ,@(macroexp-unprogn (car converted-rest))) converted)))) + + ;; Handle (unwind-protect BODY-FORM CLEANUP-FORMS...). + (`(unwind-protect ,body-form . ,cleanup-forms) + (let ((converted-body-form (iter2--convert-form body-form)) + (converted-cleanup-forms (iter2--convert-progn cleanup-forms))) + (when (cdr converted-cleanup-forms) + (error "Yielding from cleanup forms in `unwind-protect' is not allowed: %S" cleanup-forms)) + (if (cdr converted-body-form) + (progn + (push `(setq ,iter2--cleanups (cons (lambda () ,@(macroexp-unprogn (car converted-cleanup-forms))) ,iter2--cleanups)) converted) + ;; No need to use private variable names as we don't include any user code. + (push (iter2--catcher-continuation-adding-form `(let (result) + (unwind-protect + (prog1 ,(iter2--continuation-invocation-form iter2--value) + (setq result (if (eq ,iter2--continuations ,iter2--done) ,iter2--yielding 'continuing))) + (if result + (push (if (eq result t) + ;; Completed body, but yielded. Clean up when control is regained. + (lambda (,iter2--value) ,(iter2--cleanup-invocation-body) (funcall ,iter2--value)) + ;; Continuing. Re-add self. + ,iter2--catcher) + ,iter2--continuations) + ;; Either exited non-locally, or completed body and haven't yielded. + ,(iter2--cleanup-invocation-body)))) + (iter2--merge-continuation-form converted-body-form)) + converted) + (setq can-yield t + iter2--cleanups-used t)) + (push `(unwind-protect ,(car converted-body-form) ,@(macroexp-unprogn (car converted-cleanup-forms))) converted)))) + + ;; Handle (catch TAG BODY). + (`(catch ,tag . ,catch-body) + (let* ((converted-tag (iter2--convert-form tag)) + (converted-tag-form (car converted-tag))) + (when (cdr converted-tag) + (iter2--add-converted-form converted converted-tag-form) + (iter2--finish-chunk converted-chunks converted) + (setq converted-tag-form (cdr converted-tag))) + (let ((converted-catch-body (iter2--convert-progn catch-body))) + (if (cdr converted-catch-body) + (let ((literal-tag (iter2--literalp converted-tag-form))) + ;; No need to use private variable names as we don't include any user code. + (push (iter2--catcher-continuation-adding-form `(let (completed-normally) + (prog1 (catch ,(if literal-tag converted-tag-form 'tag) + (prog1 ,(iter2--continuation-invocation-form iter2--value) + (setq completed-normally t) + (unless (eq ,iter2--continuations ,iter2--done) + (push ,iter2--catcher ,iter2--continuations)))) + (unless completed-normally + (setq ,iter2--continuations ,iter2--done + ,iter2--stack ,iter2--stack-state)))) + (iter2--merge-continuation-form converted-catch-body) + `(,iter2--stack-state ,iter2--stack) + (unless literal-tag `(tag ,converted-tag-form))) + converted) + (setq can-yield t)) + (push `(catch ,converted-tag-form ,@(macroexp-unprogn (car converted-catch-body))) converted))))) + + ;; Handle (condition-case VAR BODY-FORM HANDLERS...). + (`(condition-case ,var ,body-form . ,handlers) + (let ((converted-body (iter2--convert-form body-form)) + converted-handlers + success-handler) + (dolist (handler handlers) + (pcase handler + (`(,condition . ,handler-body) + (let* ((converted-handler (iter2--convert-progn handler-body)) + (converted-handler-form `(,condition ,@(macroexp-unprogn (iter2--merge-continuation-form converted-handler))))) + ;; Emacs 28 adds special handler called `:success' invoked when the main body doesn't + ;; signal. It has to be handled specially, but only if the body yields. + (if (and (eq condition :success) (cdr converted-body)) + (progn (when success-handler + (error "Duplicate special handler `:success' in %S" form)) + (setf success-handler converted-handler-form)) + (push converted-handler-form converted-handlers)) + (when (cdr converted-handler) + (setq can-yield t)))) + (_ + (error "Invalid `condition-case' error handler: %S" handler)))) + (setq converted-handlers (nreverse converted-handlers)) + (if (cdr converted-body) + (let (success-var + condition-case-body) + (if success-handler + (setf success-var (make-symbol "$success") + condition-case-body `(prog1 ,(iter2--continuation-invocation-form iter2--value) + (if (eq ,iter2--continuations ,iter2--done) + ;; The reason for `success-var' and not evaluating `success-handler' + ;; is not directly here is that it must not be placed inside + ;; `condition-case' so that it never triggers other handlers. + (setq ,success-var t) + (push ,iter2--catcher ,iter2--continuations)))) + (setf condition-case-body `(prog1 ,(iter2--continuation-invocation-form iter2--value) + (unless (eq ,iter2--continuations ,iter2--done) + (push ,iter2--catcher ,iter2--continuations))))) + (let ((condition-case-form condition-case-body)) + ;; This check may look strange, but if the only handler is `:success', `converted-handlers' will be nil. + (when converted-handlers + (setf condition-case-form `(condition-case ,var + ,condition-case-body + ,@(mapcar (lambda (handler) + `(,(car handler) + (setq ,iter2--continuations ,iter2--done ,iter2--stack ,iter2--stack-state) + ,@(cdr handler))) + converted-handlers)))) + (when success-handler + (let ((body-value-var (make-symbol "$body-value"))) + (setf condition-case-form `(let* (,success-var + (,body-value-var ,condition-case-form)) + (if ,success-var + ,(iter2--merge-continuation-form (cdr success-handler)) + ,body-value-var))))) + (push (iter2--catcher-continuation-adding-form condition-case-form + (iter2--merge-continuation-form converted-body) + `(,iter2--stack-state ,iter2--stack)) + converted)) + (setq can-yield t)) + (push `(condition-case ,var ,(car converted-body) ,@converted-handlers) converted)))) + + ;; Handle (iter-yield VALUE). + (`(iter-yield . ,rest) + (unless (and (consp rest) (null (cdr rest))) + (error "Form `iter-yield' must be used with exactly one argument: %S" form)) + (let* ((converted-value (iter2--convert-form (car rest))) + (converted-value-form (car converted-value))) + (when iter2-generate-tracing-functions + (setq converted-value-form `(let ((,iter2--value ,converted-value-form)) + (iter2--do-trace "yielding %S" ,iter2--value) + ,iter2--value))) + (when (cdr converted-value) + (iter2--add-converted-form converted converted-value-form) + (iter2--finish-chunk converted-chunks converted) + (setq converted-value-form (cdr converted-value))) + (if (iter2--literal-or-variable-p converted-value-form) + (progn (push `(setq ,iter2--yielding t) converted) + (push converted-value-form converted)) + ;; It might be unsafe to set yielding flag first: what if the value + ;; form exits non-locally? + (push `(prog1 ,converted-value-form (setq ,iter2--yielding t)) converted)) + (setq can-yield t))) + + ;; Handle `save-excursion'. + (`(save-excursion . ,body) + (let ((converted-body (iter2--convert-progn body))) + (if (cdr converted-body) + (progn (push (iter2--catcher-continuation-adding-form `(save-excursion + ;; Byte compiler gives a dumb warning here, + ;; suggesting to use `with-current-buffer'. + (with-no-warnings (set-buffer buffer)) + (goto-char point) + (prog1 ,(iter2--continuation-invocation-form iter2--value) + (unless (eq ,iter2--continuations ,iter2--done) + (setq buffer (current-buffer) + point (point)) + (push ,iter2--catcher ,iter2--continuations)))) + (iter2--merge-continuation-form converted-body) + '(buffer (current-buffer)) + '(point (point))) + converted) + (setq can-yield t)) + (push `(save-excursion ,@(macroexp-unprogn (car converted-body))) converted)))) + + ;; Handle `save-current-buffer'. + (`(save-current-buffer . ,body) + (let ((converted-body (iter2--convert-progn body))) + (if (cdr converted-body) + (progn (push (iter2--catcher-continuation-adding-form `(save-current-buffer + (set-buffer buffer) + (prog1 ,(iter2--continuation-invocation-form iter2--value) + (unless (eq ,iter2--continuations ,iter2--done) + (setq buffer (current-buffer)) + (push ,iter2--catcher ,iter2--continuations)))) + (iter2--merge-continuation-form converted-body) + '(buffer (current-buffer))) + converted) + (setq can-yield t)) + (push `(save-current-buffer ,@(macroexp-unprogn (car converted-body))) converted)))) + + ;; Handle `save-restriction'. + (`(save-restriction . ,body) + (let ((converted-body (iter2--convert-progn body))) + (if (cdr converted-body) + (progn (push (iter2--catcher-continuation-adding-form `(save-restriction + (narrow-to-region point-min point-max) + (prog1 ,(iter2--continuation-invocation-form iter2--value) + (unless (eq ,iter2--continuations ,iter2--done) + (setq point-min (point-min) + point-max (point-max)) + (push ,iter2--catcher ,iter2--continuations)))) + (iter2--merge-continuation-form converted-body) + '(point-min (point-min)) + '(point-max (point-max))) + converted) + (setq can-yield t)) + (push `(save-restriction ,@(macroexp-unprogn (car converted-body))) converted)))) + + ;; Handle `save-match-data' macro: not a special form, but without special + ;; handling doesn't produce intended results in generator functions. + (`(save-match-data . ,body) + (let ((converted-body (iter2--convert-progn body))) + (if (cdr converted-body) + (progn (push (iter2--catcher-continuation-adding-form `(save-match-data + (set-match-data match-data) + (prog1 ,(iter2--continuation-invocation-form iter2--value) + (unless (eq ,iter2--continuations ,iter2--done) + (match-data nil match-data) + (push ,iter2--catcher ,iter2--continuations)))) + (iter2--merge-continuation-form converted-body) + '(match-data (match-data))) + converted) + (setq can-yield t)) + (push `(save-match-data ,@(macroexp-unprogn (car converted-body))) converted)))) + + ;; Handle `with-no-warnings': while not a special form, it requires special handling. + (`(with-no-warnings . ,body) + (let ((converted-body (iter2--convert-progn body))) + (push `(with-no-warnings ,@(macroexp-unprogn (iter2--merge-continuation-form converted-body))) converted) + (setq can-yield (cdr converted-body)))) + + ;; Handle all other non-atomic forms. + (`(,name . ,arguments) + ;; Several special forms are handled more-or-less like function calls. + (when (and (special-form-p name) (not (memq name '(setq setq-default throw)))) + (error "Special form %S incorrect or not supported" form)) + (let (converted-arguments + next-continuation-arguments + arguments-to-save-on-stack + (num-stack-arguments 0)) + (while arguments + (let ((argument (pop arguments))) + (cond ((eq argument iter2--stack-state) + ;; This is our private internal flag that means "take a + ;; previously computed value from the stack". + (push `(pop ,iter2--stack) converted-arguments) + (push iter2--stack-state next-continuation-arguments) + (setq num-stack-arguments (1+ num-stack-arguments))) + ((or (iter2--literalp argument) (and (memq name '(setq setq-default)) (= (% (length converted-arguments) 2) 0))) + (push argument converted-arguments) + (push argument next-continuation-arguments)) + (t + (let ((converted-argument (iter2--convert-form argument))) + (if (cdr converted-argument) + (progn (when arguments-to-save-on-stack + (push (iter2--stack-adding-form (nreverse arguments-to-save-on-stack)) converted)) + (iter2--add-converted-form converted (car converted-argument)) + (push `(,name ,@(nreverse next-continuation-arguments) ,(cdr converted-argument) ,@arguments) body) + (setq arguments nil + can-yield t)) + (push (car converted-argument) converted-arguments) + (push iter2--stack-state next-continuation-arguments) + (push (car converted-argument) arguments-to-save-on-stack))))))) + (unless can-yield + (when (> num-stack-arguments 1) + (push (iter2--stack-head-reversing-form num-stack-arguments) converted)) + (push (cons name (nreverse converted-arguments)) converted)))) + + (_ + (push form converted))) + (when can-yield + (iter2--finish-chunk converted-chunks converted + ;; With the addition of `iter2-next', we need to resolve the incoming values + ;; (wrapped in lambdas), even if the result is unused. The reason is that + ;; the lambdas can exit nonlocally or have a side effect. This is not + ;; possible with `iter-next', because the lambdas in this case just return a + ;; precomputed value, see `iter2--identity-bind'. However, with `iter2-next' + ;; they can include arbitrary forms. + `(funcall ,iter2--value)) + (setq can-yield nil)))) + + (setq converted (nreverse converted)) + (if converted-chunks + (progn (setq converted-chunks (nreverse converted-chunks)) + (cons (if (cdr converted-chunks) + `(progn ,(iter2--continuation-adding-form (reverse (cdr converted-chunks))) + ,@(macroexp-unprogn (car converted-chunks))) + (car converted-chunks)) + (if converted (macroexp-progn converted) `(funcall ,iter2--value)))) + (cons (macroexp-progn converted) nil))))) + +(defun iter2--convert-form-tracer (function form) + (let ((result (funcall function form))) + (if (or (atom form) (null iter2-tracing-function)) + result + (let ((indentation (make-string (* iter2--converter-depth 4) ? )) + (iter2--converter-depth (1+ iter2--converter-depth))) + (funcall iter2-tracing-function "%s" (replace-regexp-in-string "^" indentation (format "FORM: %s" (iter2--pp-to-string form 60 6)) t t)) + (funcall iter2-tracing-function "%s" (replace-regexp-in-string "^" indentation (format "--->: %s\n+: %s" + (iter2--pp-to-string (car result) 60 6) + (iter2--pp-to-string (cdr result) 60 6)) + t t)) + result)))) + +(defun iter2--pp-to-string (object &optional max-single-line-length indent-by) + (let* ((print-quoted t) + (string (prin1-to-string object))) + (when (and max-single-line-length (> (length string) max-single-line-length)) + (setq string (string-trim-right (pp-to-string object)))) + (when (and indent-by (> indent-by 0)) + (setq string (replace-regexp-in-string "\n" (concat "\n" (make-string indent-by ? )) string t t))) + string)) + +(defun iter2--debug-converter (enable) + (if enable + (advice-add #'iter2--convert-form :around #'iter2--convert-form-tracer) + (advice-remove #'iter2--convert-form #'iter2--convert-form-tracer))) + +(defun iter2--continuation-invocation-form (value &optional lambda) + (if iter2-generate-tracing-functions + `(let ((function ,(or lambda `(pop ,iter2--continuations)))) + (iter2--do-trace "invoking %S with value %S" function ,value) + (let ((iter2--tracing-depth (1+ iter2--tracing-depth))) + (funcall function ,value))) + `(funcall ,(or lambda `(pop ,iter2--continuations)) ,value))) + +(defun iter2--cleanup-invocation-body () + (if iter2-generate-tracing-functions + `(let ((function (pop ,iter2--cleanups))) + (iter2--do-trace "cleaning up using %S" function) + (funcall function)) + `(funcall (pop ,iter2--cleanups)))) + +(defun iter2--merge-continuation-form (converted &optional var) + (let ((converted-form (car converted)) + (continuation-form (cdr converted))) + (if continuation-form + `(progn ,(iter2--continuation-adding-form (list continuation-form) var) ,@(macroexp-unprogn converted-form)) + converted-form))) + +(defun iter2--continuation-adding-form (new-continuations &optional var) + (let ((value (or var iter2--continuations))) + (while new-continuations + (let ((continuation (pop new-continuations))) + (setq value (if (equal continuation `(funcall ,iter2--value)) + ;; With the addition of `iter2-next', we often use a `(lambda (x) (funcall x))' to + ;; resolve incoming lambdas into values (for nonlocal exits and side effects), only + ;; then to ignore the result. This is really needed, but instead of creating tons of + ;; such lambdas, just use `funcall' directly: it is exactly the same here. + `(cons 'funcall ,value) + `(cons (lambda (,iter2--value) ,@(macroexp-unprogn continuation)) ,value))))) + `(setq ,(or var iter2--continuations) ,value))) + +(defun iter2--catcher-continuation-adding-form (catcher-body next-continuation &rest additional-catcher-outer-bindings) + `(setq ,iter2--continuations + (cons (let ((,iter2--done ,iter2--continuations) + ,@(delq nil additional-catcher-outer-bindings) + ,iter2--catcher) + (setq ,iter2--catcher (lambda (,iter2--value) ,@(macroexp-unprogn catcher-body)))) + (cons (lambda (,iter2--value) ,@(macroexp-unprogn next-continuation)) + ,iter2--continuations)))) + +(defun iter2--let*-yielding-form (catcher-outer-bindings catcher-inner-bindings catcher-value-storing-forms continuation &optional form-before-continuation) + (let (main-bindings) + (while (and catcher-outer-bindings (car catcher-outer-bindings)) + (push (pop catcher-outer-bindings) main-bindings)) + (setq catcher-outer-bindings (cdr catcher-outer-bindings)) + (let ((form `(,(iter2--continuation-adding-form (list continuation)) + ,@(when form-before-continuation (macroexp-unprogn form-before-continuation))))) + (setq form (if main-bindings `(let* (,@main-bindings) ,@form) `(progn ,@form))) + (while catcher-inner-bindings + (let (outer-bindings) + (while (and catcher-outer-bindings (car catcher-outer-bindings)) + (push (pop catcher-outer-bindings) outer-bindings)) + (setq catcher-outer-bindings (cdr catcher-outer-bindings)) + (setq form (iter2--catcher-continuation-adding-form `(let (,(pop catcher-inner-bindings)) + (prog1 (unwind-protect + ,(iter2--continuation-invocation-form iter2--value) + ,(pop catcher-value-storing-forms)) + (unless (eq ,iter2--continuations ,iter2--done) + (push ,iter2--catcher ,iter2--continuations)))) + form)) + (when outer-bindings + (setq form `(let* (,@outer-bindings) + ,form))))) + form))) + +(defun iter2--stack-adding-form (new-elements) + (let ((value iter2--stack)) + (while new-elements + (setq value `(cons ,(pop new-elements) ,value))) + `(setq ,iter2--stack ,value))) + +(defun iter2--stack-head-reversing-form (n) + (pcase n + (2 `(iter2--reverse-stack-head-2 ,iter2--stack)) + (3 `(iter2--reverse-stack-head-3 ,iter2--stack)) + (_ `(setq ,iter2--stack (iter2--reverse-stack-head-n ,iter2--stack ,(1- n)))))) + + +;; Internal helpers for generated functions. + +(defun iter2--do-clean-up (cleanups) + (if (cdr cleanups) + (unwind-protect + (funcall (car cleanups)) + (iter2--do-clean-up (cdr cleanups))) + (funcall (car cleanups)))) + +(defun iter2--reverse-stack-head-2 (stack) + (let ((x (car stack)) + (link-2 (cdr stack))) + (setcar stack (car link-2)) + (setcar link-2 x))) + +(defun iter2--reverse-stack-head-3 (stack) + (let ((x (car stack)) + (link-3 (cddr stack))) + (setcar stack (car link-3)) + (setcar link-3 x))) + +(defun iter2--reverse-stack-head-n (stack n-1) + (let* ((last-head-cons (nthcdr n-1 stack)) + (stack-tail (cdr last-head-cons))) + (setcdr last-head-cons nil) + (nconc (nreverse stack) stack-tail))) + +(defun iter2--do-trace (format-string &rest arguments) + (when iter2-tracing-function + (let ((print-level (if (eq iter2-tracing-print-level t) print-level iter2-tracing-print-level)) + (print-length (if (eq iter2-tracing-print-length t) print-length iter2-tracing-print-length))) + (apply iter2-tracing-function (concat "%siter2: " format-string) (cons (make-string (* iter2--tracing-depth 4) ? ) arguments))))) + + +(defun iter2-log-message (format-string &rest arguments) + "Like built-in `message', but only write to `*Messages*' buffer." + (let ((inhibit-message (or inhibit-message (not noninteractive)))) + (apply #'message format-string arguments))) + + +;; Make sure that we are still compatible with `generator'. I couldn't make it work like +;; I wanted with fewer `eval's. +(eval-after-load 'iter2 + (eval `(unless (let* ((it (funcall (iter2-lambda () (iter-yield 1))))) + (and (equal (iter-next it) 1) (condition-case error (progn (iter-next it 2) nil) (iter-end-of-sequence (equal (cdr error) 2))))) + (warn "Compatibility of `iter2' with `generator' package appears broken; please report this to maintainer (Emacs version: %s)" (emacs-version))) + t)) + +;; Issue a warning if compatibility is broken yet again. +(iter2--special-variable-p nil t) + + +;; Work around missing Edebug specification for `iter-do' macro on older Emacs versions. +(when (and (fboundp 'iter-do) (null (get 'iter-do 'edebug-form-spec))) + (put 'iter-do 'edebug-form-spec '((symbolp form) body))) + +;; Integrate into Imenu. +(add-to-list 'lisp-imenu-generic-expression + (list nil (concat "^\\s-*(iter2-defun\\s-+\\(" lisp-mode-symbol-regexp "\\)") 1)) + + +(provide 'iter2) + +;;; iter2.el ends here