0.7.6.3:

[sbcl.git] / src / compiler / ir1tran.lisp

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 3151b25..579e41d 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -124,9 +124,8 @@
 ;;; names a macro or special form, then we error out using the
 ;;; supplied context which indicates what we were trying to do that
 ;;; demanded a function.
+(declaim (ftype (function (t string) global-var) find-free-fun))
 (defun find-free-fun (name context)
-  (declare (string context))
-  (declare (values global-var))
   (or (let ((old-free-fun (gethash name *free-funs*)))
        (and (not (invalid-free-fun-p old-free-fun))
             old-free-fun))
@@ -171,8 +170,8 @@
 ;;; corresponding value. Otherwise, we make a new leaf using
 ;;; information from the global environment and enter it in
 ;;; *FREE-VARS*. If the variable is unknown, then we emit a warning.
+(declaim (ftype (function (t) (or leaf cons heap-alien-info)) find-free-var))
 (defun find-free-var (name)
-  (declare (values (or leaf heap-alien-info)))
   (unless (symbolp name)
     (compiler-error "Variable name is not a symbol: ~S." name))
   (or (gethash name *free-vars*)
@@ -185,6 +184,15 @@
              (case kind
                (:alien
                 (info :variable :alien-info name))
+                ;; FIXME: The return value in this case should really be
+                ;; of type SB!C::LEAF.  I don't feel too badly about it,
+                ;; because the MACRO idiom is scattered throughout this
+                ;; file, but it should be cleaned up so we're not
+                ;; throwing random conses around.  --njf 2002-03-23
+                (:macro
+                 (let ((expansion (info :variable :macro-expansion name))
+                       (type (type-specifier (info :variable :type name))))
+                   `(MACRO . (the ,type ,expansion))))
                (:constant
                 (let ((value (info :variable :constant-value name)))
                   (make-constant :value value
@@ -204,7 +212,7 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   ;; The EVAL-WHEN is necessary for #.(1+ LIST-TO-HASH-TABLE-THRESHOLD) 
   ;; below. -- AL 20010227
-  (defconstant list-to-hash-table-threshold 32))
+  (def!constant list-to-hash-table-threshold 32))
 (defun maybe-emit-make-load-forms (constant)
   (let ((things-processed nil)
        (count 0))
@@ -1046,7 +1054,7 @@
        )
        ((functional-p var)
        (setf (leaf-ever-used var) t))
-       ((lambda-var-specvar var)
+       ((and (lambda-var-specvar var) (eq (first spec) 'ignore))
        ;; ANSI's definition for "Declaration IGNORE, IGNORABLE"
        ;; requires that this be a STYLE-WARNING, not a full WARNING.
        (compiler-style-warn "declaring special variable ~S to be ignored"
@@ -1165,7 +1173,7 @@
   (unless (symbolp name)
     (compiler-error "The lambda variable ~S is not a symbol." name))
   (when (member name names-so-far :test #'eq)
-    (compiler-error "The variable ~S occurs more than once in the lambda-list."
+    (compiler-error "The variable ~S occurs more than once in the lambda list."
                    name))
   (let ((kind (info :variable :kind name)))
     (when (or (keywordp name) (eq kind :constant))
@@ -1178,7 +1186,6 @@
                              :where-from (leaf-where-from specvar)
                              :specvar specvar)))
          (t
-          (note-lexical-binding name)
           (make-lambda-var :%source-name name)))))
 
 ;;; Make the default keyword for a &KEY arg, checking that the keyword
@@ -1197,7 +1204,7 @@
                   (eq (arg-info-kind info) :keyword)
                   (eq (arg-info-key info) key))
          (compiler-error
-          "The keyword ~S appears more than once in the lambda-list."
+          "The keyword ~S appears more than once in the lambda list."
           key))))
     key))
 
@@ -1463,8 +1470,8 @@
          (continuation-starts-block cont1)
          (link-node-to-previous-continuation bind cont1)
          (use-continuation bind cont2)
-         (ir1-convert-special-bindings cont2 result body aux-vars aux-vals
-                                       (svars)))
+         (ir1-convert-special-bindings cont2 result body
+                                       aux-vars aux-vals (svars)))
 
        (let ((block (continuation-block result)))
          (when block
@@ -2058,8 +2065,8 @@
       (setf (functional-inlinep fun) (defined-fun-inlinep var))
       (assert-new-definition var fun)
       (setf (defined-fun-inline-expansion var) var-expansion)
-      ;; If definitely not an interpreter stub, then substitute for any
-      ;; old references.
+      ;; If definitely not an interpreter stub, then substitute for
+      ;; any old references.
       (unless (or (eq (defined-fun-inlinep var) :notinline)
                  (not *block-compile*)
                  (and fun-info