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.
- Outdated egg!
- Generic procedures
- The module generics
- The helper module generic-helpers
- The module generics
- Last update
- Version History
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.
- generics sym ..procedure
- (define-generic (Name (x x??) ....) body ....)syntax
- (define-generic (Name (x x??) ... xs xs??) body ....)syntax
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 (Name (x x??) ....) body ....)syntax
- (define-method (Name (x x??) ... xs xs??) body ....)syntax
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? xprprocedure
- generic-method-tree Genprocedure
returns the method-tree of the generic Gen
- generic-variadic? Genprocedure
is the generic function Gen variadic?
- generic-arity Genprocedure
returns the arity of the generic function Gen i.e. the depth of its method tree
- selector? xprprocedure
is xpr a selector?
- selector parent?? predprocedure
makes a special predicate from predicate pred and selector parent??, which might be #f
- (define-selector name?? parent?? pred)syntax
defines a special predicate, name??, frome its base pradicate, pred, and its parent selector, parent??, which might be #f
- selector-parents sel??procedure
returns the parents of selector sel??
- any?? xprprocedure
selector without parent which always returns #t
- number?? xprprocedure
- integer?? xprprocedure
- fixnum?? xprprocedure
- flonum?? xprprocedure
- list?? xprprocedure
- pseudo-list?? xprprocedure
- pair?? xprprocedure
- vector?? xprprocedure
- string?? xprprocedure
- procedure?? xprprocedure
- index?? xprprocedure
non-negative fixnum selector
- method-tree-item proc sel?? ....procedure
returns a method tree item from its arguments a procedure and a non-empty list of selectors
- method-tree-item? xprprocedure
is xpr a method-tree-item?
- method-tree? xprprocedure
evaluates xpr to a method-tree?
- method-tree-depth treeprocedure
returns the depth of a method tree
- method-tree-show treeprocedure
returns a readable image of the tree
- method-tree-dispatch tree #!rest argsprocedure
searches the tree according to the types of arguments args and returns the matching method, if any, or #f
- method-tree-insert tree itemprocedure
inserts the item into the tree at the location governed by the selectors in item
Some of the following procedures are used in the macros of the generics module. Others are here for convenience.
- generic-helpers sym ..procedure
- reverse* rhead tail opprocedure
- reverse* rhead tailprocedure
- reverse* rheadprocedure
a generalisation of reverse rhead is reversed onto tail or '() by means of op or cons.
- rsplit-with ok? lstprocedure
returns two values by splitting the list at the first position where ok? returns true and reversing the head
- rsplit-at k lstprocedure
returns two values by splitting the list at position k and reversing the head
- repeat k fnprocedure
applies function fn k times in sequence
- proc-name procprocedure
returns the name of proc
- map* fn xsprocedure
maps the items of the nested pseudo-list xs via function fn
- project kprocedure
returns a procedure which chooses the kth item of its argument list
- 1+ nprocedure
add 1 to fixnum n
- 1- nprocedure
subtract 1 from fixnum n
- index? nprocedure
is fixnum n greater or equal to 0
- mfx+ #!rest numsprocedure
add all fixnums in nums
- mfx+ #!rest numsprocedure
multiply all fixnums in nums
- (named-lambda (name . args) xpr . xprs)syntax
a version of lambda which can be used recursively
(use generics) (import generic-helpers)
;; 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
Mar 12, 2018
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.
- signature of (define-)selector changed, standard selectors added
- initial import