On Sun, 2008-07-27 at 16:39 +0000, Abdulaziz Ghuloum wrote:
> There are two other situations that make the cafe go berserk.  Try:
>   (close-output-port (current-output-port))
> and 
>   (close-input-port (current-input-port))

Hehe :)

> I think that the cafe handler around "read" should only handle &lexical
> and &interrupted conditions and propagate the rest upwards while the
> handler around eval should trap all conditions.  Need to try it out.

I've tried this:

=== modified file 'scheme/ikarus.cafe.ss'
--- scheme/ikarus.cafe.ss	2008-07-13 03:05:45 +0000
+++ scheme/ikarus.cafe.ss	2008-07-28 02:34:31 +0000
@@ -53,48 +53,58 @@
             (display ">" (console-output-port))
             (display-prompt (fx+ i 1))))))
 
-  (define my-read
-    (lambda (k)
-      (parameterize ([interrupt-handler
-                      (lambda ()
-                        (flush-output-port (console-output-port))
-                        (reset-input-port! (console-input-port))
-                        (newline (console-output-port))
-                        (k))])
-         (read (console-input-port)))))
-
+  (define (print-ex ex)
+    (flush-output-port (console-output-port))
+    (display "Unhandled exception\n" (console-error-port))
+    (print-condition ex (console-error-port)))
+  
+  (define (reset k)
+    (reset-input-port! (console-input-port))
+    (k))
+  
   (define wait
     (lambda (eval-proc escape-k)
       (call/cc
         (lambda (k)
-          (with-exception-handler
-            (lambda (con)
-              (reset-input-port! (console-input-port))
-              (k (void)))
-            (lambda ()
-              (with-exception-handler
-                (lambda (con)
-                  (flush-output-port (console-output-port))
-                  (display "Unhandled exception\n" (console-error-port))
-                  (print-condition con (console-error-port))
-                  (when (interrupted-condition? con)
-                    (raise-continuable con)))
-                (lambda ()
-                  (display-prompt 0)
-                  (let ([x (my-read k)])
-                    (cond
-                      [(eof-object? x) 
-                       (newline (console-output-port))
-                       (escape-k (void))]
-                      [else
-                       (call-with-values
-                         (lambda () (eval-proc x))
-                         (lambda v*
-                           (unless (andmap (lambda (v) (eq? v (void))) v*)
-                             (for-each
-                               (lambda (v)
-                                 (pretty-print v (console-output-port)))
-                               v*))))]))))))))
+          (display-prompt 0)
+          (let ([x (with-exception-handler
+                     (lambda (ex)
+                       (cond [(lexical-violation? ex)
+                              (print-ex ex)                              
+                              (reset k)]
+                             [(interrupted-condition? ex)
+                              (flush-output-port (console-output-port))
+                              (newline (console-output-port))
+                              (reset k)]
+                             [else (raise-continuable ex)]))
+                     (lambda ()
+                       (read (console-input-port))))])
+            (cond
+              [(eof-object? x) 
+               (newline (console-output-port))
+               (escape-k (void))]
+              [else
+               (call-with-values
+                 (lambda () 
+                   (with-exception-handler
+                     (lambda (ex)
+                       (if (non-continuable-violation? ex)
+                         (reset k)
+                         (raise-continuable ex)))
+                     (lambda ()
+                       (with-exception-handler
+                         (lambda (ex)
+                           (print-ex ex)
+                           (when (serious-condition? ex)
+                             (reset k)))
+                         (lambda ()
+                           (eval-proc x))))))
+                 (lambda v*
+                   (unless (andmap (lambda (v) (eq? v (void))) v*)
+                     (for-each
+                       (lambda (v)
+                         (pretty-print v (console-output-port)))
+                       v*))))]))))
       (wait eval-proc escape-k)))
 
   (define do-new-cafe


[d@eep:~]-> ikarus | (read;read)
Unhandled exception:
 Condition components:
   1. &i/o-write
   2. &who: write
   3. &message: "EPIPE: Broken pipe"
   4. &irritants: (*stdout*)
[d@eep:~]-> ikarus | read
Unhandled exception:
 Condition components:
   1. &i/o-write
   2. &who: write
   3. &message: "EPIPE: Broken pipe"
   4. &irritants: (*stdout*)
[d@eep:~]-> ikarus | (read;read;read)
Unhandled exception:
 Condition components:
   1. &i/o-write
   2. &who: write
   3. &message: "EPIPE: Broken pipe"
   4. &irritants: (*stdout*)
[d@eep:~]-> ikarus | (read;read;read;read)
map
map
Unhandled exception:
 Condition components:
   1. &i/o-write
   2. &who: write
   3. &message: "EPIPE: Broken pipe"
   4. &irritants: (*stdout*)
[d@eep:~]-> ikarus
Ikarus Scheme version 0.0.3+ (revision 1559, build 2008-07-27)
Copyright (c) 2006-2008 Abdulaziz Ghuloum

> (close-port (current-output-port))
Unhandled exception:
 Condition components:
   1. &assertion
   2. &who: display
   3. &message: "port is closed"
   4. &irritants: (#<output-port (textual) *stdout*>)
[d@eep:~]-> ikarus
Ikarus Scheme version 0.0.3+ (revision 1559, build 2008-07-27)
Copyright (c) 2006-2008 Abdulaziz Ghuloum

> (close-port (current-input-port))
> Unhandled exception:
 Condition components:
   1. &assertion
   2. &who: get-char
   3. &message: "port is closed"
   4. &irritants: (#<input-port (textual) *stdin*>)
[d@eep:~]-> ikarus
Ikarus Scheme version 0.0.3+ (revision 1559, build 2008-07-27)
Copyright (c) 2006-2008 Abdulaziz Ghuloum

> (begin (close-port (current-output-port)) (display "foo\n"))
Unhandled exception:
 Condition components:
   1. &assertion
   2. &who: flush-output-port
   3. &message: "port is closed"
   4. &irritants: (#<output-port (textual) *stdout*>)
[d@eep:~]-> ikarus
Ikarus Scheme version 0.0.3+ (revision 1559, build 2008-07-27)
Copyright (c) 2006-2008 Abdulaziz Ghuloum

> (begin (close-port (current-input-port)) (read))
Unhandled exception
 Condition components:
   1. &assertion
   2. &who: get-char
   3. &message: "port is closed"
   4. &irritants: (#<input-port (textual) *stdin*>)
> Unhandled exception:
 Condition components:
   1. &assertion
   2. &who: get-char
   3. &message: "port is closed"
   4. &irritants: (#<input-port (textual) *stdin*>)
[d@eep:~]-> ikarus
Ikarus Scheme version 0.0.3+ (revision 1559, build 2008-07-27)
Copyright (c) 2006-2008 Abdulaziz Ghuloum

> -asdf
Unhandled exception
 Condition components:
   1. &lexical
   2. &message: "invalid numeric sequence"
   3. &irritants: ("-a")
   4. &lexical-position:
       file-name: *stdin*
       character: 1
>   ;; ^C
>   ;; ^C
>   ;; ^C
> (let loop () (loop))
Unhandled exception
 Condition components:
   1. &interrupted
   2. &message: "received an interrupt signal"
>   ;; ^C
>   ;; ^C
> (begin (raise-continuable 'foo) 'continued)
Unhandled exception
 Non-condition object: foo
continued
> (begin (raise-continuable (make-warning)) 'continued)
Unhandled exception
 Condition components:
   1. &warning
continued
> (begin (raise (make-warning)) 'continued)
Unhandled exception
 Condition components:
   1. &warning
> (begin (raise-continuable (make-error)) 'continued)
Unhandled exception
 Condition components:
   1. &error
> 

If anything anywhere goes wrong with the non- user code / ikarus
infrastructure, it's guaranteed to propagate to the base handler which
just exits (at least, that's the goal).  Also, it's more consistent with
the --r6rs-script default handler than before w.r.t. the default handler
not returning for &serious, even if the &serious was
raise-continuable'd.  I.e., previously it would do:

> (begin (raise-continuable (make-error)) 'continued)
Unhandled exception
 Condition components:
   1. &error
continued
>