DEFCLASS's :INITFORM did not expand the value of constant variables such as MOST-POSITIVE-FIXNUM.

This commit is contained in:
jgarcia 2006-10-10 11:42:13 +00:00
parent 9f836090b5
commit 0d6de50dc8
2 changed files with 51 additions and 8 deletions

View file

@ -73,6 +73,12 @@ ECL 1.0:
- GET-INTERNAL-REAL-TIME now works on Windows with 1/60s precision
(contributed by Dustin Long)
- When :INITFORM was a constant variable but not self evaluating (i.e. not T,
NIL, or a keyword), it was not processed properly
(defclass a () ((a :initform most-positive-fixnum)))
(slot-value (make-instance a) 'a) => most-positive-fixnum
;;; Local Variables: ***
;;; mode:text ***
;;; fill-column:79 ***

View file

@ -12,8 +12,45 @@
;;; ----------------------------------------------------------------------
;;; DEFCLASS
(defun make-function-initform (initform)
(if (constantp initform) initform `#'(lambda () ,initform)))
(defun self-evaluating-p (form)
;; Output T when the form has the same value if it appears quoted
;; or unquoted. It is used to check whether we can transform
;; (LIST form) into '(form ...)
(declare (si::c-local))
(and (atom form)
(or (not (symbolp form))
(member form '(t nil +initform-unsupplied+))
(and (boundp form) (constantp form) (eq (symbol-value form) form)))))
(defun make-function-initform (form)
;; INITFORM is a form that is to be evaluated at runtime. If it is a
;; constant value, we output simply a quoted form. If it is not,
;; we output a function that can be invoked at runtime to retrieve
;; the value.
;;
;; Output => (FUNCTION (LAMBDA () form))
;; => (QUOTE ...)
;;
(flet ((enclose (form) `#'(lambda () ,form)))
(cond
;; We generate function for non constant forms
((not (constantp form))
(enclose form))
;; Constants other than functions become quoted
((and (not (functionp form))
(self-evaluating-p form))
(list 'quote form))
;; Quoted forms with arguments which are not functions are
;; output as such. (the check for functions is weird, but we are
;; paranoid anyway)
((and (consp form)
(eq (first form) 'quote)
(not (functionp (second form))))
form)
;; All other stuff, including symbols other than keywords, T and NIL
;; gets in a function form
(t
(enclose form)))))
(defun parse-default-initargs (default-initargs)
(declare (si::c-local))
@ -55,15 +92,15 @@
((endp l)
(setf slots
(if (every #'constantp slots)
(list 'quote (mapcar #'second slots))
(list 'quote (mapcar #'si::maybe-unquote slots))
`(list ,@slots))))
(let* ((slotd (first l))
(initform (getf slotd :initform nil)))
(if (constantp initform)
(setf (getf slotd :initform nil) (si::maybe-unquote initform)
slotd (list 'quote slotd))
(initform (make-function-initform (getf slotd :initform nil))))
(if (eq (first initform) 'QUOTE)
(setf (getf slotd :initform nil) (second initform)
slotd (list 'quote slotd))
(setf slotd (mapcar #'(lambda (x) `',x) slotd)
(getf slotd :initform nil) (make-function-initform initform)
(getf slotd :initform nil) initform
slotd (list* 'list slotd)))
(setf (first l) slotd)))
(dolist (option args)