*** empty log message ***
[bpt/guile.git] / srfi / srfi-26.scm
CommitLineData
feeef4fb
MV
1(define-module (srfi srfi-26)
2 :export (cut cute))
3
4(cond-expand-provide (current-module) '(srfi-26))
5
6(define-macro (cut slot . slots)
7 (let loop ((slots (cons slot slots))
8 (params '())
9 (args '()))
10 (if (null? slots)
11 `(lambda ,(reverse! params) ,(reverse! args))
12 (let ((s (car slots))
13 (rest (cdr slots)))
14 (case s
15 ((<>)
16 (let ((var (gensym)))
17 (loop rest (cons var params) (cons var args))))
18 ((<...>)
19 (if (pair? rest)
20 (error "<...> not on the end of cut expression"))
21 (let ((var (gensym)))
22 `(lambda ,(append! (reverse! params) var)
23 (apply ,@(reverse! (cons var args))))))
24 (else
25 (loop rest params (cons s args))))))))
26
27(define-macro (cute . slots)
28 (let ((temp (map (lambda (s) (and (not (memq s '(<> <...>))) (gensym)))
29 slots)))
30 `(let ,(delq! #f (map (lambda (t s) (and t (list t s))) temp slots))
31 (cut ,@(map (lambda (t s) (or t s)) temp slots)))))