From fee305290b286144f53363bd64881cf1b8475e9c Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Sun, 11 Aug 2024 17:03:43 +0200
Subject: [PATCH] scope.el: Optimize and improve documentation.

---
 lisp/emacs-lisp/scope.el | 417 +++++++++++++++++++++------------------
 1 file changed, 224 insertions(+), 193 deletions(-)

diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el
index 680963faa37..af468369205 100644
--- a/lisp/emacs-lisp/scope.el
+++ b/lisp/emacs-lisp/scope.el
@@ -26,12 +26,22 @@
 
 (eval-when-compile (require 'cl-lib))
 
+(defsubst scope-local-get (sym local)
+  "Get binding position of symbol SYM in local context LOCAL."
+  (alist-get sym local))
+
+(defsubst scope-local-new (sym pos &optional local)
+  "Return new local context with SYM bound at POS.
+
+Optional argument LOCAL is a local context to extend."
+  (cons (cons sym pos) local))
+
 (defun scope-s (local sym)
   (let* ((beg (symbol-with-pos-pos sym))
          (bare (bare-symbol sym))
          (len (length (symbol-name bare))))
     (unless (or (booleanp bare) (keywordp bare))
-      (list (list beg len (alist-get bare local))))))
+      (list (list beg len (scope-local-get bare local))))))
 
 (defun scope-let (local bindings body)
   (nconc
@@ -50,14 +60,11 @@
                       (len (length (symbol-name bare))))
                  (list (list beg len beg)))))
            bindings)
-   (scope-n
-    (append (mapcar
-             (lambda (binding)
-               (let ((sym (if (consp binding) (car binding) binding)))
-                 (cons (bare-symbol sym) (symbol-with-pos-pos sym))))
-             bindings)
-            local)
-    body)))
+   (let ((l local))
+     (dolist (binding bindings)
+       (let ((sym (if (consp binding) (car binding) binding)))
+         (setq l (scope-local-new (bare-symbol sym) (symbol-with-pos-pos sym) l))))
+     (scope-n l body))))
 
 (defun scope-let* (local bindings body)
   (if bindings
@@ -75,9 +82,8 @@
                   (bare (bare-symbol sym)))
              (list (list beg (length (symbol-name bare)) beg))))
          (scope-let*
-          (cons (let ((sym (if (consp binding) (car binding) binding)))
-                  (cons (bare-symbol sym) (symbol-with-pos-pos sym)))
-                local)
+          (let ((sym (if (consp binding) (car binding) binding)))
+            (scope-local-new (bare-symbol sym) (symbol-with-pos-pos sym) local))
           (cdr bindings)
           body)))
     (scope-n local body)))
@@ -94,7 +100,7 @@
                   (cons
                    (list beg (length (symbol-name bare)) beg)
                    (nconc (scope-1 local (cadr binding))
-                          (scope-if-let* (cons (cons bare beg) local)
+                          (scope-if-let* (scope-local-new bare beg local)
                                          (cdr bindings) body))))
               ;; BINDING is (VALUEFORM).
               (nconc (scope-1 local (car binding))
@@ -105,7 +111,7 @@
                  (bare (bare-symbol sym)))
             (cons
              (list beg (length (symbol-name bare)) beg)
-             (scope-if-let* (cons (cons bare beg) local)
+             (scope-if-let* (scope-local-new bare beg local)
                             (cdr bindings) body)))))
     (scope-n local body)))
 
@@ -143,14 +149,11 @@
                args)
      (scope-1 local doc-form)
      (scope-1 local int-spec)
-     (scope-n (append
-               (seq-keep (lambda (arg)
-                           (and (symbol-with-pos-p arg)
-                                (not (memq (bare-symbol arg) '(&optional &rest)))
-                                (cons (bare-symbol arg) (symbol-with-pos-pos arg))))
-                         args)
-               local)
-              body))))
+     (let ((l local))
+       (dolist (arg args)
+         (when (and (symbol-with-pos-p arg) (not (memq (bare-symbol arg) '(&optional &rest))))
+           (setq l (scope-local-new (bare-symbol arg) (symbol-with-pos-pos arg) l))))
+       (scope-n l body)))))
 
 (defun scope-defmethod-1 (local0 local name args body)
   (if args
@@ -175,7 +178,7 @@
                            (eq 'eql (bare-symbol head))
                            (not (or (symbolp form) (symbol-with-pos-p form)))
                            (scope-1 local0 form)))))
