From c9d82c27fcf16112f3b065d4c57b98417c0bd2de Mon Sep 17 00:00:00 2001
From: Douglas Katzman <dougk@google.com>
Date: Sun, 6 Mar 2016 21:11:23 -0500
Subject: [PATCH] Always typecheck &ENVIRONMENT args even if unused.

And fix some indentation.
---
 src/compiler/early-lexenv.lisp      |  4 +++
 src/compiler/fndb.lisp              |  2 ++
 src/compiler/parse-lambda-list.lisp | 50 ++++++++++++++++++++-----------------
 3 files changed, 33 insertions(+), 23 deletions(-)

diff --git a/src/compiler/early-lexenv.lisp b/src/compiler/early-lexenv.lisp
index b75e39b0a..dab1f8771 100644
--- a/src/compiler/early-lexenv.lisp
+++ b/src/compiler/early-lexenv.lisp
@@ -146,6 +146,10 @@
 ;;; "environment objects" (of the ANSI glossary)
 (deftype lexenv-designator () '(or abstract-lexenv null))
 
+;;; Don't inline this - ABSTRACT-LEXENV would need to use DEF!STRUCT but can't.
+;;; Macroexpansion speed is not hampered by doing one type-checking call.
+(defun ensure-lexenv (x) (the lexenv-designator x))
+
 (defvar *policy*)
 (defun lexenv-policy (lexenv)
   (or (lexenv-%policy lexenv) *policy*))
diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index e2f8f06b3..1d1ec6741 100644
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -1765,6 +1765,8 @@
 (defknown policy-quality (policy symbol) policy-quality
           (flushable))
 
+(defknown ensure-lexenv (t) lexenv-designator)
+
 (defknown compiler-error (t &rest t) nil ())
 (defknown (compiler-warn compiler-style-warn) (t &rest t) (values) ())
 (defknown (compiler-notify maybe-compiler-notify) ((or string symbol) &rest t)
diff --git a/src/compiler/parse-lambda-list.lisp b/src/compiler/parse-lambda-list.lisp
index ddd242d37..af3767fc6 100644
--- a/src/compiler/parse-lambda-list.lisp
+++ b/src/compiler/parse-lambda-list.lisp
@@ -1082,15 +1082,18 @@
                ;; list again, that's when any warning(s) will be issued.
                :context :macro :silent t))
              ((outer-decls decls) (extract-var-decls decls (append env whole)))
-             (ll-env (when (eq envp t) (or env (list (make-symbol "ENV")))))
              ;; We want a hidden WHOLE arg for the lambda - not the user's -
              ;; in case one was present and declared IGNORE.
              ;; Conversely, if the user asks for &WHOLE, doesn't use it,
              ;; and doesn't declare it ignored, that deserves a warning.
              (ll-whole (make-symbol "EXPR"))
+             ;; Same for ENV arg
+             (ll-env (if (eq envp t) (make-symbol "ENV")))
              ;; Then bind the user's WHOLE from the lambda's.
              (ll-aux
-              (append (when (and (eq envp :ignore) env) `((,(car env) nil)))
+              (append (when env
+                        `((,(car env)
+                           ,(if ll-env `(if ,ll-env (ensure-lexenv ,ll-env))))))
                       (when whole `((,(car whole) ,ll-whole)))))
              ;; Drop &WHOLE and &ENVIRONMENT
              (new-ll (make-lambda-list llks nil req opt rest keys aux))
@@ -1108,27 +1111,28 @@
                                (car tail))))
           (append whole env (ds-lambda-list-variables parse nil)))
     (values `(,@(if lambda-name `(named-lambda ,lambda-name) '(lambda))
-                  (,ll-whole ,@ll-env ,@(and ll-aux (cons '&aux ll-aux)))
-               ,@(when (and docstring (eq doc-string-allowed :internal))
-                   (prog1 (list docstring) (setq docstring nil)))
-               ;; MACROLET doesn't produce an object capable of reflection,
-               ;; so don't bother inserting a different lambda-list.
-               ,@(unless (eq kind 'macrolet)
-                   ;; Normalize the lambda list by unparsing.
-                   `((declare (lambda-list ,(unparse-ds-lambda-list parse)))))
-               ,@(if outer-decls (list outer-decls))
-               ,@(and (not env) (eq envp t) `((declare (ignore ,@ll-env))))
-               ,@(sb!c:macro-policy-decls)
-               (,@(if kind
-                      `(named-ds-bind ,(if (eq kind :special-form)
-                                           `(:special-form . ,name)
-                                           `(:macro ,name . ,kind)))
-                      '(destructuring-bind))
-                   ,new-ll (,accessor ,ll-whole)
-                 ,@decls
-                 ,@(if wrap-block
-                       `((block ,(fun-name-block-name name) ,@forms))
-                       forms)))
+                  (,ll-whole ,@(and ll-env (list ll-env))
+                             ,@(and ll-aux (cons '&aux ll-aux)))
+              ,@(when (and docstring (eq doc-string-allowed :internal))
+                  (prog1 (list docstring) (setq docstring nil)))
+              ;; MACROLET doesn't produce an object capable of reflection,
+              ;; so don't bother inserting a different lambda-list.
+              ,@(unless (eq kind 'macrolet)
+                  ;; Normalize the lambda list by unparsing.
+                  `((declare (lambda-list ,(unparse-ds-lambda-list parse)))))
+              ,@(if outer-decls (list outer-decls))
+              ,@(sb!c:macro-policy-decls)
+              ,@(when (and ll-env (not env)) `((ensure-lexenv ,ll-env)))
+              (,@(if kind
+                     `(named-ds-bind ,(if (eq kind :special-form)
+                                          `(:special-form . ,name)
+                                          `(:macro ,name . ,kind)))
+                     '(destructuring-bind))
+                  ,new-ll (,accessor ,ll-whole)
+               ,@decls
+               ,@(if wrap-block
+                     `((block ,(fun-name-block-name name) ,@forms))
+                     forms)))
             docstring)))
 
 ;;; Functions should probably not retain &AUX variables as part
-- 
2.11.4.GIT