From 31c6e16944ec22dc311ca22d6681d9657d952c65 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Mon, 25 Jun 2012 13:37:05 -0400
Subject: [PATCH] Correcting content->string so that it does not concatenate
 strings in quadratic time

original commit: d926f89cbe316f9c5e481841a80f905a9da3228c
---
 collects/scribble/core.rkt | 76 +++++++++++++++++++++++---------------
 1 file changed, 46 insertions(+), 30 deletions(-)

diff --git a/collects/scribble/core.rkt b/collects/scribble/core.rkt
index 9ef225ce..45e227fc 100644
--- a/collects/scribble/core.rkt
+++ b/collects/scribble/core.rkt
@@ -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)