From 0d6de50dc8b9acf6ca9592c64928fd2e968b74eb Mon Sep 17 00:00:00 2001
From: jgarcia <jgarcia>
Date: Tue, 10 Oct 2006 11:42:13 +0000
Subject: [PATCH] DEFCLASS's :INITFORM did not expand the value of constant
 variables such as MOST-POSITIVE-FIXNUM.

---
 src/CHANGELOG         |  6 +++++
 src/clos/defclass.lsp | 53 ++++++++++++++++++++++++++++++++++++-------
 2 files changed, 51 insertions(+), 8 deletions(-)

diff --git a/src/CHANGELOG b/src/CHANGELOG
index 8f88b8192..827203710 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -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 ***
diff --git a/src/clos/defclass.lsp b/src/clos/defclass.lsp
index 5c5304706..b55360186 100644
--- a/src/clos/defclass.lsp
+++ b/src/clos/defclass.lsp
@@ -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)