7.2  An Example

As an example, we take two simple extensions: an implementation of red-black trees and a simple ``functor''-like syntax that encapsulates the operations on the rb-tree data-type. The files for an extension should reside in a separate directory, so in the case of our simple functor-implementations we have the following directory-structure:

functor.scm
functor/
  utils.scm

Here we put the macro-definition for define-functor in a separate file, this simplifies the use in compiled code. The code follows:

;;; functor.scm

(require 'srfi-1)
(require-for-syntax 'match)

(define-macro (define-functor name imports . body)
  (let ([exports 
         (filter-map
          (match-lambda
            [('define (name . llist) . body) name]
            [('define name val) name] 
            [_ #f] )
          body) ] )
    `(define (,name ,@imports)
       ,@body
       (values ,@exports) ) ) )

and

;;; functor/utils.scm

(define (instantiate-functor f . imports)
  (apply f imports) )

One more thing is needed: a setup specification that contains information about the files and settings of the extension. In this case we have:

;;; functor.setup

(chicken-setup (command-line-arguments)
  (functor ((syntax)
            (require-at-runtime (functor utils)) )
    (utils ()) ) )

Now we create an extension package:

% csi -setup functor -wrap
wrapping extension `functor' ...
functor.setup
functor.scm
functor/
functor/utils.scm

This will create the compressed archive functor.egg.

A user of this package can now use csi in combination with the -setup option to extract the contents from the archive, to build its components and install it in his Chicken system for easy use.

% ls
functor.egg
% csi -setup functor -build
extracting files from extension `functor' ...
functor.setup
functor.scm
functor/
functor/utils.scm
building extension `functor' ...
backing up registry...
adding entry for `/home/felix/chicken/lib/functor.setup' ...
compiling: csc -s ./functor/utils.scm -o ./functor/utils.so -O1 
removing temporary extension `/home/felix/chicken/lib/functor.setup' ...
restoring registry

Note that functor.scm is not compiled, because it is explicitly marked as syntax, which means it is only meant to be used at compile-time, in source-form.

The extension is now installed and ready for use.

% csi -quiet
>>> (require-for-syntax 'functor)
; loading /home/felix/chicken/lib/functor.scm ...
; loading /home/felix/chicken/lib/functor/utils.so ...
>>> (define-functor adder (+) 
      (define (make-adder init)
        (lambda (x)
          (set! init (+ init x))
          init) ) )
>>> (define ma (instantiate-functor adder +))
>>> (define a1 (ma 99))
>>> (a1 1)
100
>>> (a1 22)
122
>>>

The extension for red/black trees is created in much the same way:

;;; rbtree.scm
;
; taken directly from Chris Okasaki's ``Purely functional Data Structures''

(require-for-syntax 'match)
(require-for-syntax 'functor)

(define-functor rb-tree (rb<?)

  (define (member? x t)
    (match t
      [() #f]
      [(_ a y b) 
       (cond [(rb<? x y) (member? x a)]
             [(rb<? y x) (member? x b)]
             [else #t] ) ] ))

  (define balance
    (match-lambda
      [(or ('black ('red ('red a x b) y c) z d)
           ('black ('red a x ('red b y c)) z d)
           ('black a x ('red ('red b y c) z d))
           ('black a x ('red b y ('red c z d))) )
       `(red (black ,a ,x ,b) ,y (black ,c ,z ,d)) ]
      [body body] ) )

  (define (insert x s)
    (define ins
      (match-lambda
        [() `(red () ,x ())]
        [(and s (color a y b))
         (cond [(rb<? x y) (balance (list color (ins a) y b))]
               [(rb<? y x) (balance (list color a y (ins b)))]
               [else s] ) ] ) )
    (match (ins s)
      [(_ a y b) `(black ,a ,y ,b)] ) ) )

The setup-specification looks like this. Since we only have a single file, we don't need to put it in a separate directory:

(chicken-setup (command-line-arguments)
  (rb-tree ((options "-O2")
            (file "rbtree.scm")
            (require-for-syntax functor match) ) ) )

Note the properties used: (options "-O2") overrides the default compiler-options ("-O1") and we use a different name for the source file²⁶. This extension requires the define-functor extension, we have to use require-for-syntax to make sure that the macro is included at compile-time.

The wrapping, unwrapping, building and installation works identical to the previously given example. Here is some code that uses both extensions:

% cat testrb.scm
(require 'rb-tree 'srfi-1 'extras)
(require '(functor utils))

(define-values (num-rb-member? num-rb-balance num-rb-insert)
  (instantiate-functor rb-tree <) )

(randomize)
(print "building list...")
(define vals (list-tabulate 10000 (lambda (_) (random 100000))))

(print "building rb-tree...")
(define t1 '())
(for-each (lambda (n) (set! t1 (num-rb-insert n t1))) vals)

(print "building hash-table...")
(define ht (make-hash-table))
(for-each (lambda (n) (hash-table-set! ht n #t)) vals)

(print "linear list:")
(time (every (lambda (n) (memq n vals)) vals))

(print "hash-table:")
(time (every (lambda (n) (hash-table-ref ht n)) vals))

(print "rb:")
(time (every (lambda (n) (num-rb-member? n t1)) vals))
% csc testrb.scm -O2
% testrb
building list...
building rb-tree...
building hash-table...
linear list:
    1.74 seconds elapsed
       0 seconds in GC
       0 mutations
     161 minor GCs
       0 major GCs
hash-table:
    0.03 seconds elapsed
       0 seconds in GC
       0 mutations
     779 minor GCs
       0 major GCs
rb:
    0.27 seconds elapsed
    0.02 seconds in GC
       0 mutations
    4684 minor GCs
       0 major GCs