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

58
collects/scribble/core.rkt
View File

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