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

* Adjust the source information on @(...) scheme escapes to have the

Browse Source 
source start at the `@' -- useful with column-sensitive macros
* Fix a minor bug: avoid merging a @|"..."| escape to the following
  text (unlike @"..." which always gets merged)
* Fix the test file to work in v4.

svn: r8921
This commit is contained in:
Eli Barzilay 2008-03-08 02:13:25 +00:00
parent 80c3bb19ce
commit be901717bf
2 changed files with 35 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/scribble/reader.ss
View File

@ -321,28 +321,29 @@
(*peek re:command)) (*peek re:command))
;; read the next value ;; read the next value
=> (lambda (m) => (lambda (m)
(let ([x (cond (define x (cond [(cadr m)
[(cadr m) ;; the command is a string escape, use
;; the command is a string escape, use `read-stx*' to ;; `read-stx*' to not get a placeholder, so we
;; not get a placeholder, so we can merge the string ;; can merge the string to others
;; to others
(read-stx*)] (read-stx*)]
[(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)] (get-escape-expr #f)]
[else (read-stx)])]) ; otherwise: a plain sub-read [else (read-stx)])) ; otherwise: a plain sub-read
(loop lvl (cond [(eof-object? x) (loop lvl (cond [(eof-object? x)
;; shouldn't happen -- the sub-read would ;; shouldn't happen -- the sub-read would
;; raise an error ;; raise an error
(internal-error 'get-lines*-sub-read)] (internal-error 'get-lines*-sub-read)]
;; throw away comments ;; throw away comments
[(special-comment? x) r] [(special-comment? x) r]
;; escaped expressions: no merge ;; escaped expressions: no merge, and add a
[(pair? x) (append (reverse x) r)] ;; comment to prevent merges with later stuff
[(pair? x)
`(,(make-special-comment #f) ,@(reverse x) ,@r)]
[(null? x) (cons (make-special-comment #f) r)] [(null? x) (cons (make-special-comment #f) r)]
[else (maybe-merge x r)]))))] [else (maybe-merge x r)])))]
;; must be last, since it will always succeed with 1 char ;; must be last, since it will always succeed with 1 char
[(*peek re:item) ; don't read: regexp grabs the following text [(*peek re:item) ; don't read: regexp grabs the following text
=> (lambda (m) => (lambda (m)
@ -398,7 +399,14 @@
(read-error* "expecting a command expression, got a comment")] (read-error* "expecting a command expression, got a comment")]
[(eof-object? cmd) [(eof-object? cmd)
(read-error* 'eof "missing command")] (read-error* 'eof "missing command")]
[else cmd]))) ;; we have a command: adjust its location to include the dispatch
;; character
[else (datum->syntax #f (syntax-e cmd)
(list (syntax-source cmd)
(syntax-line cmd)
(cond [(syntax-column cmd) => sub1] [else #f])
(cond [(syntax-position cmd) => sub1] [else #f])
(cond [(syntax-span cmd) => add1] [else #f])))])))
(define (get-rprefixes) ; return punctuation prefixes in reverse (define (get-rprefixes) ; return punctuation prefixes in reverse
(let loop ([r '()]) (let loop ([r '()])

11
collects/scribble/test-reader.ss
View File

@ -1,9 +1,6 @@
#!/bin/sh #!/bin/env mzscheme
#| -*- scheme -*- #lang scheme/base
exec mzscheme -r "$0" "$@" (require mzlib/string (for-syntax scheme/base))
|#
(require mzlib/string)
#reader(lib "reader.ss" "scribble") #reader(lib "reader.ss" "scribble")
(define tests (define tests
@ -443,7 +440,7 @@ exec mzscheme -r "$0" "$@"
(eq? (car prop) (eq? (car prop)
'newline))) 'newline)))
(cons fst rst)] (cons fst rst)]
[else (cons (datum->syntax-object [else (cons (datum->syntax
fst (cadr prop) fst) fst (cadr prop) fst)
rst)])))))]))]) rst)])))))]))])
@verb[string-append]{ @verb[string-append]{