Generic helpers and generic procedures

Generic helpers and generic procedures
1. The generic-helpers module
  1. generic-helpers
  2. symbol-dispatcher
  3. 1+
  4. 1-
  5. index?
  6. mfx+
  7. mfx*
  8. reverse*
  9. rsplit-with
  10. split-with
  11. rsplit-at
  12. split-at
  13. split-along
  14. memp
  15. assp
  16. adjoin
  17. insert-before
  18. filter
  19. map*
  20. repeat
  21. project
  22. curry
  23. uncurry
  24. any?
  25. none?
  26. all?
  27. some?
  28. for-all
  29. exists
  30. always
  31. cxr
  32. ??
  33. in?
  34. random-choice
  35. nlambda
  36. dlambda
  37. mdefine
  38. mdefine*
  39. mset!
2. The generic-functions module
3. Requirements
4. Usage
5. Examples
Last update
Author
Repository
License
Version History

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

[procedure] (generic-helpers sym ..)

documentation procedure

symbol-dispatcher

[procedure] (symbol-dispatcher alist)

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

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

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?)
[procedure] (rsplit-with ok? xs)

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

split-with

[procedure] (split-with ok?)
[procedure] (split-with ok? xs)

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

[procedure] (rsplit-at k)
[procedure] (rsplit-at k xs)

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

split-at

[procedure] (split-at k)
[procedure] (split-at k xs)

returns two values, the sublist of xs upto index k and the sublist starting at index k.

split-along

[procedure] (split-along pl)
[procedure] (split-along pl xs)

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

memp

[procedure] (memp ok?)
[procedure] (memp ok? xs)

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

assp

[procedure] (assp ok?)
[procedure] (assp ok? alist)

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

adjoin

[procedure] (adjoin equ? x)
[procedure] (adjoin equ? x xs)

adds x to the list xs at the end only when x is not equ? to any item in xs.

insert-before

[procedure] (insert-before equ? x before)
[procedure] (insert-before equ? x before xs)

if before is an item of xs, the x is added to xs before it, otherwise at the end.

filter

[procedure] (filter ok?)
[procedure] (filter ok? xs)

curried and uncurried filter returning two values, the sublists of items passing or not-passing the ok? test.

map*

[procedure] (map* fn)
[procedure] (map* fn xs)

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

repeat

[procedure] (repeat k fn)

applies function fn k times in sequence

project

[procedure] (project k)

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

curry

[procedure] (curry proc)

curries proc on the first argument

uncurry

[procedure] (uncurry proc)

uncurries proc on the only argument

any?

[procedure] (any? xpr)

always #t

none?

[procedure] (none? xpr)

always #f

all?

[procedure] (all? ok?)

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

some?

[procedure] (some? ok?)

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

for-all

[procedure] (for-all fn xs ....)

applies fn to corresponding items in xs .... in sequence until either a call returns #f or return the call to the last items

exists

[procedure] (exists fn xs ....)

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

[procedure] (always xpr)

returns a procedure, which always returns xpr.

cxr

[procedure] (cxr ads)
[procedure] (cxr ads xs)

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)).

??

[syntax] (?? xpr ok? . oks?)

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?

[syntax] (in? equ? x . xs)

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

random-choice

[syntax] (random-choice . xprs)

evaluates one of the xprs choosen at random.

nlambda

[syntax] (nlambda name args xpr . xprs)

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

dlambda

[syntax] (dlambda (sym args xpr . xprs) ....)

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

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

defines multiple variables in one go

mdefine*

[syntax] (mdefine* var . vars)

defines multiple variables in one go to their names

mset!

[syntax] (mset! var val . var-val-pairs)

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

[procedure] (generic-functions sym ..)

documentation procedure

define-generic

[syntax] (define-generic (Name x ....) body ....)
[syntax] (define-generic (Name x ... . 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


(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

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