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

use the same special |...{ quoting rules for |...@ subforms

Browse Source 
svn: r6821
This commit is contained in:
Eli Barzilay 2007-07-05 01:07:54 +00:00
parent b6845746f8
commit ad49b82c3b
1 changed files with 22 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/scribble/reader.ss
View File

@ -17,6 +17,7 @@
[(bytes? x) x] [(bytes? x) x]
[(string? x) (string->bytes/utf-8 x)] [(string? x) (string->bytes/utf-8 x)]
[(char? x) (regexp-quote (bytes (char->integer x)))] [(char? x) (regexp-quote (bytes (char->integer x)))]
[(not x) #""]
[else (error 'reader "internal error [px]")])) [else (error 'reader "internal error [px]")]))
args)]) args)])
(byte-pregexp (apply bytes-append args)))) (byte-pregexp (apply bytes-append args))))
@ -44,7 +45,7 @@
(define ch:lines-begin #\{) (define ch:lines-begin #\{)
(define ch:lines-end #\}) (define ch:lines-end #\})
(define str:lines-begin* #"\\|[^a-zA-Z0-9 \t\r\n\f@\\\177-\377{]*\\{") (define str:lines-begin* #"(\\|[^a-zA-Z0-9 \t\r\n\f@\\\177-\377{]*)\\{")
(define re:command (^px ch:command (define re:command (^px ch:command
;; the following identifies string and ;; the following identifies string and
@ -61,11 +62,11 @@
(define re:lines-end (^px ch:lines-end)) (define re:lines-end (^px ch:lines-end))
(define str:end-of-line "[ \t]*\r?\n[ \t]*") ; eat spaces on the next line (define str:end-of-line "[ \t]*\r?\n[ \t]*") ; eat spaces on the next line
(define re:end-of-line (^px str:end-of-line)) (define re:end-of-line (^px str:end-of-line))
(define (re:line-item* bgn end) (define (re:line-item* bgn end cmd-prefix)
(^px "(.+?)(?:" (if bgn `(,bgn"|") "") (if end `(,end"|") "") (^px "(.+?)(?:" (and bgn `(,bgn"|")) (and end `(,end"|"))
ch:command"|"str:end-of-line"|$)")) cmd-prefix ch:command"|"str:end-of-line"|$)"))
(define re:line-item (re:line-item* ch:lines-begin ch:lines-end)) (define re:line-item (re:line-item* ch:lines-begin ch:lines-end #f))
(define re:line-item-no-nests (re:line-item* #f #f)) (define re:line-item-no-nests (re:line-item* #f #f #f))
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
;; utilities ;; utilities
@ -335,7 +336,7 @@
(cdr stxs)) (cdr stxs))
(cons stx stxs)))) (cons stx stxs))))
(define (get-lines* re:begin re:end re:item end-token) (define (get-lines* re:begin re:end re:cmd-pfx re:item end-token)
;; re:begin, re:end, end-token can be false if start-inside? is #t ;; re:begin, re:end, end-token can be false if start-inside? is #t
(let loop ([lvl 0] [r '()]) (let loop ([lvl 0] [r '()])
(let-values ([(line col pos) (port-next-location inp)]) (let-values ([(line col pos) (port-next-location inp)])
@ -357,7 +358,9 @@
(syntax-property (make-stx eol-token) (syntax-property (make-stx eol-token)
'scribble `(newline ,m)) 'scribble `(newline ,m))
r)))] r)))]
[(*peek re:command) [(if re:cmd-pfx
(and (*skip re:cmd-pfx) (*peek re:command))
(*peek re:command))
;; read the next value, include comment objs, keep source location ;; read the next value, include comment objs, keep source location
;; manually (see above) ;; manually (see above)
=> (lambda (m) => (lambda (m)
@ -416,15 +419,18 @@
[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) (get-lines* re:lines-begin re:lines-end #f
(get-lines* re:lines-begin re:lines-end re:line-item ch:lines-end)] re:line-item ch:lines-end)]
[(*match1 re:lines-begin*) [(*match re:lines-begin*)
=> (lambda (bgn) => (lambda (m)
(let* ([end (reverse-bytes bgn)] (let* ([bgn (car m)]
[end (reverse-bytes bgn)]
[bgn* (regexp-quote bgn)] [bgn* (regexp-quote bgn)]
[end* (regexp-quote end)]) [end* (regexp-quote end)]
[cmd-pfx* (regexp-quote (cadr m))])
(get-lines* (^px bgn*) (^px end*) (get-lines* (^px bgn*) (^px end*)
(re:line-item* bgn* end*) (^px cmd-pfx* "(?=" ch:command ")")
(re:line-item* bgn* end* cmd-pfx*)
end)))] end)))]
[else #f])) [else #f]))
@ -480,7 +486,7 @@
(cond (cond
[start-inside? [start-inside?
(datum->syntax-object #f (get-lines* #f #f re:line-item-no-nests #f) (datum->syntax-object #f (get-lines* #f #f #f re:line-item-no-nests #f)
(list source-name line-num col-num position (span-from position)))] (list source-name line-num col-num position (span-from position)))]
[(*peek re:whitespaces) [(*peek re:whitespaces)
(read-error "unexpected whitespace after ~a" ch:command)] (read-error "unexpected whitespace after ~a" ch:command)]