;;;; files for more information.
(in-package "SB!IMPL")
-
-(file-comment
- "$Header$")
\f
;;;; IN-PACKAGE
`(eval-when (:compile-toplevel :load-toplevel :execute)
(setq *package* (find-undeleted-package-or-lose ',package-designator))))
\f
-;;; MULTIPLE-VALUE-FOO
+;;;; MULTIPLE-VALUE-FOO
(defun list-of-symbols-p (x)
(and (listp x)
`(multiple-value-bind (,g) ,value-form
,g)))
((list-of-symbols-p vars)
- (let ((temps (mapcar #'(lambda (x)
- (declare (ignore x))
- (gensym)) vars)))
+ (let ((temps (make-gensym-list (length vars))))
`(multiple-value-bind ,temps ,value-form
,@(mapcar #'(lambda (var temp)
`(setq ,var ,temp))
;;; other things defined in terms of COND
(defmacro-mundanely when (test &body forms)
#!+sb-doc
- "First arg is a predicate. If it is non-null, the rest of the forms are
+ "If the first argument is true, the rest of the forms are
evaluated as a PROGN."
`(cond (,test nil ,@forms)))
(defmacro-mundanely unless (test &body forms)
#!+sb-doc
- "First arg is a predicate. If it is null, the rest of the forms are
+ "If the first argument is not true, the rest of the forms are
evaluated as a PROGN."
`(cond ((not ,test) nil ,@forms)))
(defmacro-mundanely and (&rest forms)
; undefined function warnings
#+sb-xc-host (/show "after PROCLAIM" (sb!c::info :function :kind 'sb!c::%%defun))
(defun sb!c::%%defun (name def doc &optional inline-expansion)
- (when (fboundp name)
- (style-warn "redefining ~S in DEFUN" name))
- (setf (sb!xc:fdefinition name) def)
- (when doc
- ;; FIXME: This should use shared SETF-name parsing logic.
- (if (and (consp name) (eq (first name) 'setf))
- (setf (fdocumentation (second name) 'setf) doc)
- (setf (fdocumentation name 'function) doc)))
- (sb!c::proclaim-as-function-name name)
- (if (eq (info :function :where-from name) :assumed)
- (progn
- (setf (info :function :where-from name) :defined)
- (if (info :function :assumed-type name)
- (setf (info :function :assumed-type name) nil))))
+ ;; When we're built as a cross-compiler, the DEF is a function
+ ;; implemented by the cross-compilation host, which is opaque to us.
+ ;; Similarly, other things like FDEFINITION or DOCUMENTATION either
+ ;; aren't ours to mess with or are meaningless to mess with. Thus,
+ ;; we punt.
+ #+sb-xc-host (declare (ignore def))
+ #-sb-xc-host
+ (progn
+ (when (fboundp name)
+ (style-warn "redefining ~S in DEFUN" name))
+ (setf (sb!xc:fdefinition name) def)
+ (when doc
+ ;; FIXME: This should use shared SETF-name-parsing logic.
+ (if (and (consp name) (eq (first name) 'setf))
+ (setf (fdocumentation (second name) 'setf) doc)
+ (setf (fdocumentation name 'function) doc))))
+ ;; Other stuff remains meaningful whether we're cross-compiling or
+ ;; native compiling.
+ (become-defined-function-name name)
(when (or inline-expansion
(info :function :inline-expansion name))
(setf (info :function :inline-expansion name)
inline-expansion))
+ ;; Voila.
name)
-;;; Ordinarily this definition of SB!C:%DEFUN as an ordinary function is not
-;;; used: the parallel (but different) definition as an IR1 transform takes
-;;; precedence. However, it's still good to define this in order to keep the
-;;; interpreter happy. We define it here (instead of alongside the parallel
-;;; IR1 transform) because while the IR1 transform is needed and appropriate
-;;; in the cross-compiler running in the host Common Lisp, this parallel
-;;; ordinary function definition is only appropriate in the target Lisp.
+;;; FIXME: Now that the IR1 interpreter is going away and EVAL-WHEN is
+;;; becoming ANSI-compliant, it should be possible to merge this and
+;;; DEF-IR1-TRANSLATOR %DEFUN into a single DEFUN. (And does %%DEFUN
+;;; merge into that too? dunno..)
(defun sb!c::%defun (name def doc source)
(declare (ignore source))
- (setf (sb!eval:interpreted-function-name def) name)
+ #-sb-xc-host (progn
+ #!+sb-interpreter
+ (setf (sb!eval:interpreted-function-name def) name))
+ (flet ((set-type-info-from-def ()
+ (setf (info :function :type name)
+ #-sb-xc-host (extract-function-type def)
+ ;; When we're built as a cross-compiler, the DEF is
+ ;; a function implemented by the cross-compilation
+ ;; host, which is opaque to us, so we have to punt here.
+ #+sb-xc-host *universal-function-type*)))
+ (ecase (info :function :where-from name)
+ (:assumed
+ (setf (info :function :where-from name) :defined)
+ (set-type-info-from-def)
+ (when (info :function :assumed-type name)
+ (setf (info :function :assumed-type name) nil)))
+ (:declared)
+ (:defined
+ (set-type-info-from-def)
+ ;; We shouldn't need to clear this here because it should be
+ ;; clear already (having been cleared when the last definition
+ ;; was processed).
+ (aver (null (info :function :assumed-type name))))))
(sb!c::%%defun name def doc))
\f
;;;; DEFVAR and DEFPARAMETER
(defmacro-mundanely defvar (var &optional (val nil valp) (doc nil docp))
#!+sb-doc
- "For defining global variables at top level. Declares the variable
- SPECIAL and, optionally, initializes it. If the variable already has a
+ "Define a global variable at top level. Declare the variable
+ SPECIAL and, optionally, initialize it. If the variable already has a
value, the old value is not clobbered. The third argument is an optional
documentation string for the variable."
`(progn
(defmacro-mundanely defparameter (var val &optional (doc nil docp))
#!+sb-doc
- "Defines a parameter that is not normally changed by the program,
- but that may be changed without causing an error. Declares the
- variable special and sets its value to VAL. The third argument is
- an optional documentation string for the parameter."
+ "Define a parameter that is not normally changed by the program,
+ but that may be changed without causing an error. Declare the
+ variable special and sets its value to VAL, overwriting any
+ previous value. The third argument is an optional documentation
+ string for the parameter."
`(progn
(declaim (special ,var))
(setq ,var ,val)
\f
;;;; iteration constructs
-;;; (These macros are defined in terms of a function DO-DO-BODY which is also
-;;; used by SB!INT:DO-ANONYMOUS. Since these macros should not be loaded
-;;; on the cross-compilation host, but SB!INT:DO-ANONYMOUS and DO-DO-BODY
-;;; should be, these macros can't conveniently be in the same file as
-;;; DO-DO-BODY.)
+;;; (These macros are defined in terms of a function DO-DO-BODY which
+;;; is also used by SB!INT:DO-ANONYMOUS. Since these macros should not
+;;; be loaded on the cross-compilation host, but SB!INT:DO-ANONYMOUS
+;;; and DO-DO-BODY should be, these macros can't conveniently be in
+;;; the same file as DO-DO-BODY.)
(defmacro-mundanely do (varlist endlist &body body)
#!+sb-doc
"DO ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form*
allowing RETURN to be used as an laternate exit mechanism."
(do-do-body varlist endlist body 'let* 'setq 'do* nil))
-;;; DOTIMES and DOLIST could be defined more concisely using destructuring
-;;; macro lambda lists or DESTRUCTURING-BIND, but then it'd be tricky to use
-;;; them before those things were defined. They're used enough times before
-;;; destructuring mechanisms are defined that it looks as though it's worth
-;;; just implementing them ASAP, at the cost of being unable to use the
-;;; standard destructuring mechanisms.
+;;; DOTIMES and DOLIST could be defined more concisely using
+;;; destructuring macro lambda lists or DESTRUCTURING-BIND, but then
+;;; it'd be tricky to use them before those things were defined.
+;;; They're used enough times before destructuring mechanisms are
+;;; defined that it looks as though it's worth just implementing them
+;;; ASAP, at the cost of being unable to use the standard
+;;; destructuring mechanisms.
(defmacro-mundanely dotimes (var-count-result &body body)
(multiple-value-bind ; to roll our own destructuring
(var count result)
(apply (lambda (var list &optional (result nil))
(values var list result))
var-list-result)
- ;; We repeatedly bind the var instead of setting it so that we never have
- ;; to give the var an arbitrary value such as NIL (which might conflict
- ;; with a declaration). If there is a result form, we introduce a
- ;; gratuitous binding of the variable to NIL w/o the declarations, then
- ;; evaluate the result form in that environment. We spuriously reference
- ;; the gratuitous variable, since we don't want to use IGNORABLE on what
- ;; might be a special var.
+ ;; We repeatedly bind the var instead of setting it so that we
+ ;; never have to give the var an arbitrary value such as NIL
+ ;; (which might conflict with a declaration). If there is a result
+ ;; form, we introduce a gratuitous binding of the variable to NIL
+ ;; without the declarations, then evaluate the result form in that
+ ;; environment. We spuriously reference the gratuitous variable,
+ ;; since we don't want to use IGNORABLE on what might be a special
+ ;; var.
(let ((n-list (gensym)))
`(do ((,n-list ,list (cdr ,n-list)))
((endp ,n-list)
projects / sbcl.git / blobdiff