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

136
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,71 +342,77 @@
(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
=> (lambda (m) (loop (add1 lvl) (maybe-merge (make-stx m) r)))] [(and re:begin (*match1 re:begin))
[(and re:end (*match1 re:end)) => (lambda (m) (loop (add1 lvl) (maybe-merge (make-stx m) r)))]
=> (lambda (m) [(and re:end (*match1 re:end))
(if (and (zero? lvl) (not start-inside?)) => (lambda (m)
(done-lines r) (if (and (zero? lvl) (not start-inside?))
(loop (sub1 lvl) (maybe-merge (make-stx m) r))))] (done-lines r)
[(*match1 re:end-of-line) (loop (sub1 lvl) (maybe-merge (make-stx m) r))))]
=> (lambda (m) [(*match1 re:end-of-line)
(loop lvl (cons ; no merge needed => (lambda (m)
(syntax-property (make-stx eol-token) (loop lvl (cons ; no merge needed
'scribble `(newline ,m)) (syntax-property (make-stx eol-token)
r)))] 'scribble `(newline ,m))
[(*peek re:command) r)))]
;; read the next value, include comment objs, keep source [(*peek re:command)
;; location manually (see above) ;; read the next value, include comment objs, keep source location
=> (lambda (m) ;; manually (see above)
(let ([x (cond => (lambda (m)
[(cadr m) (let ([x (cond
;; the command is a string escape, use [(cadr m)
;; `read-syntax', to not get a placeholder, ;; the command is a string escape, use
;; so we can merge the string to others ;; `read-syntax', to not get a placeholder, so we
(let ([x (read-syntax source-name inp)]) ;; can merge the string to others
;; adjust to not get bogus indentation (let ([x (read-syntax source-name inp)])
(make-stx (syntax-e x)))] ;; adjust to not get bogus indentation
[(caddr m) (make-stx (syntax-e x)))]
;; it's an expression escape, get multiple [(caddr m)
;; expressions and put them all here ;; it's an expression escape, get multiple
(read-bytes (caaddr m) inp) ;; expressions and put them all here
(let ([escapes (get-escape-expr (read-bytes (caaddr m) inp)
#f line col pos)]) (get-escape-expr #f line col pos)]
;; make @|| a comment that can be used to [else
;; make spaces meaningful ;; otherwise it's a plain read
(if (null? escapes) (read-syntax/recursive source-name inp)])])
(make-special-comment #f) (loop
escapes))] lvl
[else (cond
;; otherwise it's a plain read [(eof-object? x) (read-error 'eof "missing command")]
(read-syntax/recursive source-name inp)])]) [(syntax? x) (maybe-merge x r)]
(loop lvl ;; escaped expressions (not empty: @||)
(cond [(eof-object? x) [(pair? x) (append! (reverse x) r)]
(read-error 'eof "missing command")] ;; a comment in the middle of a line disappears so
[(syntax? x) (maybe-merge x r)] ;; strings next to it are merged
[(list? x) (append! (reverse x) r)] [(and (special-comment? x)
;; otherwise it's a either a comment or a (not (and (pair? r) (eol-syntax? (car r)))))
;; placeholder: wrap to get source infor r]
[else (cons (make-placeholder x ; no merge ;; otherwise it's a either null (@||) a comment (at the
(list source-name line col pos ;; beginning of a line) or a placeholder: wrap to get
(span-from pos))) ;; source info for proper indentation; @|| is turned to
r)]))))] ;; a comment, which can be used to separate strings, or
;; must be last, since it will always succeed with 1 char ;; to make spaces meaningful
[(*peek re:item) ; don't read: regexp grabs the following text [else (let ([x (if (null? x)
=> (lambda (m) (make-special-comment #f)
(loop lvl x)])
(maybe-merge (make-stx (read-bytes (cdadr m) inp)) (cons (make-placeholder x ; no merge
(list source-name line col pos
(span-from pos)))
r))]))))]
;; must be last, since it will always succeed with 1 char
[(*peek re:item) ; don't read: regexp grabs the following text
=> (lambda (m)
(loop lvl (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*]")]))))
(define (get-lines) (define (get-lines)
(cond [(*skip re:lines-begin) (cond [(*skip re:lines-begin)