This patch adds (I believe) almost-R7RS support for the `exit` and
`emergency-exit` procedures. Specifically, it allows `exit` to accept an
arbitrary object as its argument, causes `exit` to run all finalizers
and pending dynamic-wind after-thunks before exiting (by default;
defining an `exit-handler` overrides this behavior as before), and adds
the `emergency-exit` procedure which does not.
The exit status translation follows the usual Scheme falsity rules (#f
causes an exit with a status of 1, everything else exits 0), with the
exception of integers which, in the interest of backwards-compatability
(and also the need to return other exit statuses to the OS), are passed
along directly. There are probably more creative things one could do
here, but this behavior makes sense to me.
The second patch just fixes some macro un/hygiene tests that had relied
on exit's old behavior.
I think I've gotten these right, but they should obviously be looked at
carefully. If you can't trust software to stop, can you trust it at all?
Also, I believe CHICKEN's exit procedures are still not technically
R7RS-compliant even given these changes, since a user-specified
`exit-handler` or `on-exit` procedure may signal an error, contain a
non-local escape or simply refuse to exit, all of which are verboten by
the draft. I think this is probably OK, but others may feel differently.
Evan
>From 370e0ff5008dc997f19ea7a01032cadfea0c1bef Mon Sep 17 00:00:00 2001
From: Evan Hanson <ev...@foldling.org>
Date: Tue, 28 May 2013 22:47:57 +1200
Subject: [PATCH 1/2] add R7RS support for exit and emergency-exit
This allows exit to accept an arbitrary object as its argument (if the object
is an
integer, it is used as the process' exit status directly; otherwise, the exit
status follows the usual Scheme rules (#f is 1 to indicate an abnormal exit,
everything else is 0)).
It also causes exit to run all finalizers and pending dynamic-wind after-thunks
before exiting, and adds the emergency-exit procedure which does not.
---
library.scm | 21 ++++++++++++---------
manual/Parameters | 7 ++++---
manual/Unit library | 19 +++++++++++++++----
3 files changed, 31 insertions(+), 16 deletions(-)
diff --git a/library.scm b/library.scm
index 68165d9..b12bd66 100644
--- a/library.scm
+++ b/library.scm
@@ -152,11 +152,19 @@ EOF
;;; System routines:
-(define (exit #!optional (code 0)) ((##sys#exit-handler) code))
+(define (exit #!optional (obj 0)) ((##sys#exit-handler) obj))
+(define (emergency-exit #!optional (obj 0)) (##sys#exit-runtime obj))
(define (reset) ((##sys#reset-handler)))
(define (##sys#quit-hook result) ((##sys#exit-handler) 0))
(define (quit #!optional result) (##sys#quit-hook result))
+(define (##sys#exit-runtime obj)
+ (##core#inline
+ "C_exit_runtime"
+ (cond ((##sys#integer? obj) obj)
+ ((##sys#eq? obj #f) 1)
+ (else 0))))
+
(define (##sys#error . args)
(if (pair? args)
(apply ##sys#signal-hook #:error args)
@@ -3935,15 +3943,10 @@ EOF
(define exit-handler
(make-parameter
- (lambda code
+ (lambda (obj)
(##sys#cleanup-before-exit)
- (##core#inline
- "C_exit_runtime"
- (if (null? code)
- 0
- (let ([code (car code)])
- (##sys#check-exact code)
- code) ) ) ) ) )
+ (##sys#dynamic-unwind '() (length ##sys#dynamic-winds))
+ (##sys#exit-runtime obj))))
(define implicit-exit-handler
(make-parameter
diff --git a/manual/Parameters b/manual/Parameters
index bf0e7d7..cb90d87 100644
--- a/manual/Parameters
+++ b/manual/Parameters
@@ -81,9 +81,10 @@ read-syntax (see {{set-read-syntax!}} for more information).
<parameter>(exit-handler)</parameter>
-A procedure of a single optional argument. When {{exit}} is called,
-then this procedure will be invoked with the exit-code as argument. The
-default behavior is to terminate the program.
+A procedure of a single argument. When {{exit}} is called, this
+procedure is invoked with the object passed to {{exit}} as its argument.
+The default behavior is to run all pending finalizers and
+{{dynamic-wind}} thunks and terminate the program.
=== eval-handler
diff --git a/manual/Unit library b/manual/Unit library
index 1efb5bd..98dca79 100644
--- a/manual/Unit library
+++ b/manual/Unit library
@@ -451,12 +451,23 @@ the host-shell whether arguments are expanded ('globbed')
or not.
==== exit
-<procedure>(exit [CODE])</procedure>
+<procedure>(exit [OBJECT])</procedure>
-Exit the running process and return exit-code, which defaults to 0
-(Invokes {{exit-handler}}).
+Exit the running process and return an exit-code representing the given
+{{OBJECT}}, which defaults to 0. If {{OBJECT}} is an integer, it is used
+as the exit-code for the process. If {{OBJECT}} is {{#f}}, the exit-code
+will be 1, and 0 in all other cases (invokes {{exit-handler}}).
-Note that pending {{dynamic-wind}} thunks are ''not'' invoked when exiting
your program in this way.
+==== emergency-exit
+
+<procedure>(emergency-exit [OBJECT])</procedure>
+
+Exit the running process and return an exit-code representing the given
+{{OBJECT}} in the same manner as {{exit}}. Does not invoke
+{{exit-handler}}.
+
+Pending finalizers and {{dynamic-wind}} thunks are ''not'' invoked when
+exiting your program in this way.
==== build-platform
--
1.7.10.4
>From 8dba990d93e3c3181a84284830f7e9a0ca18e410 Mon Sep 17 00:00:00 2001
From: Evan Hanson <ev...@foldling.org>
Date: Tue, 28 May 2013 23:02:11 +1200
Subject: [PATCH 2/2] update syntax hygiene tests to account for R7RS exit
specification
This fixes a set of tests that relied on (exit #f) signaling an error,
since pre-R7RS exit expected an integer argument whereas passing #f is
now valid.
---
tests/syntax-tests.scm | 20 ++++++++++----------
1 file changed, 10 insertions(+), 10 deletions(-)
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index 6da0277..2d96626 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -371,20 +371,20 @@
(lambda (x r c)
(let ((body (cdr x)))
`(,(r 'call/cc)
- (,(r 'lambda) (exit)
+ (,(r 'lambda) (break)
(,(r 'let) ,(r 'f) () ,@body (,(r 'f)))))))))
(let ((n 10))
(loop
(print* n " ")
(set! n (sub1 n))
- (when (zero? n) (exit #f)))
+ (when (zero? n) (break #f)))
(newline))
(define-syntax while0
(syntax-rules ()
((_ t b ...)
- (loop (if (not t) (exit #f))
+ (loop (if (not t) (break #f))
b ...))))
(f (while0 #f (print "no.")))
@@ -393,7 +393,7 @@
(er-macro-transformer
(lambda (x r c)
`(,(r 'loop)
- (,(r 'if) (,(r 'not) ,(cadr x)) (exit #f))
+ (,(r 'if) (,(r 'not) ,(cadr x)) (break #f))
,@(cddr x)))))
(let ((n 10))
@@ -420,11 +420,11 @@
(define-macro (loop . body)
(let ((loop (gensym)))
`(call/cc
- (lambda (exit)
+ (lambda (break)
(let ,loop () ,@body (,loop))))))
(let ((i 1))
- (loop (when (> i 10) (exit #f))
+ (loop (when (> i 10) (break #f))
(print* i " ")
(set! i (add1 i))))
(newline)
@@ -571,20 +571,20 @@
(lambda (x i c)
(let ((body (cdr x)))
`(call/cc
- (lambda (,(i 'exit))
+ (lambda (,(i 'break))
(let f () ,@body (f))))))))
(let ((n 10))
(loop2
(print* n " ")
(set! n (sub1 n))
- (when (zero? n) (exit #f)))
+ (when (zero? n) (break #f)))
(newline))
(define-syntax while20
(syntax-rules ()
((_ t b ...)
- (loop2 (if (not t) (exit #f))
+ (loop2 (if (not t) (break #f))
b ...))))
(f (while20 #f (print "no.")))
@@ -593,7 +593,7 @@
(ir-macro-transformer
(lambda (x i c)
`(loop
- (if (not ,(cadr x)) (,(i 'exit) #f))
+ (if (not ,(cadr x)) (,(i 'break) #f))
,@(cddr x)))))
(let ((n 10))
--
1.7.10.4
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
