Last change
on this file since 19029 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.