goops-allocate-instance

This page is an attempt to make clear what is the role of the allocate-instance generic function in the goops extension of Guile.

The final guideline of this page is that, unless one is a real expert of GOOPS internals, allocate-instance is a function not to be messed with; if one is an expert: overloading the function is mainly a way to get more debugging informations.

This page deals with version 1.8 of Guile.

How to use allocate-instance

To understand the role of allocate-instance we have to take a look at the original GOOPS code:

 (define-method (allocate-instance (class <class>) initargs) 
   (%allocate-instance class initargs)) 
  
 (define-method (make-instance (class <class>) . initargs) 
   (let ((instance (allocate-instance class initargs))) 
     (initialize instance initargs) 
     instance)) 
  
 (define make make-instance) 

we see that the instance making protocol is really simple: allocate, initialise, return result; initialize is itself a generic function, and it should really be initialize! because it mutates its first argument and its return value is undefined.

make-instance is itself a generic function, so we can override it to implement a different instance making protocol, to do it we use a meta class:

 (define-class <my-class> (<class>)) 
  
 (define-method (make-instance (class <my-class>) . initargs) 
   ...) 
  
 (define-class <spiffy-object> () 
   slot-a slot-b slot-c 
   #:metaclass <my-class>) 

now:

 (define o (make <spiffy-object>)) 

invokes the make-instance method specialised for <my-class> classes. But if we do this: we are supposed to make sure that allocate-instance has the same role, to allocate storage space for the instance.

Overriding allocate-instance

To override the function we use a meta class:

 (define-class <my-class> (<class>)) 
  
  
 (define-method (allocate-instance (class <my-class>) . initargs) 
   ...) 
  
 (define-class <spiffy-object> () 
   slot-a slot-b slot-c 
   #:metaclass <my-class>) 

now:

 (define o (make <spiffy-object>)) 

invokes the allocate-instance method specialised for <my-class>. Every method in allocate-instance that does not wrap in GOOPS a foreign object system has to invoke one among:

• the built in %allocate-instance, it is not exported by (oop goops) so we have to call it with:

 ((@@ (oop goops) %allocate-instance) class initargs) 

• the next-method closure, it makes sense to do it if we need to validate the options;
• allocate-instance itself with a different class.

Notice that by doing:

 (define-class <meta-A> (<class>)) 
 (define-class <A> ()    #:metaclass <meta-A>) 
 (define-class <B> ()) 
  
 (define-method (allocate-instance (c <meta-A>) initargs) 
   (allocate-instance <B> initargs)) 

we end up allocating and initialising an instance of <B>, not an instance of <A>.

How many times is allocate-instance invoked?

Here we see some example of code that shows this: unless multiple inheritance is used, the function is invoked only once for each instantiated object, it is not invoked once for each superclass.

Test when all the classes have a different metaclass:

 (define-module (test) 
   #:use-module (oop goops)) 
  
 (define-class <meta-a> (<class>)) 
 (define-class <meta-b> (<class>)) 
 (define-class <meta-c> (<class>)) 
  
 (define-method (allocate-instance (c <meta-a>) args) 
   (format #t "--- allocate-instance for class <meta-a>~%") 
   (next-method)) 
  
 (define-method (allocate-instance (c <meta-b>) args) 
   (format #t "--- allocate-instance for class <meta-b>~%") 
   (next-method)) 
  
 (define-method (allocate-instance (c <meta-c>) args) 
   (format #t "--- allocate-instance for class <meta-c>~%") 
   (next-method)) 
  
 (define-class <a> ()    #:metaclass <meta-a>) 
 (define-class <b> (<a>) #:metaclass <meta-b>) 
 (define-class <c> (<b>) #:metaclass <meta-c>) 
  
 (format #t "allocating <a> ") 
 (define a (make <a>)) 
 (format #t "allocating <b> ") 
 (define b (make <b>)) 
 (format #t "allocating <c> ") 
 (define c (make <c>)) 

the output is:

allocating <a> --- allocate-instance for class <meta-a>
allocating <b> --- allocate-instance for class <meta-b>
allocating <c> --- allocate-instance for class <meta-c>

Test when only the base class has a metaclass:

 (define-module (test) 
   #:use-module (oop goops)) 
  
 (define-class <meta-a> (<class>)) 
  
 (define-method (allocate-instance (c <meta-a>) args) 
   (format #t "--- allocate-instance for class <meta-a>~%") 
   (next-method)) 
  
 (define-class <a> ()    #:metaclass <meta-a>) 
 (define-class <b> (<a>)) 
 (define-class <c> (<b>)) 
  
 (format #t "allocating <a> ") 
 (define a (make <a>)) 
 (format #t "allocating <b> ") 
 (define b (make <b>)) 
 (format #t "allocating <c> ") 
 (define c (make <c>)) 

outputs:

allocating <a> --- allocate-instance for class <meta-a>
allocating <b> --- allocate-instance for class <meta-a>
allocating <c> --- allocate-instance for class <meta-a>

Test when only the subclass has a metaclass:

 (define-module (test) 
   #:use-module (oop goops)) 
  
 (define-class <meta-c> (<class>)) 
  
 (define-method (allocate-instance (c <meta-c>) args) 
   (format #t "--- allocate-instance for class <meta-c>~%") 
   (next-method)) 
  
 (define-class <a> ()) 
 (define-class <b> (<a>)) 
 (define-class <c> (<b>) 
   #:metaclass <meta-c>) 
  
 (format #t "allocating <a>~%") 
 (define a (make <a>)) 
 (format #t "allocating <b>~%") 
 (define b (make <b>)) 
 (format #t "allocating <c>") 
 (define c (make <c>)) 

outputs:

allocating <a>
allocating <b>
allocating <c>--- allocate-instance for class <meta-c>

Test when multiple inheritance is used:

 (define-module (test) 
   #:use-module (oop goops)) 
  
 (define-class <meta-a> (<class>)) 
 (define-class <meta-b> (<class>)) 
  
 (define-method (allocate-instance (c <meta-a>) args) 
   (format #t "--- allocate-instance for class <meta-a>~%") 
   (next-method)) 
  
 (define-method (allocate-instance (c <meta-b>) args) 
   (format #t "--- allocate-instance for class <meta-b>~%") 
   (next-method)) 
  
 (define-class <a> ()    #:metaclass <meta-a>) 
 (define-class <b> ()    #:metaclass <meta-b>) 
 (define-class <c> (<b> <a>)) 
  
 (format #t "allocating <a> ") 
 (define a (make <a>)) 
 (format #t "allocating <b> ") 
 (define b (make <b>)) 
 (format #t "allocating <c>~%") 
 (define c (make <c>)) 
  
 (display (class-of c)) 
 (newline) 

outputs:

 allocating <a> --- allocate-instance for class <meta-a> 
 allocating <b> --- allocate-instance for class <meta-b> 
 allocating <c> 
 --- allocate-instance for class <meta-b> 
 --- allocate-instance for class <meta-a> 
 #<metaclass0 <c> 40351d40> 

that is allocate-instance is invoked once for each base class in a multiple inheritance hierarchy node.

Notice that allocate-instance cannot be used to parameterise the construction of an object with different base classes, even with multiple inheritance:

 (define-module (test) 
   #:use-module (oop goops)) 
  
 (define condition (make-fluid)) 
  
 (define-class <meta-a> (<class>)) 
 (define-class <meta-a1> (<class>)) 
 (define-class <meta-a2> (<class>)) 
  
 (define-class <meta-b> (<class>)) 
  
 (define-class <a> ()            #:metaclass <meta-a>) 
 (define-class <a1> (<a>)        #:metaclass <meta-a1>) 
 (define-class <a2> (<a>)        #:metaclass <meta-a2>) 
  
 (define-class <b> ()            #:metaclass <meta-b>) 
 (define-class <b1> (<a> <b>)) 
  
 (define-method (allocate-instance (c <meta-a>) args) 
   (format #t "--- allocate-instance for class <meta-a>~%") 
   (allocate-instance (if (fluid-ref condition) <a1> <a2>) args)) 
  
 (define-method (allocate-instance (b <meta-b>) args) 
   (format #t "--- allocate-instance for class <meta-b>~%") 
   (next-method)) 
  
 (format #t "with condition #t~%") 
 (with-fluids ((condition #t)) 
   (display (class-of (make <b1>))) 
   (newline)) 
  
 (format #t "~%with condition #f~%") 
 (with-fluids ((condition #f)) 
   (display (class-of (make <b1>))) 
   (newline)) 

outputs:

 with condition #t 
 --- allocate-instance for class <meta-a> 
 #<<meta-a1> <a1> 403527e0> 
  
 with condition #f 
 --- allocate-instance for class <meta-a> 
 #<<meta-a2> <a2> 40351f50> 

that is: in both cases the object is not of class <b1>.

category-guile|category-goops