6.1 Decorating a procedure object

CHICKEN allows us to associate a number of values to a procedure object, storing them in the procedure object itself, which is a block object similar to a Scheme vector; the maximum number of decorations approaches the maximum length of a Scheme vector. When adding a decoration value: we must make sure that we can identify it by applying a predicate to it.

System Operation: ##sys#lambda-decoration proc pred

Iterate over the decoration slots of the procedure object proc searching for a decoration value that matches the predicate pred. If a match is found: return that value; otherwise return #f.

System Operation: ##sys#decorate-lambda proc pred decorator

Iterate over the decoration slots of the procedure object proc searching for a decoration value that matches the predicate pred:

• If a matching decoration value is found: apply the function decorator to two values, the procedure object itself and the index of the slot in which the matching decoration value is stored.
• If no matching decoration value is found: reallocate the procedure object adding a new slot, available for this call and left uninitialised. Then apply the function decorator to two values: the new procedure object; the index of the new slot.

Return the values returned by the decorator application. decorator should return the procedure object it received as argument, because, in case of reallocation, that value is the replacement of proc; we have to assume proc itself is no more a valid Scheme object after a call to this system operation.

Keyed pair as decoration value

Let’s define an API to decorate procedure objects, the decoration value is a pair object with a “type symbol” as car:

(define MY_PROCEDURE_DECORATION_KEY
  'Sau0oosh8coodahthoa4Ohquic6oshoh)

(define (make-my-procedure-decoration-value proc)
  ;;Build a new decoration value.
  ;;
  (cons MY_PROCEDURE_DECORATION_KEY proc))

(define (my-procedure-decoration-value? obj)
  ;;Return #t if OBJ is a decoration value; otherwise return #f.
  ;;
  (and (pair? obj)
       (eq? MY_PROCEDURE_DECORATION_KEY (car obj))))

(define (decorate-my-procedure proc decoration-value-payload)
  ;;Decorate the procedure PROC with a new payload value.  Return
  ;;the, possibly reallocated, procedure object.
  ;;
  (##sys#decorate-lambda proc my-procedure-decoration-value?
    (lambda (new-proc slotidx)
      (##sys#setslot new-proc slotidx
                     (make-my-procedure-decoration-value
                        decoration-value-payload))
      new-proc)))

(define (my-procedure-decoration-payload proc)
  ;;Retrieve the payload from the decoration value associated to
  ;;the procedure object PROC.  Raise an error if no such decoration
  ;;is present.
  ;;
  (cond ((##sys#lambda-decoration proc my-procedure-decoration-value?)
         => cdr)
        (else
         (error 'my-procedure-decoration-payload
           "expected procedure object decorated with my payload"
           proc))))

now we can decorate procedures as follows:

(define (the-proc)
  123)

(set! the-proc (decorate-my-procedure the-proc "ciao"))

(my-procedure-decoration-payload the-proc))
⇒ "ciao"

or as follows:

(define the-proc
  (decorate-my-procedure
      (lambda ()
        123)
    "ciao"))

(my-procedure-decoration-payload the-proc))
⇒ "ciao"