chickadee » generics

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

generic-helpers sym ..procedure

documentation procedure

symbol-dispatcher

symbol-dispatcher alistprocedure

used to generate the helper procedure, e.g. generic-helpers

1+

1+ nprocedure

add 1 to fixnum n

1-

1- nprocedure

subtract 1 from fixnum n

index?

index? nprocedure

is fixnum n greater or equal to 0

mfx+

mfx+ #!rest numsprocedure

add all fixnums in nums

mfx*

mfx* #!rest numsprocedure

multiply all fixnums in nums

reverse*

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

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

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

rsplit-at kprocedure

rsplit-at k xsprocedure

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

split-at

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

split-along plprocedure

split-along pl xsprocedure

splits xs at the index parallel to the sentinel of pseudolist pl.

memp

memp ok?procedure

memp ok? xsprocedure

returns the sublist of xs starting with the first item passing the ok? test, or #f.

assp

assp ok?procedure

assp ok? alistprocedure

returns the first pair of the associatation list alist, whose car passes teh ok? test, or #f.

adjoin

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

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

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*

map* fnprocedure

map* fn xsprocedure

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

repeat

repeat k fnprocedure

applies function fn k times in sequence

project

project kprocedure

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

curry

curry procprocedure

curries proc on the first argument

uncurry

uncurry procprocedure

uncurries proc on the only argument

any?

any? xprprocedure

always #t

none?

none? xprprocedure

always #f

all?

all? ok?procedure

returns a unary predicate which tests, if all items of the argument list pass the ok? test.

some?

some? ok?procedure

returns a unary predicate which tests, if some item of the argument list passes the ok? test.

for-all

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

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

always xprprocedure

returns a procedure, which always returns xpr.

cxr

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?

(in? equ? x . xs)syntax

is x equ? to one of the items ins xs?

random-choice

(random-choice . xprs)syntax

evaluates one of the xprs choosen at random.

nlambda

(nlambda name args xpr . xprs)syntax

a version of lambda which can be used recursively using its name.

dlambda

(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

(mdefine var val . var-val-pairs)syntax

defines multiple variables in one go

mdefine*

(mdefine* var . vars)syntax

defines multiple variables in one go to their names

mset!

(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

generic-functions sym ..procedure

documentation procedure

define-generic

(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

(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?

generic? xprprocedure

type predicate

generic-method-tree

generic-method-tree Genprocedure

returns the method-tree of the generic Gen

generic-variadic?

generic-variadic? Genprocedure

is the generic function Gen variadic?

generic-arity

generic-arity Genprocedure

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

selector?

selector? xprprocedure

is xpr a selector?

selector

selector parent?? predprocedure

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

define-selector

(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

selector-parents sel??procedure

returns the parents of selector sel??

any??

any?? xprprocedure

selector without parent which always returns #t

number??

number?? xprprocedure

number selector

integer??

integer?? xprprocedure

integer selector

fixnum??

fixnum?? xprprocedure

fixnum selector

flonum??

flonum?? xprprocedure

flonum selector

list??

list?? xprprocedure

list selector

pseudo-list??

pseudo-list?? xprprocedure

pseudo-list selector

pair??

pair?? xprprocedure

pair selector

vector??

vector?? xprprocedure

vector selector

string??

string?? xprprocedure

string selector

procedure??

procedure?? xprprocedure

procedure selector

index??

index?? xprprocedure

non-negative fixnum selector

method-tree-item

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?

method-tree-item? xprprocedure

is xpr a method-tree-item?

method-tree?

method-tree? xprprocedure

evaluates xpr to a method-tree?

method-tree-depth

method-tree-depth treeprocedure

returns the depth of a method tree

method-tree-show

method-tree-show treeprocedure

returns a readable image of the tree

method-tree-dispatch

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

method-tree-insert tree itemprocedure

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

Requirements

simple-cells

Usage

(import generic-helpers generics)

Examples

;; 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

Last update

Aug 28, 2023

Author

Juergen Lorenz

Repository

This egg is hosted on the CHICKEN Subversion repository:

https://anonymous@code.call-cc.org/svn/chicken-eggs/release/5/generics

If you want to check out the source code repository of this egg and you are not familiar with Subversion, see this page.

License

Copyright (c) 2018-2023, 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

2.0.1

inline and online documentation fixed

2.0

egg restructured, one module renamed, generic-helpers enhanced

1.0

ported from chicken-4