From: Eshel Yaron <me@eshelyaron.com>
Date: Fri, 16 Aug 2024 13:55:32 +0000 (+0200)
Subject: (scope): Take callback argument instead of consing a list
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=314388354a6b622df438f3aed067bd37eddfd8ef;p=emacs.git

(scope): Take callback argument instead of consing a list
---

diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el
index 3b4530f46a6..fe9e4b7c37d 100644
--- a/lisp/emacs-lisp/scope.el
+++ b/lisp/emacs-lisp/scope.el
@@ -1,4 +1,4 @@
-;;; scope.el --- Scope analysis for Emacs Lisp  -*- lexical-binding: t; -*-
+;;; scope.el --- Analyze scope of Lisp symbols  -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 2024  Eshel Yaron
 
@@ -20,12 +20,7 @@
 
 ;;; Commentary:
 
-;; Scope analysis for Emacs Lisp.
-
-;;; Todo:
-
-;; - Fix handling of generalized variables.
-;; - Take callback argument instead of returning list.
+;; Symbol-scope analysis for Emacs Lisp.
 
 ;;; Code:
 
@@ -33,6 +28,8 @@
 
 (defvar scope-counter nil)
 
+(defvar scope-callback #'ignore)
+
 (defsubst scope-local-get (sym local)
   "Get binding position of symbol SYM in local context LOCAL."
   (alist-get sym local))
@@ -46,12 +43,17 @@ Optional argument LOCAL is a local context to extend."
 (defsubst scope-sym-pos (sym)
   (when (symbol-with-pos-p sym) (symbol-with-pos-pos sym)))
 
+(defsubst scope-sym-bare (sym)
+  (cond
+   ((symbolp sym) sym)
+   ((symbol-with-pos-p sym) (bare-symbol sym))))
+
 (defun scope-s (local sym)
   (let* ((beg (scope-sym-pos sym))
          (bare (bare-symbol sym))
          (len (length (symbol-name bare))))
     (unless (or (booleanp bare) (keywordp bare) (null beg))
-      (list (list beg len (scope-local-get bare local))))))
+      (funcall scope-callback 'variable beg len (scope-local-get bare local)))))
 
 (defun scope-let-1 (local0 local bindings body)
   (if bindings
@@ -60,11 +62,10 @@ Optional argument LOCAL is a local context to extend."
              (bare (bare-symbol sym))
              (len (length (symbol-name bare)))
              (beg (scope-sym-pos sym)))
-        (nconc
-         (when beg (list (list beg len beg)))
-         (scope-1 local0 (cadr binding))
-         (scope-let-1 local0 (scope-local-new bare beg local)
-                      (cdr bindings) body)))
+        (when beg (funcall scope-callback 'variable beg len beg))
+        (scope-1 local0 (cadr binding))
+        (scope-let-1 local0 (scope-local-new bare beg local)
+                     (cdr bindings) body))
     (scope-n local body)))
 
 (defun scope-let (local bindings body)
@@ -77,11 +78,10 @@ Optional argument LOCAL is a local context to extend."
              (bare (bare-symbol sym))
              (len (length (symbol-name bare)))
              (beg (scope-sym-pos sym)))
-        (nconc
-         (when beg (list (list beg len beg)))
-         (scope-1 local (cadr binding))
-         (scope-let*
-          (scope-local-new bare beg local) (cdr bindings) body)))
+        (when beg (funcall scope-callback 'variable beg len beg))
+        (scope-1 local (cadr binding))
+        (scope-let*
+         (scope-local-new bare beg local) (cdr bindings) body))
     (scope-n local body)))
 
 (defun scope-if-let* (local bindings body)
@@ -93,22 +93,24 @@ Optional argument LOCAL is a local context to extend."
                 (let* ((sym (car binding))
                        (bare (bare-symbol sym))
                        (beg (scope-sym-pos sym)))
-                  (nconc
-                   (when beg (list (list beg (length (symbol-name bare)) beg)))
-                   (scope-1 local (cadr binding))
-                   (scope-if-let* (scope-local-new bare beg local)
-                                  (cdr bindings) body)))
+                  (when beg
+                    (funcall scope-callback 'variable
+                             beg (length (symbol-name bare)) beg))
+                  (scope-1 local (cadr binding))
+                  (scope-if-let* (scope-local-new bare beg local)
+                                 (cdr bindings) body))
               ;; BINDING is (VALUEFORM).
