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

better code

Browse Source 
svn: r6822
This commit is contained in:
Eli Barzilay 2007-07-05 03:41:04 +00:00
parent ad49b82c3b
commit a01c1e92ed
1 changed files with 17 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/scribble/reader.ss
View File

@ -187,6 +187,14 @@
(let-values ([(line col pos) (port-next-location inp)]) (let-values ([(line col pos) (port-next-location inp)])
(apply read-error* line col pos #f msg xs))) (apply read-error* line col pos #f msg xs)))
(define (read-stx) (read-syntax/recursive source-name inp))
(define (read-stx/rt rt) (read-syntax/recursive source-name inp #f rt))
;; use this to avoid placeholders so we have source location information
(define (read-stx*)
;; the following should not return placeholders, but it does
;; (read-syntax/recursive source-name inp #f (current-readtable) #f)
(read-syntax source-name inp))
(define (*match rx) (*regexp-match rx inp)) (define (*match rx) (*regexp-match rx inp))
(define (*match1 rx) (*regexp-match1 rx inp)) (define (*match1 rx) (*regexp-match1 rx inp))
;; (define (*skip rx) (*regexp-match-positions rx inp)) <- see above ;; (define (*skip rx) (*regexp-match-positions rx inp)) <- see above
@ -208,10 +216,8 @@
(and (*skip begin-re) (and (*skip begin-re)
(let ([reader (if tweak-locations (let ([reader (if tweak-locations
;; should always be `read-syntax/recursive', but ;; should always be `read-syntax/recursive', but
;; then we don't get location information (in also ;; then we don't get location information
;; means that we never get a special-comment) read-stx* read-stx)])
read-syntax
read-syntax/recursive)])
(let loop ([r '()]) (let loop ([r '()])
(skip-whitespace inp) (skip-whitespace inp)
(if (*skip end-re) (if (*skip end-re)
@ -243,7 +249,7 @@
(and tw-pos 1pos 1span (and tw-pos 1pos 1span
(+ (- 1pos tw-pos) 1span)))))]) (+ (- 1pos tw-pos) 1span)))))])
(cons fst (cdr r)))]) (cons fst (cdr r)))])
(let ([x (reader source-name inp)]) (let ([x (reader)])
(if (eof-object? x) (if (eof-object? x)
(read-error 'eof "expected a '~a'" end-ch) (read-error 'eof "expected a '~a'" end-ch)
(loop (if (special-comment? x) r (cons x r)))))))))) (loop (if (special-comment? x) r (cons x r))))))))))
@ -367,19 +373,16 @@
(let ([x (cond (let ([x (cond
[(cadr m) [(cadr m)
;; the command is a string escape, use ;; the command is a string escape, use
;; `read-syntax', to not get a placeholder, so we ;; `read-stx*' to not get a placeholder, so we
;; can merge the string to others ;; can merge the string to others, and adjust
(let ([x (read-syntax source-name inp)]) ;; source location to avoid bogus indentation
;; adjust to not get bogus indentation (make-stx (syntax-e (read-stx*)))]
(make-stx (syntax-e x)))]
[(caddr m) [(caddr m)
;; it's an expression escape, get multiple ;; it's an expression escape, get multiple
;; expressions and put them all here ;; expressions and put them all here
(read-bytes (caaddr m) inp) (read-bytes (caaddr m) inp)
(get-escape-expr #f line col pos)] (get-escape-expr #f line col pos)]
[else [else (read-stx)])]) ; otherwise: a plain sub-read
;; otherwise it's a plain read
(read-syntax/recursive source-name inp)])])
(loop (loop
lvl lvl
(cond (cond
@ -455,8 +458,7 @@
;; called only when we must see a command in the input ;; called only when we must see a command in the input
(define (get-command) (define (get-command)
(define-values (line col pos) (port-next-location inp)) (define-values (line col pos) (port-next-location inp))
(let ([cmd (parameterize ([current-readtable command-readtable]) (let ([cmd (read-stx/rt command-readtable)])
(read-syntax/recursive source-name inp))])
(cond [(special-comment? cmd) (cond [(special-comment? cmd)
(read-error* line col pos (span-from pos) (read-error* line col pos (span-from pos)
"expecting a command expression, got a comment")] "expecting a command expression, got a comment")]