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

Correcting content->string so that it does not concatenate strings in quadratic time

Browse Source 
original commit: d926f89cbe316f9c5e481841a80f905a9da3228c
This commit is contained in:
Danny Yoo 2012-06-25 13:37:05 -04:00 committed by Matthew Flatt
parent db64a47dd7
commit 31c6e16944
1 changed files with 46 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
collects/scribble/core.rkt
View File

@ -539,46 +539,62 @@
(provide content->string
strip-aux)
(define content->string
;; content->port: output-port content -> void
;; Writes the string content of content into op.
(define content->port
(case-lambda
[(c)
[(op c)
(cond
[(element? c) (content->string (element-content c))]
[(multiarg-element? c) (content->string (multiarg-element-contents c))]
[(list? c) (apply string-append (map content->string c))]
[(part-relative-element? c) (content->string ((part-relative-element-plain c)))]
[(delayed-element? c) (content->string ((delayed-element-plain c)))]
[(string? c) c]
[else (case c
[(mdash) "---"]
[(ndash) "--"]
[(ldquo rdquo) "\""]
[(rsquo) "'"]
[(rarr) "->"]
[(lang) "<"]
[(rang) ">"]
[else (format "~s" c)])])]
[(c renderer sec ri)
[(element? c) (content->port op (element-content c))]
[(multiarg-element? c) (content->port op (multiarg-element-contents c))]
[(list? c) (for-each (lambda (e) (content->port op e)) c)]
[(part-relative-element? c) (content->port op ((part-relative-element-plain c)))]
[(delayed-element? c) (content->port op ((delayed-element-plain c)))]
[(string? c) (display c op)]
[else (display (case c
[(mdash) "---"]
[(ndash) "--"]
[(ldquo rdquo) "\""]
[(rsquo) "'"]
[(rarr) "->"]
[(lang) "<"]
[(rang) ">"]
[else (format "~s" c)])
op)])]
[(op c renderer sec ri)
(cond
[(and (link-element? c)
(null? (element-content c)))
(let ([dest (resolve-get sec ri (link-element-tag c))])
;; FIXME: this is specific to renderer
(if dest
(content->string (strip-aux
(if (pair? dest) (cadr dest) (vector-ref dest 1)))
renderer sec ri)
"???"))]
[(element? c) (content->string (element-content c) renderer sec ri)]
[(multiarg-element? c) (content->string (multiarg-element-contents c) renderer sec ri)]
[(list? c) (apply string-append
(map(lambda (e) (content->string e renderer sec ri))
c))]
(content->port op
(strip-aux
(if (pair? dest) (cadr dest) (vector-ref dest 1)))
renderer sec ri)
(display "???" op)))]
[(element? c) (content->port op (element-content c) renderer sec ri)]
[(multiarg-element? c) (content->port op (multiarg-element-contents c) renderer sec ri)]
[(list? c) (for-each (lambda (e)
(content->port op e renderer sec ri))
c)]
[(delayed-element? c)
(content->string (delayed-element-content c ri) renderer sec ri)]
(content->port op (delayed-element-content c ri) renderer sec ri)]
[(part-relative-element? c)
(content->string (part-relative-element-content c ri) renderer sec ri)]
[else (content->string c)])]))
(content->port op (part-relative-element-content c ri) renderer sec ri)]
[else (content->port op c)])]))
(define content->string
(case-lambda
[(c)
(define op (open-output-string))
(content->port op c)
(get-output-string op)]
[(c renderer sec ri)
(define op (open-output-string))
(content->port op c renderer sec ri)
(get-output-string op)]))
(define (aux-element? e)
(and (element? e)