Changeset 8631 in project


Ignore:
Timestamp:
02/22/08 17:46:50 (12 years ago)
Author:
Kon Lovett
Message:

Trying diff names.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/combinators/trunk/combinators-support.scm

    r8626 r8631  
    55  (define-extension combinators
    66    (export
    7       group-by
    8       key-on ) )
     7      group/key
     8      make-</key ) )
    99
    1010  (declare
     
    1313    (inline)
    1414    (no-procedure-checks-for-usual-bindings)
    15     (no-bound-checks)
    16     (import
    17       span ) ) )
    18    
     15    (no-bound-checks) ) )
     16
     17(use srfi-1)
     18
    1919;; Group a list of elements by some key attribute.
    2020;;
    2121;; The list must be in sorted order with respect to the key.
    2222;; examples:
    23 ;; (group-by identity '(1 2 3 3 4 4 4)) --> ((1) (2) (3 3) (4 4 4))
    24 ;; (group-by car '((a 1) (a 2) (b 1))) --> '(((a 1) (a 2)) ((b 1)))
     23;; (group/key identity '(1 2 3 3 4 4 4)) --> ((1) (2) (3 3) (4 4 4))
     24;; (group/key car '((a 1) (a 2) (b 1))) --> '(((a 1) (a 2)) ((b 1)))
    2525
    26 (define (group-by keyproc lst #!optional (equality equal?))
    27   (let loop ((lst lst) (acc '()))
    28     (if (null? lst)
    29         (reverse acc) ;; possibly remove the reversal?
    30         (let ((key (keyproc (car lst))))
    31           (receive (grouped rest)
    32               (span (lambda (item) (equality key (keyproc item))) lst)
    33             (loop rest (cons grouped acc)))))))
     26(define (group/key keyproc lyst #!optional (equality equal?))
     27  (let loop ([lyst lyst] [acc '()])
     28    (if (null? lyst)
     29        acc #;(reverse! acc)
     30        (let ([key (keyproc (car lyst))])
     31          (let-values ([(grouped rest)
     32                        (span (lambda (item) (equality key (keyproc item)))
     33                              lyst)])
     34            (loop rest (cons grouped acc)) ) ) ) ) )
    3435
    35 ;; Define a less-than function for a sort. E.g. to sort a list of
    36 ;; lists by their first items, using string-case-insensitive
    37 ;; comparison: (sort lst (key-on first string-ci<?))
     36;; Define a less-than function for a sort of a structured sequence.
     37;;
     38;; E.g. to sort a list of lists by their first items, using
     39;; string-case-insensitive comparison:
     40;; (sort lyst (make-</key first string-ci<?))
    3841
    39 (define (key-on keyproc #!optional (less-than <))
    40   (lambda (a b) (less-than (keyproc a) (keyproc b))))
     42(define (make-</key keyproc #!optional (less-than <))
     43  (lambda (a b)
     44    (less-than (keyproc a) (keyproc b)) ) )
Note: See TracChangeset for help on using the changeset viewer.