(def!type index-or-minus-1 () `(integer -1 (,sb!xc:array-dimension-limit)))
;;; the default value used for initializing character data. The ANSI
-;;; spec says this is arbitrary. CMU CL used #\NULL, which we avoid
-;;; because it's not in the ANSI table of portable characters.
-(defconstant default-init-char #\space)
+;;; spec says this is arbitrary, so we use the value that falls
+;;; through when we just let the low-level consing code initialize
+;;; all newly-allocated memory to zero.
+;;;
+;;; KLUDGE: It might be nice to use something which is a
+;;; STANDARD-CHAR, both to reduce user surprise a little and, probably
+;;; more significantly, to help SBCL's cross-compiler (which knows how
+;;; to dump STANDARD-CHARs). Unfortunately, the old CMU CL code is
+;;; shot through with implicit assumptions that it's #\NULL, and code
+;;; in several places (notably both DEFUN MAKE-ARRAY and DEFTRANSFORM
+;;; MAKE-ARRAY) would have to be rewritten. -- WHN 2001-10-04
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ ;; an expression we can use to construct a DEFAULT-INIT-CHAR value
+ ;; at load time (so that we don't need to teach the cross-compiler
+ ;; how to represent and dump non-STANDARD-CHARs like #\NULL)
+ (defparameter *default-init-char-form* '(code-char 0)))
+(defconstant default-init-char #.*default-init-char-form*)
;;; CHAR-CODE values for ASCII characters which we care about but
;;; which aren't defined in section "2.1.3 Standard Characters" of the
;;; like (MEMBER ITEM LIST :TEST #'EQ)
(defun memq (item list)
#!+sb-doc
- "Returns tail of LIST beginning with first element EQ to ITEM."
+ "Return tail of LIST beginning with first element EQ to ITEM."
;; KLUDGE: These could be and probably should be defined as
;; (MEMBER ITEM LIST :TEST #'EQ)),
;; but when I try to cross-compile that, I get an error from
(declaim (inline neq))
(defun neq (x y)
(not (eq x y)))
+
+;;; not really an old-fashioned function, but what the calling
+;;; convention should've been: like NTH, but with the same argument
+;;; order as in all the other dereferencing functions, with the
+;;; collection first and the index second
+(declaim (inline nth-but-with-sane-arg-order))
+(declaim (ftype (function (list index) t) nth-but-with-sane-arg-order))
+(defun nth-but-with-sane-arg-order (list index)
+ (nth index list))
\f
;;;; miscellaneous iteration extensions
;;;; various operations on names
;;; Is NAME a legal function name?
-(defun legal-function-name-p (name)
+(defun legal-fun-name-p (name)
(or (symbolp name)
(and (consp name)
(eq (car name) 'setf)
;;; Given a function name, return the name for the BLOCK which
;;; encloses its body (e.g. in DEFUN, DEFINE-COMPILER-MACRO, or FLET).
-(declaim (ftype (function ((or symbol cons)) symbol) function-name-block-name))
-(defun function-name-block-name (function-name)
- (cond ((symbolp function-name)
- function-name)
- ((and (consp function-name)
- (= (length function-name) 2)
- (eq (first function-name) 'setf))
- (second function-name))
+(declaim (ftype (function ((or symbol cons)) symbol) fun-name-block-name))
+(defun fun-name-block-name (fun-name)
+ (cond ((symbolp fun-name)
+ fun-name)
+ ((and (consp fun-name)
+ (= (length fun-name) 2)
+ (eq (first fun-name) 'setf))
+ (second fun-name))
(t
- (error "not legal as a function name: ~S" function-name))))
+ (error "not legal as a function name: ~S" fun-name))))
(defun looks-like-name-of-special-var-p (x)
(and (symbolp x)
(char= #\* (aref name 0))
(char= #\* (aref name (1- (length name))))))))
-;;; ANSI guarantees that some symbols are self-evaluating. This
-;;; function is to be called just before a change which would affect
-;;; that. (We don't absolutely have to call this function before such
-;;; changes, since such changes are given as undefined behavior. In
-;;; particular, we don't if the runtime cost would be annoying. But
-;;; otherwise it's nice to do so.)
-(defun about-to-modify (symbol)
+;;; Some symbols are defined by ANSI to be self-evaluating. Return
+;;; non-NIL for such symbols (and make the non-NIL value a traditional
+;;; message, for use in contexts where the user asks us to change such
+;;; a symbol).
+(defun symbol-self-evaluating-p (symbol)
(declare (type symbol symbol))
(cond ((eq symbol t)
- (error "Veritas aeterna. (can't change T)"))
+ "Veritas aeterna. (can't change T)")
((eq symbol nil)
- (error "Nihil ex nihil. (can't change NIL)"))
+ "Nihil ex nihil. (can't change NIL)")
((keywordp symbol)
- (error "Keyword values can't be changed."))
- ;; (Just because a value is CONSTANTP is not a good enough
- ;; reason to complain here, because we want DEFCONSTANT to
- ;; be able to use this function, and it's legal to DEFCONSTANT
- ;; a constant as long as the new value is EQL to the old
- ;; value.)
- ))
+ "Keyword values can't be changed.")
+ (t
+ nil)))
+
+;;; This function is to be called just before a change which would
+;;; affect the symbol value. (We don't absolutely have to call this
+;;; function before such changes, since such changes are given as
+;;; undefined behavior. In particular, we don't if the runtime cost
+;;; would be annoying. But otherwise it's nice to do so.)
+(defun about-to-modify-symbol-value (symbol)
+ (declare (type symbol symbol))
+ (let ((reason (symbol-self-evaluating-p symbol)))
+ (when reason
+ (error reason)))
+ ;; (Note: Just because a value is CONSTANTP is not a good enough
+ ;; reason to complain here, because we want DEFCONSTANT to be able
+ ;; to use this function, and it's legal to DEFCONSTANT a constant as
+ ;; long as the new value is EQL to the old value.)
+ (values))
+
;;; If COLD-FSET occurs not at top level, just treat it as an ordinary
;;; assignment. That way things like
(t
(error "bad option: ~S" (first option)))))))))))
`(def!method print-object ((structure ,name) ,stream)
- ;; FIXME: should probably be byte-compiled
(pprint-logical-block (,stream nil)
(print-unreadable-object (structure
,stream
projects / sbcl.git / blobdiff