~ 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