~ chicken-core (chicken-5) 1eff172120220cb7e45ee4189821f7a7c3bd29a3


commit 1eff172120220cb7e45ee4189821f7a7c3bd29a3
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Aug 5 09:34:05 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Aug 5 09:34:05 2011 +0200

    removed checks for surplus arguments in [let-]optional[sÜ]; reverted args-hack for current-directory

diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index edcb0970..45a6b08b 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -562,7 +562,6 @@
 ;;; The expression takes a rest list ARG-LIST and binds the VARi to
 ;;; the elements of the rest list. When there are no more elements, then
 ;;; the remaining VARi are bound to their corresponding DEFAULTi values.
-;;; It is an error if there are more args than variables.
 ;;;
 ;;; - The default expressions are *not* evaluated unless needed.
 ;;;
@@ -640,9 +639,7 @@
       (define (make-if-tree vars defaulters body-proc rest rename)
 	(let recur ((vars vars) (defaulters defaulters) (non-defaults '()))
 	  (if (null? vars)
-	      `(##core#if (##core#check (,(r 'null?) ,rest))
-		     (,body-proc . ,(reverse non-defaults))
-		     (##sys#error (##core#immutable '"too many optional arguments") ,rest))
+	      `(,body-proc . ,(reverse non-defaults))
 	      (let ((v (car vars)))
 		`(##core#if (null? ,rest)
 		       (,(car defaulters) . ,(reverse non-defaults))
@@ -694,7 +691,6 @@
 ;;;     (lambda (a b . r) ...)
 ;;; - If REST-ARG has 0 elements, evaluate DEFAULT-EXP and return that.
 ;;; - If REST-ARG has 1 element, return that element.
-;;; - If REST-ARG has >1 element, error.
 
 (##sys#extend-macro-environment
  'optional 
@@ -707,12 +703,8 @@
     (let ((var (r 'tmp)))
       `(##core#let ((,var ,(cadr form)))
 	(##core#if (,(r 'null?) ,var) 
-	      ,(optional (cddr form) #f)
-	      (##core#if (##core#check (,(r 'null?) (,(r 'cdr) ,var)))
-		    (,(r 'car) ,var)
-		    (##sys#error
-		     (##core#immutable '"too many optional arguments") 
-		     ,var))))))))
+		   ,(optional (cddr form) #f)
+		   (,(r 'car) ,var)))))))
 
 
 ;;; (LET-OPTIONALS* args ((var1 default1) ... [rest]) body1 ...)
@@ -727,8 +719,6 @@
 ;;;   VAR7, and ARGS has 9 values, then REST will be bound to the list of
 ;;;   the two values of ARGS. If ARGS is too short, causing defaults to
 ;;;   be used, then REST is bound to '().
-;;; - If there is no REST variable, then it is an error to have excess
-;;;   values in the ARGS list.
 
 (##sys#extend-macro-environment
  'let-optionals* 
@@ -747,11 +737,7 @@
 	  ((,rvar ,args))
 	  ,(let loop ([args rvar] [vardefs var/defs])
 	     (if (null? vardefs)
-		 `(##core#if (##core#check (,%null? ,args))
-			     (##core#let () ,@body)
-			     (##sys#error 
-			      (##core#immutable '"too many optional arguments") 
-			      ,args) )
+		 `(##core#let () ,@body)
 		 (let ([head (car vardefs)])
 		   (if (pair? head)
 		       (let ((rvar2 (r 'tmp2)))
diff --git a/posix-common.scm b/posix-common.scm
index a1f6790c..6ce6443c 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -229,7 +229,7 @@ EOF
 
 ;;; Set or get current directory:
 
-(define (current-directory #!optional dir mode) ; for "parameterize"
+(define (current-directory #!optional dir)
   (if dir
       (change-directory dir)
       (let* ((buffer (make-string 1024))
Trap