Merge from lexical-binding branch.

* doc/lispref/eval.texi (Eval): Discourage the use of `eval'.
Document its new `lexical' argument.

* doc/lispref/variables.texi (Defining Variables): Mention the new meaning of `defvar'.
(Lexical Binding): New sub-section.

* lisp/Makefile.in (BIG_STACK_DEPTH, BIG_STACK_OPTS, BYTE_COMPILE_FLAGS):
New variables.
(compile-onefile, .el.elc, compile-calc, recompile): Use them.
(COMPILE_FIRST): Add macroexp and cconv.
* lisp/makefile.w32-in: Mirror changes in Makefile.in.

* lisp/vc/cvs-status.el:
* lisp/vc/diff-mode.el:
* lisp/vc/log-edit.el:
* lisp/vc/log-view.el:
* lisp/vc/smerge-mode.el:
* lisp/textmodes/bibtex-style.el:
* textmodes/css.el:
* lisp/startup.el:
* lisp/uniquify.el:
* lisp/minibuffer.el: 
* lisp/newcomment.el: 
* lisp/reveal.el: 
* lisp/server.el: 
* lisp/mpc.el: 
* lisp/emacs-lisp/smie.el: 
* lisp/doc-view.el: 
* lisp/dired.el: 
* lisp/abbrev.el: Use lexical binding.

* lisp/custom.el (custom-initialize-default, custom-declare-variable):
Use `defvar'.

* lisp/files.el (lexical-binding): Declare safe.

* lisp/help-fns.el (help-split-fundoc): Return nil if there's nothing else
than the arglist.
(help-add-fundoc-usage): Don't add `Not documented'.
(help-function-arglist): Handle closures, subroutines, and new
byte-code-functions.
(help-make-usage): Remove leading underscores.
(describe-function-1): Handle closures.
(describe-variable): Use special-variable-p for completion.

* lisp/simple.el (with-wrapper-hook, apply-partially): Move to subr.el.

* lisp/subr.el (apply-partially): Use new closures rather than CL.
(--dolist-tail--, --dotimes-limit--): Don't declare dynamic.
(dolist, dotimes): Use slightly different expansion for lexical code.
(functionp): Move to C.
(letrec): New macro.
(with-wrapper-hook): Use it and apply-partially instead of CL.
(eval-after-load): Preserve lexical-binding.
(save-window-excursion, with-output-to-temp-buffer): Turn them
into macros.

* lisp/emacs-lisp/advice.el (ad-arglist): Use help-function-arglist.

* lisp/emacs-lisp/autoload.el (make-autoload): Don't burp on trivial macros.

* lisp/emacs-lisp/byte-opt.el: Use lexical binding.
(byte-inline-lapcode): Remove (to bytecomp).
(byte-compile-inline-expand): Pay attention to inlining to/from
lexically bound code.
(byte-compile-unfold-lambda): Don't handle byte-code-functions
any more.
(byte-optimize-form-code-walker): Don't handle save-window-excursion
any more and don't call compiler-macros.
(byte-compile-splice-in-already-compiled-code): Remove.
(byte-code): Don't inline any more.
(disassemble-offset): Receive `bytes' as argument rather than via
dynamic scoping.
(byte-compile-tag-number): Declare before first use.
(byte-decompile-bytecode-1): Handle new byte-codes, don't change
`return' even if make-spliceable.
(byte-compile-side-effect-and-error-free-ops): Add stack-ref, remove
obsolete interactive-p.
(byte-optimize-lapcode): Optimize new lap-codes.
Don't trip up on new form of `byte-constant' lap code.

* lisp/emacs-lisp/byte-run.el (make-obsolete): Don't set the `byte-compile'
handler any more.