-              (nconc (scope-1 local (car binding))
-                     (scope-if-let* local (cdr bindings) body)))
+              (scope-1 local (car binding))
+              (scope-if-let* local (cdr bindings) body))
           ;; BINDING is just SYMBOL.
           (let* ((sym binding)
                  (bare (bare-symbol sym))
                  (beg (scope-sym-pos sym)))
-            (nconc
-             (when beg (list (list beg (length (symbol-name bare)) beg)))
-             (scope-if-let* (scope-local-new bare beg local)
-                            (cdr bindings) body)))))
+            (when beg
+              (funcall scope-callback 'variable
+                       beg (length (symbol-name bare)) beg))
+            (scope-if-let* (scope-local-new bare beg local)
+                           (cdr bindings) body))))
     (scope-n local body)))
 
 (defun scope-if-let (local bindings body)
@@ -142,293 +144,55 @@ Optional argument LOCAL is a local context to extend."
                (eq (bare-symbol (caar body)) 'interactive))
       (setq int-spec (cadar body))
       (setq body (cdr body)))
-    (nconc
-     (seq-keep (lambda (arg)
-                 (and (symbol-with-pos-p arg)
-                      (not (memq (bare-symbol arg) '(&optional &rest _)))
-                      (let* ((beg (symbol-with-pos-pos arg))
-                             (bare (bare-symbol arg))
-                             (len (length (symbol-name bare))))
-                        (list beg len beg))))
-               args)
-     (scope-1 local doc-form)
-     (scope-1 local int-spec)
-     (let ((l local))
-       (dolist (arg args)
-         (when-let ((bare (bare-symbol arg))
-                    (beg (scope-sym-pos arg)))
-           (unless (memq bare '(&optional &rest))
-             (setq l (scope-local-new bare beg l)))))
-       (scope-n l body)))))
-
-(defun scope-defun (local _name args body) (scope-lambda local args body))
-
-;; (defun scope-defmethod-1 (local0 local name args body)
-;;   (if args
-;;       (let ((arg (car args)))
-;;         (cond
-;;          ((consp arg)
-;;           (let ((var (car arg))
-;;                 (spec (cadr arg)))
-;;             (cond
-;;              ((symbol-with-pos-p var)
-;;               (let* ((beg (symbol-with-pos-pos var))
-;;                      (bare (bare-symbol var))
-;;                      (len (length (symbol-name bare))))
-;;                 (cons
-;;                  (list beg len beg)
-;;                  (nconc
-;;                   (cond
-;;                    ((consp spec)
-;;                     (let ((head (car spec))
-;;                           (form (cadr spec)))
-;;                       (and (symbol-with-pos-p head)
-;;                            (eq 'eql (bare-symbol head))
-;;                            (not (or (symbolp form) (symbol-with-pos-p form)))
-;;                            (scope-1 local0 form)))))
-;;                   (scope-defmethod-1 local0 (scope-local-new bare beg local) name (cdr args) body)))))
-;;              ((consp var)
-;;               ;; VAR is (&key (VAR INIT SVAR)) or (&key VAR).
-;;               (let ((var (cadr var)))
-;;                 (cond
-;;                  ((symbol-with-pos-p var)
-;;                   (let* ((beg (symbol-with-pos-pos var))
-;;                          (bare (bare-symbol var))
-;;                          (len (length (symbol-name bare))))
-;;                     (cons
-;;                      (list beg len beg)
-;;                      (nconc
-;;                       (cond
-;;                        ((consp spec)
-;;                         (let ((head (car spec))
-;;                               (form (cadr spec)))
-;;                           (and (symbol-with-pos-p head)
-;;                                (eq 'eql (bare-symbol head))
-;;                                (not (or (symbolp form) (symbol-with-pos-p form)))
-;;                                (scope-1 local0 form)))))
-;;                       (scope-defmethod-1 local0 (scope-local-new bare beg local) name (cdr args) body)))))
-;;                  ((consp var)
-;;                   (let* ((init (cadr var))
-;;                          (svar (caddr var))
-;;                          (var (car var))
-;;                          (beg (symbol-with-pos-pos var))
-;;                          (bare (bare-symbol var))
-;;                          (len (length (symbol-name bare))))
-;;                     (cons
-;;                      (list beg len beg)
-;;                      (nconc
-;;                       (scope-1 local0 init)
-;;                       (when svar
-;;                         (let ((sbeg (symbol-with-pos-pos svar)))
-;;                           (list (list sbeg (length (symbol-name (bare-symbol svar)))
-;;                                       sbeg))))
-;;                       (scope-defmethod-1
-;;                        local0
-;;                        (scope-local-new bare beg
-;;                                         (if svar
-;;                                             (scope-local-new (bare-symbol svar)
-;;                                                              (symbol-with-pos-pos svar)
-;;                                                              local)
-;;                                           local))
-;;                        name (cdr args) body)))))))))))
-;;          ((symbol-with-pos-p arg)
-;;           (cond
-;;            ((memq (bare-symbol arg) '(&optional &rest &body _))
-;;             (scope-defmethod-1 local0 local name (cdr args) body))
-;;            ((eq (bare-symbol arg) '&context)
-;;             (let* ((expr-type (cadr args))
-;;                    (expr (car expr-type))
-;;                    (type (cadr expr-type))
-;;                    (more (cddr args)))
-;;               (nconc
-;;                (scope-1 local0 expr)
-;;                (cond
-;;                 ((consp type)
-;;                  (let ((head (car type))
-;;                        (form (cadr type)))
-;;                    (and (symbol-with-pos-p head)
-;;                         (eq 'eql (bare-symbol head))
-;;                         (not (or (symbolp form) (symbol-with-pos-p form)))
-;;                         (scope-1 local0 form)))))
-;;                (scope-defmethod-1 local0 local name more body))))
-;;            (t
-;;             (let* ((beg (symbol-with-pos-pos arg))
-;;                    (bare (bare-symbol arg))
-;;                    (len (length (symbol-name bare))))
-;;               (cons
-;;                (list beg len beg)
-;;                (scope-defmethod-1 local0 (scope-local-new bare beg local)
-;;                                   name (cdr args) body))))))))
-;;     (scope-n local body)))
-
-;; (defun scope-defmethod (local name rest)
-;;   (when (and (symbol-with-pos-p (car rest))
-;;              (eq (bare-symbol (car rest)) :extra))
-;;     (setq rest (cddr rest)))
-;;   (when (and (symbol-with-pos-p (car rest))
-;;              (memq (bare-symbol (car rest)) '(:before :after :around)))
-;;     (setq rest (cdr rest)))
-;;   (scope-defmethod-1 local local name (car rest)
-;;                      (if (stringp (cadr rest)) (cddr rest) (cdr rest))))
-
-;; (defun scope-defgeneric-2 (local name args body)
-;;   (cond
-;;    ((and (consp (car body)) (symbol-with-pos-p (caar body))
-;;          (memq (bare-symbol (caar body))
-;;                '(declare :documentation :argument-precedence-order)))
-;;     (scope-defgeneric-1 local name args (cdr body)))
-;;    ((and (consp (car body)) (symbol-with-pos-p (caar body))
-;;          (eq (bare-symbol (caar body)) :method))
-;;     (nconc
-;;      (scope-defmethod local nil (cdar body))
-;;      (scope-defgeneric-1 local name args (cdr body))))
-;;    ;; FIXME: `args' may include `&key', so defun is not a perfect match.
-;;    (t (scope-defun local name args body))))
-
-;; (defun scope-defgeneric-1 (local name args body)
-;;   (cond
-;;    ((and (consp (car body)) (symbol-with-pos-p (caar body))
-;;          (memq (bare-symbol (caar body))
-;;                '(declare :documentation :argument-precedence-order)))
-;;     (scope-defgeneric-1 local name args (cdr body)))
-;;    ((and (consp (car body)) (symbol-with-pos-p (caar body))
-;;          (eq (bare-symbol (caar body)) :method))
-;;     (nconc
-;;      (scope-defmethod local nil (cdar body))
-;;      (scope-defgeneric-1 local name args (cdr body))))
-;;    (t (scope-defgeneric-2 local name args body))))
-
-;; (defun scope-defgeneric (local name args body)
-;;   (when (stringp (car body)) (setq body (cdr body)))
-;;   (scope-defgeneric-1 local name args body))
+    (dolist (arg args)
+      (and (symbol-with-pos-p arg)
+           (not (memq (bare-symbol arg) '(&optional &rest _)))
+           (let* ((beg (symbol-with-pos-pos arg))
+                  (bare (bare-symbol arg))
+                  (len (length (symbol-name bare))))
+             (when beg (funcall scope-callback 'variable beg len beg)))))
+    (scope-1 local doc-form)
+    (scope-1 local int-spec)
+    (let ((l local))
+      (dolist (arg args)
+        (when-let ((bare (bare-symbol arg))
+                   (beg (scope-sym-pos arg)))
+          (unless (memq bare '(&optional &rest))
+            (setq l (scope-local-new bare beg l)))))
+      (scope-n l body))))
+
+(defun scope-defun (local name args body)
+  (when-let ((beg (scope-sym-pos name))
+             (bare (scope-sym-bare name)))
+    (funcall scope-callback 'defun beg (length (symbol-name bare)) nil))
+  (scope-lambda local args body))
 
 (defun scope-cond (local clauses)
-  (let ((res nil))
-    (dolist (clause clauses)
-      (setq res (nconc (scope-n local clause) res)))
-    res))
+  (dolist (clause clauses) (scope-n local clause)))
 
 (defun scope-setq (local args)
-  (when args
-    (let ((var (car args)) (val (cadr args)))
-      (nconc (when (symbol-with-pos-p var) (scope-s local var))
-             (scope-1 local val)
-             (scope-setq local (cddr args))))))
-
-(defun scope-defvar (local _sym init) (scope-1 local init))
-
-(defun scope-condition-case-handlers (local handlers)
-  (when handlers
-    (nconc
-     (scope-n local (cdar handlers))
-     (scope-condition-case-handlers local (cdr handlers)))))
+  (let ((var nil) (val nil))
+    (while args
+      (setq var  (car  args)
+            val  (cadr args)
+            args (cddr args))
+      (scope-s local var)
+      (scope-1 local val))))
+
+(defun scope-defvar (local name init)
+  (when-let ((beg (scope-sym-pos name))
+             (bare (scope-sym-bare name)))
+    (funcall scope-callback 'defvar beg (length (symbol-name bare)) nil))
+  (scope-1 local init))
 
 (defun scope-condition-case (local var bodyform handlers)
   (let* ((bare (bare-symbol var))
          (beg (when (symbol-with-pos-p var) (symbol-with-pos-pos var)))
-         (l (scope-local-new (bare-symbol var) beg local)))
-    (nconc
-     (when beg (list (list beg (length (symbol-name bare)) beg)))
-     (scope-1 local bodyform)
-     (scope-condition-case-handlers l handlers))))
-
-;; (defun scope-dotimes (local var lst res body)
-;;   (cons
-;;    (let* ((beg (symbol-with-pos-pos var))
-;;           (bare (bare-symbol var)))
-;;      (list beg (length (symbol-name bare)) beg))
-;;    (nconc
-;;     (scope-1 local lst)
-;;     (scope-1 local res)
-;;     (let ((l (scope-local-new (bare-symbol var) (symbol-with-pos-pos var) local)))
-;;       (scope-n l body)))))
-
-;; (defun scope-pcase-qpat (local qpat)
-;;   (cond
-;;    ((consp qpat)
-;;     (if (eq (car qpat) '\,) (scope-pcase-pattern local (cadr qpat))
-;;       (let* ((l-r0 (scope-pcase-qpat local (car qpat)))
-;;              (l (car l-r0))
-;;              (r0 (cdr l-r0))
-;;              (l-r (scope-pcase-qpat l (cdr qpat))))
-;;         (cons (car l-r) (nconc r0 (cdr l-r))))))
-;;    ;; FIXME: Support vector qpats.
-;;    (t (list local))))
-
-;; (defun scope-pcase-and (local patterns)
-;;   (if patterns
-;;       (let* ((l-r0 (scope-pcase-pattern local (car patterns)))
-;;              (l (car l-r0))
-;;              (r0 (cdr l-r0))
-;;              (l-r (scope-pcase-and l (cdr patterns))))
-;;         (cons (car l-r) (nconc r0 (cdr l-r))))
-;;     (list local)))
-
-;; (defun scope-pcase-pattern (local pattern)
-;;   (cond
-;;    ((symbol-with-pos-p pattern)
-;;     (let ((bare (bare-symbol pattern)))
-;;       (if (or (eq bare '_) (keywordp bare)) (list local)
-;;         ;; FIXME: Keep track of symbols bound here and analyze
-;;         ;; subsequent symbol patterns with the same symbol as equality
-;;         ;; tests, not new bindings.
-;;         (let* ((beg (symbol-with-pos-pos pattern)))
-;;           (cons (scope-local-new bare beg local)
-;;                 (list (list beg (length (symbol-name bare)) beg)))))))
-;;    ((consp pattern)
-;;     (let ((head (car pattern)))
-;;       (cond
-;;        ((eq head '\`)
-;;         (scope-pcase-qpat local (cadr pattern)))
-;;        ((eq head 'quote) (list local))
-;;        ((symbol-with-pos-p head)
-;;         (let ((bh (bare-symbol head)))
-;;           (cond
-;;            ((eq bh 'pred)
-;;             ;; FIXME: Analyze FUN at (cadr pattern).
-;;             (list local))
-;;            ((eq bh 'app)
-;;             ;; FIXME: Likewise here.
-;;             (scope-pcase-pattern local (caddr pattern)))
-;;            ((eq bh 'guard) (cons local (scope-1 local (cadr pattern))))
-;;            ((eq bh 'cl-type) (list local))
-;;            ((eq bh 'let)
-;;             (let ((r0 (scope-1 local (caddr pattern)))
-;;                   (l-r (scope-pcase-pattern local (cadr pattern))))
-;;               (cons (car l-r) (nconc r0 (cdr l-r)))))
-;;            ((eq bh 'and) (scope-pcase-and local (cdr pattern)))
-;;            ((eq bh 'or)
-;;             ;; FIXME: `or' patterns deserve special handling because
-;;             ;; they can create multiple binding positions for the same
-;;             ;; symbol in different subpatterns, and the effective
-;;             ;; binding position can only be determined at run time.
-;;             (scope-pcase-and local (cdr pattern)))))))))
-;;    ((or (integerp pattern) (stringp pattern)) (list local))))
-
-;; (defun scope-pcase-1 (local pattern body)
-;;   (let* ((l-r (scope-pcase-pattern local pattern))
-;;          (l (car l-r))
-;;          (r (cdr l-r)))
-;;     (when l (nconc r (scope-n l body)))))
-
-;; (defun scope-pcase (local exp cases)
-;;   (nconc
-;;    (scope-1 local exp)
-;;    (mapcan
-;;     (lambda (case)
-;;       (scope-pcase-1 local (car case) (cdr case)))
-;;     cases)))
-
-;; (defun scope-push (local new place)
-;;   (nconc (scope-1 local new) (scope-1 local place)))
-
-;; (defun scope-minibuffer-with-setup-hook (local fun body)
-;;   (nconc
-;;    (scope-1 local (if (and (symbol-with-pos-p (car-safe fun))
-;;                            (eq :append (bare-symbol (car-safe fun))))
-;;                       (cadr fun)
-;;                     fun))
-;;    (scope-n local body)))
+         (l (scope-local-new bare beg local)))
+    (when beg
+      (funcall scope-callback 'variable beg (length (symbol-name bare)) beg))
+    (scope-1 local bodyform)
+    (dolist (handler handlers) (scope-n l (cdr handler)))))
 
 (defun scope--backquote (local elements depth)
   (cond
@@ -439,8 +203,8 @@ Optional argument LOCAL is a local context to extend."
       (scope--backquote local (cdr elements) (1- depth)))
      ((eq (car elements) '\`)
       (scope--backquote local (cdr elements) (1+ depth)))
-     (t (nconc (scope--backquote local (car elements) depth)
-               (scope--backquote local (cdr elements) depth)))))
+     (t (scope--backquote local (car elements) depth)
+        (scope--backquote local (cdr elements) depth))))
    ((vectorp elements)
     (scope--backquote local (append elements nil) depth))))
 
@@ -456,15 +220,15 @@ Optional argument LOCAL is a local context to extend."
              (exps (cdr def))
              (beg (scope-sym-pos func))
              (bare (bare-symbol func)))
-        (nconc
-         (when beg (list (list beg  (length (symbol-name bare)) beg)))
-         (if (cdr exps)
-             ;; def is (FUNC ARGLIST BODY...)
-             (scope-lambda local (car exps) (cdr exps))
-           ;; def is (FUNC EXP)
-           (scope-1 local (car exps)))
-         (let ((scope-flet-alist (scope-local-new bare beg scope-flet-alist)))
-           (scope-flet local (cdr defs) body))))
+        (when beg
+          (funcall scope-callback 'function beg (length (symbol-name bare)) beg))
+        (if (cdr exps)
+            ;; def is (FUNC ARGLIST BODY...)
+            (scope-lambda local (car exps) (cdr exps))
+          ;; def is (FUNC EXP)
+          (scope-1 local (car exps)))
+        (let ((scope-flet-alist (scope-local-new bare beg scope-flet-alist)))
+          (scope-flet local (cdr defs) body)))
     (scope-n local body)))
 
 (defun scope-labels (local defs forms)
@@ -475,11 +239,11 @@ Optional argument LOCAL is a local context to extend."
              (body (cddr def))
              (beg (scope-sym-pos func))
              (bare (bare-symbol func)))
+        (when beg
+          (funcall scope-callback 'function beg (length (symbol-name bare)) beg))
         (let ((scope-flet-alist (scope-local-new bare beg scope-flet-alist)))
-          (nconc
-           (when beg (list (list beg (length (symbol-name bare)) beg)))
-           (scope-lambda local args body)
-           (scope-flet local (cdr defs) forms))))
+          (scope-lambda local args body)
+          (scope-flet local (cdr defs) forms)))
     (scope-n local forms)))
 
 (defvar scope-block-alist nil)
@@ -488,19 +252,18 @@ Optional argument LOCAL is a local context to extend."
   (if name
       (let* ((beg (scope-sym-pos name))
              (bare (bare-symbol name)))
-        (nconc
-         (when beg (list (list beg (length (symbol-name bare)) beg)))
-         (let ((scope-block-alist (scope-local-new bare beg scope-block-alist)))
-           (scope-n local body))))
+        (when beg
+          (funcall scope-callback 'block beg (length (symbol-name bare)) beg))
+        (let ((scope-block-alist (scope-local-new bare beg scope-block-alist)))
+          (scope-n local body)))
     (scope-n local body)))
 
 (defun scope-return-from (local name result)
-  (if-let ((bare (and (symbol-with-pos-p name) (bare-symbol name)))
-           (pos (alist-get bare scope-block-alist)))
-      (cons
-       (list (symbol-with-pos-pos name) (length (symbol-name bare)) pos)
-       (scope-1 local result))
-    (scope-1 local result)))
+  (when-let ((bare (and (symbol-with-pos-p name) (bare-symbol name)))
+             (pos (alist-get bare scope-block-alist)))
+    (funcall scope-callback 'block
+             (symbol-with-pos-pos name) (length (symbol-name bare)) pos))
+  (scope-1 local result))
 
 (defun scope-sharpquote (local arg)
   (cond
@@ -508,268 +271,15 @@ Optional argument LOCAL is a local context to extend."
     (let ((bare (bare-symbol arg))
           (beg (scope-sym-pos arg)))
       (cond
-       ((functionp bare) (when beg (list (list beg (length (symbol-name bare)) 'function))))
+       ((functionp bare)
+        (when beg
+          (funcall scope-callback 'function beg (length (symbol-name bare)) nil)))
        ((or (assq bare scope-flet-alist) (consp arg))
         (scope-1 local arg)))))
    ((consp arg) (scope-1 local arg))))
 
-;; (defun scope-cl-defun-aux (local name args body)
-;;   (if args
-;;       (let ((arg (car args)))
-;;         (cond
-;;          ((symbol-with-pos-p arg)
-;;           (let* ((beg (symbol-with-pos-pos arg))
-;;                  (bare (bare-symbol arg))
-;;                  (len (length (symbol-name bare))))
-;;             (cons
-;;              (list beg len beg)
-;;              (scope-cl-defun-aux (scope-local-new bare beg local)
-;;                                  name (cdr args) body))))
-;;          ((consp arg)
-;;           (let* ((var (car arg))
-;;                  (init (cadr arg))
-;;                  (beg (symbol-with-pos-pos var))
-;;                  (bare (bare-symbol var))
-;;                  (len (length (symbol-name bare))))
-;;             (cons
-;;              (list beg len beg)
-;;              (nconc
-;;               (scope-1 local init)
-;;               (scope-cl-defun-aux (scope-local-new bare beg local)
-;;                                   name (cdr args) body)))))))
-;;     (scope-n local body)))
-
-;; (defun scope-cl-defun-key (local name args body)
-;;   (if args
-;;       (let ((arg (car args)))
-;;         (cond
-;;          ((symbol-with-pos-p arg)
-;;           (cond
-;;            ((eq (bare-symbol arg) '&allow-other-keys)
-;;             (if (cdr args)
-;;                 (scope-cl-defun-aux local name (cddr args) body)
-;;               (scope-n local body)))
-;;            ((eq (bare-symbol arg) '&aux)
-;;             (scope-cl-defun-aux local name (cdr args) body))
-;;            (t (let* ((beg (symbol-with-pos-pos arg))
-;;                      (bare (bare-symbol arg))
-;;                      (len (length (symbol-name bare))))
-;;                 (cons
-;;                  (list beg len beg)
-;;                  (scope-cl-defun-key (scope-local-new bare beg local)
-;;                                      name (cdr args) body))))))
-;;          ((consp arg)
-;;           (let* ((var (car arg))
-;;                  (var (if (consp var) (cadr var) var))
-;;                  (init (cadr arg))
-;;                  (svar (caddr arg))
-;;                  (beg (symbol-with-pos-pos var))
-;;                  (bare (bare-symbol var))
-;;                  (len (length (symbol-name bare))))
-;;             (cons
-;;              (list beg len beg)
-;;              (nconc
-;;               (scope-1 local init)
-;;               (when svar
-;;                 (let ((sbeg (symbol-with-pos-pos svar)))
-;;                   (list (list sbeg (length (symbol-name (bare-symbol svar)))
-;;                               sbeg))))
-;;               (scope-cl-defun-key
-;;                (scope-local-new bare beg
-;;                                 (if svar
-;;                                     (scope-local-new (bare-symbol svar)
-;;                                                      (symbol-with-pos-pos svar)
-;;                                                      local)
-;;                                   local))
-;;                name (cdr args) body)))))))
-;;     (scope-n local body)))
-
-;; (defun scope-cl-defun-rest (local name args body)
-;;   (let* ((var (car args))
-;;          (beg (symbol-with-pos-pos var))
-;;          (bare (bare-symbol var))
-;;          (len (length (symbol-name bare)))
-;;          (l (scope-local-new bare beg local)))
-;;     (cons
-;;      (list beg len beg)
-;;      (if (cdr args)
-;;          (let ((next (cadr args))
-;;                (more (cddr args)))
-;;            (cond
-;;             ((eq (bare-symbol next) '&key)
-;;              (scope-cl-defun-key l name more body))
-;;             ((eq (bare-symbol next) '&aux)
-;;              (scope-cl-defun-aux l name more body))))
-;;        (scope-n l body)))))
-
-;; (defun scope-cl-defun-optional (local name args body)
-;;   (if args
-;;       (let ((arg (car args)))
-;;         (cond
-;;          ((symbol-with-pos-p arg)
-;;           (cond
-;;            ((memq (bare-symbol arg) '(&rest &body))
-;;             (scope-cl-defun-rest local name (cdr args) body))
-;;            ((eq (bare-symbol arg) '&key)
-;;             (scope-cl-defun-key local name (cdr args) body))
-;;            ((eq (bare-symbol arg) '&aux)
-;;             (scope-cl-defun-aux local name (cdr args) body))
-;;            (t (let* ((beg (symbol-with-pos-pos arg))
-;;                      (bare (bare-symbol arg))
-;;                      (len (length (symbol-name bare))))
-;;                 (cons
-;;                  (list beg len beg)
-;;                  (scope-cl-defun-optional (scope-local-new bare beg local)
-;;                                           name (cdr args) body))))))
-;;          ((consp arg)
-;;           (let* ((var (car arg))
-;;                  (init (cadr arg))
-;;                  (svar (caddr arg))
-;;                  (beg (symbol-with-pos-pos var))
-;;                  (bare (bare-symbol var))
-;;                  (len (length (symbol-name bare))))
-;;             (cons
-;;              (list beg len beg)
-;;              (nconc
-;;               (scope-1 local init)
-;;               (when svar
-;;                 (let ((sbeg (symbol-with-pos-pos svar)))
-;;                   (list (list sbeg (length (symbol-name (bare-symbol svar)))
-;;                               sbeg))))
-;;               (scope-cl-defun-optional
-;;                (scope-local-new bare beg
-;;                                 (if svar
-;;                                     (scope-local-new (bare-symbol svar)
-;;                                                      (symbol-with-pos-pos svar)
-;;                                                      local)
-;;                                   local))
-;;                name (cdr args) body)))))))
-;;     (scope-n local body)))
-
-;; (defun scope-cl-defun-1 (local name args body)
-;;   (if args
-;;       (let ((arg (car args)))
-;;         (cond
-;;          ((eq (bare-symbol arg) '&optional)
-;;           (scope-cl-defun-optional local name (cdr args) body))
-;;          ((memq (bare-symbol arg) '(&rest &body))
-;;           (scope-cl-defun-rest local name (cdr args) body))
-;;          ((eq (bare-symbol arg) '&key)
-;;           (scope-cl-defun-key local name (cdr args) body))
-;;          ((eq (bare-symbol arg) '&aux)
-;;           (scope-cl-defun-aux local name (cdr args) body))
-;;          (t (let* ((beg (symbol-with-pos-pos arg))
-;;                    (bare (bare-symbol arg))
-;;                    (len (length (symbol-name bare))))
-;;               (cons
-;;                (list beg len beg)
-;;                (scope-cl-defun-1 (scope-local-new (bare-symbol arg)
-;;                                                   (symbol-with-pos-pos arg)
-;;                                        local)
-;;                                  name (cdr args) body))))))
-;;     (scope-n local body)))
-
-;; (defun scope-cl-defun (local name args body)
-;;   (scope-cl-defun-1 local name args (if (stringp (car body)) (cdr body) body)))
-
-;; (defun scope-seq-let (local args sequence body)
-;;   (nconc
-;;    (scope-1 local sequence)
-;;    (mapcar (lambda (arg)
-;;              (let* ((beg (symbol-with-pos-pos arg))
-;;                     (bare (bare-symbol arg))
-;;                     (len (length (symbol-name bare))))
-;;                (list beg len beg)))
-;;            args)
-;;    (let ((l local))
-;;      (dolist (arg args)
-;;        (when (and (symbol-with-pos-p arg) (not (memq (bare-symbol arg) '(&rest))))
-;;          (setq l (scope-local-new (bare-symbol arg) (symbol-with-pos-pos arg) l))))
-;;      (scope-n l body))))
-
-;; (defun scope-pcase-lambda (local lambda-list body)
-;;   (if lambda-list
-;;       (let* ((l-r (scope-pcase-pattern local (car lambda-list)))
-;;              (l (car l-r))
-;;              (r (cdr l-r)))
-;;         (when l (nconc r (scope-pcase-lambda l (cdr lambda-list) body))))
-;;     (scope-n local body)))
-
-;; (defun scope-pcase-dolist (local pattern lst body)
-;;   (nconc
-;;    (scope-1 local lst)
-;;    (scope-pcase-1 local pattern body)))
-
-;; (defun scope-pcase-let-1 (local0 local bindings body)
-;;   (if bindings
-;;       (let* ((binding (car bindings))
-;;              (pat (car binding))
-;;              (exp (cadr binding)))
-;;         (nconc
-;;          (scope-1 local0 exp)
-;;          (let* ((l-r (scope-pcase-pattern local pat))
-;;                 (l (car l-r))
-;;                 (r (cdr l-r)))
-;;            (when l (nconc r (scope-pcase-let-1 local0 l (cdr bindings) body))))))
-;;     (scope-n local body)))
-
-;; (defun scope-pcase-let (local bindings body)
-;;   (scope-pcase-let-1 local local bindings body))
-
-;; (defun scope-pcase-let* (local bindings body)
-;;   (if bindings
-;;       (let* ((binding (car bindings))
-;;              (pat (car binding))
-;;              (exp (cadr binding)))
-;;         (nconc
-;;          (scope-1 local exp)
-;;          (let* ((l-r (scope-pcase-pattern local pat))
-;;                 (l (car l-r))
-;;                 (r (cdr l-r)))
-;;            (when l (nconc r (scope-pcase-let* l (cdr bindings) body))))))
-;;     (scope-n local body)))
-
-(defun scope-declare-function (_local _fn _file arglist _fileonly)
-  (seq-keep (lambda (arg)
-              (and (symbol-with-pos-p arg)
-                   (not (memq (bare-symbol arg) '(&optional &rest _)))
-                   (let* ((beg (symbol-with-pos-pos arg))
-                          (bare (bare-symbol arg))
-                          (len (length (symbol-name bare))))
-                     (list beg len beg))))
-            arglist))
-
-(defun scope-case (local expr clauses)
-  (nconc (scope-1 local expr)
-         (mapcan (lambda (clause) (scope-n local (cdr clause))) clauses)))
-
-(defun scope-define-derived (local _child _parent _name body)
-  (when (stringp (car body)) (setq body (cdr body)))
-  (while (keywordp (car body)) (setq body (cddr body)))
-  (scope-n local body))
-
-(defun scope-define-minor (local _mode _doc body)
-  (while (keywordp (car body)) (setq body (cddr body)))
-  (scope-n local body))
-
-;; (defun scope-letrec (local binders body)
-;;   (if binders
-;;       (let* ((binder (car binders))
-;;              (sym (car binder))
-;;              (bare (bare-symbol sym))
-;;              (beg (symbol-with-pos-pos sym))
-;;              (l (scope-local-new bare beg local))
-;;              (form (cadr binder)))
-;;         (cons
-;;          (list beg (length (symbol-name bare)) beg)
-;;          (nconc (scope-1 l form)
-;;                 (scope-letrec l (cdr binders) body))))
-;;     (scope-n local body)))
-
-(defsubst scope-sym-bare (sym)
-  (cond
-   ((symbolp sym) sym)
-   ((symbol-with-pos-p sym) (bare-symbol sym))))
+(defun scope-declare-function (local fn _file arglist _fileonly)
+  (scope-defun local fn arglist nil))
 
 (defun scope-loop-for-and (local rest)
   (if (eq (scope-sym-bare (car rest)) 'and)
@@ -777,57 +287,54 @@ Optional argument LOCAL is a local context to extend."
     (scope-loop local rest)))
 
 (defun scope-loop-for-by (local0 local expr rest)
-  (nconc (scope-1 local0 expr) (scope-loop-for-and local rest)))
+  (scope-1 local0 expr)
+  (scope-loop-for-and local rest))
 
 (defun scope-loop-for-to (local0 local expr rest)
-  (nconc
-   (scope-1 local0 expr)
-   (when-let ((bare (scope-sym-bare (car rest)))
-              (more (cdr rest)))
-     (cond
-      ((eq bare 'by)
-       (scope-loop-for-by local0 local (car more) (cdr more)))
-      (t (scope-loop-for-and local rest))))))
+  (scope-1 local0 expr)
+  (when-let ((bare (scope-sym-bare (car rest)))
+             (more (cdr rest)))
+    (cond
+     ((eq bare 'by)
+      (scope-loop-for-by local0 local (car more) (cdr more)))
+     (t (scope-loop-for-and local rest)))))
 
 (defun scope-loop-for-from (local0 local expr rest)
-  (nconc
-   (scope-1 local0 expr)
-   (when-let ((bare (scope-sym-bare (car rest)))
-              (more (cdr rest)))
-     (cond
-      ((memq bare '(to upto downto below above))
-       (scope-loop-for-to local0 local (car more) (cdr more)))
-      ((eq bare 'by)
-       (scope-loop-for-by local0 local (car more) (cdr more)))
-      (t (scope-loop-for-and local rest))))))
+  (scope-1 local0 expr)
+  (when-let ((bare (scope-sym-bare (car rest)))
+             (more (cdr rest)))
+    (cond
+     ((memq bare '(to upto downto below above))
+      (scope-loop-for-to local0 local (car more) (cdr more)))
+     ((eq bare 'by)
+      (scope-loop-for-by local0 local (car more) (cdr more)))
+     (t (scope-loop-for-and local rest)))))
 
 (defun scope-loop-for-= (local0 local expr rest)
-  (nconc
-   (scope-1 local0 expr)
-   (when-let ((bare (scope-sym-bare (car rest)))
-               (more (cdr rest)))
-     (cond
-      ((eq bare 'then)
-       (scope-loop-for-by local0 local (car more) (cdr more)))
-      (t (scope-loop-for-and local rest))))))
+  (scope-1 local0 expr)
+  (when-let ((bare (scope-sym-bare (car rest)))
+             (more (cdr rest)))
+    (cond
+     ((eq bare 'then)
+      (scope-loop-for-by local0 local (car more) (cdr more)))
+     (t (scope-loop-for-and local rest)))))
 
 (defun scope-loop-for-being-the-hash-keys-of-using (local form rest)
   (let* ((var (cadr form))
          (bare (scope-sym-bare var))
          (beg (scope-sym-pos var)))
-    (nconc
-     (when beg (list (list beg (length (symbol-name bare)) beg)))
-     (scope-loop-for-and (scope-local-new bare beg local) rest))))
+    (when beg
+      (funcall scope-callback 'variable beg (length (symbol-name bare)) beg))
+    (scope-loop-for-and (scope-local-new bare beg local) rest)))
 
 (defun scope-loop-for-being-the-hash-keys-of (local0 local expr rest)
-  (nconc
-   (scope-1 local0 expr)
-   (when-let ((bare (scope-sym-bare (car rest)))
-               (more (cdr rest)))
-     (cond
-      ((eq bare 'using)
-       (scope-loop-for-being-the-hash-keys-of-using local (car more) (cdr more)))
-      (t (scope-loop-for-and local rest))))))
+  (scope-1 local0 expr)
+  (when-let ((bare (scope-sym-bare (car rest)))
+             (more (cdr rest)))
+    (cond
+     ((eq bare 'using)
+      (scope-loop-for-being-the-hash-keys-of-using local (car more) (cdr more)))
+     (t (scope-loop-for-and local rest)))))
 
 (defun scope-loop-for-being-the-hash-keys (local0 local word rest)
   (when-let ((bare (scope-sym-bare word)))
@@ -856,9 +363,9 @@ Optional argument LOCAL is a local context to extend."
       (let* ((var (car (ensure-list vars)))
              (bare (bare-symbol var))
              (beg (scope-sym-pos var)))
-        (nconc
-         (when beg (list (list beg (length (symbol-name bare)) beg)))
-         (scope-loop-for local0 (scope-local-new bare beg local) (cdr-safe vars) rest)))
+        (when beg
+          (funcall scope-callback 'variable beg (length (symbol-name bare)) beg))
+        (scope-loop-for local0 (scope-local-new bare beg local) (cdr-safe vars) rest))
     (when-let ((bare (scope-sym-bare (car rest)))
                (more (cdr rest)))
       (cond
@@ -876,21 +383,22 @@ Optional argument LOCAL is a local context to extend."
         (scope-loop-for-being local0 local (car more) (cdr more)))))))
 
 (defun scope-loop-repeat (local form rest)
-  (nconc (scope-1 local form) (scope-loop local rest)))
+  (scope-1 local form)
+  (scope-loop local rest))
 
 (defun scope-loop-collect (local expr rest)
-  (nconc
-   (scope-1 local expr)
-   (let ((bw (scope-sym-bare (car rest)))
-         (more (cdr rest)))
-     (if (eq bw 'into)
-         (let* ((var (car more))
-                (bare (scope-sym-bare var))
-                (beg (scope-sym-pos var)))
-           (nconc
-            (when beg (list (list beg (length (symbol-name bare)) beg)))
-            (scope-loop (scope-local-new bare beg local) (cdr more))))
-       (scope-loop local rest)))))
+  (scope-1 local expr)
+  (let ((bw (scope-sym-bare (car rest)))
+        (more (cdr rest)))
+    (if (eq bw 'into)
+        (let* ((var (car more))
+               (bare (scope-sym-bare var))
+               (beg (scope-sym-pos var)))
+          (when beg
+            (funcall scope-callback 'variable
+                     beg (length (symbol-name bare)) beg))
+          (scope-loop (scope-local-new bare beg local) (cdr more)))
+      (scope-loop local rest))))
 
 (defun scope-loop-with-and (local rest)
   (if (eq (scope-sym-bare (car rest)) 'and)
@@ -902,27 +410,27 @@ Optional argument LOCAL is a local context to extend."
          (beg (symbol-with-pos-pos var))
          (l (scope-local-new bare beg local))
          (eql (car rest)))
-    (nconc
-     (when beg (list (list beg (length (symbol-name bare)) beg)))
-     (if (eq (scope-sym-bare eql) '=)
-         (let* ((val (cadr rest)) (more (cddr rest)))
-           (nconc (scope-1 local val) (scope-loop-with-and l more)))
-       (scope-loop-with-and l rest)))))
+    (when beg
+      (funcall scope-callback 'variable beg (length (symbol-name bare)) beg))
+    (if (eq (scope-sym-bare eql) '=)
+        (let* ((val (cadr rest)) (more (cddr rest)))
+          (scope-1 local val)
+          (scope-loop-with-and l more))
+      (scope-loop-with-and l rest))))
 
 (defun scope-loop-do (local form rest)
-  (nconc
-   (scope-1 local form)
-   (if (consp (car rest))
-       (scope-loop-do local (car rest) (cdr rest))
-     (scope-loop local rest))))
+  (scope-1 local form)
+  (if (consp (car rest))
+      (scope-loop-do local (car rest) (cdr rest))
+    (scope-loop local rest)))
 
 (defun scope-loop-named (local name rest)
   (let* ((beg (scope-sym-pos name))
          (bare (scope-sym-bare name)))
-    (nconc
-     (when beg (list (list beg (length (symbol-name bare)) beg)))
-     (let ((scope-block-alist (scope-local-new bare beg scope-block-alist)))
-       (scope-loop local rest)))))
+    (when beg
+      (funcall scope-callback 'block beg (length (symbol-name bare)) beg))
+    (let ((scope-block-alist (scope-local-new bare beg scope-block-alist)))
+      (scope-loop local rest))))
 
 (defun scope-loop-finally (local next rest)
   (if-let ((bare (scope-sym-bare next)))
@@ -930,8 +438,8 @@ Optional argument LOCAL is a local context to extend."
        ((eq bare 'do)
         (scope-loop-do local (car rest) (cdr rest)))
        ((eq bare 'return)
-        (nconc (scope-1 local (car rest))
-               (scope-loop local (cdr rest)))))
+        (scope-1 local (car rest))
+        (scope-loop local (cdr rest))))
     (scope-loop-do local next rest)))
 
 (defun scope-loop-initially (local next rest)
@@ -942,12 +450,12 @@ Optional argument LOCAL is a local context to extend."
 (defvar scope-loop-if-depth 0)
 
 (defun scope-loop-if (local keyword condition rest)
-  (nconc (scope-1 local condition)
-         (let ((scope-loop-if-depth (1+ scope-loop-if-depth)))
-           (scope-loop
-            ;; `if' binds `it'.
-            (scope-local-new 'it (scope-sym-pos keyword) local)
-            rest))))
+  (scope-1 local condition)
+  (let ((scope-loop-if-depth (1+ scope-loop-if-depth)))
+    (scope-loop
+     ;; `if' binds `it'.
+     (scope-local-new 'it (scope-sym-pos keyword) local)
+     rest)))
 
 (defun scope-loop-end (local rest)
   (let ((scope-loop-if-depth (1- scope-loop-if-depth)))
@@ -983,27 +491,26 @@ Optional argument LOCAL is a local context to extend."
 (defun scope-named-let (local name bindings body)
   (let ((bare (scope-sym-bare name))
         (beg (scope-sym-pos name)))
-    (nconc
-     (when beg (list (list beg (length (symbol-name bare)) beg)))
-     (mapcan (lambda (binding)
-               (let* ((sym (car (ensure-list binding)))
-                      (beg (symbol-with-pos-pos sym))
-                      (bare (bare-symbol sym)))
-                 (nconc
-                  (when beg (list (list beg (length (symbol-name bare)) beg)))
-                  (scope-1 local (cadr binding)))))
-             bindings)
-     (let ((l local))
-       (dolist (binding bindings)
-         (when-let ((sym (car (ensure-list binding)))
-                    (bare (scope-sym-bare sym)))
-           (setq l (scope-local-new bare (scope-sym-pos sym) l))))
-       (let ((scope-flet-alist (scope-local-new bare beg scope-flet-alist))) (scope-n l body))))))
+    (when beg
+      (funcall scope-callback 'function beg (length (symbol-name bare)) beg))
+    (dolist (binding bindings)
+      (let* ((sym (car (ensure-list binding)))
+             (beg (symbol-with-pos-pos sym))
+             (bare (bare-symbol sym)))
+        (when beg
+          (funcall scope-callback 'variable beg (length (symbol-name bare)) beg))
+        (scope-1 local (cadr binding))))
+    (let ((l local))
+      (dolist (binding bindings)
+        (when-let ((sym (car (ensure-list binding)))
+                   (bare (scope-sym-bare sym)))
+          (setq l (scope-local-new bare (scope-sym-pos sym) l))))
+      (let ((scope-flet-alist (scope-local-new bare beg scope-flet-alist)))
+        (scope-n l body)))))
 
 (defun scope-with-slots (local spec-list object body)
-  (nconc
-   (scope-1 local object)
-   (scope-let local spec-list body)))
+  (scope-1 local object)
+  (scope-let local spec-list body))
 
 (defvar scope-assume-func-p nil)
 
@@ -1015,30 +522,30 @@ Optional argument LOCAL is a local context to extend."
       (when bare
         (cond
          ((assq bare scope-flet-alist)
-          (cons (list (symbol-with-pos-pos f) (length (symbol-name bare))
-                      (alist-get bare scope-flet-alist))
-                (scope-n local forms)))
+          (funcall scope-callback 'function
+                   (symbol-with-pos-pos f) (length (symbol-name bare))
+                   (alist-get bare scope-flet-alist))
+          (scope-n local forms))
          ((get bare 'scope-function)
           (funcall (get bare 'scope-function) local forms))
          ((eq bare 'eval)
-          (nconc
-           (let ((q (scope-sym-bare (car-safe (car forms)))))
-             (cond
-              ((eq q 'quote) (scope-1 local (cadar forms)))
-              ((and (memq q '(function \`))
-                    (symbol-with-pos-p (cadar forms)))
-               (scope-s local (cadar forms)))))
-           (if (symbol-with-pos-p f)
-               (cons
-                (list (symbol-with-pos-pos f) (length (symbol-name bare)) 'function)
-                (scope-n local forms))
-             (scope-n local forms))))
+          (let ((q (scope-sym-bare (car-safe (car forms)))))
+            (cond
+             ((eq q 'quote) (scope-1 local (cadar forms)))
+             ((and (memq q '(function \`))
+                   (symbol-with-pos-p (cadar forms)))
+              (scope-s local (cadar forms)))))
+          (when (symbol-with-pos-p f)
+            (funcall scope-callback 'function
+                     (symbol-with-pos-pos f) (length (symbol-name bare))
+                     nil))
+          (scope-n local forms))
          ((functionp bare)
-          (if (symbol-with-pos-p f)
-              (cons
-               (list (symbol-with-pos-pos f) (length (symbol-name bare)) 'function)
-               (scope-n local forms))
-            (scope-n local forms)))
+          (when (symbol-with-pos-p f)
+            (funcall scope-callback 'function
+                     (symbol-with-pos-pos f) (length (symbol-name bare))
+                     nil))
+          (scope-n local forms))
          ((special-form-p bare)
           (cond
            ((eq bare 'let)
@@ -1069,99 +576,46 @@ Optional argument LOCAL is a local context to extend."
             (scope-flet local (car forms) (cdr forms)))
            ((memq bare '(cl-labels))
             (scope-labels local (car forms) (cdr forms)))
-           ((memq bare '(eval-when-compile eval-and-compile))
+           ((memq bare '( eval-when-compile eval-and-compile
+                          setf pop push with-memoization))
             (scope-n local forms))
            ((memq bare '(with-slots))
             (scope-with-slots local (car forms) (cadr forms) (cddr forms)))
-           ;; ((memq bare '( defun defmacro defsubst define-inline))
-           ;;  (scope-defun local (car forms) (cadr forms) (cddr forms)))
-           ;; FIXME: Bring back manual handling of cl-def*, these macros
-           ;; are evil in the sense that they macroexpand their bodies
-           ;; for optimization.  That means we don't see important
-           ;; intermediate forms, like `with-slots'.
-           ;; ((memq bare '( cl-defgeneric))
-           ;;  (scope-defgeneric local (car forms) (cadr forms) (cddr forms)))
-           ;; ((memq bare '(cl-case))
-           ;;  (scope-case local (car forms) (cdr forms)))
-           ;; ((memq bare '( cl-defun))
-           ;;  (scope-cl-defun local (car forms) (cadr forms) (cddr forms)))
-           ;; ((memq bare '( cl-defmethod))
-           ;;  (scope-defmethod local (car forms) (cdr forms)))
-           ;; ((memq bare '(declare-function))
-           ;;  (scope-declare-function local (car forms) (cadr forms)
-           ;;                          (caddr forms) (cadddr forms)))
-           ;; ((memq bare '(let-when-compile))
-           ;;  (scope-let* local (car forms) (cdr forms)))
-           ;; ((memq bare '(if-let when-let and-let))
-           ;;  (scope-if-let local (car forms) (cdr forms)))
-           ;; ((memq bare '(if-let* when-let* and-let* while-let))
-           ;;  (scope-if-let* local (car forms) (cdr forms)))
-           ;; ((memq bare '( defvar-local defcustom))
-           ;;  (scope-defvar local (car forms) (cadr forms)))
-           ;; ((memq bare '(dolist dotimes))
-           ;;  (scope-dotimes local (caar forms) (cadar forms) (caddar forms) (cdr forms)))
-           ;; ((memq bare '(pcase pcase-exhaustive))
-           ;;  (scope-pcase local (car forms) (cdr forms)))
-           ;; ((memq bare '(pcase-lambda))
-           ;;  (scope-pcase-lambda local (car forms) (cdr forms)))
-           ;; ((memq bare '(pcase-dolist))
-           ;;  (scope-pcase-dolist local (caar forms) (cadar forms) (cdr forms)))
-           ;; ((memq bare '(pcase-let))
-           ;;  (scope-pcase-let local (car forms) (cdr forms)))
-           ;; ((memq bare '(pcase-let*))
-           ;;  (scope-pcase-let* local (car forms) (cdr forms)))
-           ;; ((memq bare '(setq-local setq-default))
-           ;;  (scope-setq local forms))
-           ;; ((memq bare '(push))
-           ;;  (scope-push local (car forms) (cadr forms)))
-           ;; ((memq bare '(pop oref))
-           ;;  (scope-1 local (car forms)))
-           ;; ((memq bare '(letrec))
-           ;;  (scope-letrec local (car forms) (cdr forms)))
-           ;; ((memq bare '(minibuffer-with-setup-hook))
-           ;;  (scope-minibuffer-with-setup-hook local (car forms) (cdr forms)))
-           ;; ((memq bare '(condition-case-unless-debug))
-           ;;  (scope-condition-case local (car forms) (cadr forms) (cddr forms)))
-           ;; ((memq bare '(seq-let))
-           ;;  (scope-seq-let local (car forms) (cadr forms) (cddr forms)))
-           ;; ((memq bare '( define-derived-mode))
-           ;;  (scope-define-derived local (car forms) (cadr forms) (caddr forms) (cdddr forms)))
-           ;; ((memq bare '( define-minor-mode))
-           ;;  (scope-define-minor local (car forms) (cadr forms) (cddr forms)))
-           ;; ((memq bare '(inline-quote))
-           ;;  (scope-backquote local (car forms)))
-           ;; ((memq bare '(inline-letevals))
-           ;;  (scope-let local (car forms) (cdr forms)))
-           ;; ((memq bare '(with-suppressed-warnings))
-           ;;  (scope-n local (cdr forms)))
+           ((memq bare '(declare-function))
+            (scope-declare-function local (car forms) (cadr forms)
+                                    (caddr forms) (cadddr forms)))
+           ((memq bare '(let-when-compile))
+            (scope-let* local (car forms) (cdr forms)))
+           ((memq bare '(setq-local setq-default))
+            (scope-setq local forms))
            ((memq bare '(cl-block))
             (scope-block local (car forms) (cdr forms)))
            ((memq bare '(cl-return-from))
             (scope-return-from local (car forms) (cadr forms)))
-           ;; ((memq bare '(cl-return))
-           ;;  (scope-return-from local nil (cadr forms)))
-           ;; ((get bare 'scope-function) ;For custom extensions.
-           ;;  (funcall (get bare 'scope-function) local forms))
            (t (scope-1 local (let ((symbols-with-pos-enabled t))
-                               (macroexpand-1 form))))))
+                               ;; Ignore errors from trying to expand
+                               ;; invalid macro calls such as (dolist).
+                               (ignore-errors (macroexpand-1 form)))))))
          ;; Assume nothing about unknown top-level forms.
          (top-level nil)
          (scope-assume-func-p (scope-n local forms))))))
    ((symbol-with-pos-p form) (scope-s local form))))
 
-(defun scope-n (local body) (mapcan (apply-partially #'scope-1 local) body))
+(defun scope-n (local body) (dolist (form body) (scope-1 local form)))
 
 ;;;###autoload
-(defun scope (&optional stream)
-  "Read and scope-analyze code from STREAM.
+(defun scope (callback &optional stream)
+  "Read and analyze code from STREAM, reporting findings via CALLBACK.
+
+Call CALLBACK for each analyzed symbol SYM with arguments TYPE, POS, LEN
+and BINDER, where TYPE a symbol that specifies the semantics of SYM, one
+of `variable', `function', `block' `defun' and `defvar'; POS is the
+position of SYM in STREAM; LEN is SYM's length; and BINDER is the
+position in which SYM is bound.  If SYM is itself a binding occurrence,
+then POS and BINDER are equal.  If SYM is not lexically bound, then
+BINDER is nil.
 
-Return a bindings graph associating symbols with their binders.  It is a
-list of elements (OCCURRENCE LEN BINDING) where OCCURRENCE is a buffer
-position where a symbol of length LEN occurs, which is lexically bound
-at position BINDING.  If OCCURRENCE is itself a binding occurrence, then
-BINDING is equal to OCCURRENCE.  If OCCURRENCE is variable that is not
-lexically bound, then BINDING is nil.  If OCCURRENCE is a function name,
-then BINDING is \\+`function'.
+If STREAM is nil, it defaults to the current buffer.
 
 This function recursively analyzes Lisp forms (HEAD . TAIL), usually
 starting with a top-level form, by inspecting HEAD at each level:
@@ -1169,28 +623,30 @@ starting with a top-level form, by inspecting HEAD at each level:
 - If HEAD satisfies `functionp', which means it is a function in the
   running Emacs session, analzye the form as a function call.
 
-- Standard macros and special forms, such as `defun', `if', `let',
-  `pcase', `cl-loop', quotes, backquotes and more, are handled specially
-  according to their particular semantics.
+- Special forms such as `if', and `let', along with some standard macros
+  like `lambda', `setf' and backquotes, are handled specially according
+  to their particular semantics.  Other macros are expanded.
 
-- If HEAD has the property symbol `scope-function', the value of this
+- If HEAD has the symbol property `scope-function', the value of this
   property is used to analyze TAIL.  It should be a function that takes
-  two arguments, LOCAL and TAIL, and returns a bindings graph for TAIL.
-  LOCAL represents the local context around the current form, the
+  two arguments, LOCAL and TAIL, and calls `scope-callback' to report on
+  analyzed symbols in TAIL.  `scope-callback' is let-bound to CALLBACK.
+  LOCAL represents the local context around the current form; the
   `scope-function' can pass LOCAL to functions such as `scope-1' and
-  `scope-n' to obtain bindings graphs for sub-forms.  See also
-  `scope-local-new' for extending LOCAL with local bindings in TAIL.
+  `scope-n' to analyze sub-forms.  See also `scope-local-new' for
+  extending LOCAL with local bindings while analyzing TAIL.
 
 - If within the code under analysis HEAD is a `cl-flet'-bound local
   function name, analyze the form as a function call.
 
 - Otherwise, HEAD is unknown.  If the HEAD of the top-level form that
-  this function reads from STREAM is unknown, this function ignores it
-  and returns nil.  If an unknown HEAD occurs in a nested form, by
-  default it is similarly ignored, but if you set `scope-assume-func-p'
-  to non-nil, then this function assumes that such HEADs are functions."
-  (let ((scope-counter 0)) (scope-1 nil (read-positioning-symbols stream) t)))
-
+  this function reads from STREAM is unknown, then this function ignores
+  it and returns nil.  If an unknown HEAD occurs in a nested form, then
+  by default it is similarly ignored, but if `scope-assume-func-p' is
+  non-nil, then this function assumes that such HEADs are functions."
+  (let ((scope-counter 0)
+        (scope-callback callback))
+    (scope-1 nil (read-positioning-symbols (or stream (current-buffer))) t)))
 
 (provide 'scope)
 ;;; scope.el ends here
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 8d29993ff00..145ad694e86 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -334,21 +334,20 @@ happens in interactive invocations."
   "Face for highlighting binding occurrences of variables in Emacs Lisp code.")
 
 (defun elisp-highlight-variable (pos)
-  (save-excursion
-    (goto-char pos)
-    (let* ((all (save-excursion
-                  (goto-char pos)
-                  (beginning-of-defun)
-                  (scope (current-buffer))))
-           (dec (seq-some
-                 (pcase-lambda (`(,beg ,len ,bin))
-                   (when (<= beg pos (+ beg len)) bin))
-                 all)))
-      (pcase-dolist (`(,sym ,len ,bin) all)
-        (when (equal bin dec)
-          (let ((ov (make-overlay sym (+ sym len))))
-            (overlay-put ov 'face 'bold)
-            (overlay-put ov 'elisp-highlight-variable t)))))))
+  (let* (all dec)
+    (save-excursion
+      (goto-char pos)
+      (beginning-of-defun)
+      (scope (lambda (_type beg len bin)
+               (when (<= beg pos (+ beg len))
+                 (setq dec bin))
+               (when bin (push (list beg len bin) all)))
+             (current-buffer)))
+    (pcase-dolist (`(,sym ,len ,bin) all)
+      (when (equal bin dec)
+        (let ((ov (make-overlay sym (+ sym len))))
+          (overlay-put ov 'face 'bold)
+          (overlay-put ov 'elisp-highlight-variable t))))))
 
 (defun elisp-unhighlight-variable (pos)
   (save-excursion
@@ -364,31 +363,44 @@ happens in interactive invocations."
        (elisp-unhighlight-variable old)))))
 
 (defun elisp-fontify-region (beg end &optional loudly)
-  (or (ignore-errors
-        (let ((beg (save-excursion (goto-char beg) (beginning-of-defun) (point)))
-              (end (save-excursion (goto-char end) (end-of-defun)
-                                   (skip-chars-backward " \t\n")
-                                   (point))))
-          (font-lock-default-fontify-region beg end loudly)
-          (save-excursion
-            (goto-char beg)
-            (while (< (point) end)
-              (pcase-dolist (`(,sym ,len ,bin)
-                             (condition-case nil
-                                 (scope (current-buffer))
-                               (end-of-file nil)))
-                (cond
-                 ((or (numberp bin) (and (consp bin) (eq (car bin) 'gen)))
-                  (font-lock-append-text-property sym (+ sym len) 'face (if (equal sym bin)
-                                                                            'elisp-binding-variable
-                                                                          'elisp-bound-variable))
-                  (put-text-property sym (+ sym len 1) 'cursor-sensor-functions
-                                     (elisp-cursor-sensor sym)))
-                 ((eq bin 'function)
-                  (font-lock-append-text-property sym (+ sym len) 'face 'font-lock-function-call-face))
-                 (t (font-lock-append-text-property sym (+ sym len) 'face 'elisp-free-variable))))))
-          `(jit-lock-bounds ,beg . ,end)))
-      (font-lock-default-fontify-region beg end loudly)))
+  (let ((beg (save-excursion (goto-char beg) (beginning-of-defun) (point)))
+        (end (save-excursion (goto-char end) (end-of-defun)
+                             (skip-chars-backward " \t\n")
+                             (point))))
+    (font-lock-default-fontify-region beg end loudly)
+    (save-excursion
+      (goto-char beg)
+      (while (< (point) end)
+        (ignore-errors
+          (scope
+           (lambda (type sym len bin)
+             (cond
+              ((eq type 'variable)
+               (if (null bin)
+                   (put-text-property sym (+ sym len) 'face 'elisp-free-variable)
+                 (put-text-property sym (+ sym len) 'face (if (equal sym bin)
+                                                              'elisp-binding-variable
+                                                            'elisp-bound-variable))
+                 (put-text-property sym (+ sym len 1) 'cursor-sensor-functions
+                                    (elisp-cursor-sensor sym))))
+              ((eq type 'function)
+               (if (null bin)
+                   (put-text-property sym (+ sym len) 'face 'font-lock-function-call-face)
+                 (put-text-property sym (+ sym len) 'face (if (equal sym bin)
+                                                              'elisp-binding-variable
+                                                            'elisp-bound-variable))
+                 (put-text-property sym (+ sym len 1) 'cursor-sensor-functions
+                                    (elisp-cursor-sensor sym))))
+              ((eq type 'block)
+               (put-text-property sym (+ sym len) 'face (if (equal sym bin)
+                                                            'elisp-binding-variable
+                                                          'elisp-bound-variable))
+               (put-text-property sym (+ sym len 1) 'cursor-sensor-functions
+                                  (elisp-cursor-sensor sym)))
+              ((eq type 'defun)
+               (put-text-property sym (+ sym len) 'face 'font-lock-function-name-face))))
+           (current-buffer)))))
+    `(jit-lock-bounds ,beg . ,end)))
 
 ;;;###autoload
 (define-derived-mode emacs-lisp-mode lisp-data-mode
@@ -1118,13 +1130,15 @@ namespace but with lower confidence."
 (cl-defmethod xref-backend-definitions ((_backend (eql 'elisp)) identifier)
   (let* ((pos (get-text-property 0 'pos identifier))
          (dec (when pos
-                (seq-some
-                 (pcase-lambda (`(,beg ,len ,dec))
-                   (when (<= beg pos (+ beg len)) dec))
-                 (save-excursion
-                   (goto-char pos)
-                   (beginning-of-defun)
-                   (scope (current-buffer)))))))
+                (save-excursion
+                  (goto-char pos)
+                  (beginning-of-defun)
+                  (catch 'var-def
+                    (scope (lambda (_type beg len bin)
+                             (when (<= beg pos (+ beg len))
+                               (throw 'var-def bin)))
+                           (current-buffer))
+                    nil)))))
     (if (numberp dec)
         (list (xref-make "lexical binding"
                          (xref-make-buffer-location (current-buffer) dec)))
@@ -1143,29 +1157,34 @@ namespace but with lower confidence."
 
 (cl-defmethod xref-backend-references :around ((backend (eql 'elisp)) identifier)
   (let* ((pos (get-text-property 0 'pos identifier))
-         (all (save-excursion
-                (goto-char pos)
-                (beginning-of-defun)
-                (scope (current-buffer))))
-         (dec (seq-some
-               (pcase-lambda (`(,beg ,len ,bin))
-                 (when (<= beg pos (+ beg len)) bin))
-               all)))
-    (if (numberp dec)
-        (seq-keep (pcase-lambda (`(,sym ,len ,bin))
-                    (when (equal bin dec)
-                      (let* ((beg-end (save-excursion
-                                        (goto-char sym)
-                                        (cons (pos-bol) (pos-eol))))
-                             (beg (car beg-end))
-                             (end (cdr beg-end))
-                             (line (buffer-substring-no-properties beg end))
-                             (cur (- sym beg)))
-                        (add-face-text-property cur (+ len cur)
-                                                'xref-match t line)
-                        (xref-make line (xref-make-buffer-location
-                                         (current-buffer) sym)))))
-                  all)
+         all dec)
+    (when pos
+      (save-excursion
+        (goto-char pos)
+        (beginning-of-defun)
+        (scope (lambda (_type beg len bin)
+                 (when (<= beg pos (+ beg len))
+                   (setq dec bin))
+                 (when bin (setf (alist-get beg all) (list len bin))))
+               (current-buffer))))
+    (message "all: %S" all)
+    (if dec
+        (let (res)
+          (pcase-dolist (`(,sym ,len ,bin) all)
+            (when (equal bin dec)
+              (let* ((beg-end (save-excursion
+                                (goto-char sym)
+                                (cons (pos-bol) (pos-eol))))
+                     (beg (car beg-end))
+                     (end (cdr beg-end))
+                     (line (buffer-substring-no-properties beg end))
+                     (cur (- sym beg)))
+                (add-face-text-property cur (+ len cur)
+                                        'xref-match t line)
+                (push (xref-make line (xref-make-buffer-location
+                                       (current-buffer) sym))
+                      res))))
+          res)
       (cl-call-next-method backend identifier))))
 
 (defun elisp--xref-filter-definitions (definitions namespace symbol)
diff --git a/lisp/progmodes/refactor-elisp.el b/lisp/progmodes/refactor-elisp.el
index 996dbecdc3f..a747ecc761f 100644
--- a/lisp/progmodes/refactor-elisp.el
+++ b/lisp/progmodes/refactor-elisp.el
@@ -30,47 +30,59 @@
 (defun elisp-refactor-backend () '(elisp rename))
 
 (cl-defmethod refactor-backend-read-scoped-identifier ((_backend (eql elisp)))
-  (let ((all (save-excursion
-               (beginning-of-defun)
-               (scope (current-buffer)))))
-    (seq-some
-     (pcase-lambda (`(,beg ,len ,bin))
-       (and (numberp bin) (<= beg (point) (+ beg len))
-            (list (propertize (buffer-substring-no-properties beg (+ beg len))
-                              'pos beg))))
-     all)))
+  (let* ((pos (point)))
+    (when pos
+      (save-excursion
+        (goto-char pos)
+        (beginning-of-defun)
+        (catch 'var-def
+          (scope (lambda (_type beg len bin)
+                   (when (and bin (<= beg pos (+ beg len)))
+                     (throw 'var-def
+                            (list (propertize
+                                   (buffer-substring-no-properties beg (+ beg len))
+                                   'pos beg)))))
+                 (current-buffer))
+          nil)))))
 
-(cl-defmethod refactor-backend-rename-edits ((_backend (eql elisp)) _old new (_scope (eql nil)))
-  (let* ((all (save-excursion
-                (beginning-of-defun)
-                (scope (current-buffer))))
-         (dec (seq-some
-               (pcase-lambda (`(,beg ,len ,bin))
-                 (when (<= beg (point) (+ beg len)) bin))
-               all)))
+(cl-defmethod refactor-backend-rename-edits
+  ((_backend (eql elisp)) old new (_scope (eql nil)))
+  (let* ((pos (get-text-property 0 'pos old))
+         all dec)
+    (save-excursion
+      (goto-char pos)
+      (beginning-of-defun)
+      (scope (lambda (_type beg len bin)
+               (when (<= beg pos (+ beg len))
+                 (setq dec bin))
+               (when bin (push (list beg len bin) all)))
+             (current-buffer)))
     (list
      (cons (current-buffer)
-           (seq-keep
-            (pcase-lambda (`(,beg ,len ,bin))
-              (when (equal bin dec)
-                (list beg (+ beg len) new)))
-            all)))))
+           (let (res)
+             (pcase-dolist (`(,beg ,len ,bin) all)
+               (when (equal bin dec)
+                 (setf (alist-get beg res) (list (+ beg len) new))))
+             res)))))
 
 (cl-defmethod refactor-backend-rename-highlight-regions
   ((_backend (eql elisp)) old (_scope (eql nil)))
-  (when-let* ((pos (get-text-property 0 'pos old))
-              (all (save-excursion
-                     (goto-char pos)
-                     (beginning-of-defun)
-                     (scope (current-buffer))))
-              (dec (seq-some
-                    (pcase-lambda (`(,beg ,len ,bin))
-                      (when (<= beg pos (+ beg len)) bin))
-                    all)))
-    (seq-keep (pcase-lambda (`(,beg ,len ,bin))
-                (when (equal bin dec)
-                  (cons beg (+ beg len))))
-              all)))
+  (let* ((pos (get-text-property 0 'pos old))
+         all dec)
+    (save-excursion
+      (goto-char pos)
+      (beginning-of-defun)
+      (scope (lambda (_type beg len bin)
+               (when (<= beg pos (+ beg len))
+                 (setq dec bin))
+               (when bin (push (list beg len bin) all)))
+             (current-buffer)))
+    (when dec
+      (let (res)
+        (pcase-dolist (`(,beg ,len ,bin) all)
+          (when (equal bin dec)
+            (setf (alist-get beg res) (+ beg len))))
+        res))))
 
 (provide 'refactor-elisp)
 ;;; refactor-elisp.el ends here