Changeset 19028 in project


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

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

Location:
release/4/combinators/trunk
Files:
4 added
6 edited

Legend:

Unmodified
Added
Removed

  • release/4/combinators/trunk/combinators.meta

    r18946 r19028  
    1010 (files
    1111  "tests"
     12  "arguments-helpers.inc"
    1213  "section-combinators.scm"
    13   "generic-section-combinators.scm"
     14  "uni-combinators.scm"
     15  "bi-combinators.scm"
     16  "tri-combinators.scm"
     17  ;"generic-section-combinators.scm"
    1418  "logical-combinators.scm"
    1519  "sort-combinators.scm"

  • release/4/combinators/trunk/combinators.setup

    r18946 r19028  
    55(verify-extension-name "combinators")
    66
     7(setup-shared-extension-module 'uni-combinators (extension-version "1.1.0")
     8  #:compile-options '(-scrutinize -optimize-level 3 -lambda-lift))
     9
     10(setup-shared-extension-module 'bi-combinators (extension-version "1.1.0")
     11  #:compile-options '(-scrutinize -optimize-level 3 -lambda-lift))
     12
     13(setup-shared-extension-module 'tri-combinators (extension-version "1.1.0")
     14  #:compile-options '(-scrutinize -optimize-level 3 -lambda-lift))
     15
    716(setup-shared-extension-module 'section-combinators (extension-version "1.1.0")
    817  #:compile-options '(-scrutinize -optimize-level 3 -lambda-lift))
     18
     19#;
    920(setup-shared-extension-module 'generic-section-combinators (extension-version "1.1.0")
    1021  #:compile-options '(-scrutinize -optimize-level 3 -lambda-lift))
     22
    1123(setup-shared-extension-module 'logical-combinators (extension-version "1.1.0")
    1224  #:compile-options '(-scrutinize -optimize-level 3 -lambda-lift))
     25
    1326(setup-shared-extension-module 'sort-combinators (extension-version "1.1.0")
    1427  #:compile-options '(-scrutinize -optimize-level 3 -lambda-lift))
     28
    1529(setup-shared-extension-module 'stack-combinators (extension-version "1.1.0")
    1630  #:compile-options '(-scrutinize -optimize-level 3 -lambda-lift))

  • release/4/combinators/trunk/generic-section-combinators.scm

    r18947 r19028  
    11;;;; generic-section-combinators.scm
    22;;;; Kon Lovett, Jul '10
     3
     4!IN PROGRESS!
    35
    46(module generic-section-combinators
    57
    68  (;export
    7     o-with-apply
    8     left-hook right-hook
    9     left-hook+ right-hook+
    10     argument-each argument-all
     9    left-hook-each right-hook-each
     10    left-hook-each+ right-hook-each+
     11    left-hook-argument-chain right-hook-argument-chain
     12    left-hook-argument-chain+ right-hook-argument-chain+
    1113    fork-each fork-all
    1214    fork-each+ fork-all+)
    … …  
    2224  (declare
    2325    (type
    24       (o-with-apply (procedure (#!rest) (procedure (#!rest) *)))
    25       (left-hook (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
    26       (right-hook (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
    27       (left-hook+ (procedure (#!rest) (procedure (#!rest) *)))
    28       (right-hook+ (procedure (#!rest) (procedure (#!rest) *)))
    29       (argument-each (procedure (#!rest) (procedure (#!rest) list)))
    30       (argument-all (procedure (#!rest) (procedure (#!rest) list)))
     26      (left-hook-each (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
     27      (right-hook-each (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
     28      (left-hook-each+ (procedure (#!rest) (procedure (#!rest) *)))
     29      (right-hook-each+ (procedure (#!rest) (procedure (#!rest) *)))
     30      (left-hook-argument-chain (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
     31      (right-hook-argument-chain (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
     32      (left-hook-argument-chain+ (procedure (#!rest) (procedure (#!rest) *)))
     33      (right-hook-argument-chain+ (procedure (#!rest) (procedure (#!rest) *)))
    3134      (fork-each (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
    3235      (fork-all (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
    … …  
    3437      (fork-all+ (procedure (#!rest) (procedure (#!rest) *))) ))
    3538
     39  (include "arguments-helpers.inc")
     40
    3641;;; Hook
    3742
    38 ;;l Helpers
     43(define (left-arguments-X . fns)
     44  (lambda xs ((X-funcs (cons fns list)) xs)) )
    3945
    40 (define-inline (hook-recur fns xs)
    41   ; assume the length of fns is << so recursion depth is also <<
    42   (let recur ((fns fns))
    43     (if (null? fns) xs
    44       (apply (car fns) (recur (cdr fns))) ) ) )
     46(define (right-arguments-X . fns)
     47  (lambda xs ((X-funcs (cons list fns)) xs)) )
    4548
    46 (define-inline (hook-recur+ g fns xs)
    47   (apply g (hook-recur fns xs)) )
     49?????
     50(left-hook-X c fn0 ... fnn) = (arguments-chain c (arguments-X fn0 ... fnn list))
     51(right-hook-X c fn0 ... fnn) = (arguments-chain c (arguments-X list fn0 ... fnn))
    4852
    49 ;; o-with-apply
     53;; left-hook-each
    5054
    51 ; ((o-with-apply f g) arg...) -> (apply f (apply g arg...))
    52 ; ((o-with-apply f) arg...) -> (apply f arg...)
    53 ; ((o-with-apply) arg...) -> (list arg...)
     55; ((left-hook-each c f g) arg...) -> (apply c (f arg0) (g arg1) ... argn...)
     56; ((left-hook-each c f) arg...) -> (apply c (f arg0) ... (f argn) arg...)
     57; ((left-hook-each c) arg...) -> (apply c arg...)
    5458
    55 (define (o-with-apply . fns)
    56   ; 0
    57   (if (null? fns) list
    58     (let ((f (car fns))
    59           (fns (cdr fns)) )
    60       ; 1
    61       (if (null? fns) (lambda xs (apply f xs))
    62         ; > 1
    63         (lambda xs (hook-recur+ f fns xs)) ) ) ) )
     59(define (left-hook-each c . fns)
     60  (if (null? fns) (lambda xs (apply c xs))
     61    (let ((fn (each-func fns)))
     62      (lambda xs (apply c (append (list (fn xs)) xs))) ) ) )
    6463
    65 ;; left-hook
     64;; right-hook-each
    6665
    67 ; ((left-hook c f g) arg...) -> (apply c (apply f (apply g arg...)) arg...)
    68 ; ((left-hook c f) arg...) -> (apply c (apply f arg...) arg...)
    69 ; ((left-hook c) arg...) -> (apply c arg...)
     66; ((right-hook-each c f g) arg...) -> (apply c argn... (f arg0) (g arg1) ...)
     67; ((right-hook-each c f) arg...) -> (apply c arg... (f arg0) ... (f argn))
     68; ((right-hook-each c) arg...) -> (apply c arg...)
    7069
    71 (define (left-hook c . fns)
     70(define (right-hook-each c . fns)
     71  (if (null? fns) (lambda xs (apply c xs))
     72    (let ((fn (each-func fns)))
     73      (lambda xs (apply c (append xs (list (fn xs))))) ) ) )
     74
     75;; left-hook-each+ a left-hook-each that curries it's functions
     76
     77; (left-hook-each+ c func...) -> (apply left-hook-each c func...)
     78; (left-hook-each+ c) -> (lambda (func...) (apply left-hook-each+ c func...))
     79; (left-hook-each+) -> (lambda (c) (left-hook-each+ c))
     80
     81(define (left-hook-each+ . fns)
     82  (if (null? fns) (lambda (c) (left-hook-each+ c))
     83    (let ((c (car fns)) (fns (cdr fns)))
     84      (if (null? fns) (lambda fns (apply left-hook-each+ c fns))
     85        (apply left-hook-each c fns) ) ) ) )
     86
     87;; right-hook-each+ a left-hook-each that curries it's functions
     88
     89; (right-hook-each+ c func...) -> (apply right-hook-each c func...)
     90; (right-hook-each+ c) -> (lambda (func...) (apply right-hook-each+ c func...))
     91; (right-hook-each+) -> (lambda (c) (right-hook-each+ c))
     92
     93(define (right-hook-each+ . fns)
     94 (if (null? fns) (lambda (c) (right-hook-each+ c))
     95    (let ((c (car fns)) (fns (cdr fns)))
     96      (if (null? fns) (lambda fns (apply right-hook-each+ c fns))
     97        (apply right-hook-each c fns) ) ) ) )
     98
     99;; left-hook-argument-chain
     100
     101; ((left-hook-argument-chain c f g) arg...) -> (apply c (apply f (apply g arg...)) arg...)
     102; ((left-hook-argument-chain c f) arg...) -> (apply c (apply f arg...) arg...)
     103; ((left-hook-argument-chain c) arg...) -> (apply c arg...)
     104
     105(define (left-hook-argument-chain c . fns)
    72106  (let ((c (car fns))
    73107        (fns (cdr fns)) )
    74108    (if (null? fns) (lambda xs (apply c xs))
    75       (lambda xs (apply c (hook-recur+ (car fns) (cdr fns) xs) xs)) ) ) )
     109      (lambda xs (apply c (chain-recur fns xs) xs)) ) ) )
    76110
    77 ;; right-hook
     111;; right-hook-argument-chain
    78112
    79 ; ((right-hook c f g) arg...) -> (apply c arg... (apply f (apply g arg...)))
    80 ; ((right-hook c f) arg...) -> (apply c arg... (apply f arg...))
    81 ; ((right-hook c) arg...) -> (apply c arg...)
     113; ((right-hook-argument-chain c f g) arg...) -> (apply c arg... (apply f (apply g arg...)))
     114; ((right-hook-argument-chain c f) arg...) -> (apply c arg... (apply f arg...))
     115; ((right-hook-argument-chain c) arg...) -> (apply c arg...)
    82116
    83 (define (right-hook c . fns)
     117(define (right-hook-argument-chain c . fns)
    84118  (let ((c (car fns))
    85119        (fns (cdr fns)) )
    86120    (if (null? fns) (lambda xs (apply c xs))
    87       (lambda xs (apply c (append xs (list (hook-recur+ (car fns) (cdr fns) xs))))) ) ) )
     121      (lambda xs (apply c (append xs (list (chain-recur fns xs))))) ) ) )
    88122
    89 ;; left-hook+
     123;; left-hook-argument-chain+ a left-hook-argument-chain that curries it's functions
    90124
    91 ; (left-hook+ c func...) -> (apply left-hook c func...)
    92 ; (left-hook+ c) -> (lambda (func...) (apply left-hook+ c func...))
    93 ; left-hook+) -> (lambda (c) (left-hook+ c))
     125; (left-hook-argument-chain+ c func...) -> (apply left-hook-argument-chain c func...)
     126; (left-hook-argument-chain+ c) -> (lambda (func...) (apply left-hook-argument-chain+ c func...))
     127; (left-hook-argument-chain+) -> (lambda (c) (left-hook-argument-chain+ c))
    94128
    95 (define (left-hook+ . fns)
    96   (if (null? fns) (lambda (c) (left-hook+ c))
     129(define (left-hook-argument-chain+ . fns)
     130  (if (null? fns) (lambda (c) (left-hook-argument-chain+ c))
    97131    (let ((c (car fns)) (fns (cdr fns)))
    98       (if (null? fns) (lambda fns (apply left-hook+ c fns))
    99         (apply left-hook c fns) ) ) ) )
     132      (if (null? fns) (lambda fns (apply left-hook-argument-chain+ c fns))
     133        (apply left-hook-argument-chain c fns) ) ) ) )
    100134
    101 ;; right-hook+
     135;; right-hook-argument-chain+ a right-hook-argument-chain that curries it's functions
    102136
    103 ; (right-hook+ c func...) -> (apply right-hook c func...)
    104 ; (right-hook+ c) -> (lambda (func...) (apply right-hook+ c func...))
    105 ; right-hook+) -> (lambda (c) (right-hook+ c))
     137; (right-hook-argument-chain+ c func...) -> (apply right-hook-argument-chain c func...)
     138; (right-hook-argument-chain+ c) -> (lambda (func...) (apply right-hook-argument-chain+ c func...))
     139; (right-hook-argument-chain+) -> (lambda (c) (right-hook-argument-chain+ c))
    106140
    107 (define (right-hook+ . fns)
    108  (if (null? fns) (lambda (c) (right-hook+ c))
     141(define (right-hook-argument-chain+ . fns)
     142 (if (null? fns) (lambda (c) (right-hook-argument-chain+ c))
    109143    (let ((c (car fns)) (fns (cdr fns)))
    110       (if (null? fns) (lambda fns (apply right-hook+ c fns))
    111         (apply right-hook c fns) ) ) ) )
    112 
    113 ;;; Argument
    114 
    115 ;; Helpers
    116 
    117 (define-inline (argument-each-func fns)
    118   (cond
    119     ((null? fns)
    120       identity )
    121     ((null? (cdr fns))
    122       (lambda (xs) (map (cute (car fns) <>) xs)) )
    123     (else
    124       (let ((fns (apply circular-list fns)))
    125         (lambda (xs) (map (cut <> <>) fns xs)) ) ) ) )
    126 
    127 (define-inline (argument-all-funcs fns)
    128   (cond
    129     ((null? fns)
    130       identity )
    131     ((null? (cdr fns))
    132       (lambda (xs) (list (apply (car fns) xs))) )
    133     (else
    134       (lambda (xs) (map (cut apply <> xs) fns)) ) ) )
    135 
    136 ;; argument-each
    137 
    138 ; ((argument-each f g h) a b c d e) -> (list (f a) (g b) (h c) (f d) (g e))
    139 ; ((argument-each) arg...) -> (list arg...)
    140 
    141 (define (argument-each . fns)
    142   (let ((fn (argument-each-func fns)))
    143     (lambda xs (fn xs)) ) )
    144 
    145 ;; argument-all
    146 
    147 ; ((argument-all f g h) a b c) -> (list (f a b c) (g a b c) (h a b c))
    148 ; ((argument-all) arg...) -> (list arg...)
    149 
    150 (define (argument-all . fns)
    151   (let ((fn (argument-all-func fns)))
    152     (lambda xs (fn xs)) ) )
     144      (if (null? fns) (lambda fns (apply right-hook-argument-chain+ c fns))
     145        (apply right-hook-argument-chain c fns) ) ) ) )
    153146
    154147;;; Fork
    … …  
    156149;; fork-each
    157150
    158 ; (fork-each c func...) -> (lambda xs (apply c (apply (apply argument-each func...) xs)))
     151; (fork-each c func...) -> (lambda xs (apply c (apply (apply arguments-each func...) xs)))
    159152
    160153(define (fork-each c . fns)
    161   (let ((fn (argument-each-func fns)))
     154  (let ((fn (each-func fns)))
    162155    (lambda xs (apply c (fn xs))) ) )
    163156
    164157;; fork-all
    165158
    166 ; (fork-all c func...) -> (lambda xs (apply c (apply (apply argument-all func...) xs)))
     159; (fork-all c func...) -> (lambda xs (apply c (apply (apply arguments-all func...) xs)))
    167160
    168161(define (fork-all c . fns)
    169   (let ((fn (argument-all-func fns)))
     162  (let ((fn (all-func fns)))
    170163    (lambda xs (apply c (fn xs))) ) )
    171164

  • release/4/combinators/trunk/section-combinators.scm

    r18946 r19028  
    88    crop-left crop-right
    99    reversed
    10     uni uni2 uni3 uni-each uni-all
    11     bi bi2 bi3 bi-each bi-all
    12     tri tri2 tri3 tri-each tri-all)
     10    arguments-chain arguments-each arguments-all)
    1311
    1412  (import
    1513    scheme
    1614    chicken
    17     (only data-structures compose)
    18     (only srfi-1 circular-list drop drop-right))
     15    (only srfi-1 drop drop-right circular-list)
     16    (only data-structures identity))
    1917
    20   (require-library data-structures srfi-1)
     18  (require-library srfi-1)
    2119
    2220  (declare
    … …  
    2624      (reversed (procedure ((procedure (#!rest) *)) (procedure (#!rest) *)))
    2725      (crop-left (procedure ((procedure (#!rest) *) fixnum) (procedure (#!rest) *)))
    28       (crop-right (procedure ((procedure (#!rest) *) fixnum) (procedure (#!rest) *))) ) )
     26      (crop-right (procedure ((procedure (#!rest) *) fixnum) (procedure (#!rest) *)))
     27      (arguments-chain (procedure (#!rest) (procedure (#!rest) *)))
     28      (arguments-each (procedure (#!rest) (procedure (#!rest) list)))
     29      (arguments-all (procedure (#!rest) (procedure (#!rest) list))) ) )
    2930
    3031;;; Section
    … …  
    5354  (lambda xs (apply fn (reverse xs))) )
    5455
    55 ;;; Fork
     56;;; Argument
    5657
    57 ;; Unary
     58  (include "arguments-helpers.inc")
    5859
    59 (define uni
    60   (case-lambda
    61     ((c f)  (lambda (x) (c (f x))))
    62     ((c)    (lambda (f) (uni c f)))
    63     (()     (lambda (c) (uni c)))))
     60;; arguments-chain
    6461
    65 (define uni2
    66   (case-lambda
    67     ((c f)  (lambda (x y) (c (f x y))))
    68     ((c)    (lambda (f) (uni2 c f)))
    69     (()     (lambda (c) (uni2 c)))))
     62; ((arguments-chain f g) arg...) -> (apply f (apply g arg...))
     63; ((arguments-chain f) arg...) -> (apply f arg...)
     64; ((arguments-chain) arg...) -> (list arg...)
    7065
    71 (define uni3
    72   (case-lambda
    73     ((c f)  (lambda (x y z) (c (f x y z))))
    74     ((c)    (lambda (f) (uni3 c f)))
    75     (()     (lambda (c) (uni3 c)))))
     66(define (arguments-chain . fns)
     67  (let ((fn (chain-func fns)))
     68    (lambda xs (fn xs)) ) )
    7669
    77 (define (uni-each c f)
    78   (lambda (x) (c (f x))) )
     70;; arguments-each
    7971
    80 (define (uni-all c f)
    81   (lambda xs (c (apply f xs))) )
     72; ((arguments-each f g h) a b c d e) -> (list (f a) (g b) (h c) (f d) (g e))
     73; ((arguments-each) arg...) -> (list arg...)
    8274
    83 ;; Binary
     75(define (arguments-each . fns)
     76  (let ((fn (each-func fns)))
     77    (lambda xs (fn xs)) ) )
    8478
    85 (define bi
    86   (case-lambda
    87     ((c f g)  (lambda (x) (c (f x) (g x))))
    88     ((f g)    (lambda (c) (bi c f g)))
    89     ((c)      (lambda (f g) (bi c f g)))
    90     (()       (lambda (c) (bi c)))))
     79;; arguments-all
    9180
    92 (define bi2
    93   (case-lambda
    94     ((c f g)  (lambda (x y) (c (f x y) (g x y))))
    95     ((f g)    (lambda (c) (bi2 c f g)))
    96     ((c)      (lambda (f g) (bi2 c f g)))
    97     (()       (lambda (c) (bi2 c)))))
     81; ((arguments-all f g h) a b c) -> (list (f a b c) (g a b c) (h a b c))
     82; ((arguments-all) arg...) -> (list arg...)
    9883
    99 (define bi3
    100   (case-lambda
    101     ((c f g)  (lambda (x y z) (c (f x y z) (g x y z))))
    102     ((f g)    (lambda (c) (bi3 c f g)))
    103     ((c)      (lambda (f g) (bi3 c f g)))
    104     (()       (lambda (c) (bi3 c)))))
    105 
    106 (define (bi-each c f)
    107   (lambda (x y) (c (f x) (f y))) )
    108 
    109 (define (bi-all c f g)
    110   (lambda xs (c (apply f xs) (apply g xs))) )
    111 
    112 ;; Trinary
    113 
    114 (define tri
    115   (case-lambda
    116     ((c f g h)  (lambda (x) (c (f x) (g x) (h x))))
    117     ((f g h)    (lambda (c) (tri c f g h)))
    118     ((c)        (lambda (f g h) (tri c f g h)))
    119     (()         (lambda (c) (tri c)))))
    120 
    121 (define tri2
    122   (case-lambda
    123     ((c f g h)  (lambda (x y) (c (f x y) (g x y) (h x y))))
    124     ((f g h)    (lambda (c) (tri2 c f g h)))
    125     ((c)        (lambda (f g h) (tri2 c f g h)))
    126     (()         (lambda (c) (tri2 c)))))
    127 
    128 (define tri3
    129   (case-lambda
    130     ((c f g h)  (lambda (x y z) (c (f x y z) (g x y z) (h x y z))))
    131     ((f g h)    (lambda (c) (tri3 c f g h)))
    132     ((c)        (lambda (f g h) (tri3 c f g h)))
    133     (()         (lambda (c) (tri3 c)))))
    134 
    135 (define (tri-each c f)
    136   (lambda (x y z) (c (f x) (f y) (f z))) )
    137 
    138 (define (tri-all c f g h)
    139   (lambda xs (c (apply f xs) (apply g xs) (apply h xs))) )
     84(define (arguments-all . fns)
     85  (let ((fn (all-func fns)))
     86    (lambda xs (fn xs)) ) )
    14087
    14188) ;module section-combinators

  • 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

  • release/4/combinators/trunk/tests/run.scm

    r14018 r19028  
     1(use test)
     2(use section-combinators)
     3
     4(test "arguments-chain" '6 ((arguments-chain + list) 1 2 3))
     5
     6(test "arguments-each" '(#f #f #f #f #f #f #f) ((arguments-each even? odd?) 1 2 3 4 5 6 7))
     7
     8(test "arguments-all" '(6 -4 6) ((arguments-all + - *) 1 2 3))
     9
     10(use sort-combinators)
     11
     12(test "make-less-than/key" '#t ((make-less-than/key car) '(2) '(3)))
Note: See TracChangeset for help on using the changeset viewer.