Outdated egg!

This is an egg for CHICKEN 4, the unsupported old release. You're almost certainly looking for the CHICKEN 5 version of this egg, if it exists.

If it does not exist, there may be equivalent functionality provided by another egg; have a look at the egg index. Otherwise, please consider porting this egg to the current version of CHICKEN.

  1. Outdated egg!
  2. Generic procedures
    1. The module generics
      1. generics
      2. define-generic
      3. define-method
      4. generic?
      5. generic-method-tree
      6. generic-variadic?
      7. generic-arity
      8. selector?
      9. selector
      10. define-selector
      11. selector-parents
      12. any??
      13. number??
      14. integer??
      15. fixnum??
      16. flonum??
      17. list??
      18. pseudo-list??
      19. pair??
      20. vector??
      21. string??
      22. procedure??
      23. index??
      24. method-tree-item
      25. method-tree-item?
      26. method-tree?
      27. method-tree-depth
      28. method-tree-show
      29. method-tree-dispatch
      30. method-tree-insert
    2. The helper module generic-helpers
      1. generic-helpers
      2. reverse*
      3. rsplit-with
      4. rsplit-at
      5. repeat
      6. proc-name
      7. map*
      8. project
      9. 1+
      10. 1-
      11. index?
      12. mfx+
      13. mfx*
      14. named-lambda
    3. Requirements
    4. Usage
    5. Examples
  3. Last update
  4. Author
  5. License
  6. Version History

Generic procedures

This library implements simple generic functions. They are ordinary procedures with state, hence closures. The state consists of a cell containing a method tree, which in turn consists of selectors and procedures, the actual methods.

The selectors are specialized predicates, which check the arguments of the generic function in sequence and choose the corresponding method. This method is than invoked on the generic's arguments. Selectors are able not only to check one but many arguments, so that rest arguments of variadic functions are handled properly. Moreover, when called without arguments, they return a parent selector, which controls the insertion point of a new method-tree-item in the tree: Arguments of more specific or often used types should be checked and found before less specific or seldom used ones.

The two fundamental macros are define-generic and define-method. The former creates a closure with state a one-item method-tree, which can be enhanced by the latter. This closure can then be invoked indirectly by searching its method-tree and applying the first matching method. The latter macro inserts a method-tree-item into the former's method-tree at the proper place controlled by the parents of the item's selectors.

Denoting selectors with two trailing question marks and using my enhanced dot notation, two dots denote zero or one of the symbol to the left, three dots zero or more, four dots one or more, their syntax is as follows:

 (define-generic (Name (x x??) ....) body ....) 
 (define-generic (Name (x x??) ... xs xs??) body ....)

for fixed or variable argument lists respectively and -- with the same syntax

 (define-method (Name (x x??) ....) body ....)
 (define-method (Name (x x??) ... xs xs??) body ....)

How can define-method access local data of define-generic's Name? It's simple. Generic functions need at least one argument. In particular, rest paramenter lists can't be empty. Otherwise, there is nothing to dispatch on. Hence we can use a thunk version of the generic function Name to export its actual method-tree, which is packaged into a cell. So define-method knows where to put the new method-tree-item and in which position to insert it.

Since a generic function can export its method-tree, it can be inspected. The function method-tree-show will do that in a human readable form, provided all the selectors are named. This is the reason, we prefer the macro define-selector over the procedure selector.

Note that we spoke about a method tree, not a method list. The reason, of course, is efficiency of method dispatch. This has consequences to the design of generic functions: The argument which probably varies the most, should appear at the last position. Maybe, this is the reason, why Clojure has Drop and Take functions with the sequence argument last, not with the list argument first as in list-tail.

The format of a method-table of depth 2 is as follows

 ((x0?? (x00?? . proc.0.00)
        (x01?? . proc.0.01)
        ...)
  (x1?? (x10?? . proc.1.10)
        (x11?? . proc.1.11)
        ...)
  ...)

Not all positions of such a table need be occupied. For example, consider the following definitions

 (define-generic (Add (x number??) (y number??)) (+ x y))
 (define-method  (Add (x fixnum??) (y fixnum??)) (fx+ x y))

