From 9db8116248d2bc08feed02152350ae939e763f17 Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Sun, 7 Oct 2012 16:03:40 +0200
Subject: [PATCH] STRUCTURE-CLASS and STRUCTURE-OBJECT are now created at boot
 time

---
 src/clos/builtin.lsp   | 18 ------------------
 src/clos/hierarchy.lsp | 21 +++++++++++++++++++++
 2 files changed, 21 insertions(+), 18 deletions(-)

diff --git a/src/clos/builtin.lsp b/src/clos/builtin.lsp
index 4b02e7d9e..3fcc14f1f 100644
--- a/src/clos/builtin.lsp
+++ b/src/clos/builtin.lsp
@@ -72,16 +72,6 @@
 ;;; STRUCTURES
 ;;;
 
-(defclass structure-class (class)
-  (slot-descriptions
-   initial-offset
-   defstruct-form
-   constructors
-   documentation
-   copier
-   predicate
-   print-function))
-
 ;;; structure-classes cannot be instantiated
 (defmethod make-instance ((class structure-class) &rest initargs)
   (declare (ignore initargs))
@@ -93,14 +83,6 @@
     (unless (eq :INSTANCE (slot-definition-allocation slot))
       (error "The structure class ~S can't have shared slots" (class-name class)))))
 
-;;; ----------------------------------------------------------------------
-;;; Structure-object
-;;;
-;;; Structure-object has no slots and inherits only from t:
-
-(defclass structure-object (t) ()
-  (:metaclass structure-class))
-
 (defmethod make-load-form ((object structure-object) &optional environment)
   (make-load-form-saving-slots object :key environment))
 
diff --git a/src/clos/hierarchy.lsp b/src/clos/hierarchy.lsp
index 3574b4306..42bce14f6 100644
--- a/src/clos/hierarchy.lsp
+++ b/src/clos/hierarchy.lsp
@@ -85,6 +85,21 @@
 	      (optimize-slot-access)
 	      (forward)))))
 
+;;; ----------------------------------------------------------------------
+;;; STRUCTURE-CLASS
+
+(eval-when (:compile-toplevel :execute)
+  (defparameter +structure-class-slots+
+    (append +class-slots+
+	    '((slot-descriptions)
+	      (initial-offset)
+	      (defstruct-form)
+	      (constructors)
+	      (documentation)
+	      (copier)
+	      (predicate)
+	      (print-function)))))
+
 ;;; ----------------------------------------------------------------------
 ;;; STANDARD-GENERIC-FUNCTION
 
@@ -290,5 +305,11 @@
       (standard-writer-method
        :direct-superclasses (standard-accessor-method)
        :direct-slots #2#)
+      (structure-class
+       :direct-superclasses (class)
+       :direct-slots #.+structure-class-slots+)
+      (structure-object
+       :metaclass structure-class
+       :direct-superclasses (t))
       )))