From feeef4fb40adc27426a4ccf98c4131e9133c97f2 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 21 Jan 2004 00:46:10 +0000 Subject: [PATCH] New, from Daniel Skarda. Thanks! --- srfi/srfi-26.scm | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) create mode 100644 srfi/srfi-26.scm 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)))))