-                  (scope-defmethod-1 local0 (cons (cons bare beg) local) name (cdr args) body)))))
+                  (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)))
@@ -195,7 +198,7 @@
                                (eq 'eql (bare-symbol head))
                                (not (or (symbolp form) (symbol-with-pos-p form)))
                                (scope-1 local0 form)))))
-                      (scope-defmethod-1 local0 (cons (cons bare beg) local) name (cdr args) body)))))
+                      (scope-defmethod-1 local0 (scope-local-new bare beg local) name (cdr args) body)))))
                  ((consp var)
                   (let* ((init (cadr var))
                          (svar (caddr var))
@@ -211,13 +214,15 @@
                         (let ((sbeg (symbol-with-pos-pos svar)))
                           (list (list sbeg (length (symbol-name (bare-symbol svar)))
                                       sbeg))))
-                      (scope-defmethod-1 local0 (cons (cons bare beg)
-                                                      (append
-                                                       (when svar
-                                                         (list (cons (bare-symbol svar)
-                                                                     (symbol-with-pos-pos svar))))
-                                                       local))
-                                         name (cdr args) body)))))))))))
+                      (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 _))
@@ -244,7 +249,7 @@
                    (len (length (symbol-name bare))))
               (cons
                (list beg len beg)
-               (scope-defmethod-1 local0 (cons (cons bare beg) local)
+               (scope-defmethod-1 local0 (scope-local-new bare beg local)
                                   name (cdr args) body))))))))
     (scope-n local body)))
 
@@ -306,7 +311,7 @@
        (list (list beg (length (symbol-name bare)) beg))))
    (scope-1 local bodyform)
    (mapcan
-    (let ((l (if var (cons (cons (bare-symbol var) (symbol-with-pos-pos var)) local) local)))
+    (let ((l (if var (scope-local-new (bare-symbol var) (symbol-with-pos-pos var) local) local)))
       (lambda (handler) (scope-n l (cdr handler))))
     handlers)))
 
@@ -318,7 +323,7 @@
    (nconc
     (scope-1 local lst)
     (scope-1 local res)
-    (let ((l (cons (cons (bare-symbol var) (symbol-with-pos-pos var)) local)))
+    (let ((l (scope-local-new (bare-symbol var) (symbol-with-pos-pos var) local)))
       (scope-n l body)))))
 
 (defun scope-pcase-qpat (local qpat)
@@ -339,7 +344,7 @@
     (let ((bare (bare-symbol pattern)))
       (if (eq bare '_) (list local)
         (let* ((beg (symbol-with-pos-pos pattern)))
-          (cons (cons (cons bare beg) local)
+          (cons (scope-local-new bare beg local)
                 (list (list beg (length (symbol-name bare)) beg)))))))
    ((consp pattern)
     (cond
@@ -373,19 +378,22 @@
                     fun))
    (scope-n local body)))
 
-(defun scope-backquote (depth local elements)
+(defun scope--backquote (local elements depth)
   (cond
    ((zerop depth) (scope-n local elements))
    ((consp elements)
     (cond
      ((memq (car elements) '(\, \,@))
-      (scope-backquote (1- depth) local (cdr elements)))
+      (scope--backquote local (cdr elements) (1- depth)))
      ((eq (car elements) '\`)
-      (scope-backquote (1+ depth) local (cdr elements)))
-     (t (nconc (scope-backquote depth local (car elements))
-               (scope-backquote depth local (cdr elements))))))
+      (scope--backquote local (cdr elements) (1+ depth)))
+     (t (nconc (scope--backquote local (car elements) depth)
+               (scope--backquote local (cdr elements) depth)))))
    ((vectorp elements)
-    (scope-backquote depth local (append elements nil)))))
+    (scope--backquote local (append elements nil) depth))))
+
+(defun scope-backquote (local elements &optional depth)
+  (scope--backquote local elements (or depth 1)))
 
 (defvar scope-flet-list nil)
 
