projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.9.13.46: GET-INTERNAL-RUN-TIME on Windows, + Windows cleanups
[sbcl.git]
/
src
/
code
/
condition.lisp
diff --git
a/src/code/condition.lisp
b/src/code/condition.lisp
index
165fa06
..
253b76f
100644
(file)
--- a/
src/code/condition.lisp
+++ b/
src/code/condition.lisp
@@
-41,7
+41,7
@@
(/show0 "condition.lisp 24")
(/show0 "condition.lisp 24")
-(def!struct (condition-classoid (:include slot-classoid)
+(def!struct (condition-classoid (:include classoid)
(:constructor make-condition-classoid))
;; list of CONDITION-SLOT structures for the direct slots of this
;; class
(:constructor make-condition-classoid))
;; list of CONDITION-SLOT structures for the direct slots of this
;; class
@@
-391,6
+391,8
@@
(lambda (new-value condition)
(condition-writer-function condition new-value slot-name))))
(lambda (new-value condition)
(condition-writer-function condition new-value slot-name))))
+(defvar *define-condition-hooks* nil)
+
(defun %define-condition (name parent-types layout slots documentation
report default-initargs all-readers all-writers
source-location)
(defun %define-condition (name parent-types layout slots documentation
report default-initargs all-readers all-writers
source-location)
@@
-440,7
+442,10
@@
(dolist (initarg (condition-slot-initargs slot) nil)
(when (functionp (getf e-def-initargs initarg))
(return t))))
(dolist (initarg (condition-slot-initargs slot) nil)
(when (functionp (getf e-def-initargs initarg))
(return t))))
- (push slot (condition-classoid-hairy-slots class))))))))
+ (push slot (condition-classoid-hairy-slots class)))))))
+ (when (boundp '*define-condition-hooks*)
+ (dolist (fun *define-condition-hooks*)
+ (funcall fun class))))
name))
(defmacro define-condition (name (&rest parent-types) (&rest slot-specs)
name))
(defmacro define-condition (name (&rest parent-types) (&rest slot-specs)
@@
-524,8
+529,8
@@
:initform-p ',initform-p
:documentation ',documentation
:initform
:initform-p ',initform-p
:documentation ',documentation
:initform
- ,(if (constantp initform)
- `',(eval initform)
+ ,(if (sb!xc:constantp initform)
+ `',(constant-form-value initform)
`#'(lambda () ,initform)))))))
(dolist (option options)
`#'(lambda () ,initform)))))))
(dolist (option options)
@@
-548,8
+553,8
@@
(let ((val (second initargs)))
(setq default-initargs
(list* `',(first initargs)
(let ((val (second initargs)))
(setq default-initargs
(list* `',(first initargs)
- (if (constantp val)
- `',(eval val)
+ (if (sb!xc:constantp val)
+ `',(constant-form-value val)
`#'(lambda () ,val))
default-initargs)))))
(t
`#'(lambda () ,val))
default-initargs)))))
(t
@@
-831,7
+836,8
@@
(destructuring-bind (type data) (cdr reference)
(ecase type
(:initialization
(destructuring-bind (type data) (cdr reference)
(ecase type
(:initialization
- (format stream "Initialization of ~A Metaobjects" data))
+ (format stream "Initialization of ~:(~A~) Metaobjects"
+ (substitute #\ #\- (symbol-name data))))
(:generic-function (format stream "Generic Function ~S" data))
(:section (format stream "Section ~{~D~^.~}" data)))))
(:ansi-cl
(:generic-function (format stream "Generic Function ~S" data))
(:section (format stream "Section ~{~D~^.~}" data)))))
(:ansi-cl