;;;; files for more information.
(in-package "SB!IMPL")
+
\f
;;;; 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)))))
\f
;;;; MULTIPLE-VALUE-FOO
#-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
(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
#+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)
\f
;;;; DEFVAR and DEFPARAMETER
(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
(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)
\f
;;;; iteration constructs
;;; 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