From b825da0e5a6b295fe9c5c4c163a3f45bead1fd17 Mon Sep 17 00:00:00 2001 From: stibear Date: Tue, 25 Mar 2014 01:32:21 +0900 Subject: [PATCH] implemented completely --- piclib/srfi/26.scm | 53 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 piclib/srfi/26.scm diff --git a/piclib/srfi/26.scm b/piclib/srfi/26.scm new file mode 100644 index 00000000..de387b71 --- /dev/null +++ b/piclib/srfi/26.scm @@ -0,0 +1,53 @@ +(define-library (srfi 26) + (import (scheme base) + (picrin macro) + (srfi 1)) + + (define-syntax cut% + (ir-macro-transformer + (lambda (form inject compare?) + (let ((slots (second form)) + (combi (third form)) + (se (cdddr form))) + (cond ((null? se) + `(lambda ,slots ((begin ,(car combi)) ,@(cdr combi)))) + ((and (symbol? (car se)) + (compare? (car se) '<...>)) + `(lambda (,@slots . rest-slot) (apply ,@combi rest-slot))) + ((and (symbol? (car se)) + (compare? (car se) '<>)) + `(cut% (,@slots x) (,@combi x) ,@(cdr se))) + (else `(cut% ,slots (,@combi ,(car se)) ,@(cdr se)))))))) + + (define-syntax cute% + (ir-macro-transformer + (lambda (form inject compare?) + (let ((slots (second form)) + (binds (third form)) + (combi (fourth form)) + (se (cddddr form))) + (cond ((null? se) + `(let ,binds + (lambda ,slots ((begin ,(car combi)) ,@(cdr combi))))) + ((and (symbol? (car se)) + (compare? (car se) '<...>)) + `(let ,binds + (lambda (,@slots . rest-slot) (apply ,@combi rest-slot)))) + ((and (symbol? (car se)) + (compare? (car se) '<>)) + `(cute% (,@slots x) ,binds (,@combi x) ,@(cdr se))) + (else + `(cute% ,slots ((x ,(car se)) ,@binds) + (,@combi x) ,@(cdr se)))))))) + + (define-syntax cut + (ir-macro-transformer + (lambda (form inject compare?) + `(cut% () () ,@(cdr form))))) + + (define-syntax cute + (ir-macro-transformer + (lambda (form inject compare?) + `(cute% () () () ,@(cdr form))))) + + (export cut cute))