fix a scribble bug; add r6rs reader
svn: r8635
This commit is contained in:
Matthew Flatt
parent
074b611215
commit
0dc359a956
18
collects/r6rs/lang/reader.ss
Normal file
18
collects/r6rs/lang/reader.ss
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require (only-in syntax/module-reader wrap-read-all)
|
||||
"../private/readtable.ss")
|
||||
(provide (rename-out [*read read]
|
||||
[*read-syntax read-syntax]))
|
||||
|
||||
(define (*read in)
|
||||
(wrap in read))
|
||||
|
||||
(define (*read-syntax src in)
|
||||
(wrap in (lambda (in)
|
||||
(read-syntax src in))))
|
||||
|
||||
(define (wrap in read)
|
||||
(with-r6rs-reader-parameters
|
||||
(lambda ()
|
||||
(wrap-read-all 'r6rs in read))))
|
||||
9
collects/r6rs/main.ss
Normal file
9
collects/r6rs/main.ss
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
#lang scheme/base
|
||||
|
||||
(provide (rename-out [module-begin #%module-begin])
|
||||
quote)
|
||||
|
||||
(define-syntax-rule (module-begin . stuff)
|
||||
(#%module-begin
|
||||
"The R6RS language just supplies a reader, so far."
|
||||
'stuff))
|
||||
551
collects/r6rs/private/readtable.ss
Normal file
551
collects/r6rs/private/readtable.ss
Normal file
|
|
@ -0,0 +1,551 @@
|
|||
#lang scheme/base
|
||||
|
||||
;; Readtable-based R6RS reading
|
||||
|
||||
(require syntax/readerr
|
||||
(for-syntax scheme/base))
|
||||
|
||||
(provide with-r6rs-reader-parameters)
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (generic-not-allowed where ch port src line col pos)
|
||||
(raise-read-error
|
||||
(format "illegal character~a in input: `~a'"
|
||||
where
|
||||
(let ([s (format "~s" (string ch))])
|
||||
(substring s 1 (- (string-length s) 1))))
|
||||
src line col pos 1))
|
||||
|
||||
(define (not-allowed ch port src line col pos)
|
||||
(generic-not-allowed "" ch port src line col pos))
|
||||
|
||||
(define (dispatch-not-allowed ch port src line col pos)
|
||||
(generic-not-allowed " after `#'" ch port src line col pos))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; #!r6rs as a comment
|
||||
|
||||
(define (read-hash-bang ch port src line col pos)
|
||||
(if (regexp-try-match #rx"^r6rs" port)
|
||||
(make-special-comment #f)
|
||||
(let* ([s (regexp-match #rx"^(r6r|r6|r|)(.|)" port)]
|
||||
[len (+ 2 (bytes-length (cadr s)))]
|
||||
[next (caddr s)])
|
||||
(if (bytes=? next #"")
|
||||
(raise-read-eof-error
|
||||
(format "unexpected end-of-file after `#!~a'"
|
||||
(cadr s))
|
||||
src line (and col (+ col len)) (and pos (+ pos len)) 1)
|
||||
(generic-not-allowed (format " after `#!~a'" (cadr s))
|
||||
(string-ref (bytes->string/utf-8 (caddr s)) 0)
|
||||
port
|
||||
src
|
||||
line
|
||||
(and col (+ col len))
|
||||
(and pos (+ pos len)))))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; delimiter helpers
|
||||
|
||||
(define (delimiter? delim)
|
||||
(or (eof-object? delim)
|
||||
(char-whitespace? delim)
|
||||
(char=? delim #\()
|
||||
(char=? delim #\))
|
||||
(char=? delim #\[)
|
||||
(char=? delim #\])
|
||||
(char=? delim #\")
|
||||
(char=? delim #\;)
|
||||
(char=? delim #\#)))
|
||||
|
||||
(define (check-delimiter result prefix ch port src line col pos len)
|
||||
(let ([delim (peek-char port)])
|
||||
(if (delimiter? delim)
|
||||
result
|
||||
(generic-not-allowed (format " after ~a~a (need a delimiter)"
|
||||
prefix ch)
|
||||
(read-char port)
|
||||
port src line
|
||||
(and col (+ col len))
|
||||
(and pos (+ pos len))))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; booleans (delimiter required)
|
||||
|
||||
(define (read-boolean ch port src line col pos)
|
||||
(check-delimiter (case ch
|
||||
[(#\t #\T) #t]
|
||||
[else #f])
|
||||
"#" ch
|
||||
port src line col pos 2))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; characters
|
||||
|
||||
(define (read-character ch port src line col pos)
|
||||
;; #\ has been consumed
|
||||
(let ([ch (read-char port)])
|
||||
(if (eof-object? ch)
|
||||
(raise-read-eof-error
|
||||
"unexpected end-of-file after `#\\'"
|
||||
src line (and col (+ col 1)) (and pos (+ pos 1))
|
||||
2)
|
||||
(let ([next (peek-char port)])
|
||||
(if (delimiter? next)
|
||||
ch
|
||||
(let ([r+str
|
||||
(ormap (lambda (d)
|
||||
(and (eq? ch (car d))
|
||||
(regexp-try-match (cadr d) port)
|
||||
(values (cddr d))))
|
||||
(let-syntax ([char-names
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ str ...)
|
||||
(let ([strs (map syntax-e (syntax->list #'(str ...)))])
|
||||
(with-syntax ([(init-char ...)
|
||||
(map (lambda (s) (string-ref s 0))
|
||||
strs)]
|
||||
[(rx ...)
|
||||
(map (lambda (s)
|
||||
(regexp (string-append "^" (substring s 1))))
|
||||
strs)]
|
||||
[(result-char ...)
|
||||
(map (lambda (s)
|
||||
(cond
|
||||
[(string=? s "alarm") #\u07]
|
||||
[(string=? s "esc") #\u1B]
|
||||
[(string=? s "delete") #\u7F]
|
||||
[else
|
||||
(read (open-input-string (string-append "#\\" s)))]))
|
||||
strs)])
|
||||
#`(quote ((init-char rx result-char . str) ...))))]))])
|
||||
(char-names
|
||||
"space"
|
||||
"newline"
|
||||
"alarm"
|
||||
"backspace"
|
||||
"tab"
|
||||
"linefeed"
|
||||
"newline"
|
||||
"vtab"
|
||||
"page"
|
||||
"return"
|
||||
"esc"
|
||||
"space"
|
||||
"delete")))])
|
||||
(if r+str
|
||||
(check-delimiter
|
||||
(car r+str)
|
||||
"#\\" (cdr r+str)
|
||||
port src line col pos
|
||||
(+ 2 (string-length (cdr r+str))))
|
||||
(let ([hex (and (eq? ch #\x)
|
||||
(regexp-try-match #rx"^[0-9a-fA-F]+" port))])
|
||||
(if hex
|
||||
(let ([hex-val (string->number
|
||||
(bytes->string/latin-1 (car hex))
|
||||
16)])
|
||||
(if (or (<= 0 hex-val #xD7FF)
|
||||
(<= #xE000 hex-val #x10FFFF))
|
||||
(check-delimiter
|
||||
(integer->char hex-val)
|
||||
"#\\" (car hex)
|
||||
port src line col pos
|
||||
(+ 3 (bytes-length (car hex))))
|
||||
(raise-read-error
|
||||
(format "out of range character constant `#\\x~a'"
|
||||
(car hex))
|
||||
src line
|
||||
col
|
||||
pos
|
||||
(and pos (+ 3 (bytes-length (car hex)))))))
|
||||
(let ([more (bytes->string/utf-8
|
||||
(car (regexp-match #px"^.([a-z]{0,20})" port)))])
|
||||
(raise-read-error
|
||||
(format "unknown character constant `#\\~a~a'"
|
||||
ch more)
|
||||
src line
|
||||
col
|
||||
pos
|
||||
(and pos (+ 2 (string-length more))))))))))))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; byte vectors
|
||||
|
||||
(define (do-read-byte-string stx? ch port src line col pos)
|
||||
;; #v has been read
|
||||
(if (and (regexp-try-match #rx"^u8" port)
|
||||
(eq? #\( (peek-char port)))
|
||||
(let* ([l (if stx?
|
||||
(read-syntax/recursive src port)
|
||||
(read/recursive port))]
|
||||
[lst (if stx?
|
||||
(syntax->list l)
|
||||
l)])
|
||||
(unless (list? lst)
|
||||
(raise-read-error
|
||||
(format "expected a parenthesized sequence without `.' after `#vu8'")
|
||||
src line col pos (and pos 4)))
|
||||
(for-each (lambda (e)
|
||||
(let ([elem (if stx?
|
||||
(syntax-e e)
|
||||
e)])
|
||||
(unless (byte? elem)
|
||||
(let ([msg (format "invalid byte-vector element (not an octet): ~e"
|
||||
elem)])
|
||||
(if stx?
|
||||
(raise-read-error
|
||||
msg
|
||||
(syntax-source e)
|
||||
(syntax-line e)
|
||||
(syntax-column e)
|
||||
(syntax-position e)
|
||||
(syntax-span e))
|
||||
(raise-read-error
|
||||
msg
|
||||
#f #f #f #f #f))))))
|
||||
lst)
|
||||
(list->bytes (if stx? (map syntax-e lst) lst)))
|
||||
(raise-read-error
|
||||
"`#v' to continue `#vu8('"
|
||||
src line
|
||||
col pos
|
||||
2)))
|
||||
|
||||
(define read-byte-string
|
||||
(case-lambda
|
||||
[(ch port)
|
||||
(do-read-byte-string #f ch port #f #f #f #f)]
|
||||
[(ch port src line col pos)
|
||||
(do-read-byte-string #t ch port src line col pos)]))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; strings
|
||||
|
||||
(define (read-a-string ch port src line col pos)
|
||||
(let ([content (regexp-match #rx"^(?:[^\"\\\\]|\\\\.)*(?:\"|\\\\?$)" port)])
|
||||
(let* ([bytes (car content)]
|
||||
[len (bytes-utf-8-length bytes)])
|
||||
;; Check/convert escapes and <line ending>s
|
||||
(let ([pieces
|
||||
(let loop ([bpos 0])
|
||||
(let ([m (regexp-match-positions #rx"(?:\r\n|\r\u85|[\r\u85\u2028])|\\\\." bytes bpos)])
|
||||
(if m
|
||||
(if (= (bytes-ref bytes (caar m)) (char->integer #\\))
|
||||
(let ([char (string-ref
|
||||
(bytes->string/utf-8 (subbytes bytes (add1 (caar m)) (cdar m)))
|
||||
0)])
|
||||
(cond
|
||||
[(memq char '(#\a #\b #\t #\n #\v #\f #\r #\\ #\"))
|
||||
(list* (subbytes bytes bpos (caar m))
|
||||
(case char
|
||||
[(#\n) #"\n"]
|
||||
[(#\r) #"\r"]
|
||||
[(#\t) #"\t"]
|
||||
[(#\a) #"\a"]
|
||||
[(#\b) #"\b"]
|
||||
[(#\v) #"\v"]
|
||||
[(#\f) #"\f"]
|
||||
[(#\\) #"\\"]
|
||||
[(#\\) #"\""])
|
||||
(loop (cdar m)))]
|
||||
[(eq? char #\x)
|
||||
(let ([hm (regexp-match-positions #px"^[a-zA-Z0-9]*;"
|
||||
bytes
|
||||
(+ 2 (caar m)))])
|
||||
(if hm
|
||||
(let* ([hex-bytes (subbytes bytes (+ 2 (caar m)) (sub1 (cdar hm)))]
|
||||
[v (string->number (bytes->string/utf-8 hex-bytes) 16)])
|
||||
(if (or (<= 0 v #xD7FF)
|
||||
(<= #xE000 v #x10FFFF))
|
||||
(list* (subbytes bytes bpos (caar m))
|
||||
(string->bytes/utf-8 (string (integer->char v)))
|
||||
(loop (cdar hm)))
|
||||
(raise-read-error
|
||||
(format "out-of-range `\\x~a;' escape in string" hex-bytes)
|
||||
src line
|
||||
col pos
|
||||
(and pos (+ 1 len)))))
|
||||
(raise-read-error
|
||||
(format "bad escape `\\x~a' in string"
|
||||
(car (regexp-match #px"^[a-zA-Z0-9]*." bytes (+ 2 (caar m)))))
|
||||
src line
|
||||
col pos
|
||||
(and pos (+ 1 len)))))]
|
||||
[(or (eq? char #\tab)
|
||||
(eq? (char-general-category char) 'zs))
|
||||
(let ([wm (regexp-match-positions #px"^(?:\t|\\p{Zs})*(?:\r\n|\r\u85|[\r\n\u85\u2028])(?:\t|\\p{Zs})*"
|
||||
bytes
|
||||
(add1 (caar m)))])
|
||||
(if wm
|
||||
(cons (subbytes bytes bpos (caar m)) ; drop matched part
|
||||
(loop (cdar wm)))
|
||||
;; This is an eof error if there's only intraline whitespace
|
||||
((if (regexp-match #px"^(?:\t|\\p{Zs})*$" bytes (+ 1 bpos))
|
||||
raise-read-eof-error
|
||||
raise-read-error)
|
||||
"missing <line ending> after `\\<intraline-whitespace>'"
|
||||
src line
|
||||
col pos
|
||||
(and pos (+ 1 len)))))]
|
||||
[else
|
||||
(raise-read-error
|
||||
(format "bad escape `\\~a' in string" char)
|
||||
src line
|
||||
col pos
|
||||
(and pos (+ 1 len)))]))
|
||||
;; found a <line ending> that isn't just a newline:
|
||||
(list* (subbytes bytes bpos (caar m))
|
||||
#"\n"
|
||||
(loop (cdar m))))
|
||||
(let ([end (sub1 (bytes-length bytes))])
|
||||
(if (or (= end -1)
|
||||
(not (= (char->integer #\")
|
||||
(bytes-ref bytes end))))
|
||||
(raise-read-error
|
||||
"unexpected end-of-file within string"
|
||||
src line col pos (and pos (+ 1 len)))
|
||||
;; Ok:
|
||||
(list (subbytes bytes bpos end)))))))])
|
||||
(bytes->string/utf-8
|
||||
(if (= 1 (length pieces))
|
||||
(car pieces)
|
||||
(apply bytes-append pieces)))))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; numbers and symbols
|
||||
|
||||
(define-values (rx:id rx:number)
|
||||
;; Build regexp versions of the R6RS grammar productions for
|
||||
;; <identifier> and <number>.
|
||||
(let ([or (lambda args
|
||||
(and (ormap values args)
|
||||
(apply
|
||||
string-append
|
||||
(append
|
||||
(list "(?:")
|
||||
(cdr (apply append
|
||||
(map (lambda (a) (list "|" a))
|
||||
(filter values args))))
|
||||
(list ")")))))]
|
||||
[seq (lambda args
|
||||
(and (andmap values args)
|
||||
(apply string-append args)))]
|
||||
[+ (lambda (s) (and s (string-append s "+")))]
|
||||
[* (lambda (s) (and s (string-append s "*")))])
|
||||
|
||||
(define letter "[a-zA-Z]")
|
||||
(define constituent (or letter
|
||||
(string-append
|
||||
"(?:(?=[^\0-\177])(?:"
|
||||
(substring
|
||||
(apply
|
||||
string-append
|
||||
(map
|
||||
(lambda (s)
|
||||
(format "|\\p{~a}" s))
|
||||
'(Lu Lt Lm Lo Mn Nl No Pd Pc Po Sc Sm Sk So Co)))
|
||||
1)
|
||||
"))")))
|
||||
(define special-initial "[!$%&*/:<=>?^_~]")
|
||||
(define special-subsequent "[-+.@]")
|
||||
(define inline-hex-escape "\\\\x[0-9a-fA-F]+;")
|
||||
(define initial (or constituent
|
||||
special-initial
|
||||
inline-hex-escape))
|
||||
(define subsequent (or initial
|
||||
"[0-9]"
|
||||
special-subsequent
|
||||
"(?:\\p{Nd}|\\p{Mc}|\\p{Me})"))
|
||||
(define peculiar-identifier (or "[+]"
|
||||
"-"
|
||||
"[.][.][.]"
|
||||
(seq "->" (* subsequent))))
|
||||
(define identifier (or (seq initial (* subsequent))
|
||||
peculiar-identifier))
|
||||
|
||||
(define digit-16 "[0-9a-fA-F]")
|
||||
(define digit-10 "[0-9]")
|
||||
(define digit-8 "[0-7]")
|
||||
(define digit-2 "[01]")
|
||||
(define (digit R)
|
||||
(case R
|
||||
[(2) digit-2]
|
||||
[(8) digit-8]
|
||||
[(10) digit-10]
|
||||
[(16) digit-16]))
|
||||
(define radix-16 "#[xX]")
|
||||
(define radix-10 "(?:#[dD]|)")
|
||||
(define radix-8 "#[oO]")
|
||||
(define radix-2 "#[bB]")
|
||||
(define (radix R)
|
||||
(case R
|
||||
[(2) radix-2]
|
||||
[(8) radix-8]
|
||||
[(10) radix-10]
|
||||
[(16) radix-16]))
|
||||
(define exactness "(?:#[iIeE]|)")
|
||||
(define sign "(?:[+-]|)")
|
||||
(define mantissa-width (or "" (seq "[|]" (+ digit-10))))
|
||||
(define exponent-marker "[eEsSfFdDlL]")
|
||||
(define suffix (or "" (seq exponent-marker sign digit-10)))
|
||||
|
||||
(define (prefix R) (or (seq (radix R) exactness)
|
||||
(seq exactness (radix R))))
|
||||
(define (uinteger R) (+ (digit R)))
|
||||
(define decimal-10 (or (seq (uinteger 10) suffix)
|
||||
(seq "[.]" (+ (digit 10)) suffix)
|
||||
(seq (+ (digit 10)) "[.]" (* (digit 10)) suffix))) ; removed redundant last production
|
||||
(define (decimal R)
|
||||
(case R
|
||||
[(10) decimal-10]
|
||||
[else #f])) ; <<--- using #f to mean "can't match", and combinators propagate #f appropriately
|
||||
(define (ureal R) (or (uinteger R)
|
||||
(seq (uinteger R) "/" (uinteger R))
|
||||
(seq (decimal R) mantissa-width)))
|
||||
(define naninf (or "nan[.]0" "inf[.]0"))
|
||||
(define (real R) (or (seq sign (ureal R))
|
||||
(seq "[+]" naninf)
|
||||
(seq "-" naninf)))
|
||||
(define (complex R) (or (real R)
|
||||
(seq (real R) "@" (real R))
|
||||
(seq (real R) "[+]" (ureal R) "i")
|
||||
(seq (real R) "-" (ureal R) "i")
|
||||
(seq (real R) "[+]" naninf "i")
|
||||
(seq (real R) "-" naninf "i")
|
||||
(seq (real R) "[+]i")
|
||||
(seq (real R) "-i")
|
||||
(seq "[+]" (ureal R) "i")
|
||||
(seq "-" (ureal R) "i")
|
||||
(seq "[+]" naninf "i")
|
||||
(seq "-" naninf "i")
|
||||
"[+]i"
|
||||
"-i"))
|
||||
(define (num R) (seq (prefix R) (complex R)))
|
||||
(define number (or (num 10)
|
||||
(num 16)
|
||||
(num 8)
|
||||
(num 2)))
|
||||
|
||||
(values (pregexp (string-append "^" identifier "$"))
|
||||
(pregexp (string-append "^" number "$")))))
|
||||
|
||||
(define (do-read-symbol-or-number num? prefix port src line col pos)
|
||||
;; Read a delimited sequence (using an extended notion of delimiter),
|
||||
;; then make sure it's a number or identifier.
|
||||
(let ([thing (bytes-append
|
||||
(string->bytes/utf-8 prefix)
|
||||
(car (or (regexp-match #px"^(?:\\\\x[0-9a-fA-F]+;|[^\\s\\[\\]()#\";,'`])*" port)
|
||||
'(#""))))])
|
||||
(cond
|
||||
[(regexp-match rx:number thing)
|
||||
(let ([n (string->number
|
||||
(bytes->string/utf-8
|
||||
;; MzScheme doesn't hanel mantissa widths, so strip them out:
|
||||
(regexp-replace* #rx#"[|][0-9]+"
|
||||
thing
|
||||
#"")))])
|
||||
(unless n
|
||||
(error 'r6rs-parser "number didn't convert: ~e" thing))
|
||||
n)]
|
||||
[(and (not num?)
|
||||
(regexp-match rx:id thing))
|
||||
(string->symbol
|
||||
(bytes->string/utf-8
|
||||
(let loop ([t thing])
|
||||
(let ([m (regexp-match #rx#"^(.*)\\\\x([0-9a-fA-F]+);(.*)$" t)])
|
||||
(if m
|
||||
(loop (bytes-append
|
||||
(loop (cadr m))
|
||||
(let ([v (string->number
|
||||
(bytes->string/latin-1 (caddr m))
|
||||
16)])
|
||||
(unless (or (<= 0 v #xD7FF)
|
||||
(<= #xE000 v #x10FFFF))
|
||||
(let ([str (bytes->string/utf-8 thing)])
|
||||
(raise-read-error
|
||||
(format "out of range escape: `\\x~a;'" (cadr m))
|
||||
src line col pos (and pos (string-length str)))))
|
||||
(string->bytes/utf-8 (string (integer->char v))))
|
||||
(loop (cadddr m))))
|
||||
t)))))]
|
||||
[else
|
||||
(let ([str (bytes->string/utf-8 thing)])
|
||||
(raise-read-error
|
||||
(format "not a number or identifier: `~a'" str)
|
||||
src line col pos (and pos (string-length str))))])))
|
||||
|
||||
|
||||
(define (read-symbol-or-number ch port src line col pos)
|
||||
(do-read-symbol-or-number #f
|
||||
(string ch)
|
||||
port src line col pos))
|
||||
|
||||
(define (read-number ch port src line col pos)
|
||||
(do-read-symbol-or-number #t
|
||||
(string #\# ch)
|
||||
port src line col pos))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define r6rs-readtable
|
||||
(make-readtable
|
||||
#f
|
||||
#\{ 'terminating-macro not-allowed
|
||||
#\} 'terminating-macro not-allowed
|
||||
#\| 'terminating-macro not-allowed
|
||||
#\" 'terminating-macro read-a-string
|
||||
#\{ 'dispatch-macro dispatch-not-allowed
|
||||
#\\ 'dispatch-macro read-character
|
||||
#\" 'dispatch-macro dispatch-not-allowed
|
||||
#\% 'dispatch-macro dispatch-not-allowed
|
||||
#\: 'dispatch-macro dispatch-not-allowed
|
||||
#\& 'dispatch-macro dispatch-not-allowed
|
||||
#\! 'dispatch-macro read-hash-bang
|
||||
#\~ 'dispatch-macro dispatch-not-allowed
|
||||
#\< 'dispatch-macro dispatch-not-allowed
|
||||
#\r 'dispatch-macro dispatch-not-allowed
|
||||
#\p 'dispatch-macro dispatch-not-allowed
|
||||
#\c 'dispatch-macro dispatch-not-allowed
|
||||
#\C 'dispatch-macro dispatch-not-allowed
|
||||
#\s 'dispatch-macro dispatch-not-allowed
|
||||
#\S 'dispatch-macro dispatch-not-allowed
|
||||
#\h 'dispatch-macro dispatch-not-allowed
|
||||
#\r 'dispatch-macro dispatch-not-allowed
|
||||
#\l 'dispatch-macro dispatch-not-allowed
|
||||
#\0 'dispatch-macro dispatch-not-allowed
|
||||
#\1 'dispatch-macro dispatch-not-allowed
|
||||
#\2 'dispatch-macro dispatch-not-allowed
|
||||
#\3 'dispatch-macro dispatch-not-allowed
|
||||
#\4 'dispatch-macro dispatch-not-allowed
|
||||
#\5 'dispatch-macro dispatch-not-allowed
|
||||
#\6 'dispatch-macro dispatch-not-allowed
|
||||
#\8 'dispatch-macro dispatch-not-allowed
|
||||
#\9 'dispatch-macro dispatch-not-allowed
|
||||
#\t 'dispatch-macro read-boolean
|
||||
#\T 'dispatch-macro read-boolean
|
||||
#\f 'dispatch-macro read-boolean
|
||||
#\F 'dispatch-macro read-boolean
|
||||
#\v 'dispatch-macro read-byte-string
|
||||
#\i 'dispatch-macro read-number
|
||||
#\I 'dispatch-macro read-number
|
||||
#\e 'dispatch-macro read-number
|
||||
#\E 'dispatch-macro read-number
|
||||
#\b 'dispatch-macro read-number
|
||||
#\B 'dispatch-macro read-number
|
||||
#\d 'dispatch-macro read-number
|
||||
#\D 'dispatch-macro read-number
|
||||
#\o 'dispatch-macro read-number
|
||||
#\O 'dispatch-macro read-number
|
||||
#\x 'dispatch-macro read-number
|
||||
#\X 'dispatch-macro read-number
|
||||
#\\ 'terminating-macro read-symbol-or-number
|
||||
#f 'non-terminating-macro read-symbol-or-number
|
||||
))
|
||||
|
||||
(define (with-r6rs-reader-parameters thunk)
|
||||
(parameterize ([current-readtable r6rs-readtable]
|
||||
[read-accept-infix-dot #f])
|
||||
(thunk)))
|
||||
|
|
@ -1424,10 +1424,12 @@
|
|||
(let ([just-name
|
||||
(make-target-element*
|
||||
make-toc-target-element
|
||||
stx-id
|
||||
(if (pair? name)
|
||||
(car (syntax-e stx-id))
|
||||
stx-id)
|
||||
(annote-exporting-library
|
||||
(to-element (if (pair? name)
|
||||
(make-just-context (car name) stx-id)
|
||||
(make-just-context (car name) (car (syntax-e stx-id)))
|
||||
stx-id)))
|
||||
(let ([name (if (pair? name)
|
||||
(car name)
|
||||
|
|
@ -1451,7 +1453,8 @@
|
|||
fields))))))])
|
||||
(if (pair? name)
|
||||
(to-element (list just-name
|
||||
(make-just-context (cadr name) stx-id)))
|
||||
(make-just-context (cadr name)
|
||||
(cadr (syntax-e stx-id)))))
|
||||
just-name))]
|
||||
[short-width (apply +
|
||||
(length fields)
|
||||
|
|
|
|||
|
|
@ -116,6 +116,7 @@ on the next character or characters in the input stream as follows:
|
|||
@dispatch[@litchar{#,}]{starts a syntax quote; see @secref["parse-quote"]}
|
||||
@dispatch[@litchar["#! "]]{starts a line comment; see @secref["parse-comment"]}
|
||||
@dispatch[@litchar["#!/"]]{starts a line comment; see @secref["parse-comment"]}
|
||||
@dispatch[@litchar["#!"]]{may start a reader extension; see @secref["parse-reader"]}
|
||||
@dispatch[@litchar{#`}]{starts a syntax quasiquote; see @secref["parse-quote"]}
|
||||
@dispatch[@litchar{#,}]{starts an syntax [splicing] unquote; see @secref["parse-quote"]}
|
||||
@dispatch[@litchar["#~"]]{starts compiled code; see @scheme[current-compile]}
|
||||
|
|
@ -750,14 +751,21 @@ If the @scheme[read-accept-reader] @tech{parameter} is set to
|
|||
|
||||
@guideintro["hash-lang"]{@schememodfont["#lang"]}
|
||||
|
||||
The @as-index{@litchar{#lang}} reader form is similar, but more
|
||||
constrained: the @litchar{#lang} must be followed by a single space
|
||||
(ASCII 32), and then a non-empty sequence of alphanumeric ASCII,
|
||||
@litchar{+}, @litchar{-}, @litchar{_}, and/or @litchar{/} characters
|
||||
terminated by @schemelink[char-whitespace?]{whitespace} or an
|
||||
end-of-file. The sequence must not start or end with @litchar{/}. A
|
||||
sequence @litchar{#lang }@nonterm{name} is equivalent to
|
||||
@litchar{#reader }@nonterm{name}@litchar{/lang/reader}.
|
||||
The @as-index{@litchar{#lang}} reader form is similar to
|
||||
@litchar{#reader}, but more constrained: the @litchar{#lang} must be
|
||||
followed by a single space (ASCII 32), and then a non-empty sequence
|
||||
of alphanumeric ASCII, @litchar{+}, @litchar{-}, @litchar{_}, and/or
|
||||
@litchar{/} characters terminated by
|
||||
@schemelink[char-whitespace?]{whitespace} or an end-of-file. The
|
||||
sequence must not start or end with @litchar{/}. A sequence
|
||||
@litchar{#lang }@nonterm{name} is equivalent to @litchar{#reader
|
||||
}@nonterm{name}@litchar{/lang/reader}.
|
||||
|
||||
Finally, @as-index{@litchar{#!}} followed by alphanumeric ASCII,
|
||||
@litchar{+}, @litchar{-}, or @litchar{_} is a synonym for
|
||||
@litchar{#lang} followed by a space. Use of this synonym is discourage
|
||||
except as needed to construct programs that conform to certain
|
||||
grammars, such as that of R@superscript{6}RS @cite["Sperber07"].
|
||||
|
||||
By convention, @litchar{#lang} normally appears at the beginning of a
|
||||
file, possibly after comment forms, to specify the syntax of a module.
|
||||
|
|
|
|||
|
|
@ -103,6 +103,12 @@ languages, where @schememodname[scheme] includes all of
|
|||
#:location "Workshop on Scheme and Functional Programming"
|
||||
#:date "2004")
|
||||
|
||||
(bib-entry #:key "Sperber07"
|
||||
#:author "Michael Sperber, R. Kent Dybvig, Matthew Flatt, and Anton van Straaten (editors)"
|
||||
#:title @elem{The Revised@superscript{6} Report on the Algorithmic Language Scheme}
|
||||
#:date "2007"
|
||||
#:url "http://www.r6rs.org/")
|
||||
|
||||
(bib-entry #:key "Sitaram90"
|
||||
#:author "Dorai Sitaram"
|
||||
#:title "Control Delimiters and Their Hierarchies"
|
||||
|
|
|
|||
|
|
@ -583,9 +583,9 @@ of by-name arguments (for use with @scheme[new]).}
|
|||
Like @scheme[defconstructor/make], but with multiple constructor
|
||||
patterns analogous @scheme[defproc*].}
|
||||
|
||||
@defform[(defconstructor/super-init [(arg-spec ...) ...] pre-flow ...)]{
|
||||
@defform[(defconstructor/auto-super [(arg-spec ...) ...] pre-flow ...)]{
|
||||
|
||||
Like @scheme[defconstructor/super-init], but the constructor is
|
||||
Like @scheme[defconstructor], but the constructor is
|
||||
annotated to indicate that additional initialization arguments are
|
||||
accepted and propagated to the sueprclass.}
|
||||
|
||||
|
|
|
|||
|
|
@ -1662,6 +1662,14 @@
|
|||
(loop (if uniform? end (+ n 1)))))))
|
||||
kcrl)))
|
||||
|
||||
|
||||
(test '(#" ") regexp-match #px#"\t|\\p{Zs}" " ")
|
||||
(test '(" ") regexp-match #px"\t|\\p{Zs}" " ")
|
||||
(test '(#"\t") regexp-match #px#"\t|\\p{Zs}" "\t")
|
||||
(test '("\t") regexp-match #px"\t|\\p{Zs}" "\t")
|
||||
(test #f regexp-match #px#"\t|\\p{Zs}" "a")
|
||||
(test #f regexp-match #px"\t|\\p{Zs}" "a")
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; Check that [\s] doesn't match \s, etc.
|
||||
|
|
|
|||
|
|
@ -1742,9 +1742,14 @@ regranges(int parse_flags, int at_start)
|
|||
if ((c >= '0') && (c <= '9'))
|
||||
break;
|
||||
if (((c >= 'a') && (c <= 'z'))
|
||||
|| ((c >= 'A') && (c <= 'Z')))
|
||||
|| ((c >= 'A') && (c <= 'Z'))) {
|
||||
if ((c == 'p') || (c == 'P')) {
|
||||
/* unicode char class; give up */
|
||||
break;
|
||||
}
|
||||
regcharclass(regparsestr[regparse], new_map);
|
||||
else
|
||||
|
||||
} else
|
||||
new_map[c] = 1;
|
||||
} else
|
||||
new_map[c] = 1;
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user