From 1570bd1cd4bb4892e1e4ab2dd926874ff09d58e1 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Tue, 16 Jun 2015 19:10:49 +0900 Subject: [PATCH] syntax-rules: rewrite case-lambda.scm. (p ... . var) pattern is not supported --- contrib/05.r7rs/scheme/case-lambda.scm | 25 +++++++++++-------------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/contrib/05.r7rs/scheme/case-lambda.scm b/contrib/05.r7rs/scheme/case-lambda.scm index fff2b26c..6a6ca432 100644 --- a/contrib/05.r7rs/scheme/case-lambda.scm +++ b/contrib/05.r7rs/scheme/case-lambda.scm @@ -1,28 +1,25 @@ (define-library (scheme case-lambda) (import (scheme base)) + (define (length+ list) + (if (pair? list) + (+ 1 (length+ (cdr list))) + 0)) + (define-syntax case-lambda (syntax-rules () ((case-lambda (params body0 ...) ...) (lambda args (let ((len (length args))) (letrec-syntax - ((cl (syntax-rules ::: () + ((cl (syntax-rules () ((cl) (error "no matching clause")) - ((cl ((p :::) . body) . rest) - (if (= len (length '(p :::))) - (apply (lambda (p :::) - . body) - args) - (cl . rest))) - ((cl ((p ::: . tail) . body) - . rest) - (if (>= len (length '(p :::))) - (apply - (lambda (p ::: . tail) - . body) - args) + ((cl (formal . body) . rest) + (if (if (list? 'formal) + (= len (length 'formal)) + (>= len (length+ 'formal))) + (apply (lambda formal . body) args) (cl . rest)))))) (cl (params body0 ...) ...)))))))