~ chicken-core (chicken-5) 50191ad8b52bc5f67740b97aae168aa231f0f8c2

commit 50191ad8b52bc5f67740b97aae168aa231f0f8c2
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri May 21 22:08:37 2010 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri May 21 22:08:37 2010 +0200

    should be put somewhere else

diff --git a/expand.scm b/expand.scm
index 13e4ee7d..043a6f3a 100644
--- a/expand.scm
+++ b/expand.scm
@@ -1922,73 +1922,3 @@
       (set-module-sexports! mod sexports))))
 
 (define ##sys#module-table '())
-
-
-;;; Procedure to pre-parse keyword argument lists
-
-(define ##sys#parse-keyword-argument-list
-  (let ((reverse reverse)
-	(string-append string-append))
-    (lambda (arglist k+d k #!key (rename identity) (warn? #t) location)
-      (let ((%let (rename 'let)))
-	(define (warn msg . args)
-	  (when warn?
-	    (apply
-	     ##sys#warn
-	     (if location
-		 (string-append 
-		  "(" (##sys#symbol->string location) ") "
-		  msg)
-		 msg)
-	     args)))
-	(define (kw->sym kw) 
-	  (##sys#string->symbol (##sys#symbol->string kw)))
-	(let loop ((args arglist) (bindings '()))
-	  (cond ((null? args)
-		 `(,%let ,(map cdr (reverse bindings))
-			 (,%let	; bind variables with names of keyword args
-			  ,(let loop ((k+d k+d)) ; in case defaults refer to them
-			     (if (null? k+d) 
-				 '()
-				 (let* ((x (car k+d))
-					(kw (car x))
-					(def (cdr x)))
-				   (cond ((assq kw bindings) =>
-					  (lambda (a)
-					    (cons (list (kw->sym kw) (cadr a))
-						  (loop (cdr k+d)))))
-					 (else 
-					  (cons (list (kw->sym kw) def)
-						(loop (cdr k+d))))))))
-			  ,(k (let loop ((k+d k+d))
-				(if (null? k+d) 
-				    '()
-				    (let* ((x (car k+d))
-					   (kw (car x)))
-				      (cond ((assq kw bindings) => 
-					     (lambda (a)
-					       (cons (cadr a) (loop (cdr k+d)))))
-					    (else
-					     (cons (kw->sym kw)
-						   (loop (cdr k+d))))))))))))
-		((not (pair? args))
-		 (warn "invalid argument list syntax" arglist)
-		 #f)
-		(else
-		 (let ((arg (car args))
-		       (rest (cdr args)))
-		   (cond ((keyword? arg)
-			  (cond ((assq arg k+d) =>
-				 (lambda (a)
-				   (cond ((not (pair? rest))
-					  (warn "missing keyword argument value" arg arglist)
-					  #f)
-					 (else
-					  (let ((tmp (gensym arg)))
-					    (loop 
-					     (cdr rest) 
-					     (cons (list arg tmp (car rest)) bindings)))))))
-				(else
-				 (warn "unrecognized keyword argument" arg arglist)
-				 #f)))
-			 (else #f))))))))))