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:
Matthew Flatt 2011-12-14 15:19:11 -07:00
parent a16caef298
commit ee775c3cc3
25 changed files with 123 additions and 118 deletions

View File

@ -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

View File

@ -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))))))]

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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))

View File

@ -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)])

View File

@ -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)))

View File

@ -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)

View File

@ -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)))

View File

@ -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))

View File

@ -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.

View File

@ -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}

View File

@ -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

View File

@ -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.}

View File

@ -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\".*\""

View File

@ -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

View File

@ -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.

View File

@ -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?]{

View File

@ -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

View File

@ -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

View File

@ -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)])

View File

@ -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?

View File

@ -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));

View File

@ -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)