Since number?? is a parent of fixnum?? this would result in the table

 ((fixnum?? (fixnum?? . ?))
  (number?? (number?? . ?)))

In a naive implementation, we'd check the first argument against the cars of the table and then the second against the cars of the resulting subtables. But that would fail, if the first argument is a fixnum and the second a number. Instead we would like to have dispatch to result in + in that case. In other words, we need backtracking, and that complicates matters.

The module generics

generics

[procedure] (generics sym ..)

documentation procedure

define-generic

[syntax] (define-generic (Name (x x??) ....) body ....)
[syntax] (define-generic (Name (x x??) ... xs xs??) body ....)

defines a new generic function Name with one anonymous method from arguments x .... or x ... . xs, selectors x?? .... or x?? ... xs?? and body .... The state of this generic consists of a cell containing a one-item method tree. This state can be accessed by calling Name as a thunk

define-method

[syntax] (define-method (Name (x x??) ....) body ....)
[syntax] (define-method (Name (x x??) ... xs xs??) body ....)

inserts an anonymous method constructed from arguments x .... or x ... . xs, selectors x?? .... or x?? ... xs?? and body .... into the method tree of the generic function Name at the position determined by selector's parents

generic?

[procedure] (generic? xpr)

type predicate

generic-method-tree

[procedure] (generic-method-tree Gen)

returns the method-tree of the generic Gen

generic-variadic?

[procedure] (generic-variadic? Gen)

is the generic function Gen variadic?

generic-arity

[procedure] (generic-arity Gen)

returns the arity of the generic function Gen i.e. the depth of its method tree

selector?

[procedure] (selector? xpr)

is xpr a selector?

selector

[procedure] (selector parent?? pred)

makes a special predicate from predicate pred and selector parent??, which might be #f

define-selector

[syntax] (define-selector name?? parent?? pred)

defines a special predicate, name??, frome its base pradicate, pred, and its parent selector, parent??, which might be #f

selector-parents

[procedure] (selector-parents sel??)

returns the parents of selector sel??

any??

[procedure] (any?? xpr)

selector without parent which always returns #t

number??

[procedure] (number?? xpr)

number selector

integer??

[procedure] (integer?? xpr)

integer selector

fixnum??

[procedure] (fixnum?? xpr)

fixnum selector

flonum??

[procedure] (flonum?? xpr)

flonum selector

list??

[procedure] (list?? xpr)

list selector

pseudo-list??

[procedure] (pseudo-list?? xpr)

pseudo-list selector

pair??

[procedure] (pair?? xpr)

pair selector

vector??

[procedure] (vector?? xpr)

vector selector

string??

[procedure] (string?? xpr)

string selector

procedure??

[procedure] (procedure?? xpr)

procedure selector

index??

[procedure] (index?? xpr)

non-negative fixnum selector

method-tree-item

[procedure] (method-tree-item proc sel?? ....)

returns a method tree item from its arguments a procedure and a non-empty list of selectors

method-tree-item?

[procedure] (method-tree-item? xpr)

is xpr a method-tree-item?

method-tree?

[procedure] (method-tree? xpr)

evaluates xpr to a method-tree?

method-tree-depth

[procedure] (method-tree-depth tree)

returns the depth of a method tree

method-tree-show

[procedure] (method-tree-show tree)

returns a readable image of the tree

method-tree-dispatch

[procedure] (method-tree-dispatch tree . args)

searches the tree according to the types of arguments args and returns the matching method, if any, or #f

method-tree-insert

[procedure] (method-tree-insert tree item)

inserts the item into the tree at the location governed by the selectors in item

The helper module generic-helpers

Some of the following procedures are used in the macros of the generics module. Others are here for convenience.

generic-helpers

[procedure] (generic-helpers sym ..)

documentation procedure

reverse*

[procedure] (reverse* rhead tail op)
[procedure] (reverse* rhead tail)
[procedure] (reverse* rhead)

a generalisation of reverse rhead is reversed onto tail or '() by means of op or cons.

