speed up doc build a little; fix bugs related to getting continuation marks from a thread and using the errortrace profiler

svn: r12237

original commit: 37aae202c56968d53901b4398a90e096bbe8c754

collects/scribble/base-render.ss

@@ -383,6 +383,7 @@
 
     (define/public (render-element i part ri)
       (cond
+        [(string? i) (render-other i part ri)] ; short-cut for common case
         [(and (link-element? i)
               (null? (element-content i)))
          (let ([v (resolve-get part ri (link-element-tag i))])

collects/scribble/basic.ss

@@ -127,11 +127,11 @@
                 v)))
         v)))
 
-(define (module-path-index->taglet mod)
+(define (do-module-path-index->taglet mod)
   ;; Derive the name from the module path:
   (let ([p (collapse-module-path-index
             mod
-            (build-path (current-directory) "dummy"))])
+            (lambda () (build-path (current-directory) "dummy")))])
     (if (path? p)
         ;; If we got a path back anyway, then it's best to use the resolved
         ;; name; if the current directory has changed since we 
@@ -160,6 +160,13 @@
                      p)])
           (intern-taglet p)))))
 
+(define collapsed (make-weak-hasheq))
+(define (module-path-index->taglet mod)
+  (or (hash-ref collapsed mod #f)
+      (let ([v (do-module-path-index->taglet mod)])
+        (hash-set! collapsed mod v)
+        v)))
+
 (define (module-path-prefix->string p)
   (format "~a" (module-path-index->taglet (module-path-index-join p #f))))
 

collects/scribble/html-render.ss

@@ -91,18 +91,16 @@
 (define (anchor-name v)
   (define (encode-byte b)
     (string-append (if (< b 16) "~0" "~") (number->string b 16)))
-  (define (encode-str str)
+  (define (encode-bytes str)
-    (if (regexp-match? #px"[^[:ascii:]]" str)
+    (string->bytes/utf-8 (encode-byte (bytes-ref str 0))))
-      (string-append* (map encode-byte (bytes->list (string->bytes/utf-8 str))))
-      (encode-byte (char->integer (string-ref str 0)))))
   (if (literal-anchor? v)
     (literal-anchor-string v)
-    (let* ([v (format "~a" v)]
+    (let* ([v (string->bytes/utf-8 (format "~a" v))]
-           [v (regexp-replace* #rx"[A-Z.]" v ".&")]
+           [v (regexp-replace* #rx#"[A-Z.]" v #".&")]
-           [v (regexp-replace* #rx" " v "._")]
+           [v (regexp-replace* #rx#" " v #"._")]
-           [v (regexp-replace* #rx"\"" v ".'")]
+           [v (regexp-replace* #rx#"\"" v #".'")]
-           [v (regexp-replace* #rx"[^-a-zA-Z0-9_!+*'()/.,]" v encode-str)])
+           [v (regexp-replace* #rx#"[^-a-zA-Z0-9_!+*'()/.,]" v encode-bytes)])
-      v)))
+      (bytes->string/utf-8 v))))
 
 (define-serializable-struct literal-anchor (string))
 
@@ -826,6 +824,7 @@
 
     (define/override (render-element e part ri)
       (cond
+        [(string? e) (super render-element e part ri)] ; short-cut for common case
         [(hover-element? e)
          `((span ([title ,(hover-element-text e)])
              ,@(render-plain-element e part ri)))]
@@ -1270,9 +1269,16 @@
                           (loop (cdr path) (cdr root))))))
              roots))))
 
+(define exploded (make-weak-hash))
+(define (explode/cache p)
+  (or (hash-ref exploded p #f)
+      (let ([v (explode p)])
+        (hash-set! exploded p v)
+        v)))
+
 (define (from-root p d)
-  (define e-p (explode (path->complete-path p (current-directory))))
+  (define e-p (explode/cache (path->complete-path p (current-directory))))
-  (define e-d (and d (explode (path->complete-path d (current-directory)))))
+  (define e-d (and d (explode/cache (path->complete-path d (current-directory)))))
   (define p-in? (in-plt? e-p))
   (define d-in? (and d (in-plt? e-d)))
   ;; use an absolute link if the link is from outside the plt tree
@@ -1287,12 +1293,13 @@
     (let loop ([e-d e-d] [e-p e-p])
       (cond
         [(null? e-d)
+         (string-append*
           (let loop ([e-p e-p])
-           (cond [(null? e-p) "/"]
+            (cond [(null? e-p) '("/")]
-                 [(null? (cdr e-p)) (car e-p)]
+                  [(null? (cdr e-p)) (list (car e-p))]
                   [(eq? 'same (car e-p)) (loop (cdr e-p))]
-                 [(eq? 'up (car e-p)) (string-append "../" (loop (cdr e-p)))]
+                  [(eq? 'up (car e-p)) (cons "../" (loop (cdr e-p)))]
-                 [else (string-append (car e-p) "/" (loop (cdr e-p)))]))]
+                  [else (cons (car e-p) (cons "/" (loop (cdr e-p))))])))]
         [(equal? (car e-d) (car e-p)) (loop (cdr e-d) (cdr e-p))]
         [(eq? 'same (car e-d)) (loop (cdr e-d) e-p)]
         [(eq? 'same (car e-p)) (loop e-d (cdr e-p))]

collects/scribble/private/manual-proc.ss

@@ -295,8 +295,9 @@
               (*sig-elem (sig-id sig) (extract-id prototype))
               (to-element (make-just-context (extract-id prototype)
                                              stx-id)))))]))
+    (define p-depth (prototype-depth prototype))
     (define flat-size (+ (prototype-size args + + #f)
-                         (prototype-depth prototype)
+                         p-depth
                          (element-width tagged)))
     (define short? (or (flat-size . < . 40) ((length args) . < . 2)))
     (define res
@@ -319,7 +320,7 @@
                                   (loop (cdr res))))))))))
           res)))
     (define tagged+arg-width (+ (prototype-size args max max #t)
-                                (prototype-depth prototype)
+                                p-depth
                                 (element-width tagged)))
     (define result-next-line?
       ((+ (if short? flat-size tagged+arg-width) (block-width res))
@@ -339,10 +340,10 @@
              (to-flow
               (make-element
                #f
-               `(,(make-openers (add1 (prototype-depth prototype)))
+               `(,(make-openers (add1 p-depth))
                  ,tagged
                  ,@(if (null? args)
-                     (list (make-closers (prototype-depth prototype)))
+                     (list (make-closers p-depth))
                      (append-map (lambda (arg)
                                    (list spacer ((arg->elem #t) arg)))
                                  args))
@@ -363,7 +364,7 @@
                  (make-element
                   #f
                   (list
-                   (make-openers (add1 (prototype-depth prototype)))
+                   (make-openers (add1 p-depth))
                    tagged)))
                 (if one-ok?
                   (list*