X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=6a8fa7b5133765a89568a7752e2ad07b626076ee;hb=a4882e3023fdd5e777169a4cbede33605281173c;hp=c20344735ba7eda43f645f34c64bd73f43b6bcc7;hpb=d604a358d8e5eb5587989e0a4f1d31dbe6ac5ffe;p=sbcl.git

diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index c203447..6a8fa7b 100644
--- a/src/compiler/globaldb.lisp
+++ b/src/compiler/globaldb.lisp
@@ -180,7 +180,7 @@
 (declaim (hash-table *info-classes*))
 #-sb-xc ; as per KLUDGE note above
 (eval-when (:compile-toplevel :execute)
-  (setf *info-classes* (make-hash-table)))
+  (setf *info-classes* (make-hash-table :test #'eq)))
 
 ;;; If NAME is the name of a type in CLASS, then return the TYPE-INFO,
 ;;; otherwise NIL.
@@ -197,8 +197,14 @@
   #+sb-xc (/noshow0 "entering CLASS-INFO-OR-LOSE, CLASS=..")
   #+sb-xc (/nohexstr class)
   (prog1
-      (or (gethash class *info-classes*)
-          (error "~S is not a defined info class." class))
+      (flet ((lookup (class)
+               (or (gethash class *info-classes*)
+                   (error "~S is not a defined info class." class))))
+        (if (symbolp class)
+            (or (get class 'class-info-or-lose-cache)
+                (setf (get class 'class-info-or-lose-cache)
+                      (lookup class)))
+            (lookup class)))
     #+sb-xc (/noshow0 "returning from CLASS-INFO-OR-LOSE")))
 (declaim (ftype (function (keyword keyword) type-info) type-info-or-lose))
 (defun type-info-or-lose (class type)
@@ -1370,6 +1376,33 @@
   :type-spec list
   :default ())
 
+;;; Used to record the source location of definitions.
+(define-info-class :source-location)
+
+(define-info-type
+  :class :source-location
+  :type :variable
+  :type-spec t
+  :default nil)
+
+(define-info-type
+  :class :source-location
+  :type :constant
+  :type-spec t
+  :default nil)
+
+(define-info-type
+  :class :source-location
+  :type :typed-structure
+  :type-spec t
+  :default nil)
+
+(define-info-type
+  :class :source-location
+  :type :symbol-macro
+  :type-spec t
+  :default nil)
+
 #!-sb-fluid (declaim (freeze-type info-env))
 
 ;;; Now that we have finished initializing *INFO-CLASSES* and
@@ -1378,7 +1411,7 @@
 (!cold-init-forms
   (/show0 "beginning *INFO-CLASSES* init, calling MAKE-HASH-TABLE")
   (setf *info-classes*
-        (make-hash-table :size #.(hash-table-size *info-classes*)))
+        (make-hash-table :test 'eq :size #.(hash-table-size *info-classes*)))
   (/show0 "done with MAKE-HASH-TABLE in *INFO-CLASSES* init")
   (dolist (class-info-name '#.(let ((result nil))
                                 (maphash (lambda (key value)