* lisp/emacs-lisp/bytecomp.el: Use lexical binding instead of
a "bytecomp-" prefix.  Macroexpand everything as a separate phase.
(byte-compile-initial-macro-environment):
Handle declare-function here.
(byte-compile--lexical-environment): New var.
(byte-stack-ref, byte-stack-set, byte-discardN)
(byte-discardN-preserve-tos): New lap codes.
(byte-interactive-p): Don't use any more.
(byte-compile-push-bytecodes, byte-compile-push-bytecode-const2):
New macros.
(byte-compile-lapcode): Use them and handle new lap codes.
(byte-compile-obsolete): Remove.
(byte-compile-arglist-signature): Handle new byte-code arg"lists".
(byte-compile-arglist-warn): Check late def of inlinable funs.
(byte-compile-cl-warn): Don't silence warnings for compiler-macros
since they should have been expanded by now.
(byte-compile--outbuffer): Rename from bytecomp-outbuffer.
(byte-compile-from-buffer): Remove unused second arg.
(byte-compile-preprocess): New function.
(byte-compile-toplevel-file-form): New function to distinguish
file-form calls from outside from file-form calls from hunk-handlers.
(byte-compile-file-form): Simplify.
(byte-compile-file-form-defsubst): Remove.
(byte-compile-file-form-defmumble): Simplify now that
byte-compile-lambda always returns a byte-code-function.
(byte-compile): Preprocess.
(byte-compile-byte-code-maker, byte-compile-byte-code-unmake):
Remove, not used any more.
(byte-compile-arglist-vars, byte-compile-make-lambda-lexenv)
(byte-compile-make-args-desc): New funs.
(byte-compile-lambda): Handle lexical functions.  Always return
a byte-code-function.
(byte-compile-reserved-constants): New var, to make up room for
closed-over variables.
(byte-compile-constants-vector): Obey it.
(byte-compile-top-level): New args `lexenv' and `reserved-csts'.
(byte-compile-macroexpand-declare-function): New function.
(byte-compile-form): Call byte-compile-unfold-bcf to inline immediate
byte-code-functions.
(byte-compile-form): Check obsolescence here.
(byte-compile-inline-lapcode, byte-compile-unfold-bcf): New functions.
(byte-compile-variable-ref): Remove.
(byte-compile-dynamic-variable-op): New fun.
(byte-compile-dynamic-variable-bind, byte-compile-variable-ref)
(byte-compile-variable-set): New funs.
(byte-compile-discard): Add 2 args.
(byte-compile-stack-ref, byte-compile-stack-set)
(byte-compile-make-closure, byte-compile-get-closed-var): New funs.
(byte-compile-funarg, byte-compile-funarg-2): Remove, handled in
macroexpand-all instead.
(byte-compile-quote-form): Remove.
(byte-compile-push-binding-init, byte-compile-not-lexical-var-p)
(byte-compile-bind, byte-compile-unbind): New funs.
(byte-compile-let): Handle let* and lexical binding.
(byte-compile-let*): Remove.
(byte-compile-catch, byte-compile-unwind-protect)
(byte-compile-track-mouse, byte-compile-condition-case):
Handle a new :fun-body form, used for lexical scoping.
(byte-compile-save-window-excursion)
(byte-compile-with-output-to-temp-buffer): Remove.
(byte-compile-defun): Simplify.
(byte-compile-stack-adjustment): New fun.
(byte-compile-out): Use it.
(byte-compile-refresh-preloaded): Don't reload byte-compiler files.

* lisp/emacs-lisp/cconv.el: New file.

* lisp/emacs-lisp/cl-extra.el (cl-macroexpand-all): Properly quote CL
closures.

* lisp/emacs-lisp/cl-macs.el (cl-byte-compile-block)
(cl-byte-compile-throw): Remove.
(cl-block-wrapper, cl-block-throw): Use compiler-macros instead.

* lisp/emacs-lisp/cl.el (pushnew): Silence warning.

* lisp/emacs-lisp/disass.el (disassemble-internal): Handle new
`closure' objects.
(disassemble-1): Handle new byte codes.

* lisp/emacs-lisp/edebug.el (edebug-eval-defun)
(edebug-eval-top-level-form): Use eval-sexp-add-defvars.
(edebug-toggle): Avoid `eval'.

* lisp/emacs-lisp/eieio-comp.el: Remove.

