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
This commit is contained in:
Matthew Flatt 2011-12-14 15:19:11 -07:00
parent 9d0ff0cdfd
commit 27d597b71f
11 changed files with 27 additions and 27 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))