source: project/release/4/combinators/trunk/arguments-helpers.inc @ 19028

Last change on this file since 19028 was 19028, checked in by Kon Lovett, 10 years ago

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

File size: 997 bytes
Line 
1;;;; arguments-helpers.inc
2;;;; Kon Lovett, Jul '10
3
4;;; Helpers
5
6(define-inline (chain-recur fns xs)
7  ; assume the length of fns is << so recursion depth is also <<
8  (let recur ((fns fns))
9    (if (null? fns) xs
10      (apply (car fns) (recur (cdr fns))) ) ) )
11
12(define-inline (chain-func fns)
13  (cond
14    ((null? fns)
15      identity )
16    ((null? (cdr fns))
17      (let ((f (car fns)))
18        (lambda (xs) (apply f xs)) ) )
19    (else
20      (lambda (xs) (chain-recur fns xs)) ) ) )
21
22(define-inline (each-func fns)
23  (cond
24    ((null? fns)
25      identity )
26    ((null? (cdr fns))
27      (let ((f (car fns)))
28        (lambda (xs) (map (cut f <>) xs)) ) )
29    (else
30      (let ((fns (apply circular-list fns)))
31        (lambda (xs) (map (cut <> <>) fns xs)) ) ) ) )
32
33(define-inline (all-func fns)
34  (cond
35    ((null? fns)
36      identity )
37    ((null? (cdr fns))
38      (let ((f (car fns)))
39        (lambda (xs) (list (apply f xs))) ) )
40    (else
41      (lambda (xs) (map (cut apply <> xs) fns)) ) ) )
Note: See TracBrowser for help on using the repository browser.