* lisp/emacs-lisp/eieio.el (byte-compile-file-form-defmethod):
Don't autoload.
(eieio-defgeneric-form-primary-only-one): Use `byte-compile' rather
than the internal `byte-compile-lambda'.
(defmethod): Don't hide code under quotes.
(eieio-defmethod): New `code' argument.

* lisp/emacs-lisp/float-sup.el (pi): Don't declare as dynamically bound.

* lisp/emacs-lisp/lisp-mode.el (eval-last-sexp-1):
Use eval-sexp-add-defvars.
(eval-sexp-add-defvars): New fun.

* lisp/emacs-lisp/macroexp.el: Use lexical binding.
(macroexpand-all-1): Check obsolete macros.  Expand compiler-macros.
Don't convert ' to #' without checking that it's indeed quoting
a lambda.

* lisp/emacs-lisp/pcase.el: Don't use destructuring-bind.
(pcase--memoize): Rename from pcase-memoize.  Change weakness.
(pcase): Add `let' pattern.
Change memoization so it actually works.
(pcase-mutually-exclusive-predicates): Add byte-code-function-p.
(pcase--u1) <guard, pred>: Fix possible shadowing problem.
<let>: New case.

* src/alloc.c (Fmake_symbol): Init new `declared_special' field.

* src/buffer.c (defvar_per_buffer): Set new `declared_special' field.

* src/bytecode.c (Bstack_ref, Bstack_set, Bstack_set2, BdiscardN):
New byte-codes.
(exec_byte_code): New function extracted from Fbyte_code to handle new
calling convention for byte-code-functions.  Add new byte-codes.

* src/callint.c (Fcall_interactively): Preserve lexical-binding mode for
interactive spec.

* src/doc.c (Fdocumentation, store_function_docstring):
* src/data.c (Finteractive_form): Handle closures.

* src/eval.c (Fsetq): Handle lexical vars.
(Fdefun, Fdefmacro, Ffunction): Make closures when needed.
(Fdefconst, Fdefvaralias, Fdefvar): Mark as dynamic.
(FletX, Flet): Obey lexical binding.
(Fcommandp): Handle closures.
(Feval): New `lexical' arg.
(eval_sub): New function extracted from Feval.  Use it almost
everywhere where Feval was used.  Look up vars in lexical env.
Handle closures.
(Ffunctionp): Move from subr.el.
(Ffuncall): Handle closures.
(apply_lambda): Remove `eval_flags'.
(funcall_lambda): Handle closures and new byte-code-functions.
(Fspecial_variable_p): New function.
(syms_of_eval): Initialize the Vinternal_interpreter_environment var,
but without exporting it to Lisp.

* src/fns.c (concat, mapcar1): Accept byte-code-functions.

* src/image.c (parse_image_spec): Use Ffunctionp.

* src/keyboard.c (eval_dyn): New fun.
(menu_item_eval_property): Use it.

* src/lisp.h (struct Lisp_Symbol): New field `declared_special'.

* src/lread.c (lisp_file_lexically_bound_p): New function.
(Fload): Bind Qlexical_binding.
(readevalloop): Remove `evalfun' arg.
Bind Qinternal_interpreter_environment.
(Feval_buffer): Bind Qlexical_binding.
(defvar_int, defvar_bool, defvar_lisp_nopro, defvar_kboard):
Mark as dynamic.
(syms_of_lread): Declare `lexical-binding'.

* src/window.c (Ftemp_output_buffer_show): New fun.
(Fsave_window_excursion):
* src/print.c (Fwith_output_to_temp_buffer): Move to subr.el.

1 files changed, 132 insertions, 73 deletions

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 916dcd4785c..e6c4ccbbc50 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -1,4 +1,4 @@
-;;; pcase.el --- ML-style pattern-matching macro for Elisp
+;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2010-2011  Free Software Foundation, Inc.
 
@@ -27,16 +27,21 @@
 
 ;; Todo:
 
+;; - (pcase e (`(,x . ,x) foo)) signals an "x unused" warning if `foo' doesn't
+;;   use x, because x is bound separately for the equality constraint
+;;   (as well as any pred/guard) and for the body, so uses at one place don't
+;;   count for the other.
 ;; - provide ways to extend the set of primitives, with some kind of
 ;;   define-pcase-matcher.  We could easily make it so that (guard BOOLEXP)
 ;;   could be defined this way, as a shorthand for (pred (lambda (_) BOOLEXP)).
 ;;   But better would be if we could define new ways to match by having the
 ;;   extension provide its own `pcase--split-<foo>' thingy.
