it lives

quad/quadwriter/query.rkt

@@ -3,9 +3,9 @@
 (provide (all-defined-out))
 
 (define (make-linear-index q)
-  (if (quad? q)
-      (cons q (append-map make-linear-index (quad-elems q)))
-      null))
+  (cons q (append* (for/list ([elem (in-list (quad-elems q))]
+                                   #:when (quad? elem))
+                          (make-linear-index elem)))))
 
 (define (string->pred str)
   (match str
@@ -23,8 +23,10 @@
       [(list all name arg) (cons (string->pred name) (or (string->number arg)
                                                          (string->symbol arg)))])))
 
-(define (query qs query-str)
-  (for/fold ([qs qs]
+(define (query quad-or-index query-str)
+  (for/fold ([qs (match quad-or-index
+                   [(? quad? q) (make-linear-index q)]
+                   [idx idx])]
              #:result (and qs (car qs)))
             ([query-piece (in-list (parse-query query-str))])
     (match-define (cons pred count) query-piece)

quad/quadwriter/render.rkt

@@ -402,13 +402,24 @@
       (section-pages-used (+ (section-pages-used) (length section-pages))))))
 
 (define (resolve-parents doc)
+  (define (wants-parent? x) (and (quad? x) (quad-ref x :anchor-parent)))
+  (define parent-wanter-acc null)
+  (let loop ([x doc])
+    (match x
+      [(? quad?) (define-values (parent-wanters others)
+                   (partition wants-parent? (quad-elems x)))
+                 (when (pair? parent-wanters)
+                   (set! parent-wanter-acc (append parent-wanter-acc parent-wanters))
+                   (quad-update! x [elems others]))
+                 (map loop others)]
+      [_ x]))
   (define linearized-qs (make-linear-index doc))
-  (for* ([q (in-list linearized-qs)]
-         [query-str (in-value (quad-ref q :anchor-parent))]
+  (for* ([wp (in-list parent-wanter-acc)]
+         [query-str (in-value (quad-ref wp :anchor-parent))]
          #:when query-str
          [parent (in-value (query linearized-qs query-str))]
          #:when parent)
-        (quad-update! parent [elems (append (quad-elems parent) (list q))]))
+    (quad-update! parent [elems (append (quad-elems parent) (list wp))]))
   doc)
 
 (define (correct-line-alignment doc)
@@ -485,10 +496,10 @@
     (setup-pdf-metadata! qs (current-pdf))
     ;; all the heavy lifting happens inside `make-sections`
     ;; which calls out to `make-pages`, `make-columns`, and so on.
-    (define doc (let* ([doc (quad-update! q:doc [elems (make-sections qs)])]
-                       [doc (correct-line-alignment doc)]
+    (define doc (let ([doc (quad-update! q:doc [elems (make-sections qs)])])
+                  (time-log prep-doc (let* ([doc (correct-line-alignment doc)]
                                             [doc (resolve-parents doc)])
-                  doc))
+                                       doc))))
     ;; call `position` and `draw` separately so we can print a timer for each
     (define positioned-doc (time-log position (position doc)))
     ;; drawing implies that a PDF is written to disk