intern strings, etc. only when making syntax objects, not in `read'
Rename `read-intern-literal' to `datum-intern-literal'. Interning is needed only in `read-syntax' or `datum->syntax' to set up the invariants that the bytecode compiler needs for cross-module optimization. When `read'ing numbers from a data file, meanwhile, interning slows things down a lot and doesn't seem worthwhile.
This commit is contained in:
parent
a16caef298
commit
ee775c3cc3
|
@ -40,12 +40,12 @@
|
|||
(provide include-section)
|
||||
|
||||
(define (gen-tag content)
|
||||
(read-intern-literal
|
||||
(datum-intern-literal
|
||||
(regexp-replace* "[^-a-zA-Z0-9_=]" (content->string content) "_")))
|
||||
|
||||
(define (prefix->string p)
|
||||
(and p (if (string? p)
|
||||
(read-intern-literal p)
|
||||
(datum-intern-literal p)
|
||||
(module-path-prefix->string p))))
|
||||
|
||||
(define (convert-tag tag content)
|
||||
|
@ -174,7 +174,7 @@
|
|||
(define (intern-taglet v)
|
||||
(let ([v (if (list? v)
|
||||
(map intern-taglet v)
|
||||
(read-intern-literal v))])
|
||||
(datum-intern-literal v))])
|
||||
(if (or (string? v)
|
||||
(bytes? v)
|
||||
(list? v))
|
||||
|
@ -229,7 +229,7 @@
|
|||
v)))
|
||||
|
||||
(define (module-path-prefix->string p)
|
||||
(read-intern-literal
|
||||
(datum-intern-literal
|
||||
(format "~a" (module-path-index->taglet (module-path-index-join p #f)))))
|
||||
|
||||
(define doc-prefix
|
||||
|
|
|
@ -90,7 +90,7 @@
|
|||
(let* ([s (regexp-replace* #px"\\s+" s " ")]
|
||||
[s (regexp-replace* #rx"^ " s "")]
|
||||
[s (regexp-replace* #rx" $" s "")])
|
||||
(read-intern-literal s)))
|
||||
(datum-intern-literal s)))
|
||||
|
||||
(define (decode-string s)
|
||||
(let loop ([l '((#rx"---" mdash)
|
||||
|
@ -101,7 +101,7 @@
|
|||
(cond [(null? l) (list s)]
|
||||
[(regexp-match-positions (caar l) s)
|
||||
=> (lambda (m)
|
||||
(read-intern-literal
|
||||
(datum-intern-literal
|
||||
(append (decode-string (substring s 0 (caar m)))
|
||||
(cdar l)
|
||||
(decode-string (substring s (cdar m))))))]
|
||||
|
|
|
@ -56,7 +56,7 @@
|
|||
|
||||
(define hovers (make-weak-hasheq))
|
||||
(define (intern-hover-style text)
|
||||
(let ([text (read-intern-literal text)])
|
||||
(let ([text (datum-intern-literal text)])
|
||||
(or (hash-ref hovers text #f)
|
||||
(let ([s (make-style #f (list (make-hover-property text)))])
|
||||
(hash-set! hovers text s)
|
||||
|
@ -189,7 +189,7 @@
|
|||
(if index?
|
||||
(make-index-element
|
||||
#f (list elem) tag
|
||||
(list (read-intern-literal (symbol->string (syntax-e id))))
|
||||
(list (datum-intern-literal (symbol->string (syntax-e id))))
|
||||
(list elem)
|
||||
(and show-libs?
|
||||
(with-exporting-libraries
|
||||
|
@ -223,7 +223,7 @@
|
|||
#f
|
||||
(list (make-one (if form? 'form 'def))
|
||||
(make-dep (list taglet id) null)
|
||||
(let ([str (read-intern-literal (symbol->string id))])
|
||||
(let ([str (datum-intern-literal (symbol->string id))])
|
||||
(make-index-element #f
|
||||
null
|
||||
(intern-taglet
|
||||
|
|
|
@ -101,7 +101,7 @@
|
|||
(if (hash-ref ht k #f)
|
||||
#f
|
||||
(begin (hash-set! ht k #t)
|
||||
(cons (read-intern-literal (symbol->string k))
|
||||
(cons (datum-intern-literal (symbol->string k))
|
||||
(**method k (car super))))))
|
||||
(cls/intf-methods (cdr super)))])
|
||||
(if (null? inh)
|
||||
|
@ -133,7 +133,7 @@
|
|||
symbol-color
|
||||
(list (make-link-element
|
||||
value-link-color
|
||||
(list (read-intern-literal
|
||||
(list (datum-intern-literal
|
||||
(symbol->string (syntax-e (decl-name decl)))))
|
||||
tag)))
|
||||
(map id-info (decl-app-mixins decl))
|
||||
|
@ -207,7 +207,7 @@
|
|||
(list
|
||||
(make-index-element
|
||||
#f content tag
|
||||
(list (read-intern-literal
|
||||
(list (datum-intern-literal
|
||||
(symbol->string (syntax-e stx-id))))
|
||||
content
|
||||
(with-exporting-libraries
|
||||
|
|
|
@ -326,7 +326,7 @@
|
|||
(if kw-id
|
||||
(list (make-index-element
|
||||
#f content tag
|
||||
(list (read-intern-literal (symbol->string (syntax-e kw-id))))
|
||||
(list (datum-intern-literal (symbol->string (syntax-e kw-id))))
|
||||
content
|
||||
(with-exporting-libraries
|
||||
(lambda (libs)
|
||||
|
|
|
@ -129,7 +129,7 @@
|
|||
(append (map (lambda (modpath)
|
||||
(make-part-tag-decl
|
||||
(intern-taglet
|
||||
`(mod-path ,(read-intern-literal
|
||||
`(mod-path ,(datum-intern-literal
|
||||
(element->string modpath))))))
|
||||
modpaths)
|
||||
(flow-paragraphs (decode-flow content)))))))
|
||||
|
@ -137,8 +137,8 @@
|
|||
(define the-module-path-index-desc (make-module-path-index-desc))
|
||||
|
||||
(define (make-defracketmodname mn mp)
|
||||
(let ([name-str (read-intern-literal (element->string mn))]
|
||||
[path-str (read-intern-literal (element->string mp))])
|
||||
(let ([name-str (datum-intern-literal (element->string mn))]
|
||||
[path-str (datum-intern-literal (element->string mp))])
|
||||
(make-index-element #f
|
||||
(list mn)
|
||||
(intern-taglet `(mod-path ,path-str))
|
||||
|
|
|
@ -145,7 +145,7 @@
|
|||
(if (eq? mode 'new)
|
||||
(make-element
|
||||
#f (list (racketparenfont "[")
|
||||
(racketidfont (read-intern-literal (keyword->string (arg-kw arg))))
|
||||
(racketidfont (datum-intern-literal (keyword->string (arg-kw arg))))
|
||||
spacer
|
||||
(to-element (make-var-id (arg-id arg)))
|
||||
(racketparenfont "]")))
|
||||
|
@ -267,7 +267,7 @@
|
|||
#f
|
||||
content
|
||||
tag
|
||||
(list (read-intern-literal (symbol->string mname)))
|
||||
(list (datum-intern-literal (symbol->string mname)))
|
||||
content
|
||||
(with-exporting-libraries
|
||||
(lambda (libs)
|
||||
|
@ -289,7 +289,7 @@
|
|||
#f
|
||||
(list (make-index-element
|
||||
#f content tag
|
||||
(list (read-intern-literal (symbol->string (extract-id prototype))))
|
||||
(list (datum-intern-literal (symbol->string (extract-id prototype))))
|
||||
content
|
||||
(with-exporting-libraries
|
||||
(lambda (libs)
|
||||
|
@ -899,7 +899,7 @@
|
|||
#f
|
||||
content
|
||||
tag
|
||||
(list (read-intern-literal (symbol->string name)))
|
||||
(list (datum-intern-literal (symbol->string name)))
|
||||
content
|
||||
(with-exporting-libraries
|
||||
(lambda (libs) (make-thing-index-desc name libs)))))
|
||||
|
@ -942,7 +942,7 @@
|
|||
(make-target-element*
|
||||
make-target-element
|
||||
stx-id
|
||||
(let* ([name (read-intern-literal (string-append* (map symbol->string (cdar wrappers))))]
|
||||
(let* ([name (datum-intern-literal (string-append* (map symbol->string (cdar wrappers))))]
|
||||
[target-maker
|
||||
(id-to-target-maker (datum->syntax stx-id (string->symbol name))
|
||||
#t)])
|
||||
|
|
|
@ -207,7 +207,7 @@
|
|||
(define (*as-modname-link s e)
|
||||
(make-link-element module-link-color
|
||||
(list e)
|
||||
`(mod-path ,(read-intern-literal (format "~s" s)))))
|
||||
`(mod-path ,(datum-intern-literal (format "~s" s)))))
|
||||
|
||||
(define-syntax-rule (indexed-racket x)
|
||||
(add-racket-index 'x (racket x)))
|
||||
|
|
|
@ -112,7 +112,7 @@
|
|||
(define (indexed-file . str)
|
||||
(let* ([f (apply filepath str)]
|
||||
[s (element->string f)])
|
||||
(index* (list (read-intern-literal
|
||||
(index* (list (datum-intern-literal
|
||||
(clean-up-index-string
|
||||
(substring s 1 (sub1 (string-length s))))))
|
||||
(list f)
|
||||
|
|
|
@ -22,7 +22,7 @@
|
|||
[s (regexp-replace #rx"ies$" s "y")]
|
||||
[s (regexp-replace #rx"s$" s "")]
|
||||
[s (regexp-replace* #px"[-\\s]+" s " ")]
|
||||
[s (read-intern-literal s)])
|
||||
[s (datum-intern-literal s)])
|
||||
(make-elem style c (list 'tech (doc-prefix doc prefix s)))))
|
||||
|
||||
(define (deftech #:style? [style? #t] . s)
|
||||
|
@ -33,7 +33,7 @@
|
|||
(make-index-element #f
|
||||
(list t)
|
||||
(target-element-tag t)
|
||||
(list (read-intern-literal
|
||||
(list (datum-intern-literal
|
||||
(clean-up-index-string (element->string e))))
|
||||
(list e)
|
||||
'tech)))
|
||||
|
|
|
@ -197,8 +197,8 @@
|
|||
|
||||
(define iformat
|
||||
(case-lambda
|
||||
[(str val) (read-intern-literal (format str val))]
|
||||
[(str . vals) (read-intern-literal (apply format str vals))]))
|
||||
[(str val) (datum-intern-literal (format str val))]
|
||||
[(str . vals) (datum-intern-literal (apply format str vals))]))
|
||||
|
||||
(define (typeset-atom c out color? quote-depth expr?)
|
||||
(if (and (var-id? (syntax-e c))
|
||||
|
|
|
@ -13,8 +13,8 @@ A @deftech{byte string} is a fixed-length array of bytes. A
|
|||
@defterm{mutable} or @defterm{immutable}. When an immutable byte
|
||||
string is provided to a procedure like @racket[bytes-set!], the
|
||||
@exnraise[exn:fail:contract]. Byte-string constants generated by the
|
||||
default reader (see @secref["parse-string"]) are immutable
|
||||
and @tech{interned}.
|
||||
default reader (see @secref["parse-string"]) are immutable,
|
||||
and they are @tech{interned} in @racket[read-syntax] mode.
|
||||
|
||||
Two byte strings are @racket[equal?] when they have the same length
|
||||
and contain the same sequence of bytes.
|
||||
|
|
|
@ -17,7 +17,7 @@ characters whose values range from @racketvalfont{#x0} to
|
|||
Two characters are @racket[eqv?] if they correspond to the same scalar
|
||||
value. For each scalar value less than 256, character values that are
|
||||
@racket[eqv?] are also @racket[eq?]. Characters produced by the default
|
||||
reader are @tech{interned}.
|
||||
reader are @tech{interned} in @racket[read-syntax] mode.
|
||||
|
||||
@see-read-print["character"]{characters}
|
||||
|
||||
|
|
|
@ -81,7 +81,7 @@ with fixnums. See also the @racketmodname[racket/fixnum] module, below.
|
|||
Two fixnums that are @racket[=] are also the same
|
||||
according to @racket[eq?]. Otherwise, the result of @racket[eq?]
|
||||
applied to two numbers is undefined, except that numbers produced
|
||||
by the default reader are @tech{interned} and therefore @racket[eq?]
|
||||
by the default reader in @racket[read-syntax] mode are @tech{interned} and therefore @racket[eq?]
|
||||
when they are @racket[eqv?].
|
||||
|
||||
Two numbers are @racket[eqv?] when they are both inexact with the same precision or both
|
||||
|
|
|
@ -325,33 +325,3 @@ except that special-comment values (see
|
|||
The default port read handler itself can be customized through a
|
||||
readtable; see @secref["readtables"] for more information.}
|
||||
|
||||
|
||||
@defproc[(read-intern-literal [v any/c]) any/c]{
|
||||
|
||||
Converts some values to be consistent with an @tech{interned} result
|
||||
produced by the default reader.
|
||||
|
||||
If @racket[v] is a @tech{number}, @tech{character}, @tech{string},
|
||||
@tech{byte string}, or @tech{regular expression}, then the result is a
|
||||
value that is @racket[equal?] to @racket[v] and @racket[eq?] to a
|
||||
potential result of the default reader. (Note that mutable strings and
|
||||
byte strings are @tech{interned} as immutable strings and byte
|
||||
strings.)
|
||||
|
||||
If @racket[v] is an @tech{uninterned} or an @tech{unreadable symbol},
|
||||
the result is still @racket[v], since an @tech{interned} symbol would
|
||||
not be @racket[equal?] to @racket[v].
|
||||
|
||||
The conversion process does not traverse compound values. For example,
|
||||
if @racket[v] is a @tech{pair} containing strings, then the strings
|
||||
within @racket[v] are not @tech{interned}.
|
||||
|
||||
If @racket[_v1] and @racket[_v2] are @racket[equal?] but not
|
||||
@racket[eq?], then it is possible that @racket[(read-intern-literal
|
||||
_v1)] will return @racket[_v1] and---sometime after @racket[_v1]
|
||||
becomes unreachable as determined by the garbage collector (see
|
||||
@secref["gc-model"])---@racket[(read-intern-literal _v2)] can still
|
||||
return @racket[_v2]. In other words, @racket[read-intern-literal]
|
||||
may adopt a given value as an @tech{interned} representative, but
|
||||
if a former representative becomes otherwise unreachable, then
|
||||
@racket[read-intern-literal] may adopt a new representative.}
|
||||
|
|
|
@ -38,15 +38,17 @@ Reading is defined in terms of Unicode characters; see
|
|||
@secref["ports"] for information on how a byte stream is converted
|
||||
to a character stream.
|
||||
|
||||
Symbols, keywords, strings, byte strings, regexps, characters, and numbers
|
||||
produced by the reader are @deftech{interned}, which means that such
|
||||
values in the result of @racket[read] or @racket[read-syntax] are
|
||||
always @racket[eq?] when they are @racket[equal?] (whether from the
|
||||
same call or different calls to @racket[read] or
|
||||
@racket[read-syntax]). Sending an @tech{interned} value across a
|
||||
@tech{place channel} does not necessarily produce an @tech{interned}
|
||||
value at the receiving @tech{place}. See also
|
||||
@racket[read-intern-literal] and @racket[datum->syntax].
|
||||
Symbols, keywords, strings, byte strings, regexps, characters, and
|
||||
numbers produced by the reader in @racket[read-syntax] mode are
|
||||
@deftech{interned}, which means that such values in the result of
|
||||
@racket[read-syntax] are always @racket[eq?] when they are
|
||||
@racket[equal?] (whether from the same call or different calls to
|
||||
@racket[read-syntax]). Symbols and keywords are @tech{interned} in
|
||||
both @racket[read] and @racket[read-syntax] mode. Sending an
|
||||
@tech{interned} value across a @tech{place channel} does not
|
||||
necessarily produce an @tech{interned} value at the receiving
|
||||
@tech{place}. See also @racket[datum-intern-literal] and
|
||||
@racket[datum->syntax].
|
||||
|
||||
@;------------------------------------------------------------------------
|
||||
@section[#:tag "default-readtable-dispatch"]{Delimiters and Dispatch}
|
||||
|
@ -208,7 +210,8 @@ case-sensitive mode.
|
|||
A sequence that does not start with a delimiter is parsed as a @tech{number}
|
||||
when it matches the following grammar case-insenstively for
|
||||
@nonterm{number@sub{10}} (decimal), where @metavar{n} is a
|
||||
meta-meta-variable in the grammar. The resulting number is @tech{interned}.
|
||||
meta-meta-variable in the grammar. The resulting number is @tech{interned} in
|
||||
@racket[read-syntax] mode.
|
||||
|
||||
A number is optionally prefixed by an exactness specifier,
|
||||
@as-index{@litchar{#e}} (exact) or @as-index{@litchar{#i}} (inexact),
|
||||
|
@ -393,7 +396,8 @@ exception, instead of the infix conversion.
|
|||
When the reader encounters @as-index{@litchar{"}}, it begins parsing
|
||||
characters to form a @tech{string}. The string continues until it is
|
||||
terminated by another @litchar{"} (that is not escaped by
|
||||
@litchar{\}). The resulting string is @tech{interned}.
|
||||
@litchar{\}). The resulting string is @tech{interned} in
|
||||
@racket[read-syntax] mode.
|
||||
|
||||
Within a string sequence, the following escape sequences are
|
||||
recognized:
|
||||
|
@ -465,7 +469,8 @@ constant, the @exnraise[exn:fail:read].
|
|||
A string constant preceded by @litchar{#} is parsed as a
|
||||
@tech{byte string}. (That is, @as-index{@litchar{#"}} starts a byte-string
|
||||
literal.) See @secref["bytestrings"] for information on byte
|
||||
strings. The resulting byte string is @tech{interned}.
|
||||
strings. The resulting byte string is @tech{interned} in
|
||||
@racket[read-syntax] mode.
|
||||
Byte-string constants support the same escape sequences as
|
||||
character strings, except @litchar{\u} and @litchar{\U}.
|
||||
|
||||
|
@ -740,7 +745,8 @@ A @as-index{@litchar{#rx}} or @as-index{@litchar{#px}} starts a
|
|||
expression as would be constructed by @racket[regexp], @litchar{#px}
|
||||
as constructed by @racket[pregexp], @litchar{#rx#} as constructed by
|
||||
@racket[byte-regexp], and @litchar{#px#} as constructed by
|
||||
@racket[byte-pregexp]. The resulting regular expression is @tech{interned}.
|
||||
@racket[byte-pregexp]. The resulting regular expression is @tech{interned} in
|
||||
@racket[read-syntax] mode.
|
||||
|
||||
@reader-examples[
|
||||
"#rx\".*\""
|
||||
|
|
|
@ -58,7 +58,8 @@ or both byte regexps.
|
|||
|
||||
A literal or printed regular expression starts with @litchar{#rx} or
|
||||
@litchar{#px}. @see-read-print["regexp"]{regular expressions} Regular
|
||||
expressions produced by the default reader are @tech{interned}.
|
||||
expressions produced by the default reader are @tech{interned} in
|
||||
@racket[read-syntax] mode.
|
||||
|
||||
The internal size of a regexp value is limited to 32 kilobytes; this
|
||||
limit roughly corresponds to a source string with 32,000 literal
|
||||
|
|
|
@ -13,7 +13,7 @@ A @deftech{string} is a fixed-length array of
|
|||
procedure like @racket[string-set!], the
|
||||
@exnraise[exn:fail:contract]. String constants generated by the
|
||||
default reader (see @secref["parse-string"]) are
|
||||
immutable and @tech{interned}.
|
||||
immutable, and they are @tech{interned} in @racket[read-syntax] mode.
|
||||
|
||||
Two strings are @racket[equal?] when they have the same length and
|
||||
contain the same sequence of characters.
|
||||
|
|
|
@ -116,7 +116,7 @@ leaving nested syntax structure (if any) in place. The result of
|
|||
|
||||
@item{some other kind of datum---usually a number, boolean, or
|
||||
string---that is @tech{interned} when
|
||||
@racket[read-intern-literal] would convert the
|
||||
@racket[datum-intern-literal] would convert the
|
||||
value}
|
||||
|
||||
]
|
||||
|
@ -189,7 +189,7 @@ pair, vector, box, immutable @tech{hash table}, immutable
|
|||
@tech{prefab} structure, or @tech{syntax object}, conversion means
|
||||
wrapping the value with lexical information, source-location
|
||||
information, and properties after the value is @tech{interned}
|
||||
via @racket[read-intern-literal].
|
||||
via @racket[datum-intern-literal].
|
||||
|
||||
Converted objects in @racket[v] are given the lexical context
|
||||
information of @racket[ctxt] and the source-location information of
|
||||
|
@ -233,6 +233,37 @@ The @racket[ignored] argument is allowed for backward compatibility
|
|||
and has no effect on the returned syntax object.}
|
||||
|
||||
|
||||
@defproc[(datum-intern-literal [v any/c]) any/c]{
|
||||
|
||||
Converts some values to be consistent with an @tech{interned} result
|
||||
produced by the default reader in @racket[read-syntax] mode.
|
||||
|
||||
If @racket[v] is a @tech{number}, @tech{character}, @tech{string},
|
||||
@tech{byte string}, or @tech{regular expression}, then the result is a
|
||||
value that is @racket[equal?] to @racket[v] and @racket[eq?] to a
|
||||
potential result of the default reader. (Note that mutable strings and
|
||||
byte strings are @tech{interned} as immutable strings and byte
|
||||
strings.)
|
||||
|
||||
If @racket[v] is an @tech{uninterned} or an @tech{unreadable symbol},
|
||||
the result is still @racket[v], since an @tech{interned} symbol would
|
||||
not be @racket[equal?] to @racket[v].
|
||||
|
||||
The conversion process does not traverse compound values. For example,
|
||||
if @racket[v] is a @tech{pair} containing strings, then the strings
|
||||
within @racket[v] are not @tech{interned}.
|
||||
|
||||
If @racket[_v1] and @racket[_v2] are @racket[equal?] but not
|
||||
@racket[eq?], then it is possible that @racket[(datum-intern-literal
|
||||
_v1)] will return @racket[_v1] and---sometime after @racket[_v1]
|
||||
becomes unreachable as determined by the garbage collector (see
|
||||
@secref["gc-model"])---@racket[(datum-intern-literal _v2)] can still
|
||||
return @racket[_v2]. In other words, @racket[datum-intern-literal]
|
||||
may adopt a given value as an @tech{interned} representative, but
|
||||
if a former representative becomes otherwise unreachable, then
|
||||
@racket[datum-intern-literal] may adopt a new representative.}
|
||||
|
||||
|
||||
@defproc[(syntax-shift-phase-level [stx syntax?]
|
||||
[shift exact-integer?])
|
||||
syntax?]{
|
||||
|
|
|
@ -38,7 +38,7 @@
|
|||
[else (raise-type-error to-rel-name "path, string, or bytes"
|
||||
path0)]))
|
||||
(let loop ([path (explode-path path1)] [root (force exploded-root)])
|
||||
(cond [(null? root) (cons tag (map (lambda (pe) (read-intern-literal (path-element->bytes pe)))
|
||||
(cond [(null? root) (cons tag (map (lambda (pe) (datum-intern-literal (path-element->bytes pe)))
|
||||
path))]
|
||||
;; Note: in some cases this returns the input path as is, which
|
||||
;; could be a byte string -- it should be possible to return
|
||||
|
|
|
@ -168,28 +168,28 @@ Use syntax/modcollapse instead.
|
|||
;; It has a suffix:
|
||||
(if (regexp-match? #rx"/" e)
|
||||
;; It has a path, so it's fine:
|
||||
(let ([e2 (read-intern-literal (ss->rkt e))])
|
||||
(let ([e2 (datum-intern-literal (ss->rkt e))])
|
||||
(if (eq? e e2)
|
||||
s
|
||||
`(lib ,e2)))
|
||||
;; No path, so add "mzlib/":
|
||||
`(lib ,(read-intern-literal
|
||||
`(lib ,(datum-intern-literal
|
||||
(string-append "mzlib/" (ss->rkt e)))))]
|
||||
[(regexp-match? #rx"/" e)
|
||||
;; It has a separator, so add a suffix:
|
||||
`(lib ,(read-intern-literal (string-append e ".rkt")))]
|
||||
`(lib ,(datum-intern-literal (string-append e ".rkt")))]
|
||||
[else
|
||||
;; No separator or suffix, so add "/main.rkt":
|
||||
`(lib ,(read-intern-literal (string-append e "/main.rkt")))]))
|
||||
`(lib ,(datum-intern-literal (string-append e "/main.rkt")))]))
|
||||
;; multi-string version:
|
||||
(if (regexp-match? #rx"[.]" (cadr s))
|
||||
;; there's a suffix, so we can collapse to a single string:
|
||||
`(lib ,(read-intern-literal
|
||||
`(lib ,(datum-intern-literal
|
||||
(string-join (append (cddr s)
|
||||
(list (ss->rkt (cadr s))))
|
||||
"/")))
|
||||
;; No suffix, so we must keep the old style:
|
||||
(cons 'lib (map read-intern-literal (cdr s))))))
|
||||
(cons 'lib (map datum-intern-literal (cdr s))))))
|
||||
|
||||
(define (normalize-planet s)
|
||||
(cond
|
||||
|
|
|
@ -352,18 +352,16 @@
|
|||
(test-ht (readstr "#hasheq((1 . 2))") 1 #t 1 2)
|
||||
(test-ht (readstr "#hasheqv((1 . 2))") 1 #f 1 2)
|
||||
(test-ht (readstr "#hash((\"apple\" . 1))") 1 #f "apple" 1)
|
||||
(test-ht (readstr "#hash((\"apple\" . 1))") 1 #f (list->string (string->list "apple")) 1)
|
||||
(test-ht (readstr "#hasheq((\"apple\" . 1))") 1 #t "apple" 1)
|
||||
(test-ht (readstr "#hasheq((\"apple\" . 1))") 1 #t (list->string (string->list "apple")) #f)
|
||||
(test-ht (readstr "#hasheqv((\"apple\" . 1))") 1 #f (list->string (string->list "apple")) #f)
|
||||
(test-ht (readstr "#hash((#s(s \"apple\") . 1) (#s(s \"apple\") . 10))") 1 #f '#s(s "apple") 10)
|
||||
(test-ht (readstr "#hasheq((#s(s \"apple\") . 1) (#s(s \"apple\") . 10))") 2 #t '#s(s "apple") #f)
|
||||
(test-ht (readstr "#hasheqv((#s(s \"apple\") . 1) (#s(s \"apple\") . 10))") 2 #f #s(s "apple") #f)
|
||||
(test-ht (readstr "#hasheq((\"apple\" . 1))") 1 #t "apple" #f)
|
||||
(test-ht (readstr "#hasheqv((\"apple\" . 1))") 1 #f "apple" #f)
|
||||
(test-ht (readstr "#hash((\"apple\" . 1) (\"apple\" . 10))") 1 #f "apple" 10)
|
||||
(test-ht (readstr "#hasheq((\"apple\" . 1) (\"apple\" . 10))") 2 #t "apple" #f)
|
||||
(test-ht (readstr "#hasheqv((\"apple\" . 1) (\"apple\" . 10))") 2 #f "apple" #f)
|
||||
(test-ht (readstr "#hash((apple . 1) (apple . 10))") 1 #f 'apple 10)
|
||||
(test-ht (readstr "#hasheq((apple . 1) (apple . 10))") 1 #t 'apple 10)
|
||||
(test-ht (readstr "#hasheqv((apple . 1) (apple . 10))") 1 #f 'apple 10)
|
||||
(test-ht (readstr "#hasheq((#0=\"apple\" . 1) (#0# . 10))") 1 #t (list->string (string->list "apple")) #f)
|
||||
(test-ht (readstr "#hash((#0=\"apple\" . 1) (\"banana\" . #0#))") 2 #f "banana" (list->string (string->list "apple")))
|
||||
(test-ht (readstr "#hasheq((#0=\"apple\" . 1) (#0# . 10))") 1 #t "apple" #f)
|
||||
(test-ht (readstr "#hash((#0=\"apple\" . 1) (\"banana\" . #0#))") 2 #f "banana" "apple")
|
||||
(test-ht (readstr "#hash((a . 1) (b . 2) (c . 3) (e . 4) (f . 5) (g . 6) (h . 7) (i . 8))") 8 #f 'f 5)
|
||||
(let ([t (readstr "#0=#hash((\"apple\" . #0#))")])
|
||||
(test-ht t 1 #f "apple" t))
|
||||
|
@ -374,13 +372,6 @@
|
|||
(let ([t (readstr "#0=#hash((#0# . 17))")])
|
||||
;; Don't look for t, because that's a hash on a circular object!
|
||||
(test-ht t 1 #f 'none #f))
|
||||
;; check intern and comparison of regexps:
|
||||
(test-ht (readstr "#hasheq((#rx\"apple\" . 1))") 1 #t #rx"apple" 1)
|
||||
(test-ht (readstr "#hasheq((#rx\"apple\" . 1))") 1 #t #px"apple" #f)
|
||||
(test-ht (readstr "#hasheq((#rx#\"apple\" . 1))") 1 #t #rx#"apple" 1)
|
||||
(test-ht (readstr "#hasheq((#rx#\"apple\" . 1))") 1 #t #rx"apple" #f)
|
||||
(test-ht (readstr "#hasheq((#rx#\"apple\" . 1))") 1 #t #px#"apple" #f)
|
||||
(test-ht (readstr "#hasheq((#px#\"apple\" . 1))") 1 #t #px#"apple" 1)
|
||||
|
||||
(define (test-write-ht writer t . strings)
|
||||
(let ([o (open-output-string)])
|
||||
|
|
|
@ -1,3 +1,6 @@
|
|||
Version 5.2.0.7
|
||||
Intern strings, etc., only in read-syntax mode, not read mode
|
||||
|
||||
Version 5.2.0.6
|
||||
Added pseudo-random-generator-vector?
|
||||
|
||||
|
|
|
@ -501,7 +501,7 @@ void scheme_init_read(Scheme_Env *env)
|
|||
GLOBAL_FOLDING_PRIM("readtable?", readtable_p, 1, 1, 1, env);
|
||||
GLOBAL_PRIM_W_ARITY2("readtable-mapping", readtable_mapping, 2, 2, 3, 3, env);
|
||||
|
||||
GLOBAL_NONCM_PRIM("read-intern-literal", read_intern, 1, 1, env);
|
||||
GLOBAL_NONCM_PRIM("datum-intern-literal", read_intern, 1, 1, env);
|
||||
|
||||
if (getenv("PLT_DELAY_FROM_ZO")) {
|
||||
use_perma_cache = 0;
|
||||
|
@ -1470,10 +1470,10 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
|
|||
return NULL;
|
||||
}
|
||||
|
||||
str = scheme_intern_literal_string(str);
|
||||
|
||||
if (stxsrc)
|
||||
if (stxsrc) {
|
||||
str = scheme_intern_literal_string(str);
|
||||
str = scheme_make_stx_w_offset(str, line, col, pos, SPAN(port, pos), stxsrc, STX_SRCTAG);
|
||||
}
|
||||
|
||||
return str;
|
||||
}
|
||||
|
@ -3012,9 +3012,10 @@ read_string(int is_byte, Scheme_Object *port,
|
|||
s[i] = 0;
|
||||
result = scheme_make_immutable_sized_byte_string(s, i, 0);
|
||||
}
|
||||
result = scheme_intern_literal_string(result);
|
||||
if (stxsrc)
|
||||
if (stxsrc) {
|
||||
result = scheme_intern_literal_string(result);
|
||||
result = scheme_make_stx_w_offset(result, line, col, pos, SPAN(port, pos), stxsrc, STX_SRCTAG);
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
@ -3104,10 +3105,10 @@ read_here_string(Scheme_Object *port, Scheme_Object *stxsrc,
|
|||
|
||||
str = scheme_make_immutable_sized_char_string(s, len, 1);
|
||||
|
||||
str = scheme_intern_literal_string(str);
|
||||
|
||||
if (stxsrc)
|
||||
if (stxsrc) {
|
||||
str = scheme_intern_literal_string(str);
|
||||
str = scheme_make_stx_w_offset(str, line, col, pos, SPAN(port, pos), stxsrc, STX_SRCTAG);
|
||||
}
|
||||
|
||||
return str;
|
||||
}
|
||||
|
@ -3428,7 +3429,7 @@ read_number_or_symbol(int init_ch, int skip_rt, Scheme_Object *port,
|
|||
port, NULL, 0,
|
||||
stxsrc, line, col, pos, SPAN(port, pos),
|
||||
indentation);
|
||||
if (!SCHEME_INTP(o))
|
||||
if (!SCHEME_INTP(o) && stxsrc)
|
||||
o = scheme_intern_literal_number(o);
|
||||
}
|
||||
|
||||
|
@ -3564,12 +3565,14 @@ static int u_strcmp(mzchar *s, const char *_t)
|
|||
return 0;
|
||||
}
|
||||
|
||||
static Scheme_Object *make_interned_char(int ch)
|
||||
static Scheme_Object *make_interned_char(int ch, Scheme_Object *stxsrc)
|
||||
{
|
||||
if (ch < 256)
|
||||
return scheme_make_character(ch);
|
||||
else
|
||||
else if (stxsrc)
|
||||
return scheme_intern_literal_number(scheme_make_char(ch));
|
||||
else
|
||||
return scheme_make_char(ch);
|
||||
}
|
||||
|
||||
/* "#\" has been read */
|
||||
|
@ -3610,7 +3613,7 @@ read_character(Scheme_Object *port,
|
|||
|
||||
ch = ((ch - '0') << 6) + ((next - '0') << 3) + (last - '0');
|
||||
|
||||
return make_interned_char(ch);
|
||||
return make_interned_char(ch, stxsrc);
|
||||
}
|
||||
|
||||
if (((ch == 'u') || (ch == 'U')) && NOT_EOF_OR_SPECIAL(next) && scheme_isxdigit(next)) {
|
||||
|
@ -3710,7 +3713,7 @@ read_character(Scheme_Object *port,
|
|||
"read: expected a character after #\\");
|
||||
}
|
||||
|
||||
return make_interned_char(ch);
|
||||
return make_interned_char(ch, stxsrc);
|
||||
}
|
||||
|
||||
/*========================================================================*/
|
||||
|
@ -4374,7 +4377,7 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
|
|||
break;
|
||||
case CPT_CHAR:
|
||||
l = read_compact_number(port);
|
||||
return make_interned_char(l);
|
||||
return make_interned_char(l, scheme_true);
|
||||
break;
|
||||
case CPT_INT:
|
||||
return scheme_make_integer(read_compact_number(port));
|
||||
|
|
|
@ -13,12 +13,12 @@
|
|||
consistently.)
|
||||
*/
|
||||
|
||||
#define MZSCHEME_VERSION "5.2.0.6"
|
||||
#define MZSCHEME_VERSION "5.2.0.7"
|
||||
|
||||
#define MZSCHEME_VERSION_X 5
|
||||
#define MZSCHEME_VERSION_Y 2
|
||||
#define MZSCHEME_VERSION_Z 0
|
||||
#define MZSCHEME_VERSION_W 6
|
||||
#define MZSCHEME_VERSION_W 7
|
||||
|
||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||
|
|
Loading…
Reference in New Issue
Block a user