From ad20e502942aa0b8b7f23c564a9e9ff40b25fe43 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 14 Feb 2020 19:20:37 -0800 Subject: [PATCH] next: vectorize, repeat --- quad/quadwriter/param.rkt | 5 -- quad/quadwriter/query.rkt | 54 +++++++++-------- quad/quadwriter/render.rkt | 115 +++++++++++++++++++------------------ 3 files changed, 89 insertions(+), 85 deletions(-) diff --git a/quad/quadwriter/param.rkt b/quad/quadwriter/param.rkt index 9c572f4d..c90e5fb1 100644 --- a/quad/quadwriter/param.rkt +++ b/quad/quadwriter/param.rkt @@ -1,11 +1,6 @@ #lang debug racket (provide (all-defined-out)) (define current-doc (make-parameter #false)) -(define current-section (make-parameter #false)) -(define current-page (make-parameter #false)) -(define current-column (make-parameter #false)) -(define current-block (make-parameter #false)) -(define current-line (make-parameter #false)) (define current-pdf (make-parameter #false)) (define current-line-wrap (make-parameter #f)) ; because kp is slow and maybe we want to disable for "draft" mode diff --git a/quad/quadwriter/query.rkt b/quad/quadwriter/query.rkt index 4e6628cc..0e118fcc 100644 --- a/quad/quadwriter/query.rkt +++ b/quad/quadwriter/query.rkt @@ -2,10 +2,16 @@ (require quad/base "struct.rkt" "param.rkt") (provide (all-defined-out)) -(define (make-linear-index q) - (cons q (append* (for/list ([elem (in-list (quad-elems q))] - #:when (quad? elem)) - (make-linear-index elem))))) +;; we want to construct a query index once with reversed variant +;; so we don't have to keep generating it +(struct query-index (forward reverse) #:transparent) + +(define (make-query-index q) + (define qs (let loop ([q q]) + (cons q (append* (for/list ([elem (in-list (quad-elems q))] + #:when (quad? elem)) + (loop elem)))))) + (query-index qs (reverse qs))) (define (string->key str #:this [this? #false]) (match str @@ -23,36 +29,34 @@ 'block block-quad? 'line line-quad?)) -(define quad-params (hasheq 'doc current-doc - 'section current-section - 'page current-page - 'column current-column - 'block current-block - 'line current-line)) - (define (parse-query str) (for/list ([piece (in-list (string-split str ":"))]) (match (regexp-match #px"^(.*)\\[(.*?)\\]$" piece) [#false (cons (string->key piece) #false)] - [(list _ name "this") (cons (let ([quad-param-val ((hash-ref quad-params (string->key name)))]) - (λ (q) (eq? q quad-param-val))) 1)] [(list _ name arg) (cons (hash-ref preds (string->key name)) (or (string->number arg) (string->symbol arg)))]))) -(define (query quad-or-index query-str) - (for/fold ([qs (match quad-or-index - [(? quad? q) (make-linear-index q)] - [idx idx])] +(define (query quad-or-index query-str [querying-q #false]) + (define qi (match quad-or-index + [(? quad? q) (make-query-index q)] + [idx idx])) + (for/fold ([qs (query-index-forward qi)] #:result (and qs (car qs))) ([query-piece (in-list (parse-query query-str))]) - (match-define (cons pred count) query-piece) - (let loop ([qs qs][seen 0]) - (define maybe-tail (memf pred qs)) - (and maybe-tail - (let ([seen (add1 seen)]) - (cond - [(= seen count) maybe-tail] - [else (loop (cdr maybe-tail) seen)])))))) + (match query-piece + [(cons pred 'this) + ;; resolve `this` by finding the querying quad, and searching backward + (define this-thing (findf pred (memq querying-q (query-index-reverse qi)))) + ;; once we have this-thing, locate it in the forward index and keep going + (memq this-thing (query-index-forward qi))] + [(cons pred count) + (let loop ([qs qs][seen 0]) + (define maybe-tail (memf pred qs)) + (and maybe-tail + (let ([seen (add1 seen)]) + (cond + [(= seen count) maybe-tail] + [else (loop (cdr maybe-tail) seen)]))))]))) (module+ test (require rackunit) diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index 11dc0f01..aa79de59 100644 --- a/quad/quadwriter/render.rkt +++ b/quad/quadwriter/render.rkt @@ -58,7 +58,7 @@ #:min-left-length 3 #:min-right-length 3))] [substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))]) - (struct-copy quad q [elems (list substr)]))] + (struct-copy quad q [elems (list substr)]))] [else (list q)])) @@ -67,12 +67,12 @@ (unless (even? (length pcs)) (raise-argument-error 'string->feature-list "even number of tags and values" pcs)) (for/list ([kv (in-slice 2 pcs)]) - (cons (match (first kv) - [(? string? k) (string->bytes/utf-8 k)] - [k (raise-argument-error 'string->feature-list "string" k)]) - (match (string->number (second kv)) - [(? number? num) num] - [v (raise-argument-error 'string->feature-list "number string" v)])))) + (cons (match (first kv) + [(? string? k) (string->bytes/utf-8 k)] + [k (raise-argument-error 'string->feature-list "string" k)]) + (match (string->number (second kv)) + [(? number? num) num] + [v (raise-argument-error 'string->feature-list "number string" v)])))) (define (parse-font-features! attrs) ;; `font-features` are OpenType font feature specifiers. @@ -107,7 +107,7 @@ ;; we parse them into the equivalent measurement in points. (for ([k (in-hash-keys attrs)] #:when (takes-dimension-string? k)) - (hash-update! attrs k (λ (val) (parse-dimension val attrs)))) + (hash-update! attrs k (λ (val) (parse-dimension val attrs)))) attrs) (define (downcase-values! attrs) @@ -115,9 +115,9 @@ ;; so we can check them more easily later. (for ([k (in-hash-keys attrs)] #:unless (has-case-sensitive-value? k)) - (hash-update! attrs k (λ (val) (match val - [(? string? str) (string-downcase str)] - [_ val])))) + (hash-update! attrs k (λ (val) (match val + [(? string? str) (string-downcase str)] + [_ val])))) attrs) (define (complete-every-path! attrs) @@ -126,7 +126,7 @@ ;; relies on `current-directory` being parameterized to source file's dir (for ([k (in-hash-keys attrs)] #:when (takes-path? k)) - (hash-update! attrs k (compose1 path->string path->complete-path))) + (hash-update! attrs k (compose1 path->string path->complete-path))) attrs) (define (handle-cascading-attrs attrs) @@ -139,7 +139,7 @@ ;; because they can be denoted relative to em size parse-dimension-strings! parse-font-features!))]) - (proc attrs))) + (proc attrs))) (define (drop-leading-breaks qs) ;; any leading breaks are pointless at the start of the doc, so drop them. @@ -164,7 +164,7 @@ (define (get-define-val q) (quad-ref q 'define)) (define-values (dqs not-dqs) (partition get-define-val qs)) (for ([dq-group (in-list (group-by get-define-val dqs))]) - (hash-set! (current-named-quads) (get-define-val (car dq-group)) dq-group)) + (hash-set! (current-named-quads) (get-define-val (car dq-group)) dq-group)) not-dqs) (define default-line-height-multiplier 1.42) @@ -257,9 +257,9 @@ (cons :pdf-keywords 'Keywords)))] [str (in-value (and (pair? qs) (quad-ref (car qs) k)))] #:when str) - (cons pdf-k str)))) + (cons pdf-k str)))) (for ([(k v) (in-dict kv-dict)]) - (hash-set! (pdf-info pdf) k v))) + (hash-set! (pdf-info pdf) k v))) (define (footnote-flow? q) (equal? (quad-ref q 'flow) "footnote")) @@ -293,19 +293,19 @@ (for ([page (in-list (for*/list ([sec (in-list secs)] [elem (in-list (quad-elems sec))] #:when (page-quad? elem)) - elem))] + elem))] [page-num (in-naturals 1)] [page-side (in-cycle '(right left))]) - (define repeaters-for-this-page - (for/list ([repeater (in-list repeaters)] - #:when (let* ([val (quad-ref repeater :page-repeat)] - [sym (string->symbol val)]) - (or (eq? sym 'all) - (eq? sym page-side) - (eq? sym (if (= page-num 1) 'first 'rest))))) - repeater)) - (when (pair? repeaters-for-this-page) - (set-quad-elems! page (append repeaters-for-this-page (quad-elems page))))) + (define repeaters-for-this-page + (for/list ([repeater (in-list repeaters)] + #:when (let* ([val (quad-ref repeater :page-repeat)] + [sym (string->symbol val)]) + (or (eq? sym 'all) + (eq? sym page-side) + (eq? sym (if (= page-num 1) 'first 'rest))))) + repeater)) + (when (pair? repeaters-for-this-page) + (set-quad-elems! page (append repeaters-for-this-page (quad-elems page))))) secs) (define (make-sections all-qs) @@ -356,20 +356,20 @@ (for/list ([page (in-list section-pages-without-repeaters)] [page-num (in-naturals 1)] [page-side (in-cycle ((if (eq? section-starting-side 'right) values reverse) '(right left)))]) - (define section-repeaters-for-this-page - (for/list ([repeater (in-list section-repeaters)] - #:when (let* ([val (quad-ref repeater :page-repeat)] - [sym (string->symbol (string-trim val #px"section\\s"))]) - (or (eq? sym 'section) - (eq? sym 'all) - (eq? sym page-side) - (eq? sym (if (= page-num 1) 'first 'rest))))) - repeater)) - (cond - [(null? section-repeaters-for-this-page) page] - [else - (quad-copy page-quad page - [elems (append section-repeaters-for-this-page (quad-elems page))])]))) + (define section-repeaters-for-this-page + (for/list ([repeater (in-list section-repeaters)] + #:when (let* ([val (quad-ref repeater :page-repeat)] + [sym (string->symbol (string-trim val #px"section\\s"))]) + (or (eq? sym 'section) + (eq? sym 'all) + (eq? sym page-side) + (eq? sym (if (= page-num 1) 'first 'rest))))) + repeater)) + (cond + [(null? section-repeaters-for-this-page) page] + [else + (quad-copy page-quad page + [elems (append section-repeaters-for-this-page (quad-elems page))])]))) (begin0 (cond @@ -401,8 +401,12 @@ (cons new-section sections-acc)]) (section-pages-used (+ (section-pages-used) (length section-pages)))))) +(define (wants-parent? x) (and (quad? x) (quad-ref x :anchor-parent))) (define (resolve-parents doc) - (define (wants-parent? x) (and (quad? x) (quad-ref x :anchor-parent))) + ;; we make our index now so that it includes the quads that want parents + ;; so if we come across `this` as a subscript, we can resolve it + ;; by reference to the parent-wanting quad + (define qi (make-query-index doc)) ;; extract the quads that want parents (define parent-wanter-acc null) (let loop ([x doc]) @@ -415,13 +419,14 @@ (map loop others)] [_ x])) ;; then put them where they want to go - (define linearized-qs (make-linear-index doc)) + ;; if the query has no result, then the quad doesn't get replaced (ie. disappears) + ;; which seems like the right outcome. (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))] + [parent (in-value (query qi query-str wp))] #:when parent) - (quad-update! parent [elems (append (quad-elems parent) (list wp))])) + (quad-update! parent [elems (append (quad-elems parent) (list wp))])) doc) (define (correct-line-alignment doc) @@ -431,16 +436,16 @@ (for* ([section (in-list (quad-elems doc))] [(page page-idx) (in-indexed (quad-elems section))] #:when (page-quad? page)) - (define right-side? (odd? (add1 page-idx))) - (define zero-filler-side (if right-side? "inner" "outer")) - (let loop ([x page]) - (cond - [(and (line-quad? x) - (equal? zero-filler-side (quad-ref x :line-align)) - (filler-quad? (car (quad-elems x)))) - ;; collapse the filler quad by setting size to 0 - (set-quad-size! (car (quad-elems x)) (pt 0 0))] - [(quad? x) (for-each loop (quad-elems x))]))) + (define right-side? (odd? (add1 page-idx))) + (define zero-filler-side (if right-side? "inner" "outer")) + (let loop ([x page]) + (cond + [(and (line-quad? x) + (equal? zero-filler-side (quad-ref x :line-align)) + (filler-quad? (car (quad-elems x)))) + ;; collapse the filler quad by setting size to 0 + (set-quad-size! (car (quad-elems x)) (pt 0 0))] + [(quad? x) (for-each loop (quad-elems x))]))) doc) (define/contract (render-pdf qx-arg