conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

improve error handling mechanism

This commit is contained in:
Yuichi Nishiwaki 2014-09-19 17:14:08 +09:00
parent abc86efc55
commit d8cbcde157
2 changed files with 32 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
contrib/20.repl/repl.scm
View File

@ -2,25 +2,19 @@
(import (scheme base) (import (scheme base)
(scheme read) (scheme read)
(scheme write) (scheme write)
(scheme eval) (scheme eval))
(picrin macro)
(picrin library))
;; FIXME picrin doesn't offer cond-expand for now, so we define a macro ourselves (cond-expand
(define-syntax define-readline ((library (picrin readline))
(er-macro-transformer (import (picrin readline)
(lambda (form rename compare) (picrin readline history)))
(if (member '(picrin readline) (libraries)) (else
`(import (picrin readline) (begin
(picrin readline history)) (define (readline str)
`(begin (display str)
(define (readline str) (read-line))
(display str) (define (add-history str)
(read-line)) #f))))
(define (add-history str)
#f))))))
(define-readline)
(define (repl) (define (repl)
(let loop ((buf "")) (let loop ((buf ""))
@ -33,23 +27,27 @@
(lambda (exit) (lambda (exit)
(with-exception-handler (with-exception-handler
(lambda (condition) (lambda (condition)
(unless (equal? (error-object-message condition) "unexpected EOF") (if (error-object? condition)
(display (error-object-message condition) (current-error-port)) (unless (equal? (error-object-message condition) "unexpected EOF")
(newline) (display "error: ")
(set! str "")) (display (error-object-message condition))
(newline)
(set! str ""))
(begin
(display "raised: ")
(write condition)
(newline)
(set! str "")))
(exit)) (exit))
(lambda () (lambda ()
;; FIXME (call-with-port (open-input-string str)
;; non-local exception jump from inside call-with-port (lambda (port)
;; fails with segv, though i don't know why... (let next ((expr (read port)))
(let ((port (open-input-string str))) (unless (eof-object? expr)
(let next ((expr (read port))) (write (eval expr '(picrin user)))
(unless (eof-object? expr) (newline)
(write (eval expr '(picrin user))) (set! str "")
(newline) (next (read port))))))))))
(set! str "")
(next (read port))))
(close-port port))))))
(loop str)))))) (loop str))))))
(export repl)) (export repl))

2
extlib/benz

@ -1 +1 @@
Subproject commit 06971a1144404bab62f0a9a7e7f881b18b6afde4 Subproject commit c4258153138a33441054e75072ea30e4012f9265