suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

* Better dealing with errors in eval-string and read-from-string/-all

Browse Source 
* Made them work with byte strings too
* Added tests to the above

svn: r5081

original commit: a772fa8c8407386a2279c4d6ea2d6294de7c83c0
This commit is contained in:
Eli Barzilay 2006-12-11 18:03:33 +00:00
parent d0c55dfa6c
commit 831e099478
1 changed files with 24 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
collects/mzlib/string.ss
View File

@ -26,23 +26,28 @@
(define string-lowercase! (make-string-do! char-downcase)) (define string-lowercase! (make-string-do! char-downcase))
(define string-uppercase! (make-string-do! char-upcase)) (define string-uppercase! (make-string-do! char-upcase))
;; helper for eval-string and read-from-string-one-or-all ;; helpers for eval-string and read-from-string-one-or-all
(define-syntax wrap-errors (define-syntax wrap-errors
(syntax-rules () (syntax-rules ()
[(wrap-errors error-display error-result body ...) [(wrap-errors who error-handler body ...)
(if (or error-display error-result) (if error-handler
(with-handlers (with-handlers
([void (lambda (exn) ([void
((or error-display (cond [(not (procedure? error-handler))
(lambda (x) ((error-display-handler) x exn))) (error who "bad error handler: ~e" error-handler)]
(exn-message exn)) [(procedure-arity-includes? error-handler 1)
(and error-result (error-result)))]) error-handler]
[(procedure-arity-includes? error-handler 0)
(lambda (exn) (error-handler))]
[else (error who "bad error handler: ~e" error-handler)])])
body ...) body ...)
(begin body ...))])) (begin body ...))]))
(define (open-input-bstring s)
(if (bytes? s) (open-input-bytes s) (open-input-string s)))
(define/kw (eval-string str #:optional error-display error-result) (define/kw (eval-string str #:optional error-handler)
(wrap-errors error-display error-result (wrap-errors 'eval-string error-handler
(let ([p (open-input-string str)]) (let ([p (open-input-bstring str)])
(apply values (apply values
(let loop () (let loop ()
(let ([e (read p)]) (let ([e (read p)])
@ -52,12 +57,13 @@
(lambda () (eval e)) (lambda () (eval e))
(lambda vals (append vals (loop))))))))))) (lambda vals (append vals (loop)))))))))))
(define/kw (read-from-string str #:optional error-display error-result) (define/kw (read-from-string str #:optional error-handler)
(wrap-errors error-display error-result (read (open-input-string str)))) (wrap-errors 'read-from-string error-handler
(read (open-input-bstring str))))
(define/kw (read-from-string-all str #:optional error-display error-result) (define/kw (read-from-string-all str #:optional error-handler)
(let ([p (open-input-string str)]) (let ([p (open-input-bstring str)])
(wrap-errors error-display error-result (wrap-errors 'read-from-string-all error-handler
(let loop ([r '()]) (let loop ([r '()])
(let ([v (read p)]) (let ([v (read p)])
(if (eof-object? v) (reverse! r) (loop (cons v r)))))))) (if (eof-object? v) (reverse! r) (loop (cons v r))))))))
@ -85,10 +91,10 @@
;; Regexp helpers ;; Regexp helpers
(define (bstring-length s) (define (bstring-length s)
(if (string? s) (string-length s) (bytes-length s))) (if (bytes? s) (bytes-length s) (string-length s)))
(define (subbstring s st e) (define (subbstring s st e)
(if (string? s) (substring s st e) (subbytes s st e))) (if (bytes? s) (subbytes s st e) (substring s st e)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Regexp helpers ;; Regexp helpers