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

fix readtable composition in #2d reader

Browse Source 
original commit: 6914451426194ed7e334d302d35f95d0f5ce1b35
This commit is contained in:
Robby Findler 2013-03-13 08:48:50 -05:00
parent d9dfcf0acb
commit d2630cd78f
1 changed files with 7 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/unstable/2d/private/readtable.rkt
View File

@ -23,13 +23,13 @@ example uses:
(provide make-2d-readtable) (provide make-2d-readtable)
(define (make-2d-readtable) (define (make-2d-readtable)
(make-readtable (define previous-readtable (current-readtable))
#f (make-readtable
previous-readtable
#\2 #\2
'dispatch-macro 'dispatch-macro
(case-lambda (case-lambda
[(char port) [(char port)
(define previous-readtable (current-readtable))
(define-values (line col pos) (port-next-location port)) (define-values (line col pos) (port-next-location port))
;; the "-2"s here are because the initial line and column ;; the "-2"s here are because the initial line and column
@ -40,12 +40,10 @@ example uses:
(and pos (- pos 2)) (and pos (- pos 2))
read/recursive previous-readtable)] read/recursive previous-readtable)]
[(char port source _line _col _pos) [(char port source _line _col _pos)
(define previous-readtable (current-readtable))
(dispatch-proc char port source _line _col _pos (dispatch-proc char port source _line _col _pos
(λ (a b c) (read-syntax/recursive source a b c)) (λ (a b c) (read-syntax/recursive source a b c))
previous-readtable)]))) previous-readtable)])))
(define (dispatch-proc char port source _line _col _pos /recursive previous-readtable) (define (dispatch-proc char port source _line _col _pos /recursive previous-readtable)
(define next-char (peek-char port)) (define next-char (peek-char port))
(cond (cond
@ -109,7 +107,7 @@ example uses:
`[,(sort (set->list set-of-indicies) compare/xy) `[,(sort (set->list set-of-indicies) compare/xy)
,@(read-subparts source scratch-port ,@(read-subparts source scratch-port
initial-space-count table-column-breaks heights set-of-indicies initial-space-count table-column-breaks heights set-of-indicies
previous-readtable /recursive)]))] /recursive)]))]
[else [else
(/recursive (/recursive
(input-port-append #f (open-input-string "#2") port) (input-port-append #f (open-input-string "#2") port)
@ -119,7 +117,7 @@ example uses:
(define (read-subparts source scratch-port (define (read-subparts source scratch-port
initial-space-count table-column-breaks heights lhs initial-space-count table-column-breaks heights lhs
previous-readtable /recursive) /recursive)
(with-handlers (#; (with-handlers (#;
[exn:fail:read? [exn:fail:read?
(λ (exn) (λ (exn)
@ -136,7 +134,7 @@ example uses:
source source
initial-space-count table-column-breaks heights lhs))))]) initial-space-count table-column-breaks heights lhs))))])
(let loop () (let loop ()
(define o (/recursive scratch-port #f previous-readtable)) (define o (/recursive scratch-port #f (current-readtable)))
(cond (cond
[(eof-object? o) '()] [(eof-object? o) '()]
[else (cons o (loop))])))) [else (cons o (loop))]))))