* (interrupt-handler) is added to handle INT signals.

* Cafes now customize the interrupt-handler to suppress the error
  message during read that the default interrupt handler generates.
This commit is contained in:
Abdulaziz Ghuloum 2006-12-24 12:53:01 +03:00
parent da9518cc49
commit 4f5490039b
5 changed files with 39 additions and 15 deletions

Binary file not shown.

View File

@ -46,6 +46,16 @@ description:
(display ">" (console-output-port)) (display ">" (console-output-port))
(display-prompt (fx+ i 1)))))) (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 wait (define wait
(lambda (eval escape-k) (lambda (eval escape-k)
(call/cc (call/cc
@ -57,7 +67,7 @@ description:
(k (void))) (k (void)))
(lambda () (lambda ()
(display-prompt 0) (display-prompt 0)
(let ([x (read (console-input-port))]) (let ([x (my-read k)])
(cond (cond
[(eof-object? x) [(eof-object? x)
(newline (console-output-port)) (newline (console-output-port))

View File

@ -1176,19 +1176,6 @@ reference-implementation:
;;X (error 'make-parameter "insufficient arguments"))))) ;;X (error 'make-parameter "insufficient arguments")))))
;;X ;;X
(primitive-set! 'make-parameter
(case-lambda
[(x)
(case-lambda
[() x]
[(v) (set! x v)])]
[(x guard)
(unless (procedure? guard)
(error 'make-parameter "~s is not a procedure" guard))
(set! x (guard x))
(case-lambda
[() x]
[(v) (set! x (guard v))])]))
(let () (let ()
(define vector-loop (define vector-loop

View File

@ -1,8 +1,34 @@
(primitive-set! 'make-parameter
(case-lambda
[(x)
(case-lambda
[() x]
[(v) (set! x v)])]
[(x guard)
(unless (procedure? guard)
(error 'make-parameter "~s is not a procedure" guard))
(set! x (guard x))
(case-lambda
[() x]
[(v) (set! x (guard v))])]))
(primitive-set! 'error (primitive-set! 'error
(lambda args (lambda args
(foreign-call "ik_error" args))) (foreign-call "ik_error" args)))
(primitive-set! 'interrupt-handler
(make-parameter
(lambda ()
(flush-output-port (console-output-port))
(error #f "interrupted"))
(lambda (x)
(if (procedure? x)
x
(error 'interrupt-handler "~s is not a procedure" x)))))
(primitive-set! '$apply-nonprocedure-error-handler (primitive-set! '$apply-nonprocedure-error-handler
(lambda (x) (lambda (x)
(error 'apply "~s is not a procedure" x))) (error 'apply "~s is not a procedure" x)))
@ -77,7 +103,7 @@
(if ($interrupted?) (if ($interrupted?)
(begin (begin
($unset-interrupted!) ($unset-interrupted!)
(error #f "Interrupted")) ((interrupt-handler)))
(display "Engine Expired\n" (console-output-port))))) (display "Engine Expired\n" (console-output-port)))))

View File

@ -83,6 +83,7 @@
quotient+remainder quotient remainder number? positive? quotient+remainder quotient remainder number? positive?
negative? zero? number->string logand = < > <= >= negative? zero? number->string logand = < > <= >=
make-guardian weak-cons collect make-guardian weak-cons collect
interrupt-handler
)) ))
(define system-primitives (define system-primitives