commit 27d597b71fac5cfc8d1b2ce21dc2cf401236aa3d
parent 9d0ff0cdfd555388dd87d881dc75137f8cc2c813
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 14 Dec 2011 15:19:11 -0700
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.
original commit: ee775c3cc3088a8de848399b3c1eec97bbc52b89
Diffstat:
11 files changed, 27 insertions(+), 27 deletions(-)
diff --git a/collects/scribble/base.rkt b/collects/scribble/base.rkt
@@ -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
diff --git a/collects/scribble/decode.rkt b/collects/scribble/decode.rkt
@@ -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))))))]
diff --git a/collects/scribble/private/manual-bind.rkt b/collects/scribble/private/manual-bind.rkt
@@ -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
diff --git a/collects/scribble/private/manual-class.rkt b/collects/scribble/private/manual-class.rkt
@@ -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
diff --git a/collects/scribble/private/manual-form.rkt b/collects/scribble/private/manual-form.rkt
@@ -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)
diff --git a/collects/scribble/private/manual-mod.rkt b/collects/scribble/private/manual-mod.rkt
@@ -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))
diff --git a/collects/scribble/private/manual-proc.rkt b/collects/scribble/private/manual-proc.rkt
@@ -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)])
diff --git a/collects/scribble/private/manual-scheme.rkt b/collects/scribble/private/manual-scheme.rkt
@@ -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)))
diff --git a/collects/scribble/private/manual-style.rkt b/collects/scribble/private/manual-style.rkt
@@ -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)
diff --git a/collects/scribble/private/manual-tech.rkt b/collects/scribble/private/manual-tech.rkt
@@ -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)))
diff --git a/collects/scribble/racket.rkt b/collects/scribble/racket.rkt
@@ -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))
