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

@|| always separates strings, strings around comments are still merged

Browse Source 
svn: r6816
This commit is contained in:
Eli Barzilay 2007-07-04 03:13:07 +00:00
parent cccb5150f0
commit e8f7b15c80
1 changed files with 71 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
collects/scribble/reader.ss
View File

@ -1,7 +1,7 @@
;; ============================================================================ ;; ============================================================================
;; Implements the @-reader macro for embedding text in Scheme code. ;; Implements the @-reader macro for embedding text in Scheme code.
(module reader mzscheme (module reader mzscheme*
(require (lib "kw.ss") (lib "string.ss") (lib "readerr.ss" "syntax")) (require (lib "kw.ss") (lib "string.ss") (lib "readerr.ss" "syntax"))
@ -342,7 +342,8 @@
(datum->syntax-object #f (datum->syntax-object #f
(if (bytes? sexpr) (bytes->string/utf-8 sexpr) sexpr) (if (bytes? sexpr) (bytes->string/utf-8 sexpr) sexpr)
(list source-name line col pos (span-from pos)))) (list source-name line col pos (span-from pos))))
(cond [(and re:begin (*match1 re:begin)) (cond
[(and re:begin (*match1 re:begin))
=> (lambda (m) (loop (add1 lvl) (maybe-merge (make-stx m) r)))] => (lambda (m) (loop (add1 lvl) (maybe-merge (make-stx m) r)))]
[(and re:end (*match1 re:end)) [(and re:end (*match1 re:end))
=> (lambda (m) => (lambda (m)
@ -356,14 +357,14 @@
'scribble `(newline ,m)) 'scribble `(newline ,m))
r)))] r)))]
[(*peek re:command) [(*peek re:command)
;; read the next value, include comment objs, keep source ;; read the next value, include comment objs, keep source location
;; location manually (see above) ;; manually (see above)
=> (lambda (m) => (lambda (m)
(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, ;; `read-syntax', to not get a placeholder, so we
;; so we can merge the string to others ;; can merge the string to others
(let ([x (read-syntax source-name inp)]) (let ([x (read-syntax source-name inp)])
;; adjust to not get bogus indentation ;; adjust to not get bogus indentation
(make-stx (syntax-e x)))] (make-stx (syntax-e x)))]
@ -371,39 +372,44 @@
;; 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)
(let ([escapes (get-escape-expr (get-escape-expr #f line col pos)]
#f line col pos)])
;; make @|| a comment that can be used to
;; make spaces meaningful
(if (null? escapes)
(make-special-comment #f)
escapes))]
[else [else
;; otherwise it's a plain read ;; otherwise it's a plain read
(read-syntax/recursive source-name inp)])]) (read-syntax/recursive source-name inp)])])
(loop lvl (loop
(cond [(eof-object? x) lvl
(read-error 'eof "missing command")] (cond
[(eof-object? x) (read-error 'eof "missing command")]
[(syntax? x) (maybe-merge x r)] [(syntax? x) (maybe-merge x r)]
[(list? x) (append! (reverse x) r)] ;; escaped expressions (not empty: @||)
;; otherwise it's a either a comment or a [(pair? x) (append! (reverse x) r)]
;; placeholder: wrap to get source infor ;; a comment in the middle of a line disappears so
[else (cons (make-placeholder x ; no merge ;; strings next to it are merged
[(and (special-comment? x)
(not (and (pair? r) (eol-syntax? (car r)))))
r]
;; otherwise it's a either null (@||) a comment (at the
;; beginning of a line) or a placeholder: wrap to get
;; source info for proper indentation; @|| is turned to
;; a comment, which can be used to separate strings, or
;; to make spaces meaningful
[else (let ([x (if (null? x)
(make-special-comment #f)
x)])
(cons (make-placeholder x ; no merge
(list source-name line col pos (list source-name line col pos
(span-from pos))) (span-from pos)))
r)]))))] 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)
(loop lvl (loop lvl (maybe-merge (make-stx (read-bytes (cdadr m) inp))
(maybe-merge (make-stx (read-bytes (cdadr m) inp))
r)))] r)))]
[(*peek #rx#"^$") [(*peek #rx#"^$")
(if end-token (if end-token
(read-error 'eof "missing closing `~a'~a" end-token (read-error 'eof "missing closing `~a'~a" end-token
(if (and line-num col-num) (if (and line-num col-num)
(format " for command at ~a:~a" (format " for command at ~a:~a" line-num col-num)
line-num col-num)
"")) ""))
(done-lines r))] (done-lines r))]
[else (read-error "internal error [get-lines*]")])))) [else (read-error "internal error [get-lines*]")]))))