diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp
index d9896677818489c55de021fa96b57829c30c99e7..15dd335080f91d61d7ee5374aae090ff5967af35 100644
--- a/compiler/ir1tran.lisp
+++ b/compiler/ir1tran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.40 1991/04/04 14:34:41 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.41 1991/04/20 14:09:59 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -39,6 +39,15 @@
 (defvar *lexical-environment*)
 (proclaim '(type lexenv *lexical-environment*))
 
+;;; That variable is used to control the context-sensitive declarations
+;;; mechanism (see WITH-COMPILATION-UNIT).  Each entry is a function which is
+;;; called with the function name and parent form name.  If it returns non-nil,
+;;; then that is a list of DECLARE forms which should be inserted at the head
+;;; of the body.
+;;;
+(defvar *context-declarations* ())
+(declaim (list *context-declarations*))
+
 ;;; *free-variables* translates from the names of variables referenced globally
 ;;; to the Leaf structures for them.  *free-functions* is like
 ;;; *free-variables*, only it deals with function names.
@@ -453,8 +462,10 @@
 ;;;
 (defun ir1-convert-global-lambda (fun)
   (let ((*lexical-environment*
-	 (make-lexenv :default (make-null-environment)
-		      :cookie (lexenv-cookie *lexical-environment*))))
+	 (make-lexenv
+	  :default (make-null-environment)
+	  :cookie (lexenv-cookie *lexical-environment*)
+	  :interface-cookie (lexenv-interface-cookie *lexical-environment*))))
     (ir1-convert-lambda fun)))
 
 
@@ -880,6 +891,12 @@
      (make-lexenv
       :default res
       :cookie (process-optimize-declaration spec (lexenv-cookie res))))
+    (optimize-interface
+     (make-lexenv
+      :default res
+      :interface-cookie (process-optimize-declaration
+			 spec
+			 (lexenv-interface-cookie res))))
     (type
      (process-type-declaration (cdr spec) res vars))
     (values
@@ -901,7 +918,7 @@
 	      res))))))
 
 
-;;; Process-Declarations  --  Internal
+;;; Process-Declarations  --  Interface
 ;;;
 ;;;    Use a list of Declare forms to annotate the lists of Lambda-Var and
 ;;; Functional structures which are being bound.  In addition to filling in
@@ -1082,6 +1099,9 @@
 ;;; mark the corresponding var as Ever-Used to inhibit "defined but not read"
 ;;; warnings for arguments that are only used by default forms.
 ;;;
+;;;    We bind *lexical-environment* to change the policy over to the interface
+;;; policy.
+;;;
 (defun convert-optional-entry (fun vars vals defaults)
   (declare (type clambda fun) (list vars vals defaults))
   (let* ((fvars (reverse vars))
@@ -1092,6 +1112,8 @@
 				:where-from (leaf-where-from var)
 				:specvar (lambda-var-specvar var)))
 			   fvars))
+	 (*lexical-environment*
+	  (make-lexenv :cookie (make-interface-cookie *lexical-environment*)))
 	 (fun
 	  (ir1-convert-lambda-body
 	   `((%funcall ,fun ,@(reverse vals) ,@defaults))
@@ -1171,6 +1193,10 @@
 ;;;    We deal with :allow-other-keys by delaying unknown keyword errors until
 ;;; we have scanned all the keywords.
 ;;;
+;;;    When converting the function, we bind *lexical-environment* to change
+;;; the compilation policy over to the interface policy, so that keyword args
+;;; will be checked even when type checking isn't on in general.
+;;;
 (defun convert-more-entry (res entry-vars entry-vals rest keys)
   (declare (type optional-dispatch res) (list entry-vars entry-vals keys))
   (collect ((arg-vars)
@@ -1252,7 +1278,10 @@
 	      (body `(when (and ,n-losep (not ,n-allowp))
 		       (%unknown-keyword-argument-error ,n-losep)))))))
       
