Let us bring these points together with an example. Consider a simple object system with single inheritance. Objects will be normal structures, and classes will be vtables with three extra class fields: the name of the class, the parent class, and the list of fields.
So, first we need a meta-vtable that allocates instances with these extra class fields.
(define <class>
(make-vtable
(string-append standard-vtable-fields "pwpwpw")
(lambda (x port)
(format port "<<class> ~a>" (class-name x)))))
(define (class? x)
(and (struct? x)
(eq? (struct-vtable x) <class>)))
To make a structure with a specific meta-vtable, we will use
make-struct/no-tail, passing it the computed instance layout and
printer, as with make-vtable, and additionally the extra three
class fields.
(define (make-class name parent fields)
(let* ((fields (compute-fields parent fields))
(layout (compute-layout fields)))
(make-struct/no-tail <class>
layout
(lambda (x port)
(print-instance x port))
name
parent
fields)))
Instances will store their associated data in slots in the structure: as
many slots as there are fields. The compute-layout procedure
below can compute a layout, and field-index returns the slot
corresponding to a field.
(define-syntax-rule (define-accessor name n)
(define (name obj)
(struct-ref obj n)))
;; Accessors for classes
(define-accessor class-name (+ vtable-offset-user 0))
(define-accessor class-parent (+ vtable-offset-user 1))
(define-accessor class-fields (+ vtable-offset-user 2))
(define (compute-fields parent fields)
(if parent
(append (class-fields parent) fields)
fields))
(define (compute-layout fields)
(make-struct-layout
(string-concatenate (make-list (length fields) "pw"))))
(define (field-index class field)
(list-index (class-fields class) field))
(define (print-instance x port)
(format port "<~a" (class-name (struct-vtable x)))
(for-each (lambda (field idx)
(format port " ~a: ~a" field (struct-ref x idx)))
(class-fields (struct-vtable x))
(iota (length (class-fields (struct-vtable x)))))
(format port ">"))
So, at this point we can actually make a few classes:
(define-syntax-rule (define-class name parent field ...) (define name (make-class 'name parent '(field ...)))) (define-class <surface> #f width height) (define-class <window> <surface> x y)
And finally, make an instance:
(make-struct/no-tail <window> 400 300 10 20) ⇒ <<window> width: 400 height: 300 x: 10 y: 20>
And that’s that. Note that there are many possible optimizations and feature enhancements that can be made to this object system, and the included GOOPS system does make most of them. For more simple use cases, the records facility is usually sufficient. But sometimes you need to make new kinds of data abstractions, and for that purpose, structs are here.