diff options
author | Marius Vollmer <mvo@zagadka.de> | 2004-01-21 00:46:10 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2004-01-21 00:46:10 +0000 |
commit | feeef4fb40adc27426a4ccf98c4131e9133c97f2 (patch) | |
tree | cebcf56dd956c9cf185462d8eda02581af018c7d /srfi/srfi-26.scm | |
parent | 012a3a7537d305b5ce2f95f3337978facac8634f (diff) | |
download | guile-feeef4fb40adc27426a4ccf98c4131e9133c97f2.tar.gz |
New, from Daniel Skarda. Thanks!
Diffstat (limited to 'srfi/srfi-26.scm')
-rw-r--r-- | srfi/srfi-26.scm | 31 |
1 files changed, 31 insertions, 0 deletions
diff --git a/srfi/srfi-26.scm b/srfi/srfi-26.scm new file mode 100644 index 000000000..b536311bd --- /dev/null +++ b/srfi/srfi-26.scm @@ -0,0 +1,31 @@ +(define-module (srfi srfi-26) + :export (cut cute)) + +(cond-expand-provide (current-module) '(srfi-26)) + +(define-macro (cut slot . slots) + (let loop ((slots (cons slot slots)) + (params '()) + (args '())) + (if (null? slots) + `(lambda ,(reverse! params) ,(reverse! args)) + (let ((s (car slots)) + (rest (cdr slots))) + (case s + ((<>) + (let ((var (gensym))) + (loop rest (cons var params) (cons var args)))) + ((<...>) + (if (pair? rest) + (error "<...> not on the end of cut expression")) + (let ((var (gensym))) + `(lambda ,(append! (reverse! params) var) + (apply ,@(reverse! (cons var args)))))) + (else + (loop rest params (cons s args)))))))) + +(define-macro (cute . slots) + (let ((temp (map (lambda (s) (and (not (memq s '(<> <...>))) (gensym))) + slots))) + `(let ,(delq! #f (map (lambda (t s) (and t (list t s))) temp slots)) + (cut ,@(map (lambda (t s) (or t s)) temp slots))))) |