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

fix unstable/2d reader for ports with specials

Browse Source 
(eg drracket files with comment boxes or images)

original commit: aa3bef0468ce4dd26693b75357221315f1587b48
This commit is contained in:
Robby Findler 2013-10-24 21:34:44 -05:00
parent 5910ad88d9
commit eccec9a2ad
3 changed files with 56 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
pkgs/unstable-2d/unstable/2d/private/lexer.rkt
View File

@ -48,11 +48,15 @@ todo:
;; (the ones outside the table, ;; (the ones outside the table,
;; specifically, are always just spaces) ;; specifically, are always just spaces)
(unless (eq? tok 'white-space) (unless (eq? tok 'white-space)
(define c1 (string-ref val i))
(unless (equal? c1 c2) ;; 3) sometimes we get specials in the port
(error '2d/lexer.rkt "expected a ~s, got ~s while feeding token ~s" (when (char? c2)
c1 c2
(car (2d-lexer-state-pending-tokens a-2d-lexer-state))))))) (define c1 (string-ref val i))
(unless (equal? c1 c2)
(error '2d/lexer.rkt "expected a ~s, got ~s while feeding token ~s"
c1 c2
(car (2d-lexer-state-pending-tokens a-2d-lexer-state))))))))
;; actually read the characters in ;; actually read the characters in
(define last-i (- end start)) (define last-i (- end start))
@ -65,12 +69,12 @@ todo:
;; of those and then use str-offset when indexing into the string ;; of those and then use str-offset when indexing into the string
[str-offset 0]) [str-offset 0])
(unless (= i last-i) (unless (= i last-i)
(define c2 (read-char port)) (define c2 (read-char-or-special port))
(check-char (+ str-offset i) c2) (check-char (+ str-offset i) c2)
(cond (cond
[(and (equal? c2 #\return) [(and (equal? c2 #\return)
(equal? (peek-char port) #\newline)) (equal? (peek-char-or-special port) #\newline))
(read-char port) (read-char-or-special port)
(check-char (+ str-offset i 1) #\newline) (check-char (+ str-offset i 1) #\newline)
(loop (+ i 1) (loop (+ i 1)
(+ str-offset 1))] (+ str-offset 1))]
@ -92,9 +96,11 @@ todo:
(if (null? next-tokens) (if (null? next-tokens)
new-state new-state
(dont-stop new-state)))] (dont-stop new-state)))]
[(equal? #\# (peek-char port)) [(equal? #\# (peek-char-or-special port))
(define pp (peeking-input-port port)) (define pp (peeking-input-port port))
(define chars (list (read-char pp) (read-char pp) (read-char pp))) (define chars (list (read-char-or-special pp)
(read-char-or-special pp)
(read-char-or-special pp)))
(cond (cond
[(equal? chars '(#\# #\2 #\d)) [(equal? chars '(#\# #\2 #\d))
(start-new-2d-cond-lexing port a-2d-lexer-state uniform-chained-lexer offset)] (start-new-2d-cond-lexing port a-2d-lexer-state uniform-chained-lexer offset)]
@ -119,9 +125,9 @@ todo:
(define (start-new-2d-cond-lexing port a-2d-lexer-state uniform-chained-lexer offset) (define (start-new-2d-cond-lexing port a-2d-lexer-state uniform-chained-lexer offset)
(define-values (line col pos) (port-next-location port)) (define-values (line col pos) (port-next-location port))
;; consume #\# #\2 and #\d that must be there (peeked them earlier) ;; consume #\# #\2 and #\d that must be there (peeked them earlier)
(read-char port) (read-char-or-special port)
(read-char port) (read-char-or-special port)
(read-char port) (read-char-or-special port)
;; read in the keyword and get those tokens ;; read in the keyword and get those tokens
(define-values (backwards-chars eol-string) (define-values (backwards-chars eol-string)
@ -135,7 +141,7 @@ todo:
(equal? c #\newline)) (equal? c #\newline))
(values kwd-chars (string c))] (values kwd-chars (string c))]
[else [else
(read-char port) ;; actually get the char (read-char-or-special port) ;; actually get the char
(loop (cons c kwd-chars))]))) (loop (cons c kwd-chars))])))
(define first-tok-string (define first-tok-string
(apply string (reverse backwards-chars))) (apply string (reverse backwards-chars)))
@ -157,7 +163,11 @@ todo:
c-pos)) c-pos))
(define peek-port (peeking-input-port port)) (define peek-port (peeking-input-port port))
;; pull the newline out of the peek-port ;; pull the newline out of the peek-port
(for ([x (in-range (string-length eol-string))]) (read-char peek-port)) (for ([x (in-range (string-length eol-string))]
[c1 (in-string eol-string)])
(define c2 (read-char-or-special peek-port))
(unless (equal? c1 c2)
(error 'unstable/2d/lexer.rkt "got an unexpected char.1 ~s vs ~s" c1 c2)))
(define the-state (make-state line pos (string-length first-tok-string))) (define the-state (make-state line pos (string-length first-tok-string)))
(setup-state the-state) (setup-state the-state)
@ -205,7 +215,7 @@ todo:
(define error-pos (- (srcloc-position (car (exn:fail:read-srclocs failed))) (define error-pos (- (srcloc-position (car (exn:fail:read-srclocs failed)))
base-position)) ;; account for the newline base-position)) ;; account for the newline
(when (< error-pos 0) (when (< error-pos 0)
(error 'unstable/2d/lexer.rkt "got error-pos < 0: ~s ~s\n" (error 'unstable/2d/lexer.rkt "got error-pos < 0: ~s ~s"
(srcloc-position (car (exn:fail:read-srclocs failed))) (srcloc-position (car (exn:fail:read-srclocs failed)))
base-position)) base-position))
(define peek-port2 (peeking-input-port port)) (define peek-port2 (peeking-input-port port))
@ -216,13 +226,20 @@ todo:
(let loop ([n n]) (let loop ([n n])
(cond (cond
[(zero? n) '()] [(zero? n) '()]
[else (cons (read-char peek-port2) (loop (- n 1)))])))) [else
(define c (read-char-or-special peek-port2))
(cond
[(char? c)
(cons c (loop (- n 1)))]
[else
;; drop replace specials with spaces
(cons #\space (loop (- n 1)))])]))))
(cond (cond
[else [else
;; pull the newline out of peek-port2 ;; pull the newline out of peek-port2
(for ([x (in-range (string-length eol-string))]) (read-char peek-port2)) (for ([x (in-range (string-length eol-string))]) (read-char-or-special peek-port2))
(define before-token (list (pull-chars error-pos) (define before-token (list (pull-chars error-pos)
'no-color 'no-color
@ -232,14 +249,22 @@ todo:
(define end-of-table-approx (define end-of-table-approx
(let ([peek-port3 (peeking-input-port peek-port2)]) (let ([peek-port3 (peeking-input-port peek-port2)])
(port-count-lines! peek-port3) (port-count-lines! peek-port3)
(define (read-line/check-double-barred)
(let loop ([found-double-barred? #f])
(define c (read-char-or-special peek-port3))
(cond
[(or (equal? c #\n) (eof-object? c))
found-double-barred?]
[else (loop (or found-double-barred?
(member c double-barred-chars)))])))
(let loop () (let loop ()
(define l (read-line peek-port3)) (define found-double-barred? (read-line/check-double-barred))
(define-values (line col pos) (port-next-location peek-port3))
(cond (cond
[(and (string? l) [found-double-barred?
(regexp-match double-barred-chars-regexp l))
(loop)] (loop)]
[else pos])))) [else
(define-values (line col pos) (port-next-location peek-port3))
pos]))))
(define after-token (define after-token
(list (pull-chars (- end-of-table-approx 1)) (list (pull-chars (- end-of-table-approx 1))
'error 'error
@ -251,7 +276,9 @@ todo:
(list newline-token before-token after-token))])] (list newline-token before-token after-token))])]
[else [else
(define lhses (close-cell-graph cell-connections (length table-column-breaks) (length rows))) (define lhses (close-cell-graph cell-connections
(length table-column-breaks)
(length rows)))
(define scratch-string (make-string (for/sum ([ss (in-list rows)]) (define scratch-string (make-string (for/sum ([ss (in-list rows)])
(for/sum ([s (in-list ss)]) (for/sum ([s (in-list ss)])
(string-length s))) (string-length s)))

8
pkgs/unstable-2d/unstable/2d/private/read-util.rkt
View File

@ -312,18 +312,20 @@ example uses:
(set! current-line-number (+ current-line-number 1))) (set! current-line-number (+ current-line-number 1)))
(define chars (define chars
(let loop ([chars-read 0]) (let loop ([chars-read 0])
(define c (read-char port)) (define c (read-char-or-special port))
(cond (cond
[(eof-object? c) [(eof-object? c)
(raise-read-eof-error (raise-read-eof-error
"unexpected eof; " "unexpected eof; "
source _line _col _pos source _line _col _pos
(and _pos (- (+ current-line-start-position chars-read) _pos)))] (and _pos (- (+ current-line-start-position chars-read) _pos)))]
[(not (char? c))
(readerr "unexpected special" chars-read)]
[(equal? c #\return) [(equal? c #\return)
(cond (cond
[(equal? #\newline (peek-char port)) [(equal? #\newline (peek-char-or-special port))
(set! newline-char-count 2) (set! newline-char-count 2)
(list c (read-char port))] (list c (read-char-or-special port))]
[else [else
(set! newline-char-count 1) (set! newline-char-count 1)
(list c)])] (list c)])]

10
pkgs/unstable-debug-lib/LICENSE.txt
View File

@ -1,10 +0,0 @@
unstable-debug-lib
Copyright (c) 2010-2013 PLT Design Inc.
This package is distributed under the GNU Lesser General Public
License (LGPL). This means that you can link Racket into proprietary
applications, provided you follow the rules stated in the LGPL. You
can also modify this package; if you distribute a modified version,
you must distribute it under the terms of the LGPL, which in
particular means that you must release the source code for the
modified software. See COPYING_LESSER.txt for more information.