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

much improvements

Browse Source 
svn: r5073
This commit is contained in:
Eli Barzilay 2006-12-10 00:01:10 +00:00
parent d835aa46f9
commit 2da3b1f2aa
1 changed files with 32 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
collects/mzlib/string.ss
View File

@ -26,63 +26,41 @@
(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))
(define eval-string ;; helper for eval-string and read-from-string-one-or-all
(let ([do-eval (define-syntax wrap-errors
(lambda (str) (syntax-rules ()
(let ([p (open-input-string str)]) [(wrap-errors error-display error-result body ...)
(apply (if (or error-display error-result)
values (with-handlers
(let loop () ([void (lambda (exn)
(let ([e (read p)]) ((or error-display
(if (eof-object? e) (lambda (x) ((error-display-handler) x exn)))
'() (exn-message exn))
(call-with-values (and error-result (error-result)))])
(lambda () (eval e)) body ...)
(case-lambda (begin body ...))]))
[() (loop)]
[(only) (cons only (loop))]
[multi (append multi (loop))]))))))))])
(lambda/kw (str #:optional error-display error-result)
(if (or error-display error-result)
(with-handlers ([void
(lambda (exn)
((or error-display
(lambda (x)
((error-display-handler) x exn)))
(exn-message exn))
(if error-result
(error-result)
#f))])
(do-eval str))
(do-eval str)))))
(define/kw (read-from-string-one-or-all (define/kw (eval-string str #:optional error-display error-result)
k all? str #:optional error-display error-result) (wrap-errors error-display error-result
(let* ([p (open-input-string str)] (let ([p (open-input-string str)])
[go (lambda () (apply values
(let loop () (let loop ()
(let ([v (read p)]) (let ([e (read p)])
(if (eof-object? v) (if (eof-object? e)
'() '()
(cons v (if all? (loop) '()))))))]) (call-with-values
(if error-display (lambda () (eval e))
(with-handlers ([void (lambda vals (append vals (loop)))))))))))
(lambda (exn)
((or error-display
(lambda (x) ((error-display-handler) x exn)))
(exn-message exn))
(k (if error-result (error-result) #f)))])
(go))
(go))))
(define (read-from-string . args) (define/kw (read-from-string str #:optional error-display error-result)
(let/ec k (wrap-errors error-display error-result (read (open-input-string str))))
(let ([l (apply read-from-string-one-or-all k #f args)])
(if (null? l) eof (car l)))))
(define (read-from-string-all . args) (define/kw (read-from-string-all str #:optional error-display error-result)
(let/ec k (let ([p (open-input-string str)])
(apply read-from-string-one-or-all k #t args))) (wrap-errors error-display error-result
(let loop ([r '()])
(let ([v (read p)])
(if (eof-object? v) (reverse! r) (loop (cons v r))))))))
(define (expr->string v) (define (expr->string v)
(let ([port (open-output-string)]) (let ([port (open-output-string)])