@@ -405,8 +413,8 @@
             (scope-1 local (car exps)))
           (let ((scope-flet-list (cons (bare-symbol func) scope-flet-list)))
             (scope-flet
-             (cons (cons (bare-symbol func) (symbol-with-pos-pos func))
-                   local)
+             (scope-local-new (bare-symbol func) (symbol-with-pos-pos func)
+                              local)
              (cdr defs) body)))))
     (scope-n local body)))
 
@@ -420,13 +428,13 @@
          (list (symbol-with-pos-pos func) (length (symbol-name (bare-symbol func)))
                (symbol-with-pos-pos func))
          (let ((scope-flet-list (cons (bare-symbol func) scope-flet-list))
-               (l (cons (cons (bare-symbol func) (symbol-with-pos-pos func)) local)))
+               (l (scope-local-new (bare-symbol func) (symbol-with-pos-pos func) local)))
            (nconc
             (scope-defun l nil args body)
             (scope-flet l (cdr defs) forms)))))
     (scope-n local forms)))
 
-(defun scope-function (local arg)
+(defun scope-sharpquote (local arg)
   (and (or (and (symbol-with-pos-p arg) (memq (bare-symbol arg) scope-flet-list))
            (consp arg))
        (scope-1 local arg)))
@@ -441,7 +449,7 @@
                  (len (length (symbol-name bare))))
             (cons
              (list beg len beg)
-             (scope-cl-defun-aux (cons (cons bare beg) local)
+             (scope-cl-defun-aux (scope-local-new bare beg local)
                                  name (cdr args) body))))
          ((consp arg)
           (let* ((var (car arg))
@@ -453,7 +461,7 @@
              (list beg len beg)
              (nconc
               (scope-1 local init)
-              (scope-cl-defun-aux (cons (cons bare beg) local)
+              (scope-cl-defun-aux (scope-local-new bare beg local)
                                   name (cdr args) body)))))))
     (scope-n local body)))
 
@@ -474,7 +482,7 @@
                      (len (length (symbol-name bare))))
                 (cons
                  (list beg len beg)
-                 (scope-cl-defun-key (cons (cons bare beg) local)
+                 (scope-cl-defun-key (scope-local-new bare beg local)
                                      name (cdr args) body))))))
          ((consp arg)
           (let* ((var (car arg))
@@ -492,13 +500,14 @@
                 (let ((sbeg (symbol-with-pos-pos svar)))
                   (list (list sbeg (length (symbol-name (bare-symbol svar)))
                               sbeg))))
-              (scope-cl-defun-key (cons (cons bare beg)
-                                        (append
-                                         (when svar
-                                           (list (cons (bare-symbol svar)
-                                                       (symbol-with-pos-pos svar))))
-                                         local))
-                                  name (cdr args) body)))))))
+              (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)
@@ -506,7 +515,7 @@
          (beg (symbol-with-pos-pos var))
          (bare (bare-symbol var))
          (len (length (symbol-name bare)))
-         (l (cons (cons bare beg) local)))
+         (l (scope-local-new bare beg local)))
     (cons
      (list beg len beg)
      (if (cdr args)
@@ -536,7 +545,7 @@
                      (len (length (symbol-name bare))))
                 (cons
                  (list beg len beg)
-                 (scope-cl-defun-optional (cons (cons bare beg) local)
+                 (scope-cl-defun-optional (scope-local-new bare beg local)
                                           name (cdr args) body))))))
          ((consp arg)
           (let* ((var (car arg))
@@ -553,13 +562,14 @@
                 (let ((sbeg (symbol-with-pos-pos svar)))
                   (list (list sbeg (length (symbol-name (bare-symbol svar)))
                               sbeg))))
-              (scope-cl-defun-optional (cons (cons bare beg)
-                                             (append
-                                              (when svar
-                                                (list (cons (bare-symbol svar)
-                                                            (symbol-with-pos-pos svar))))
-                                              local))
-                                       name (cdr args) body)))))))
+              (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)
@@ -579,8 +589,8 @@
                    (len (length (symbol-name bare))))
               (cons
                (list beg len beg)
-               (scope-cl-defun-1 (cons (cons (bare-symbol arg)
-                                             (symbol-with-pos-pos arg))
+               (scope-cl-defun-1 (scope-local-new (bare-symbol arg)
+                                                  (symbol-with-pos-pos arg)
                                        local)
                                  name (cdr args) body))))))
     (scope-n local body)))
