#!+sb-doc
"Signals an error if the value of test-form is nil. Continuing from this
error using the CONTINUE restart will allow the user to alter the value of
- some locations known to SETF, starting over with test-form. Returns nil."
+ some locations known to SETF, starting over with test-form. Returns NIL."
`(do () (,test-form)
(assert-error ',test-form ',places ,datum ,@arguments)
,@(mapcar #'(lambda (place)
;;;
;;; FIXME: In reality, this restart cruft is needed hardly anywhere in
;;; the system. Write NEED and NEED-TYPE to replace ASSERT and
-;;; CHECK-TYPE inside the system.
+;;; CHECK-TYPE inside the system. (CL:CHECK-TYPE must still be
+;;; defined, since it's specified by ANSI and it is sometimes nice for
+;;; whipping up little things. But as far as I can tell it's not
+;;; usually very helpful deep inside the guts of a complex system like
+;;; SBCL.)
;;;
;;; CHECK-TYPE-ERROR isn't defined until a later file because it uses
;;; the macro RESTART-CASE, which isn't defined until a later file.
(defmacro-mundanely check-type (place type &optional type-string)
#!+sb-doc
- "Signals a restartable error of type TYPE-ERROR if the value of PLACE is
+ "Signal a restartable error of type TYPE-ERROR if the value of PLACE is
not of the specified type. If an error is signalled and the restart is
- used to return, the
- return if the
- STORE-VALUE is invoked. It will store into PLACE and start over."
+ used to return, this can only return if the STORE-VALUE restart is
+ invoked. In that case it will store into PLACE and start over."
(let ((place-value (gensym)))
- `(do ((,place-value ,place))
+ `(do ((,place-value ,place ,place))
((typep ,place-value ',type))
(setf ,place
(check-type-error ',place ,place-value ',type ,type-string)))))
-
-#!+high-security-support
-(defmacro-mundanely check-type-var (place type-var &optional type-string)
- #!+sb-doc
- "Signals an error of type TYPE-ERROR if the contents of PLACE are not of the
- specified type to which the TYPE-VAR evaluates. If an error is signaled,
- this can only return if STORE-VALUE is invoked. It will store into PLACE
- and start over."
- (let ((place-value (gensym))
- (type-value (gensym)))
- `(do ((,place-value ,place)
- (,type-value ,type-var))
- ((typep ,place-value ,type-value))
- (setf ,place
- (check-type-error ',place ,place-value ,type-value ,type-string)))))
\f
;;;; DEFCONSTANT
;;; the guts of DEFCONSTANT
(defun sb!c::%defconstant (name value doc)
(unless (symbolp name)
- (error "constant name not a symbol: ~S" name))
+ (error "The constant name is not a symbol: ~S" name))
(about-to-modify name)
(let ((kind (info :variable :kind name)))
(case kind
(t (warn "redefining ~(~A~) ~S to be a constant" kind name))))
(when doc
(setf (fdocumentation name 'variable) doc))
- (setf (symbol-value name) value)
+
+ ;; We want to set the cross-compilation host's symbol value, not just
+ ;; the cross-compiler's (INFO :VARIABLE :CONSTANT-VALUE NAME), so
+ ;; that code like
+ ;; (defconstant max-entries 61)
+ ;; (deftype entry-index () `(mod ,max-entries))
+ ;; will be cross-compiled correctly.
+ #-sb-xc-host (setf (symbol-value name) value)
+ #+sb-xc-host (progn
+ (/show (symbol-package name))
+ ;; Redefining our cross-compilation host's CL symbols
+ ;; would be poor form.
+ ;;
+ ;; FIXME: Having to check this and then not treat it
+ ;; as a fatal error seems like a symptom of things
+ ;; being pretty broken. It's also a problem in and of
+ ;; itself, since it makes it too easy for cases of
+ ;; using the cross-compilation host Lisp's CL
+ ;; constant values in the target Lisp to slip by. I
+ ;; got backed into this because the cross-compiler
+ ;; translates DEFCONSTANT SB!XC:FOO into DEFCONSTANT
+ ;; CL:FOO. It would be good to unscrew the
+ ;; cross-compilation package hacks so that that
+ ;; translation doesn't happen. Perhaps:
+ ;; * Replace SB-XC with SB-CL. SB-CL exports all the
+ ;; symbols which ANSI requires to be exported from CL.
+ ;; * Make a nickname SB!CL which behaves like SB!XC.
+ ;; * Go through the loaded-on-the-host code making
+ ;; every target definition be in SB-CL. E.g.
+ ;; DEFMACRO-MUNDANELY DEFCONSTANT becomes
+ ;; DEFMACRO-MUNDANELY SB!CL:DEFCONSTANT.
+ ;; * Make IN-TARGET-COMPILATION-MODE do
+ ;; UNUSE-PACKAGE CL and USE-PACKAGE SB-CL in each
+ ;; of the target packages (then undo it on exit).
+ ;; * Make the cross-compiler's implementation of
+ ;; EVAL-WHEN (:COMPILE-TOPLEVEL) do UNCROSS.
+ ;; (This may not require any change.)
+ ;; * Hack GENESIS as necessary so that it outputs
+ ;; SB-CL stuff as COMMON-LISP stuff.
+ ;; * Now the code here can assert that the symbol
+ ;; being defined isn't in the cross-compilation
+ ;; host's CL package.
+ (unless (eql (find-symbol (symbol-name name) :cl) name)
+ ;; KLUDGE: In the cross-compiler, we use the
+ ;; cross-compilation host's DEFCONSTANT macro
+ ;; instead of just (SETF SYMBOL-VALUE), in order to
+ ;; get whatever blessing the cross-compilation host
+ ;; may expect for a global (SETF SYMBOL-VALUE).
+ ;; (CMU CL, at least around 2.4.19, generated full
+ ;; WARNINGs for code -- e.g. DEFTYPE expanders --
+ ;; which referred to symbols which had been set by
+ ;; (SETF SYMBOL-VALUE). I doubt such warnings are
+ ;; ANSI-compliant, but I'm not sure, so I've
+ ;; written this in a way that CMU CL will tolerate
+ ;; and which ought to work elsewhere too.) -- WHN
+ ;; 2001-03-24
+ (eval `(defconstant ,name ',value))))
+
(setf (info :variable :kind name) :constant)
(setf (info :variable :constant-value name) value)
name)
(defun sb!c::%define-compiler-macro (name definition lambda-list doc)
;; FIXME: Why does this have to be an interpreted function? Shouldn't
;; it get compiled?
- (assert (sb!eval:interpreted-function-p definition))
+ (aver (sb!eval:interpreted-function-p definition))
(setf (sb!eval:interpreted-function-name definition)
(format nil "DEFINE-COMPILER-MACRO ~S" name))
(setf (sb!eval:interpreted-function-arglist definition) lambda-list)
projects / sbcl.git / blobdiff