X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefboot.lisp;h=5035116178a441a09c29e8e0084a0bde53de1636;hb=71766d9db05e93567cb7e829abfc675c3cb895c9;hp=f87d263331a339c4ac0f313e28fb31843bd83ff0;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index f87d263..5035116 100644
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -19,12 +19,14 @@
 ;;;; files for more information.
 
 (in-package "SB!IMPL")
+
 
 ;;;; IN-PACKAGE
 
-(defmacro-mundanely in-package (package-designator)
-  `(eval-when (:compile-toplevel :load-toplevel :execute)
-     (setq *package* (find-undeleted-package-or-lose ',package-designator))))
+(defmacro-mundanely in-package (string-designator)
+  (let ((string (string string-designator)))
+    `(eval-when (:compile-toplevel :load-toplevel :execute)
+       (setq *package* (find-undeleted-package-or-lose ,string)))))
 
 ;;;; MULTIPLE-VALUE-FOO
 
@@ -200,10 +202,12 @@
                    #-sb-xc-host ,named-lambda
                    #+sb-xc-host (fdefinition ',name)
                    ,doc
-                   ',inline-lambda))))))
+                   ',inline-lambda
+                   (sb!c:source-location)))))))
 
 #-sb-xc-host
-(defun %defun (name def doc inline-lambda)
+(defun %defun (name def doc inline-lambda source-location)
+  (declare (ignore source-location))
   (declare (type function def))
   (declare (type (or null simple-string) doc))
   (aver (legal-fun-name-p name)) ; should've been checked by DEFMACRO DEFUN
@@ -213,6 +217,8 @@
     (style-warn "redefining ~S in DEFUN" name))
   (setf (sb!xc:fdefinition name) def)
 
+  (sb!c::note-name-defined name :function)
+
   ;; FIXME: I want to do this here (and fix bug 137), but until the
   ;; breathtaking CMU CL function name architecture is converted into
   ;; something sane, (1) doing so doesn't really fix the bug, and
@@ -220,7 +226,11 @@
   #+nil (setf (%fun-name def) name)
 
   (when doc
-    (setf (fdocumentation name 'function) doc))
+    (setf (fdocumentation name 'function) doc)
+    #!+sb-eval
+    (when (typep def 'sb!eval:interpreted-function)
+      (setf (sb!eval:interpreted-function-documentation def)
+            doc)))
   name)
 
 ;;;; DEFVAR and DEFPARAMETER
@@ -235,7 +245,9 @@
      (eval-when (:compile-toplevel)
        (%compiler-defvar ',var))
      (eval-when (:load-toplevel :execute)
-       (%defvar ',var (unless (boundp ',var) ,val) ',valp ,doc ',docp))))
+       (%defvar ',var (unless (boundp ',var) ,val)
+                ',valp ,doc ',docp
+                (sb!c:source-location)))))
 
 (defmacro-mundanely defparameter (var val &optional (doc nil docp))
   #!+sb-doc
@@ -248,27 +260,31 @@
      (eval-when (:compile-toplevel)
        (%compiler-defvar ',var))
      (eval-when (:load-toplevel :execute)
-       (%defparameter ',var ,val ,doc ',docp))))
+       (%defparameter ',var ,val ,doc ',docp (sb!c:source-location)))))
 
 (defun %compiler-defvar (var)
   (sb!xc:proclaim `(special ,var)))
 
 #-sb-xc-host
-(defun %defvar (var val valp doc docp)
+(defun %defvar (var val valp doc docp source-location)
   (%compiler-defvar var)
   (when valp
     (unless (boundp var)
       (set var val)))
   (when docp
     (setf (fdocumentation var 'variable) doc))
+  (sb!c:with-source-location (source-location)
+    (setf (info :source-location :variable var) source-location))
   var)
 
 #-sb-xc-host
-(defun %defparameter (var val doc docp)
+(defun %defparameter (var val doc docp source-location)
   (%compiler-defvar var)
   (set var val)
   (when docp
     (setf (fdocumentation var 'variable) doc))
+  (sb!c:with-source-location (source-location)
+    (setf (info :source-location :variable var) source-location))
   var)
 
 ;;;; iteration constructs
@@ -310,25 +326,18 @@
 ;;; destructuring mechanisms.
 (defmacro-mundanely dotimes ((var count &optional (result nil)) &body body)
   (cond ((numberp count)
-         `(do ((,var 0 (1+ ,var)))
-              ((>= ,var ,count) ,result)
-            (declare (type unsigned-byte ,var))
-            ,@body))
-        (t (let ((v1 (gensym)))
-             `(do ((,var 0 (1+ ,var)) (,v1 ,count))
-                  ((>= ,var ,v1) ,result)
-                (declare (type unsigned-byte ,var))
-                ,@body)))))
-
-(defun filter-dolist-declarations (decls)
-  (mapcar (lambda (decl)
-            `(declare ,@(remove-if
-                         (lambda (clause)
-                           (and (consp clause)
-                                (or (eq (car clause) 'type)
-                                    (eq (car clause) 'ignore))))
-                         (cdr decl))))
-          decls))
+        `(do ((,var 0 (1+ ,var)))
+             ((>= ,var ,count) ,result)
+           (declare (type unsigned-byte ,var))
+           ,@body))
+        (t
+         (let ((c (gensym "COUNT")))
+           `(do ((,var 0 (1+ ,var))
+                 (,c ,count))
+                ((>= ,var ,c) ,result)
+              (declare (type unsigned-byte ,var)
+                       (type integer ,c))
+              ,@body)))))
 
 (defmacro-mundanely dolist ((var list &optional (result nil)) &body body)
   ;; We repeatedly bind the var instead of setting it so that we never