@@ -597,12 +607,11 @@
                     (len (length (symbol-name bare))))
                (list beg len beg)))
            args)
-   (scope-n (append
-             (mapcar (lambda (arg)
-                       (cons (bare-symbol arg) (symbol-with-pos-pos arg)))
-                     args)
-             local)
-            body)))
+   (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
@@ -675,7 +684,7 @@
              (sym (car binder))
              (bare (bare-symbol sym))
              (beg (symbol-with-pos-pos sym))
-             (l (cons (cons bare beg) local))
+             (l (scope-local-new bare beg local))
              (form (cadr binder)))
         (cons
          (list beg (length (symbol-name bare)) beg)
@@ -683,127 +692,122 @@
                 (scope-letrec l (cdr binders) body))))
     (scope-n local body)))
 
-(defun scope-f (local f)
-  "Return function that scope-analyzes arguments of F in context LOCAL."
-  (cond
-   ((symbol-with-pos-p f)
-    (let ((bare (bare-symbol f)))
-      (cond
-       ((functionp bare) (apply-partially #'scope-n local))
-       ((macrop bare)
-        (cond
-         ((eq (get bare 'edebug-form-spec) t)
-          (apply-partially #'scope-n local))
-         ((memq bare '( setf with-memoization cl-assert cl-incf cl-decf
-                        eval-when-compile eval-and-compile with-eval-after-load
-                        ;; We could recognize contant symbols bindings
-                        ;; in `cl-progv', but it is not really worth the
-                        ;; trouble since this macro is specifically
-                        ;; intended for computing bindings at run time.
-                        cl-progv))
-          (apply-partially #'scope-n local))
-         ((memq bare '( defun defmacro defsubst define-inline))
-          (lambda (forms) (scope-defun local (car forms) (cadr forms) (cddr forms))))
-         ((memq bare '( cl-defgeneric))
-          (lambda (forms) (scope-defgeneric local (car forms) (cadr forms) (cddr forms))))
-         ((memq bare '(cl-case))
-          (lambda (forms) (scope-case local (car forms) (cdr forms))))
-         ((memq bare '( cl-defun))
-          (lambda (forms) (scope-cl-defun local (car forms) (cadr forms) (cddr forms))))
-         ((memq bare '( cl-defmethod))
-          (lambda (forms) (scope-defmethod local (car forms) (cdr forms))))
-         ((memq bare '(lambda))
-          (lambda (forms) (scope-defun local nil (car forms) (cdr forms))))
-         ((memq bare '(declare-function))
-          (lambda (forms) (scope-declare-function local (car forms) (cadr forms)
-                                                  (caddr forms) (cadddr forms))))
-         ((memq bare '(if-let when-let and-let))
-          (lambda (forms) (scope-if-let local (car forms) (cdr forms))))
-         ((memq bare '(if-let* when-let* and-let* while-let))
-          (lambda (forms) (scope-if-let* local (car forms) (cdr forms))))
-         ((memq bare '( defvar-local defcustom))
-          (lambda (forms) (scope-defvar local (car forms) (cadr forms))))
-         ((memq bare '(dolist dotimes))
-          (lambda (forms) (scope-dotimes local (caar forms) (cadar forms) (caddar forms) (cdr forms))))
-         ((memq bare '(pcase pcase-exhaustive))
-          (lambda (forms) (scope-pcase local (car forms) (cdr forms))))
-         ((memq bare '(pcase-lambda))
-          (lambda (forms) (scope-pcase-lambda local (car forms) (cdr forms))))
-         ((memq bare '(pcase-dolist))
-          (lambda (forms) (scope-pcase-dolist local (caar forms) (cadar forms) (cdr forms))))
-         ((memq bare '(pcase-let))
-          (lambda (forms) (scope-pcase-let local (car forms) (cdr forms))))
-         ((memq bare '(pcase-let*))
-          (lambda (forms) (scope-pcase-let* local (car forms) (cdr forms))))
-         ((memq bare '(setq-local setq-default))
-          (apply-partially #'scope-setq local))
-         ((memq bare '(push))
-          (lambda (forms) (scope-push local (car forms) (cadr forms))))
-         ((memq bare '(pop oref))
-          (lambda (forms) (scope-1 local (car forms))))
-         ((memq bare '(letrec))
-          (lambda (forms) (scope-letrec local (car forms) (cdr forms))))
-         ((memq bare '(cl-flet))
-          (lambda (forms) (scope-flet local (car forms) (cdr forms))))
-         ((memq bare '(cl-labels))
-          (lambda (forms) (scope-labels local (car forms) (cdr forms))))
-         ((memq bare '(minibuffer-with-setup-hook))
-          (lambda (forms) (scope-minibuffer-with-setup-hook local (car forms) (cdr forms))))
-         ((memq bare '(condition-case-unless-debug))
-          (lambda (forms) (scope-condition-case local (car forms) (cadr forms) (cddr forms))))
-         ((memq bare '(seq-let))
-          (lambda (forms) (scope-seq-let local (car forms) (cadr forms) (cddr forms))))
-         ((memq bare '( define-derived-mode))
-          (lambda (forms)
-            (scope-define-derived local (car forms) (cadr forms) (caddr forms) (cdddr forms))))
-         ((memq bare '( define-minor-mode))
-          (lambda (forms) (scope-define-minor local (car forms) (cadr forms) (cddr forms))))
-         ((memq bare '(inline-quote))
-          (lambda (forms) (scope-backquote 1 local (car forms))))
-         ((memq bare '(inline-letevals))
-          (lambda (forms) (scope-let local (car forms) (cdr forms))))
-         ((memq bare '(with-suppressed-warnings))
-          (lambda (forms) (scope-n local (cdr forms))))
-         ((get bare 'scope-function)    ;For custom extensions.
-          (apply-partially (get bare 'scope-function) local))
-         (t #'ignore)))
-       ((special-form-p bare)
-        (cond
-         ((memq bare '( if and or while
-                        save-excursion save-restriction save-current-buffer
-                        catch unwind-protect
-                        progn prog1))
-          (apply-partially #'scope-n local))
-         ((eq bare 'let)
-          (lambda (forms) (scope-let local (car forms) (cdr forms))))
-         ((eq bare 'let*)
-          (lambda (forms) (scope-let* local (car forms) (cdr forms))))
-         ((eq bare 'cond) (apply-partially #'scope-cond local))
-         ((eq bare 'setq) (apply-partially #'scope-setq local))
-         ((memq bare '( defconst defvar))
-          (lambda (forms) (scope-defvar local (car forms) (cadr forms))))
-         ((eq bare 'condition-case)
-          (lambda (forms) (scope-condition-case local (car forms) (cadr forms) (cddr forms))))
-         (t #'ignore)))
-       ((memq bare scope-flet-list)
-        (lambda (forms) (nconc (scope-s local f)
-                               (scope-n local forms))))
-       ;; FIXME: Assume unknown symbols refer to functions, unless at
-       ;; top level.
-       (t #'ignore))))
-   ;; Symbol without position, a quotation marker that the reader
-   ;; expands into a symbol but does not annotate with a position.
-   ((symbolp f)
-    (cond
-     ((eq f '\`) (lambda (forms) (scope-backquote 1 local (car forms))))
-     ((eq f 'function) (lambda (forms) (scope-function local (car forms))))
-     (t #'ignore)))
-   (t #'ignore)))
+(defvar scope-assume-func-p nil)
 
-(defun scope-1 (local form)
+(defun scope-1 (local form &optional top-level)
   (cond
    ((consp form)
-    (funcall (scope-f local (car form)) (cdr form)))
+    (let ((f (car form))
+          (forms (cdr form)))
+      (cond
+       ((symbol-with-pos-p f)
+        (let ((bare (bare-symbol f)))
+          (cond
+           ((or (functionp bare)
+                (memq bare '( if and or while
+                              save-excursion save-restriction save-current-buffer
+                              catch unwind-protect
+                              progn prog1 eval-when-compile eval-and-compile with-eval-after-load
+                              with-memoization cl-assert cl-incf cl-decf setf
+                              ;; We could recognize contant symbols bindings
+                              ;; in `cl-progv', but it is not really worth the
+                              ;; trouble since this macro is specifically
+                              ;; intended for computing bindings at run time.
+                              cl-progv))
+                (eq (get bare 'edebug-form-spec) t))
+            (scope-n local forms))
+           ((macrop bare)
+            (cond
+             ((memq bare '( defun defmacro defsubst define-inline))
+              (scope-defun local (car forms) (cadr forms) (cddr forms)))
+             ((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 '(lambda))
+              (scope-defun local nil (car forms) (cdr forms)))
+             ((memq bare '(declare-function))
+              (scope-declare-function local (car forms) (cadr forms)
+                                      (caddr forms) (cadddr 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 '(cl-flet))
+              (scope-flet local (car forms) (cdr forms)))
+             ((memq bare '(cl-labels))
+              (scope-labels 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)))
+             ((get bare 'scope-function) ;For custom extensions.
+              (funcall (get bare 'scope-function) local forms))))
+           ((special-form-p bare)
+            (cond
+             ((eq bare 'let)
+              (scope-let local (car forms) (cdr forms)))
+             ((eq bare 'let*)
+              (scope-let* local (car forms) (cdr forms)))
+             ((eq bare 'cond) (scope-cond local forms))
+             ((eq bare 'setq) (scope-setq local forms))
+             ((memq bare '( defconst defvar))
+              (scope-defvar local (car forms) (cadr forms)))
+             ((eq bare 'condition-case)
+              (scope-condition-case local (car forms) (cadr forms) (cddr forms)))
+             ((get bare 'scope-function)
+              (funcall (get bare 'scope-function) local forms))))
+           ((memq bare scope-flet-list)
+            (nconc (scope-s local f) (scope-n local forms)))
+           ((get bare 'scope-function)
+            (funcall (get bare 'scope-function) local forms))
+           ;; Assume nothing about unknown top-level forms.
+           (top-level nil)
+           (scope-assume-func-p (scope-n local forms)))))
+       ;; Symbol without position, a quotation marker that the reader
+       ;; expands into a symbol but does not annotate with a position.
+       ((symbolp f)
+        (cond
+         ((eq f '\`) (scope-backquote local (car forms)))
+         ((eq f 'function) (scope-sharpquote local (car forms))))))))
    ((symbol-with-pos-p form)
     (scope-s local form))))
 
@@ -818,8 +822,35 @@ list of elements (OCCURRENCE LEN BINDING) where OCCURRENCE is a buffer
 position where a symbol of length LEN occurs, which is bound by another
 occurrence of the same symbol that starts at position BINDING.  If
 OCCURRENCE is itself a binding occurrence, then BINDING and OCCURRENCE
-are equal.  If OCCURRENCE is not lexically bound, then BINDING is nil."
-  (scope-1 nil (read-positioning-symbols stream)))
+are equal.  If OCCURRENCE is not lexically bound, then BINDING is nil.
+
+This function recursively analyzes Lisp forms (HEAD . TAIL), usually
+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', quotes, backquotes and more, are handled specially according
+  to their particular semantics.
+
+- If HEAD has the property symbol `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
+  `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.
+
+- If within the code under analysis HEAD is a `cl-letf'-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."
+  (scope-1 nil (read-positioning-symbols stream) t))
 
 (provide 'scope)
 ;;; scope.el ends here
-- 
2.39.2