suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

read-intern strings generated by Scribble; other interning

Browse Source 
This change saves a small amount of space in cross-reference files
and some space in loaded cross-reference information.
It also saves work converting strings to mutable on deserialize,
although the performance difference seems negligible.

original commit: b2fade9206590173e4c2e346357ad13150525387
This commit is contained in:
Matthew Flatt 2011-12-09 16:29:03 -07:00
parent c17636d399
commit f1a593d3a3
11 changed files with 96 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/scribble/base.rkt
View File

@ -40,10 +40,13 @@
(provide include-section) (provide include-section)
(define (gen-tag content) (define (gen-tag content)
(regexp-replace* "[^-a-zA-Z0-9_=]" (content->string content) "_")) (read-intern-literal
(regexp-replace* "[^-a-zA-Z0-9_=]" (content->string content) "_")))
(define (prefix->string p) (define (prefix->string p)
(and p (if (string? p) p (module-path-prefix->string p)))) (and p (if (string? p)
(read-intern-literal p)
(module-path-prefix->string p))))
(define (convert-tag tag content) (define (convert-tag tag content)
(if (list? tag) (if (list? tag)
@ -171,7 +174,7 @@
(define (intern-taglet v) (define (intern-taglet v)
(let ([v (if (list? v) (let ([v (if (list? v)
(map intern-taglet v) (map intern-taglet v)
v)]) (read-intern-literal v))])
(if (or (string? v) (if (or (string? v)
(bytes? v) (bytes? v)
(list? v)) (list? v))
@ -226,7 +229,8 @@
v))) v)))
(define (module-path-prefix->string p) (define (module-path-prefix->string p)
(format "~a" (module-path-index->taglet (module-path-index-join p #f)))) (read-intern-literal
(format "~a" (module-path-index->taglet (module-path-index-join p #f)))))
(define doc-prefix (define doc-prefix
(case-lambda (case-lambda

5
collects/scribble/decode.rkt
View File

@ -88,7 +88,7 @@
(let* ([s (regexp-replace* #px"\\s+" s " ")] (let* ([s (regexp-replace* #px"\\s+" s " ")]
[s (regexp-replace* #rx"^ " s "")] [s (regexp-replace* #rx"^ " s "")]
[s (regexp-replace* #rx" $" s "")]) [s (regexp-replace* #rx" $" s "")])
s)) (read-intern-literal s)))
(define (decode-string s) (define (decode-string s)
(let loop ([l '((#rx"---" mdash) (let loop ([l '((#rx"---" mdash)
@ -99,9 +99,10 @@
(cond [(null? l) (list s)] (cond [(null? l) (list s)]
[(regexp-match-positions (caar l) s) [(regexp-match-positions (caar l) s)
=> (lambda (m) => (lambda (m)
(read-intern-literal
(append (decode-string (substring s 0 (caar m))) (append (decode-string (substring s 0 (caar m)))
(cdar l) (cdar l)
(decode-string (substring s (cdar m)))))] (decode-string (substring s (cdar m))))))]
[else (loop (cdr l))]))) [else (loop (cdr l))])))
(define (line-break? v) (define (line-break? v)

31
collects/scribble/private/manual-bind.rkt
View File

@ -4,6 +4,8 @@
"../search.rkt" "../search.rkt"
"../basic.rkt" "../basic.rkt"
"../manual-struct.rkt" "../manual-struct.rkt"
(only-in "../core.rkt" make-style)
"../html-properties.rkt"
"manual-ex.rkt" "manual-ex.rkt"
racket/contract/base racket/contract/base
(for-syntax scheme/base) (for-syntax scheme/base)
@ -53,21 +55,28 @@
(lambda () s) (lambda () s)
(lambda () s)))) (lambda () s))))
(define hovers (make-weak-hasheq))
(define (intern-hover-style text)
(let ([text (read-intern-literal text)])
(or (hash-ref hovers text #f)
(let ([s (make-style #f (list (make-hover-property text)))])
(hash-set! hovers text s)
s))))
(define (annote-exporting-library e) (define (annote-exporting-library e)
(make-delayed-element (make-delayed-element
(lambda (render p ri) (lambda (render p ri)
(let ([from (resolve-get/tentative p ri '(exporting-libraries #f))]) (let ([from (resolve-get/tentative p ri '(exporting-libraries #f))])
(if (and from (pair? from)) (if (and from (pair? from))
(list (make-hover-element (list (make-element
#f (intern-hover-style
(list e)
(intern-taglet
(string-append (string-append
"Provided from: " "Provided from: "
(let loop ([from from]) (let loop ([from from])
(if (null? (cdr from)) (if (null? (cdr from))
(format "~s" (car from)) (format "~s" (car from))
(format "~s, ~a" (car from) (loop (cdr from))))))))) (format "~s, ~a" (car from) (loop (cdr from)))))))
e))
(list e)))) (list e))))
(lambda () e) (lambda () e)
(lambda () e))) (lambda () e)))
@ -184,7 +193,7 @@
(if index? (if index?
(make-index-element (make-index-element
#f (list elem) tag #f (list elem) tag
(list (symbol->string (syntax-e id))) (list (read-intern-literal (symbol->string (syntax-e id))))
(list elem) (list elem)
(and show-libs? (and show-libs?
(with-exporting-libraries (with-exporting-libraries
@ -218,11 +227,13 @@
#f #f
(list (make-one (if form? 'form 'def)) (list (make-one (if form? 'form 'def))
(make-one 'dep) (make-one 'dep)
(let ([str (read-intern-literal (symbol->string id))])
(make-index-element #f (make-index-element #f
null null
(intern-taglet
(list (if form? 'form 'def) (list (if form? 'form 'def)
(list taglet id)) (list taglet id)))
(list (symbol->string id)) (list str)
(list (list
(make-element (make-element
symbol-color symbol-color
@ -231,10 +242,10 @@
(if form? (if form?
syntax-link-color syntax-link-color
value-link-color) value-link-color)
(list (symbol->string id)))))) (list str)))))
((if form? ((if form?
make-form-index-desc make-form-index-desc
make-procedure-index-desc) make-procedure-index-desc)
id id
(list mod-path)))))))) (list mod-path)))))))))
redirects)))) redirects))))

8
collects/scribble/private/manual-class.rkt
View File

@ -101,7 +101,7 @@
(if (hash-ref ht k #f) (if (hash-ref ht k #f)
#f #f
(begin (hash-set! ht k #t) (begin (hash-set! ht k #t)
(cons (symbol->string k) (cons (read-intern-literal (symbol->string k))
(**method k (car super)))))) (**method k (car super))))))
(cls/intf-methods (cdr super)))]) (cls/intf-methods (cdr super)))])
(if (null? inh) (if (null? inh)
@ -133,7 +133,8 @@
symbol-color symbol-color
(list (make-link-element (list (make-link-element
value-link-color value-link-color
(list (symbol->string (syntax-e (decl-name decl)))) (list (read-intern-literal
(symbol->string (syntax-e (decl-name decl)))))
tag))) tag)))
(map id-info (decl-app-mixins decl)) (map id-info (decl-app-mixins decl))
(and (decl-super decl) (and (decl-super decl)
@ -206,7 +207,8 @@
(list (list
(make-index-element (make-index-element
#f content tag #f content tag
(list (symbol->string (syntax-e stx-id))) (list (read-intern-literal
(symbol->string (syntax-e stx-id))))
content content
(with-exporting-libraries (with-exporting-libraries
(lambda (libs) (lambda (libs)

2
collects/scribble/private/manual-form.rkt
View File

@ -326,7 +326,7 @@
(if kw-id (if kw-id
(list (make-index-element (list (make-index-element
#f content tag #f content tag
(list (symbol->string (syntax-e kw-id))) (list (read-intern-literal (symbol->string (syntax-e kw-id))))
content content
(with-exporting-libraries (with-exporting-libraries
(lambda (libs) (lambda (libs)

7
collects/scribble/private/manual-mod.rkt
View File

@ -127,13 +127,14 @@
names names
modpaths)) modpaths))
(append (map (lambda (modpath) (append (map (lambda (modpath)
(make-part-tag-decl `(mod-path ,(element->string modpath)))) (make-part-tag-decl `(mod-path ,(read-intern-literal
(element->string modpath)))))
modpaths) modpaths)
(flow-paragraphs (decode-flow content))))))) (flow-paragraphs (decode-flow content)))))))
(define (make-defracketmodname mn mp) (define (make-defracketmodname mn mp)
(let ([name-str (element->string mn)] (let ([name-str (read-intern-literal (element->string mn))]
[path-str (element->string mp)]) [path-str (read-intern-literal (element->string mp))])
(make-index-element #f (make-index-element #f
(list mn) (list mn)
`(mod-path ,path-str) `(mod-path ,path-str)

10
collects/scribble/private/manual-proc.rkt
View File

@ -145,7 +145,7 @@
(if (eq? mode 'new) (if (eq? mode 'new)
(make-element (make-element
#f (list (racketparenfont "[") #f (list (racketparenfont "[")
(racketidfont (keyword->string (arg-kw arg))) (racketidfont (read-intern-literal (keyword->string (arg-kw arg))))
spacer spacer
(to-element (make-var-id (arg-id arg))) (to-element (make-var-id (arg-id arg)))
(racketparenfont "]"))) (racketparenfont "]")))
@ -267,7 +267,7 @@
#f #f
content content
tag tag
(list (symbol->string mname)) (list (read-intern-literal (symbol->string mname)))
content content
(with-exporting-libraries (with-exporting-libraries
(lambda (libs) (lambda (libs)
@ -289,7 +289,7 @@
#f #f
(list (make-index-element (list (make-index-element
#f content tag #f content tag
(list (symbol->string (extract-id prototype))) (list (read-intern-literal (symbol->string (extract-id prototype))))
content content
(with-exporting-libraries (with-exporting-libraries
(lambda (libs) (lambda (libs)
@ -899,7 +899,7 @@
#f #f
content content
tag tag
(list (symbol->string name)) (list (read-intern-literal (symbol->string name)))
content content
(with-exporting-libraries (with-exporting-libraries
(lambda (libs) (make-thing-index-desc name libs))))) (lambda (libs) (make-thing-index-desc name libs)))))
@ -942,7 +942,7 @@
(make-target-element* (make-target-element*
make-target-element make-target-element
stx-id stx-id
(let* ([name (string-append* (map symbol->string (cdar wrappers)))] (let* ([name (read-intern-literal (string-append* (map symbol->string (cdar wrappers))))]
[target-maker [target-maker
(id-to-target-maker (datum->syntax stx-id (string->symbol name)) (id-to-target-maker (datum->syntax stx-id (string->symbol name))
#t)]) #t)])

2
collects/scribble/private/manual-scheme.rkt
View File

@ -207,7 +207,7 @@
(define (*as-modname-link s e) (define (*as-modname-link s e)
(make-link-element module-link-color (make-link-element module-link-color
(list e) (list e)
`(mod-path ,(format "~s" s)))) `(mod-path ,(read-intern-literal (format "~s" s)))))
(define-syntax-rule (indexed-racket x) (define-syntax-rule (indexed-racket x)
(add-racket-index 'x (racket x))) (add-racket-index 'x (racket x)))

5
collects/scribble/private/manual-style.rkt
View File

@ -112,8 +112,9 @@
(define (indexed-file . str) (define (indexed-file . str)
(let* ([f (apply filepath str)] (let* ([f (apply filepath str)]
[s (element->string f)]) [s (element->string f)])
(index* (list (clean-up-index-string (index* (list (read-intern-literal
(substring s 1 (sub1 (string-length s))))) (clean-up-index-string
(substring s 1 (sub1 (string-length s))))))
(list f) (list f)
f))) f)))
(define (exec . str) (define (exec . str)

6
collects/scribble/private/manual-tech.rkt
View File

@ -21,7 +21,8 @@
[s (string-foldcase (or key (content->string c)))] [s (string-foldcase (or key (content->string c)))]
[s (regexp-replace #rx"ies$" s "y")] [s (regexp-replace #rx"ies$" s "y")]
[s (regexp-replace #rx"s$" s "")] [s (regexp-replace #rx"s$" s "")]
[s (regexp-replace* #px"[-\\s]+" s " ")]) [s (regexp-replace* #px"[-\\s]+" s " ")]
[s (read-intern-literal s)])
(make-elem style c (list 'tech (doc-prefix doc prefix s))))) (make-elem style c (list 'tech (doc-prefix doc prefix s)))))
(define (deftech #:style? [style? #t] . s) (define (deftech #:style? [style? #t] . s)
@ -32,7 +33,8 @@
(make-index-element #f (make-index-element #f
(list t) (list t)
(target-element-tag t) (target-element-tag t)
(list (clean-up-index-string (element->string e))) (list (read-intern-literal
(clean-up-index-string (element->string e))))
(list e) (list e)
'tech))) 'tech)))

24
collects/scribble/racket.rkt
View File

@ -149,18 +149,19 @@
(lambda (renderer sec ri) (lambda (renderer sec ri)
(let* ([tag (find-racket-tag sec ri c #f)]) (let* ([tag (find-racket-tag sec ri c #f)])
(if tag (if tag
(let ([tag (intern-taglet tag)])
(list (list
(case (car tag) (case (car tag)
[(form) [(form)
(make-link-element syntax-link-color (nonbreak-leading-hyphens s) tag)] (make-link-element syntax-link-color (nonbreak-leading-hyphens s) tag)]
[else [else
(make-link-element value-link-color (nonbreak-leading-hyphens s) tag)])) (make-link-element value-link-color (nonbreak-leading-hyphens s) tag)])))
(list (list
(make-element "badlink" (make-element "badlink"
(make-element value-link-color s)))))) (make-element value-link-color s))))))
(lambda () s) (lambda () s)
(lambda () s) (lambda () s)
key)]) (intern-taglet key))])
(when key (when key
(hash-set! id-element-cache key (make-weak-box e))) (hash-set! id-element-cache key (make-weak-box e)))
e)))) e))))
@ -194,10 +195,15 @@
(inc!) (inc!)
(to-unquoted expr? (sub1 quote-depth) out color? inc!)))) (to-unquoted expr? (sub1 quote-depth) out color? inc!))))
(define iformat
(case-lambda
[(str val) (read-intern-literal (format str val))]
[(str . vals) (read-intern-literal (apply format str vals))]))
(define (typeset-atom c out color? quote-depth expr?) (define (typeset-atom c out color? quote-depth expr?)
(if (and (var-id? (syntax-e c)) (if (and (var-id? (syntax-e c))
(zero? quote-depth)) (zero? quote-depth))
(out (format "~s" (let ([v (var-id-sym (syntax-e c))]) (out (iformat "~s" (let ([v (var-id-sym (syntax-e c))])
(if (syntax? v) (if (syntax? v)
(syntax-e v) (syntax-e v)
v))) v)))
@ -208,8 +214,8 @@
(let ([sc (syntax-e c)]) (let ([sc (syntax-e c)])
(let ([s (cond (let ([s (cond
[(syntax-property c 'display-string) => values] [(syntax-property c 'display-string) => values]
[(literal-syntax? sc) (format "~s" (literal-syntax-stx sc))] [(literal-syntax? sc) (iformat "~s" (literal-syntax-stx sc))]
[(var-id? sc) (format "~s" (var-id-sym sc))] [(var-id? sc) (iformat "~s" (var-id-sym sc))]
[(eq? sc #t) [(eq? sc #t)
(if (equal? (syntax-span c) 5) (if (equal? (syntax-span c) 5)
"#true" "#true"
@ -218,7 +224,7 @@
(if (equal? (syntax-span c) 6) (if (equal? (syntax-span c) 6)
"#false" "#false"
"#f")] "#f")]
[else (format "~s" sc)])]) [else (iformat "~s" sc)])])
(if (and (symbol? sc) (if (and (symbol? sc)
((string-length s) . > . 1) ((string-length s) . > . 1)
(char=? (string-ref s 0) #\_) (char=? (string-ref s 0) #\_)
@ -564,7 +570,7 @@
"cons"))] "cons"))]
[(vector? (syntax-e c)) "vector"] [(vector? (syntax-e c)) "vector"]
[(mpair? (syntax-e c)) "mcons"] [(mpair? (syntax-e c)) "mcons"]
[else (format "~a" [else (iformat "~a"
(if (struct-proxy? (syntax-e c)) (if (struct-proxy? (syntax-e c))
(syntax-e (struct-proxy-name (syntax-e c))) (syntax-e (struct-proxy-name (syntax-e c)))
(object-name (syntax-e c))))])]) (object-name (syntax-e c))))])])
@ -785,7 +791,7 @@
(set! src-col (+ orig-col (syntax-span c)))))] (set! src-col (+ orig-col (syntax-span c)))))]
[(graph-reference? (syntax-e c)) [(graph-reference? (syntax-e c))
(advance c init-line!) (advance c init-line!)
(out (format "#~a#" (unbox (graph-reference-bx (syntax-e c)))) (out (iformat "#~a#" (unbox (graph-reference-bx (syntax-e c))))
(if (positive? quote-depth) (if (positive? quote-depth)
value-color value-color
paren-color)) paren-color))
@ -793,7 +799,7 @@
[(graph-defn? (syntax-e c)) [(graph-defn? (syntax-e c))
(advance c init-line!) (advance c init-line!)
(let ([bx (graph-defn-bx (syntax-e c))]) (let ([bx (graph-defn-bx (syntax-e c))])
(out (format "#~a=" (unbox bx)) (out (iformat "#~a=" (unbox bx))
(if (positive? quote-depth) (if (positive? quote-depth)
value-color value-color
paren-color)) paren-color))