-      (let ((ep (ir1-convert-lambda-body
+      (let* ((*lexical-environment*
+	      (make-lexenv :cookie
+			   (make-interface-cookie *lexical-environment*)))
+	     (ep (ir1-convert-lambda-body
 		 `((let ,(temps)
 		     ,@(body)
 		     (%funcall ,(optional-dispatch-main-entry res)
@@ -1467,9 +1496,13 @@
     
 ;;; IR1-Convert-Lambda  --  Internal
 ;;;
-;;;    Convert a Lambda into a Lambda or Optional-Dispatch leaf.
+;;;    Convert a Lambda into a Lambda or Optional-Dispatch leaf.  Name and
+;;; Parent-Form are context that is used to drive the context sensitive
+;;; declaration mechanism.  If we find an entry in *context-declarations* that
+;;; matches this context (by returning a non-null value) then we add it into
+;;; the local declarations.
 ;;;
-(defun ir1-convert-lambda (form)
+(defun ir1-convert-lambda (form &optional name parent-form)
   (unless (and (consp form) (eq (car form) 'lambda) (consp (cdr form))
 	       (listp (cadr form)))
     (compiler-error "Malformed lambda expression: ~S." form))
@@ -1479,9 +1512,15 @@
     (multiple-value-bind
 	(body decls)
 	(system:parse-body (cddr form) *lexical-environment* t)
-      (let* ((cont (make-continuation))
+      (let* ((context-decls
+	      (and parent-form
+		   (loop for fun in *context-declarations*
+		         append (funcall fun name parent-form))))
+	     (cont (make-continuation))
 	     (*lexical-environment*
-	      (process-declarations decls (append aux-vars vars) nil cont))
+	      (process-declarations (append context-decls decls)
+				    (append aux-vars vars)
+				    nil cont))
 	     (res (if (or (find-if #'lambda-var-arg-info vars) keyp)
 		      (ir1-convert-hairy-lambda body vars keyp
 						allow-other-keys
@@ -2312,7 +2351,7 @@
   Return the lexically apparent definition of the function Name.  Name may also
   be a lambda."
   (if (and (consp thing) (eq (car thing) 'lambda))
-      (reference-leaf start cont (ir1-convert-lambda thing) nil)
+      (reference-leaf start cont (ir1-convert-lambda thing nil 'function) nil)
       (multiple-value-bind (var inlinep)
 			   (find-lexically-apparent-function
 			    thing "as the argument to FUNCTION")
@@ -2487,7 +2526,8 @@
 	     (process-ftype-proclamation (first args) (rest args)))
 	    ;;
 	    ;; No non-global state to be updated.
-	    ((inline notinline maybe-inline optimize declaration freeze-type))
+	    ((inline notinline maybe-inline optimize optimize-interface
+		     declaration freeze-type))
 	    ;;
 	    ;; Totally ignore these operations at non-top-level.
 	    ((start-block end-block)
@@ -2634,7 +2674,7 @@
   (multiple-value-bind (names defs)
 		       (extract-flet-variables definitions 'flet)
     (let* ((fvars (mapcar #'(lambda (n d)
-			      (let ((res (ir1-convert-lambda d)))
+			      (let ((res (ir1-convert-lambda d n 'flet)))
 				(setf (leaf-name res) n)
 				res))
 			  names defs))
@@ -2667,7 +2707,7 @@
 	   (real-funs 
 	    (let ((*lexical-environment* (make-lexenv :functions new-fenv)))
 	      (mapcar #'(lambda (n d)
-			  (let ((res (ir1-convert-lambda d)))
+			  (let ((res (ir1-convert-lambda d n 'labels)))
 			    (setf (leaf-name res) n)
 			    res))
 		      names defs))))
@@ -3074,7 +3114,7 @@
 	    #-new-compiler def))
 
     (let* ((*current-path* (revert-source-path 'defmacro))
-	   (fun (ir1-convert-lambda def)))
+	   (fun (ir1-convert-lambda def name 'defmacro)))
       (setf (leaf-name fun)
 	    (concatenate 'string "DEFMACRO " (symbol-name name)))
       (setf (functional-arg-documentation fun) (eval lambda-list))
@@ -3134,7 +3174,7 @@
     ;; If not in a null environment, discard any forward references to this
     ;; function.
     (unless null-fenv-p (remhash name *free-functions*))
-    (let ((fun (ir1-convert-lambda (cadr def)))
+    (let ((fun (ir1-convert-lambda (cadr def) name 'defun))
 	  (old (gethash name *free-functions*)))
       (setf (leaf-name fun) name)
       ;;