- Generic helpers and generic procedures
- The generic-helpers module
- The generic-functions module
- Last update
- Version History
Generic helpers and generic procedures
When starting to code this library, I considered the helpers a prerequisite of generics. So I had only one extension with two modules, the helpers module rather small.
Now I've changed my mind and implemented generic-helpers as a grab box of general helper routines, only some of which are used in generics. So I've split the library into two extensions.
The generic-helpers module
Some of the following procedures are used in the macros of the generics module. Others are here for convenience. Most list-processing functions are given in curried and uncurried form, documenting only the latter. Curried versions can be used with map and friends.
- generic-helpers sym ..procedure
- symbol-dispatcher alistprocedure
used to generate the helper procedure, e.g. generic-helpers
- 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
- 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?procedure
- rsplit-with ok? xsprocedure
returns two values by splitting the list xs at the first position where ok? returns true and reversing the head
- split-with ok?procedure
- split-with ok? xsprocedure
returns two values, the sublist of xs upto the first item which passes the ok? test and the sublist starting with the first item passed by ok?
- rsplit-at kprocedure
- rsplit-at k xsprocedure
returns two values by splitting the list xs at position k and reversing the head
- split-at kprocedure
- split-at k xsprocedure
returns two values, the sublist of xs upto index k and the sublist starting at index k.
- split-along plprocedure
- split-along pl xsprocedure
splits xs at the index parallel to the sentinel of pseudolist pl.
- memp ok?procedure
- memp ok? xsprocedure
returns the sublist of xs starting with the first item passing the ok? test, or #f.
- assp ok?procedure
- assp ok? alistprocedure
returns the first pair of the associatation list alist, whose car passes teh ok? test, or #f.
- adjoin equ? xprocedure
- adjoin equ? x xsprocedure
adds x to the list xs at the end only when x is not equ? to any item in xs.
- insert-before equ? x beforeprocedure
- insert-before equ? x before xsprocedure
if before is an item of xs, the x is added to xs before it, otherwise at the end.
- filter ok?procedure
- filter ok? xsprocedure
curried and uncurried filter returning two values, the sublists of items passing or not-passing the ok? test.
- map* fnprocedure
- map* fn xsprocedure
maps the items of the nested pseudo-list xs via function fn
- repeat k fnprocedure
applies function fn k times in sequence
- project kprocedure
returns a procedure which chooses the kth item of its argument list
- curry procprocedure
curries proc on the first argument
- uncurry procprocedure
uncurries proc on the only argument
- any? xprprocedure
- none? xprprocedure
- all? ok?procedure
returns a unary predicate which tests, if all items of the argument list pass the ok? test.
- some? ok?procedure
returns a unary predicate which tests, if some item of the argument list passes the ok? test.
- for-all fn xs ....procedure
applies fn to corresponding items in xs .... in sequence until either a call returns #f or return the call to the last items
- exists fn xs ....procedure
returns #f if all lists xs are empty. Otherwise applies fn to corresponding items in xs .... in sequence until either a call returns #t or return the call to the last items
- always xprprocedure
returns a procedure, which always returns xpr.
- cxr adsprocedure
- cxr ads xsprocedure
accesses the tree xs recursively with car and cdr acording to the symbol ads, which must be a combination of a's and d's. So, for example, (cxr 'dada) is equivalent to cdadar. Notice the mnemonics: the x in cxr is replaced by the ads symbol. the first form is a curried version of the second.
Alternatively can be a flat list of pairs consisting of indexes and a's or d's. In this case cdadar is equivalent to (cxr '(1 d 1 a 1 d 1 a)). This is usefull for deep accesses, e.g. (cxr '(1 a 10 d)).
- (?? xpr ok? . oks?)syntax
checks xpr against predicates ok? .... in sequence and returns xpr in case all tests succed. Otherwise prints an error message with the offending predicate.
- (in? equ? x . xs)syntax
is x equ? to one of the items ins xs?
- (random-choice . xprs)syntax
evaluates one of the xprs choosen at random.
- (nlambda name args xpr . xprs)syntax
a version of lambda which can be used recursively using its name.
- (dlambda (sym args xpr . xprs) ....)syntax
destructuring version of lambda. Generates as many procedures as there are syms. Usually used in the body of a let to generate objects to access by message passing. Note, that dlambda expands into nlambdas, so that the routines can be recursive.
- (mdefine var val . var-val-pairs)syntax
defines multiple variables in one go
- (mdefine* var . vars)syntax
defines multiple variables in one go to their names
- (mset! var val . var-val-pairs)syntax
set! multiple variables in one go
The generic-functions module
This module implements generic functions, which are ordinary procedures with state, hence closures. The state consists of a cell containing a method tree, which in turn consists of selectors and methods. Selectors are special predicates with a name and a parent, methods are procedures with name. The names are used for inspecting the method-tree, and the parent helps to insert a method-tree-item in the proper place: Arguments of more specific or often used types should be checked and found before less specific or seldom used ones. This place controls, which effective method is found by the method-tree-dispatch routine.
The dispatcher works by checking the generic's arguments recursively with corresponding selectors and stepping down the tree in case the first selector succeeds. So we reach eventually a matching method.
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 ....) body ....) (define-generic (Name x ... . xs) body ....)
for fixed or variable argument lists respectively and -- with selectors
(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 y) (error 'Add "no method found") (define-method (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.
- generic-functions sym ..procedure
- (define-generic (Name x ....) body ....)syntax
- (define-generic (Name x ... . 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
(import generic-helpers generics)
;; split, rsplit and reverse ;; ------------------------- (reverse* '(10 20 30) '(1 2 3 4 5)) ; -> '(30 20 10 1 2 3 4 5) (reverse* '(10 20 30) '((0 . 1) (0 . 2)) list) ; -> '(30 (20 (10 (0 . 1) (0 . 2)))) (receive (head tail) (split-at 2 '(0 1 2 3 4)) (list head tail)) ; -> '((0 1) (2 3 4)) (receive (rhead tail) ((rsplit-with even?) '(1 3 5 2 4 6)) (list rhead tail)) ; -> '((5 3 1) (2 4 6)) ;; cxr accessors as generalisation of cadddr and friends ;; ----------------------------------------------------- ((cxr 'addd) '(0 1 2 3 4)) ;-> 3 (cxr '(1 a 3 d) '(0 1 2 3 4)) ;-> 3 ;; destructuring lambda ;; -------------------- (define count-test (let ((count 0)) (dlambda (reset () (set! count 0) count) (inc (n) (set! count (+ count n)) count) (dec (n) (set! count (- count n)) count) (bound (lo hi) (set! count (min hi (max lo count))) count) (else () #f) ))) (dlambda (fac (n) (if (zero? n) 1 (* n (fac (- n 1)))))) ;; non-variadic generics ;; --------------------- (define-generic (Add x y) (error 'Add "no method defined")) (define-method (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 seq) (error "At no method defined")) (define-method (At (k index??) (seq list??)) (list-ref seq k)) (define-generic (Drop k seq) (error 'Drop "no method define")) (define-method (Drop (k index??) (seq list??)) (list-tail seq k)) (define-generic (Take k seq) (error 'Take "no method defined")) (define-method (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) (error 'Add* "no method defined")) (define-method (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
Aug 06, 2020
This egg is hosted on the CHICKEN Subversion repository:
If you want to check out the source code repository of this egg and you are not familiar with Subversion, see this page.
Copyright (c) 2018-2020, 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.
- inline and online documentation fixed
- egg restructured, one module renamed, generic-helpers enhanced
- ported from chicken-4