+;; - along these lines, provide patterns to match CL structs.
 ;; - provide something like (setq VAR) so a var can be set rather than
 ;;   let-bound.
-;; - provide a way to fallthrough to other cases.
+;; - provide a way to fallthrough to subsequent cases.
 ;; - try and be more clever to reduce the size of the decision tree, and
-;;   to reduce the number of leafs that need to be turned into function:
+;;   to reduce the number of leaves that need to be turned into function:
 ;;   - first, do the tests shared by all remaining branches (it will have
 ;;     to be performed anyway, so better so it first so it's shared).
 ;;   - then choose the test that discriminates more (?).
@@ -45,14 +50,12 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
-
 ;; Macro-expansion of pcase is reasonably fast, so it's not a problem
 ;; when byte-compiling a file, but when interpreting the code, if the pcase
 ;; is in a loop, the repeated macro-expansion becomes terribly costly, so we
 ;; memoize previous macro expansions to try and avoid recomputing them
 ;; over and over again.
-(defconst pcase-memoize (make-hash-table :weakness t :test 'equal))
+(defconst pcase--memoize (make-hash-table :weakness 'key :test 'eq))
 
 (defconst pcase--dontcare-upats '(t _ dontcare))
 
@@ -69,6 +72,7 @@ UPatterns can take the following forms:
   `QPAT		matches if the QPattern QPAT matches.
   (pred PRED)	matches if PRED applied to the object returns non-nil.
   (guard BOOLEXP)	matches if BOOLEXP evaluates to non-nil.
+  (let UPAT EXP)	matches if EXP matches UPAT.
 If a SYMBOL is used twice in the same pattern (i.e. the pattern is
 \"non-linear\"), then the second occurrence is turned into an `eq'uality test.
 
@@ -88,10 +92,21 @@ E.g. you can match pairs where the cdr is larger than the car with a pattern
 like `(,a . ,(pred (< a))) or, with more checks:
 `(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))"
   (declare (indent 1) (debug case))     ;FIXME: edebug `guard' and vars.
-  (or (gethash (cons exp cases) pcase-memoize)
-      (puthash (cons exp cases)
-               (pcase--expand exp cases)
-               pcase-memoize)))
+  ;; We want to use a weak hash table as a cache, but the key will unavoidably
+  ;; be based on `exp' and `cases', yet `cases' is a fresh new list each time
+  ;; we're called so it'll be immediately GC'd.  So we use (car cases) as key
+  ;; which does come straight from the source code and should hence not be GC'd
+  ;; so easily.
+  (let ((data (gethash (car cases) pcase--memoize)))
+    ;; data = (EXP CASES . EXPANSION)
+    (if (and (equal exp (car data)) (equal cases (cadr data)))
+        ;; We have the right expansion.
+        (cddr data)
+      (when data
+        (message "pcase-memoize: equal first branch, yet different"))
+      (let ((expansion (pcase--expand exp cases)))
+        (puthash (car cases) (cons exp (cons cases expansion)) pcase--memoize)
+        expansion))))
 
 ;;;###autoload
 (defmacro pcase-let* (bindings &rest body)
@@ -145,6 +160,8 @@ of the form (UPAT EXP)."
   (and (symbolp upat) (not (memq upat pcase--dontcare-upats))))
 
 (defun pcase--expand (exp cases)
+  ;; (message "pid=%S (pcase--expand %S ...hash=%S)"
+  ;;          (emacs-pid) exp (sxhash cases))
   (let* ((defs (if (symbolp exp) '()
                  (let ((sym (make-symbol "x")))
                    (prog1 `((,sym ,exp)) (setq exp sym)))))
@@ -165,7 +182,9 @@ of the form (UPAT EXP)."
                 ;; to a separate function if that number is too high.
                 ;;
                 ;; We've already used this branch.  So it is shared.
