Ignore:
Timestamp:
07/31/10 03:14:44 (11 years ago)
Author:
Kon Lovett
Message:

Export Scheme-ish uni, etc. & arguments-X routines

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/combinators/trunk/sort-combinators.scm

    r18918 r19028  
    77
    88(module sort-combinators (;export
    9   group/key
     9  group-by group/key
    1010  make-equal/key make-less-than/key)
    1111
    12   (import scheme chicken srfi-1)
     12  (import
     13    scheme
     14    chicken
     15    (only srfi-1 span)
     16    (only bi-combinators bi-each))
    1317
    14   (require-library srfi-1)
     18  (require-library srfi-1 bi-combinators)
    1519
    1620  (declare
    1721    (type
     22      (group-by (procedure ((procedure (*) *) #!optional (procedure (* *) boolean)) (procedure (list) list)))
    1823      (group/key (procedure ((procedure (*) *) list #!optional (procedure (* *) boolean)) list))
    1924      (make-less-than/key (procedure ((procedure (*) *) #!optional (procedure (* *) boolean)) (procedure (* *) boolean)))
     
    2328
    2429;kinda violates the argument list orientation of comibinators
    25 (define (group-by proc #!optional (equality equal?))
     30(define (group-by proc #!optional (equals equal?))
    2631  (lambda (ls)
    2732    (let loop ((ls ls) (acc '()))
    2833      (if (null? ls) acc #;(reverse! acc)
    2934          (let ((key (proc (car ls))))
    30             (receive (grouped rest) (span (lambda (item) (equality key (proc item))) ls)
     35            (receive (grouped rest) (span (lambda (item) (equals key (proc item))) ls)
    3136              (loop rest (cons grouped acc)) ) ) ) ) ) )
    3237
     
    3944;; (group/key car '((a 1) (a 2) (b 1))) --> '(((a 1) (a 2)) ((b 1)))
    4045
    41 (define (group/key keyproc ls #!optional (equality equal?))
    42   ((group-by keyproc equality) ls) )
     46(define (group/key keyproc ls #!optional (equals equal?))
     47  ((group-by keyproc equals) ls) )
    4348
    4449;; Define a less-than function for a sort of a structured sequence.
     
    4954
    5055(define (make-less-than/key keyproc #!optional (less-than <))
    51   (lambda (a b) (less-than (keyproc a) (keyproc b)) ) )
     56  (bi-each less-than keyproc) )
    5257
    5358;; Define a equal function for a sort of a structured sequence.
     
    5762;; (make-hash-table (o string-ci-hash first) (make-equal/key first string-ci=?))
    5863
    59 (define (make-equal/key keyproc #!optional (equal =))
    60   (lambda (a b) (equal (keyproc a) (keyproc b)) ) )
     64(define (make-equal/key keyproc #!optional (equals =))
     65  (bi-each equals keyproc) )
    6166
    6267) ;module sort-combinators
Note: See TracChangeset for help on using the changeset viewer.