rsplit-with

[procedure] (rsplit-with ok? lst)

returns two values by splitting the list at the first position where ok? returns true and reversing the head

rsplit-at

[procedure] (rsplit-at k lst)

returns two values by splitting the list at position k and reversing the head

repeat

[procedure] (repeat k fn)

applies function fn k times in sequence

proc-name

[procedure] (proc-name proc)

returns the name of proc

map*

[procedure] (map* fn xs)

maps the items of the nested pseudo-list xs via function fn

project

[procedure] (project k)

returns a procedure which chooses the kth item of its argument list

1+

[procedure] (1+ n)

add 1 to fixnum n

1-

[procedure] (1- n)

subtract 1 from fixnum n

index?

[procedure] (index? n)

is fixnum n greater or equal to 0

mfx+

[procedure] (mfx+ . nums)

add all fixnums in nums

mfx*

[procedure] (mfx+ . nums)

multiply all fixnums in nums

named-lambda

[syntax] (named-lambda (name . args) xpr . xprs)

a version of lambda which can be used recursively

Requirements

simple-cells

Usage

 

(use generics)
(import generic-helpers)

Examples

 

;; non-variadic generics
;; ---------------------
(define-generic (Add (x number??) (y number??)) (+ x y))
(define-method  (Add (x fixnum??) (y fixnum??)) (fx+ x y))

(generic? Add) ; -> #t
(generic-variadic? Add) ; -> #f
(generic-arity Add) ; -> 2
(Add 1 2.0) ; -> 3.0
(Add 1 2) ; -> 3
(condition-case (Add 1 #f) ((exn) #f)) ; -> #f

;; sequences
;; ---------
(define-generic (At (k index??) (seq list??)) (list-ref seq k))
(define-generic (Drop (k index??) (seq list??)) (list-tail seq k))
(define-generic (Take (k index??) (seq list??))
                (let loop ((n 0) (lst seq) (result '()))
                  (if (fx= n k)
                    (reverse result)
                    (loop (1+ n)
                          (cdr lst)
                          (cons (car lst) result)))))
(define seq '(0 1 2 3 4))
(At 2 seq) ; -> 2
(Drop 2 seq) ; -> '(2 3 4)
(Take 2 seq) ; -> '(0 1)
(generic? At) ; -> #t
(generic-variadic? At) ; -> #f
(generic-arity At) ; -> 2

(define-method (At (k index??) (seq vector??)) (vector-ref seq k))
(define-method (Drop (k index??) (seq vector??)) (subvector seq k))
(define-method (Take (k index??) (seq vector??)) (subvector seq 0 k))
(define-method (At (k index??) (seq string??)) (string-ref seq k))
(define-method (Drop (k index??) (seq string??)) (substring seq k))
(define-method (Take (k index??) (seq string??)) (substring seq 0 k))
(generic-variadic? At) ; -> #f
(generic-arity Take) ; -> 2
(Drop 2 "abcde") ; _> "cde"
(At 2 seq) ; -> 2
(Take 2 #(0 1 2 3 4)) ; -> #(0 1)

;; variadic generics
;; -----------------
(define-generic (Add* xs number??) (apply + xs))
(define-method (Add* xs list??) (apply append xs))
(Add* 1 2 3) ; -> 6
(Add* '(1) '(2) '(3)) ; -> '(1 2 3)
(define-method (Add* xs string??) (apply string-append xs))
(Add* "1" "2" "3") ; -> "123"
(condition-case (Add* 1 #f 3) ((exn) #f)) ; -> #f
(generic? Add*) ; -> #t
(generic-variadic? Add*) ; -> #t
(generic-arity Add*) ; -> 1

Last update

Mar 12, 2018

Author

Juergen Lorenz

License

 
Copyright (c) 2018, Juergen Lorenz (ju (at) jugilo (dot) de)
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
Neither the name of the author nor the names of its contributors may be
used to endorse or promote products derived from this software without
specific prior written permission. 
  
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Version History
0.2.1
bugfix
0.2
signature of (define-)selector changed, standard selectors added
0.1
initial import