-                (destructuring-bind (code prevvars res) prev
+                (let* ((code (car prev))         (cdrprev (cdr prev))
+                       (prevvars (car cdrprev))  (cddrprev (cdr cdrprev))
+                       (res (car cddrprev)))
                   (unless (symbolp res)
                     ;; This is the first repeat, so we have to move
                     ;; the branch to a separate function.
@@ -269,7 +288,10 @@ MATCH is the pattern that needs to be matched, of the form:
   (and MATCH ...)
   (or MATCH ...)"
   (when (setq branches (delq nil branches))
-    (destructuring-bind (match code &rest vars) (car branches)
+    (let* ((carbranch (car branches))
+           (match (car carbranch)) (cdarbranch (cdr carbranch))
+           (code (car cdarbranch))
+           (vars (cdr cdarbranch)))
       (pcase--u1 (list match) code vars (cdr branches)))))
 
 (defun pcase--and (match matches)
@@ -281,19 +303,25 @@ MATCH is the pattern that needs to be matched, of the form:
     (symbolp . consp)
     (symbolp . arrayp)
     (symbolp . stringp)
+    (symbolp . byte-code-function-p)
     (integerp . consp)
     (integerp . arrayp)
     (integerp . stringp)
+    (integerp . byte-code-function-p)
     (numberp . consp)
     (numberp . arrayp)
     (numberp . stringp)
+    (numberp . byte-code-function-p)
     (consp . arrayp)
     (consp . stringp)
-    (arrayp . stringp)))
+    (consp . byte-code-function-p)
+    (arrayp . stringp)
+    (arrayp . byte-code-function-p)
+    (stringp . byte-code-function-p)))
 
 (defun pcase--split-match (sym splitter match)
-  (case (car match)
-    ((match)
+  (cond
+    ((eq (car match) 'match)
      (if (not (eq sym (cadr match)))
          (cons match match)
        (let ((pat (cddr match)))
@@ -307,7 +335,7 @@ MATCH is the pattern that needs to be matched, of the form:
                                              (cdr pat)))))
           (t (let ((res (funcall splitter (cddr match))))
                (cons (or (car res) match) (or (cdr res) match))))))))
