;;; Now, to build out the class hierarchy.
;;;
-;; Applicables and their classes.
(define-standard-class <procedure-class> (<class>))
(define-standard-class <applicable-struct-class>
(<procedure-class>))
<extended-generic-with-setter>)
#:metaclass <applicable-struct-with-setter-class>)
-;; Methods
(define-standard-class <method> (<object>)
generic-function
specializers
(define-standard-class <accessor-method> (<method>)
(slot-definition #:init-keyword #:slot-definition))
-;; Primitive types classes
(define-standard-class <boolean> (<top>))
(define-standard-class <char> (<top>))
(define-standard-class <list> (<top>))
(struct-set! <applicable> class-index-direct-subclasses
(cons class subclasses)))))
+
+\f
+
+;;;
+;;; At this point we have defined the class hierarchy, and it's time to
+;;; move on to instance allocation and generics. Once we have generics,
+;;; we'll fill out the metaobject protocol.
+;;;
+;;; Here we define a limited version of `make', so that we can allocate
+;;; instances of specific classes. This definition will be replaced
+;;; later.
+;;;
(define (%invalidate-method-cache! gf)
(slot-set! gf 'procedure (delayed-compile gf))
(slot-set! gf 'effective-methods '()))
(scm-error 'wrong-type-arg #f "Not a keyword: ~S" (list kw) #f))
(if (eq? kw key) arg (lp l))))))
-;; A simple make which will be redefined later. This version handles
-;; only creation of gf, methods and classes (no instances).
-;;
-;; Since this code will disappear when Goops will be fully booted,
-;; no precaution is taken to be efficient.
-;;
(define (%allocate-instance class)
(let ((obj (allocate-struct class (struct-ref class class-index-nfields))))
(%clear-fields! obj)
@code{#f} otherwise."
(and (memq class (class-precedence-list (class-of obj))) #t))
+
+\f
+
+;;;
+;;; Slot access.
+;;;
+
;; In the future, this function will return the effective slot
;; definition associated with SLOT_NAME. Now it just returns some of
;; the information which will be stored in the effective slot