[Chicken-hackers] [PATCH] correct pseudo-parameter implementation and types.db fixes

[Felix]

The attached patch fixes the implementation of the "pseudo" parameters
current-input-port, current-output-port, current-error-port and
current-exception-handler which now return the correct value in the
assignment case.

Also, some types.db entries have been corrected.


cheers,
felix

commit 54fa2545d475740cfe66f42627163aad70b35446
Author: felix <address@hidden>
Date:   Fri Sep 23 08:34:20 2011 +0200

    pseudo parameters current-input-port, current-output-port, 
current-error-port and current-exception-handler now return the correct value 
in the assignment case; fixed some types.db entries; all noted by sjamaan

diff --git a/library.scm b/library.scm
index 8ceb7de..d84c805 100644
--- a/library.scm
+++ b/library.scm
@@ -1813,25 +1813,25 @@ EOF
   p )
 
 (define (current-input-port . arg)
-  (if (pair? arg)
-      (let ([p (car arg)])
-       (##sys#check-port p 'current-input-port)
-       (set! ##sys#standard-input p) )
-      ##sys#standard-input) )
+  (when (pair? arg)
+    (let ([p (car arg)])
+      (##sys#check-port p 'current-input-port)
+      (set! ##sys#standard-input p) ))
+  ##sys#standard-input)
 
 (define (current-output-port . arg)
-  (if (pair? arg)
-      (let ([p (car arg)])
-       (##sys#check-port p 'current-output-port)
-       (set! ##sys#standard-output p) )
-      ##sys#standard-output) )
+  (when (pair? arg)
+    (let ([p (car arg)])
+      (##sys#check-port p 'current-output-port)
+      (set! ##sys#standard-output p) ) )
+  ##sys#standard-output)
 
 (define (current-error-port . arg)
-  (if (pair? arg)
-      (let ([p (car arg)])
-       (##sys#check-port p 'current-error-port)
-       (set! ##sys#standard-error p) )
-      ##sys#standard-error) )
+  (when (pair? arg)
+    (let ([p (car arg)])
+      (##sys#check-port p 'current-error-port)
+      (set! ##sys#standard-error p) ) )
+  ##sys#standard-error)
 
 (define (##sys#tty-port? port)
   (and (not (zero? (##sys#peek-unsigned-integer port 0)))
@@ -3954,9 +3954,9 @@ EOF
       (lambda () (set! ##sys#current-exception-handler oldh)) ) ) )
 
 (define (current-exception-handler #!optional proc)
-  (if proc
-      (set! ##sys#current-exception-handler proc)
-      ##sys#current-exception-handler))
+  (when proc
+    (set! ##sys#current-exception-handler proc))
+  ##sys#current-exception-handler)
 
 (define (make-property-condition kind . props)
   (##sys#make-structure
diff --git a/types.db b/types.db
index de03b3c..17f1f01 100644
--- a/types.db
+++ b/types.db
@@ -684,6 +684,7 @@
 ;; chicken
 
 (abort (procedure abort (*) noreturn))
+(##sys#abort (procedure abort (*) noreturn))
 
 (add1 (#(procedure #:clean #:enforce) add1 (number) number)
       ((float) (float) 
@@ -1069,7 +1070,7 @@
                               ((string) #(1)))
 (##sys#foreign-symbol-argument (#(procedure #:clean #:enforce) 
##sys#foreign-symbol-argument (symbol) symbol)
                               ((symbol) #(1)))
-(##sys#foreign-pointer-argument (#(procedure #:clean #:enforce) 
##sys#foreign-pointer-argument ((or boolean pointer)) pointer)
+(##sys#foreign-pointer-argument (#(procedure #:clean #:enforce) 
##sys#foreign-pointer-argument (pointer) pointer)
                                ((pointer) #(1)))
 
 (##sys#check-blob (#(procedure #:clean #:enforce) ##sys#check-blob (blob 
#!optional *) *)