-    ((or and)
+    ((memq (car match) '(or and))
      (let ((then-alts '())
            (else-alts '())
            (neutral-elem (if (eq 'or (car match))
@@ -474,53 +502,60 @@ Otherwise, it defers to REST which is a list of branches of the form
         (pcase--u1 (cons `(match ,var or . ,(nreverse simples)) (cdr matches))
                    code vars
                    (if (null others) rest
-                     (cons (list*
+                     (cons (cons
                             (pcase--and (if (cdr others)
                                             (cons 'or (nreverse others))
                                           (car others))
                                         (cdr matches))
-                            code vars)
+                            (cons code vars))
                            rest))))
        (t
         (pcase--u1 (cons (pop alts) (cdr matches)) code vars
                    (if (null alts) (progn (error "Please avoid it") rest)
-                     (cons (list*
+                     (cons (cons
                             (pcase--and (if (cdr alts)
                                             (cons 'or alts) (car alts))
                                         (cdr matches))
-                            code vars)
+                            (cons code vars))
                            rest)))))))
    ((eq 'match (caar matches))
-    (destructuring-bind (op sym &rest upat) (pop matches)
+    (let* ((popmatches (pop matches))
+           (_op (car popmatches))      (cdrpopmatches (cdr popmatches))
+           (sym (car cdrpopmatches))
+           (upat (cdr cdrpopmatches)))
       (cond
        ((memq upat '(t _)) (pcase--u1 matches code vars rest))
        ((eq upat 'dontcare) :pcase--dontcare)
-       ((functionp upat)  (error "Feature removed, use (pred %s)" upat))
        ((memq (car-safe upat) '(guard pred))
         (if (eq (car upat) 'pred) (put sym 'pcase-used t))
-        (destructuring-bind (then-rest &rest else-rest)
-            (pcase--split-rest
-             sym (apply-partially #'pcase--split-pred upat) rest)
+        (let* ((splitrest
+                (pcase--split-rest
+                 sym (apply-partially #'pcase--split-pred upat) rest))
+               (then-rest (car splitrest))
+               (else-rest (cdr splitrest)))
           (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat)))
                          `(,(cadr upat) ,sym)
                        (let* ((exp (cadr upat))
                               ;; `vs' is an upper bound on the vars we need.
                               (vs (pcase--fgrep (mapcar #'car vars) exp))
-                              (call (cond
-                                     ((eq 'guard (car upat)) exp)
-                                     ((functionp exp) `(,exp ,sym))
-                                     (t `(,@exp ,sym)))))
+                              (env (mapcar (lambda (var)
+                                             (list var (cdr (assq var vars))))
+                                           vs))
+                              (call (if (eq 'guard (car upat))
+                                        exp
+                                      (when (memq sym vs)
+                                        ;; `sym' is shadowed by `env'.
+                                        (let ((newsym (make-symbol "x")))
+                                          (push (list newsym sym) env)
+                                          (setq sym newsym)))
+                                      (if (functionp exp) `(,exp ,sym)
+                                        `(,@exp ,sym)))))
                          (if (null vs)
                              call
                            ;; Let's not replace `vars' in `exp' since it's
                            ;; too difficult to do it right, instead just
                            ;; let-bind `vars' around `exp'.
-                           `(let ,(mapcar (lambda (var)
-                                            (list var (cdr (assq var vars))))
-                                          vs)
-                              ;; FIXME: `vars' can capture `sym'.  E.g.
-                              ;; (pcase x ((and `(,x . ,y) (pred (fun x)))))
-                              ,call))))
+                           `(let* ,env ,call))))
                      (pcase--u1 matches code vars then-rest)
                      (pcase--u else-rest))))
        ((symbolp upat)
@@ -531,6 +566,25 @@ Otherwise, it defers to REST which is a list of branches of the form
           (pcase--u1 (cons `(match ,sym . (pred (eq ,(cdr (assq upat vars)))))
                            matches)
                      code vars rest)))
+       ((eq (car-safe upat) 'let)
+        ;; A upat of the form (let VAR EXP).
+        ;; (pcase--u1 matches code
+        ;;            (cons (cons (nth 1 upat) (nth 2 upat)) vars) rest)
+        (let* ((exp
+                (let* ((exp (nth 2 upat))
+                       (found (assq exp vars)))
+                  (if found (cdr found)
+                    (let* ((vs (pcase--fgrep (mapcar #'car vars) exp))
+                           (env (mapcar (lambda (v) (list v (cdr (assq v vars))))
+                                        vs)))
+                      (if env `(let* ,env ,exp) exp)))))
+               (sym (if (symbolp exp) exp (make-symbol "x")))
+               (body
+                (pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches)
+                           code vars rest)))
+          (if (eq sym exp)
+              body
+            `(let* ((,sym ,exp)) ,body))))
        ((eq (car-safe upat) '\`)
         (put sym 'pcase-used t)
         (pcase--q1 sym (cadr upat) matches code vars rest))
@@ -546,13 +600,15 @@ Otherwise, it defers to REST which is a list of branches of the form
                 (setq all nil))))
           (if all
               ;; Use memq for (or `a `b `c `d) rather than a big tree.
-              (let ((elems (mapcar 'cadr (cdr upat))))
-                (destructuring-bind (then-rest &rest else-rest)
-                    (pcase--split-rest
-                     sym (apply-partially #'pcase--split-member elems) rest)
-                  (pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems)
-                             (pcase--u1 matches code vars then-rest)
-                             (pcase--u else-rest))))
+              (let* ((elems (mapcar 'cadr (cdr upat)))
+                     (splitrest
+                      (pcase--split-rest
+                       sym (apply-partially #'pcase--split-member elems) rest))
+                     (then-rest (car splitrest))
+                     (else-rest (cdr splitrest)))
+                (pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems)
+                           (pcase--u1 matches code vars then-rest)
+                           (pcase--u else-rest)))
             (pcase--u1 (cons `(match ,sym ,@(cadr upat)) matches) code vars
                        (append (mapcar (lambda (upat)
                                          `((and (match ,sym . ,upat) ,@matches)
@@ -575,15 +631,14 @@ Otherwise, it defers to REST which is a list of branches of the form
         ;; `(PAT3 . PAT4)) which the programmer can easily rewrite
         ;; to the more efficient `(,(and PAT1 PAT3) . ,(and PAT2 PAT4))).
         (pcase--u1 `((match ,sym . ,(cadr upat)))
-                   (lexical-let ((rest rest))
-                     ;; FIXME: This codegen is not careful to share its
-                     ;; code if used several times: code blow up is likely.
-                     (lambda (vars)
-                       ;; `vars' will likely contain bindings which are
-                       ;; not always available in other paths to
-                       ;; `rest', so there' no point trying to pass
-                       ;; them down.
-                       (pcase--u rest)))
+                   ;; FIXME: This codegen is not careful to share its
+                   ;; code if used several times: code blow up is likely.
+                   (lambda (_vars)
+                     ;; `vars' will likely contain bindings which are
+                     ;; not always available in other paths to
+                     ;; `rest', so there' no point trying to pass
+                     ;; them down.
+                     (pcase--u rest))
                    vars
                    (list `((and . ,matches) ,code . ,vars))))
        (t (error "Unknown upattern `%s'" upat)))))
@@ -600,29 +655,33 @@ Otherwise, it defers to REST which is a list of branches of the form
     ;; FIXME.
     (error "Vector QPatterns not implemented yet"))
    ((consp qpat)
-    (let ((syma (make-symbol "xcar"))
-          (symd (make-symbol "xcdr")))
-      (destructuring-bind (then-rest &rest else-rest)
-          (pcase--split-rest sym
-                             (apply-partially #'pcase--split-consp syma symd)
-                             rest)
-        (let ((then-body (pcase--u1 `((match ,syma . ,(pcase--upat (car qpat)))
-                                      (match ,symd . ,(pcase--upat (cdr qpat)))
-                                      ,@matches)
-                                    code vars then-rest)))
-          (pcase--if
-           `(consp ,sym)
-           ;; We want to be careful to only add bindings that are used.
-           ;; The byte-compiler could do that for us, but it would have to pay
-           ;; attention to the `consp' test in order to figure out that car/cdr
-           ;; can't signal errors and our byte-compiler is not that clever.
-           `(let (,@(if (get syma 'pcase-used) `((,syma (car ,sym))))
-                  ,@(if (get symd 'pcase-used) `((,symd (cdr ,sym)))))
-              ,then-body)
-           (pcase--u else-rest))))))
+    (let* ((syma (make-symbol "xcar"))
+           (symd (make-symbol "xcdr"))
+           (splitrest (pcase--split-rest
+                       sym
+                       (apply-partially #'pcase--split-consp syma symd)
+                       rest))
+           (then-rest (car splitrest))
+           (else-rest (cdr splitrest))
+           (then-body (pcase--u1 `((match ,syma . ,(pcase--upat (car qpat)))
+                                   (match ,symd . ,(pcase--upat (cdr qpat)))
+                                   ,@matches)
+                                 code vars then-rest)))
+      (pcase--if
+       `(consp ,sym)
+       ;; We want to be careful to only add bindings that are used.
+       ;; The byte-compiler could do that for us, but it would have to pay
+       ;; attention to the `consp' test in order to figure out that car/cdr
+       ;; can't signal errors and our byte-compiler is not that clever.
+       `(let (,@(if (get syma 'pcase-used) `((,syma (car ,sym))))
+              ,@(if (get symd 'pcase-used) `((,symd (cdr ,sym)))))
+          ,then-body)
+       (pcase--u else-rest))))
    ((or (integerp qpat) (symbolp qpat) (stringp qpat))
-    (destructuring-bind (then-rest &rest else-rest)
-        (pcase--split-rest sym (apply-partially 'pcase--split-equal qpat) rest)
+      (let* ((splitrest (pcase--split-rest
+                         sym (apply-partially 'pcase--split-equal qpat) rest))
+             (then-rest (car splitrest))
+             (else-rest (cdr splitrest)))
       (pcase--if `(,(if (stringp qpat) #'equal #'eq) ,sym ',qpat)
                  (pcase--u1 matches code vars then-rest)
                  (pcase--u else-rest))))