From 4b7dcc27540ec3e1293e4012b4766e3723c899ad Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 16 May 2015 18:58:17 -0700 Subject: [PATCH] suspend contracts --- quad/main.rkt | 12 ++++++------ quad/quads.rkt | 12 ++++++------ quad/render.rkt | 4 ++-- quad/utils.rkt | 32 ++++++++++++++++---------------- quad/wrap.rkt | 32 ++++++++++++++++---------------- 5 files changed, 46 insertions(+), 46 deletions(-) diff --git a/quad/main.rkt b/quad/main.rkt index 9b150032..50768d0a 100644 --- a/quad/main.rkt +++ b/quad/main.rkt @@ -74,12 +74,12 @@ (quad-attr-set* line 'line-idx line-idx 'lines (length wrapped-lines))))) -(define+provide/contract (number-pages ps) +(define+provide (number-pages ps) (pages? . -> . pages?) (for/list ([i (in-naturals)][p (in-list ps)]) (quad (quad-name p) (merge-attrs (quad-attrs p) `(page ,i)) (quad-list p)))) -(define+provide/contract (pages->doc ps) +(define+provide (pages->doc ps) (pages? . -> . doc?) ;; todo: resolve xrefs and other last-minute tasks ;; todo: generalize computation of widths and heights, recursively @@ -90,7 +90,7 @@ doc) (require racket/class csp) -(define+provide/contract (lines->columns lines) +(define+provide (lines->columns lines) (lines? . -> . columns?) (define prob (new problem%)) (define max-column-lines world:default-lines-per-column) @@ -159,7 +159,7 @@ (values (cons (quad-attr-set (quads->column lines-to-take) world:column-index-key col-idx) columns) lines-to-leave))) (reverse columns)) -(define/contract (columns->pages cols) +(define (columns->pages cols) (columns? . -> . pages?) (define columns-per-page (quad-attr-ref/parameter (car cols) world:column-count-key)) (define column-gutter (quad-attr-ref/parameter (car cols) world:column-gutter-key)) @@ -186,7 +186,7 @@ (define (block-quads->lines qs) (block->lines (quads->block qs))) -(define/contract (typeset x) +(define (typeset x) (coerce/input? . -> . doc?) (load-text-cache-file) (define pages (append* (for/list ([multipage (in-list (input->nested-blocks x))]) @@ -205,6 +205,6 @@ (parameterize ([world:quality-default world:draft-quality] [world:paper-width-default 600] [world:paper-height-default 700]) - (define sample (ti5)) + (define sample (jude0)) (define to (begin (time (typeset sample)))) (time (send (new pdf-renderer%) render-to-file to "foo.pdf")))) diff --git a/quad/quads.rkt b/quad/quads.rkt index a4c33b10..6eb06564 100644 --- a/quad/quads.rkt +++ b/quad/quads.rkt @@ -104,7 +104,7 @@ (define-syntax-rule (quad-ref q r) (list-ref (quad-list q) r)) -(define/contract (quad-ends-with? q str) +(define (quad-ends-with? q str) (quad? string? . -> . boolean?) (cond [(not (empty? (quad-list q))) @@ -115,11 +115,11 @@ [else #f])) -(define/contract (quad-append q new-item) +(define (quad-append q new-item) (quad? (or/c quad? string?) . -> . quad?) (quad (quad-name q) (quad-attrs q) (append (quad-list q) (list new-item)))) -(define/contract (quad->string x) +(define (quad->string x) (quad? . -> . string?) (cond [(quad? x) (string-append* (map quad->string (quad-list x)))] @@ -167,7 +167,7 @@ ;; put contract here rather than on struct, because this is the main interface ;; and this contract is more liberal. ;; but don't put a separate contract on struct, because it's superfluous. - (define/contract (id [attrs empty] . xs) + (define (id [attrs empty] . xs) (() ((or/c quad-attrs? hashable-list?)) #:rest quad-list? . ->* . id?) (quad 'id (and attrs (if (hash? attrs) attrs (apply hash attrs))) xs)) ;; quad list predicate and list-of-list predicate. @@ -183,7 +183,7 @@ ;; do not treat empty string as whitespace. ;; throws off tests that rely on adjacency to positive whitespace. -(define/contract (whitespace? x [nbsp? #f]) +(define (whitespace? x [nbsp? #f]) ((any/c)(boolean?) . ->* . coerce/boolean?) (cond [(quad? x) (whitespace? (quad-list x) nbsp?)] @@ -210,7 +210,7 @@ (define-box-type id-break) (define-box-type multi-id) ;; breaker - (define/contract (split-on-id-breaks x) + (define (split-on-id-breaks x) (quads? . -> . lists-of-quads?) ;; omit leading & trailing whitespace, because they're superfluous next to a break (map (curryr trimf whitespace?) (filter-split x id-break?)))))])) diff --git a/quad/render.rkt b/quad/render.rkt index b2dc2c36..f5d62000 100644 --- a/quad/render.rkt +++ b/quad/render.rkt @@ -3,8 +3,8 @@ (require "utils.rkt" "quads.rkt" "world.rkt") (provide (all-defined-out)) -(define/contract abstract-renderer% - (class/c [render (quad? . ->m . any/c)] +(define abstract-renderer% + #;(class/c [render (quad? . ->m . any/c)] [render-element (quad? . ->m . quad?)]) (class object% diff --git a/quad/utils.rkt b/quad/utils.rkt index 016eb97a..ac7daab5 100644 --- a/quad/utils.rkt +++ b/quad/utils.rkt @@ -13,7 +13,7 @@ ;; push together multiple attr sources into one list of pairs. ;; mostly a helper function for the two attr functions below. -(define+provide/contract (join-attrs quads-or-attrs-or-lists) +(define+provide (join-attrs quads-or-attrs-or-lists) (list-of-mergeable-attrs? . -> . pairs?) (append-map hash->list (filter-not false? (map (λ(x) (cond @@ -25,44 +25,44 @@ ;; merge concatenates attributes, with later ones overriding earlier. ;; most of the work is done by join-attrs. -(define+provide/contract (merge-attrs . quads-or-attrs-or-lists) +(define+provide (merge-attrs . quads-or-attrs-or-lists) (() #:rest list-of-mergeable-attrs? . ->* . quad-attrs?) (define all-attrs (join-attrs quads-or-attrs-or-lists)) (apply hash (flatten all-attrs))) ;; functionally update a quad attr. Similar to hash-set -(define+provide/contract (quad-attr-set q k v) +(define+provide (quad-attr-set q k v) (quad? symbol? any/c . -> . quad?) (quad (quad-name q) (merge-attrs (quad-attrs q) (list k v)) (quad-list q))) ;; functionally update multiple quad attrs. Similar to hash-set* -(define+provide/contract (quad-attr-set* q . kvs) +(define+provide (quad-attr-set* q . kvs) ((quad?) #:rest hashable-list? . ->* . quad?) (for/fold ([current-q q])([kv-list (in-list (slice-at kvs 2))]) (apply quad-attr-set current-q kv-list))) ;; functionally remove a quad attr. Similar to hash-remove -(define+provide/contract (quad-attr-remove q k) +(define+provide (quad-attr-remove q k) (quad? symbol? . -> . quad?) (if (quad-attrs q) (quad (quad-name q) (hash-remove (quad-attrs q) k) (quad-list q)) q)) ;; functionally remove multiple quad attrs. Similar to hash-remove -(define+provide/contract (quad-attr-remove* q . ks) +(define+provide (quad-attr-remove* q . ks) ((quad?) #:rest (λ(ks) (and (list? ks) (andmap symbol? ks))) . ->* . quad?) (for/fold ([current-q q])([k (in-list ks)]) (quad-attr-remove current-q k))) -(define+provide/contract (quad-map proc q) +(define+provide (quad-map proc q) (procedure? quad? . -> . quad?) (quad (quad-name q) (quad-attrs q) (map proc (quad-list q)))) ;; flatten merges attributes, but applies special logic suitable to flattening ;; for instance, resolving x and y coordinates. -(define+provide/contract (flatten-attrs . quads-or-attrs-or-falses) +(define+provide (flatten-attrs . quads-or-attrs-or-falses) (() #:rest (listof (or/c quad? quad-attrs?)) . ->* . quad-attrs?) (define all-attrs (join-attrs quads-or-attrs-or-falses)) (define-values (x-attrs y-attrs other-attrs-reversed) @@ -149,7 +149,7 @@ ;; the last char of a quad -(define+provide/contract (quad-last-char q) +(define+provide (quad-last-char q) (quad? . -> . (or/c #f string?)) (define split-qs (split-quad q)) ; split makes it simple, but is it too expensive? (if (or (empty? split-qs) (empty? (quad-list (last split-qs)))) @@ -157,7 +157,7 @@ (car (quad-list (last split-qs))))) ;; the first char of a quad -(define+provide/contract (quad-first-char q) +(define+provide (quad-first-char q) (quad? . -> . (or/c #f string?)) (define split-qs (split-quad q)) ; explosion makes it simple, but is it too expensive? (if (or (empty? split-qs) (empty? (quad-list (first split-qs)))) @@ -167,7 +167,7 @@ ;; propagate x and y adjustments throughout the tree, ;; using parent x and y to adjust children, and so on. -(define+provide/contract (compute-absolute-positions i [parent-x 0][parent-y 0]) +(define+provide (compute-absolute-positions i [parent-x 0][parent-y 0]) ((quad?) (integer? integer?) . ->* . quad?) (cond [(quad? i) @@ -199,23 +199,23 @@ result)))])) ;; find total pages in doc by searching on page count key. -(define+provide/contract (pages-in-doc doc) +(define+provide (pages-in-doc doc) (doc? . -> . integer?) (add1 (apply max (map (curryr quad-attr-ref world:page-key 0) (quad-list doc))))) ;; todo: how to guarantee line has leading key? -(define+provide/contract (compute-line-height line) +(define+provide (compute-line-height line) (line? . -> . line?) (quad-attr-set line world:height-key (quad-attr-ref/parameter line world:leading-key))) (define (fixed-height? q) (quad-has-attr? q world:height-key)) -(define+provide/contract (quad-height q) +(define+provide (quad-height q) (quad? . -> . number?) (quad-attr-ref q world:height-key 0)) ;; use heights to compute vertical positions -(define+provide/contract (add-vert-positions starting-quad) +(define+provide (add-vert-positions starting-quad) (quad? . -> . quad?) (define-values (new-quads final-height) (for/fold ([new-quads empty][height-so-far 0])([q (in-list (quad-list starting-quad))]) @@ -224,7 +224,7 @@ (quad (quad-name starting-quad) (quad-attrs starting-quad) (reverse new-quads))) ;; recursively hyphenate strings in a quad -(define+provide/contract (hyphenate-quad x) +(define+provide (hyphenate-quad x) (quad? . -> . quad?) (cond [(quad? x) (quad-map hyphenate-quad x)] diff --git a/quad/wrap.rkt b/quad/wrap.rkt index def00f84..5f7ba24e 100644 --- a/quad/wrap.rkt +++ b/quad/wrap.rkt @@ -4,22 +4,22 @@ (require "ocm.rkt" "quads.rkt" "utils.rkt" "measure.rkt" "world.rkt" "logger.rkt" ) ;; predicate for the soft hyphen -(define+provide/contract (soft-hyphen? x) +(define+provide (soft-hyphen? x) (string? . -> . boolean?) (equal? (format "~a" world:soft-hyphen) x)) ;; visible characters that also mark possible breakpoints -(define+provide/contract (visible-breakable? x) +(define+provide (visible-breakable? x) (string? . -> . boolean?) (and (member x world:hyphens-and-dashes) #t)) ;; invisible characters that denote possible breakpoints -(define+provide/contract (invisible-breakable? x) +(define+provide (invisible-breakable? x) (string? . -> . boolean?) (and (member x (cons world:empty-string world:spaces)) #t)) ;; union of visible & invisible -(define+provide/contract (breakable? x) +(define+provide (breakable? x) (any/c . -> . boolean?) (cond [(string? x) (or (visible-breakable? x) (invisible-breakable? x))] @@ -28,19 +28,19 @@ ;; used by insert-spacers to determine which characters ;; can be surrounded by stretchy spacers -(define+provide/contract (takes-justification-space? x) +(define+provide (takes-justification-space? x) (any/c . -> . boolean?) (whitespace/nbsp? x)) ;; test if a quad can be a word break: ;; either it's an explicit word break, ;; or it's breakable (and can be converted to a word break) -(define+provide/contract (possible-word-break-quad? q) +(define+provide (possible-word-break-quad? q) (quad? . -> . boolean?) (or (word-break? q) (breakable? q))) ;; convert a possible word break into an actual one -(define+provide/contract (convert-to-word-break q) +(define+provide (convert-to-word-break q) (possible-word-break-quad? . -> . word-break?) (cond [(word-break? q) q] @@ -65,7 +65,7 @@ ;; meaning, a line can wrap at a piece boundary, but not elsewhere. ;; hyphenation produces more, smaller pieces, which means more linebreak opportunities ;; but this also makes wrapping slower. -(define+provide/contract (make-pieces qs) +(define+provide (make-pieces qs) (quads? . -> . pieces?) (define-values (breakable-items items-to-make-unbreakable) (split-at-right qs (min world:minimum-last-line-chars (length qs)))) (define unbreak-qs (append breakable-items (map make-unbreakable items-to-make-unbreakable))) @@ -91,7 +91,7 @@ ;; Try the attr first, and if it's not available, compute the width. ;; comes in fast or slow versions. ;; not designed to update the source quad. -(define+provide/contract (quad-width q) +(define+provide (quad-width q) (quad? . -> . flonum?) (cond [(quad-has-attr? q world:width-key) (fl (quad-attr-ref q world:width-key))] @@ -106,7 +106,7 @@ ;; used by renderer to align text runs baseline-to-baseline. ;; consult the attrs, and if not available, compute it. ;; not designed to update the source quad. -(define+provide/contract (ascent q) +(define+provide (ascent q) (quad? . -> . flonum?) (or (quad-attr-ref q world:ascent-key #f) (cond @@ -119,7 +119,7 @@ ;; if a piece appears elsewhere in a line, it is rendered in "no break" mode. ;; this allows the appearance of a piece to change depending on whether it's at the end. ;; and thus give correct behavior to trailing word spaces, soft hyphens, etc. -(define+provide/contract (render-piece p [before-break? #f]) +(define+provide (render-piece p [before-break? #f]) ((piece?) (boolean?) . ->* . piece?) ;; a piece doesn't necessarily have a word-break item in it. ;; only needs it if the appearance of the piece changes based on location. @@ -157,7 +157,7 @@ (render-word-break wb world:before-break-key)) ;; is this the last line? compare current line-idx to total lines -(define+provide/contract (last-line? line) +(define+provide (last-line? line) (line? . -> . boolean?) (define line-idx (quad-attr-ref line world:line-index-key #f)) (define lines (quad-attr-ref line world:total-lines-key #f)) @@ -173,7 +173,7 @@ ;; the optical kern doesn't have left- or right-handed versions. ;; it just looks at quads on both sides and kerns them if appropriate. ;; in practice, only one will likely be used. -(define+provide/contract (render-optical-kerns exploded-line-quads) +(define+provide (render-optical-kerns exploded-line-quads) (quads? . -> . quads?) (define (overhang-width q) (if (and (word? q) (member (word-string q) world:hanging-chars)) @@ -193,7 +193,7 @@ ;; spacers are used to soak up extra space left over in a line. ;; depending on where the spacers are inserted, different formatting effects are achieved. ;; e.g., left / right / centered / justified. -(define+provide/contract (insert-spacers-in-line line [alignment-override #f]) +(define+provide (insert-spacers-in-line line [alignment-override #f]) ((line?) ((or/c #f symbol?)) . ->* . line?) ;; important principle: avoid peeking into quad-list to get attributes. ;; because non-attributed quads may be added. @@ -507,7 +507,7 @@ ;; build quad out to a given width by distributing excess into spacers ;; todo: adjust this to work recursively, so that fill operation cascades down -(define+provide/contract (fill starting-quad [target-width? #f]) +(define+provide (fill starting-quad [target-width? #f]) ((quad?) ((or/c #f flonum?)) . ->* . quad?) (define target-width (fl (or target-width? (quad-attr-ref starting-quad world:measure-key)))) (define subquads (quad-list starting-quad)) @@ -530,7 +530,7 @@ ;; add x positions to a list of fixed-width quads ;; todo: adjust this to work recursively, so that positioning operation cascades down -(define+provide/contract (add-horiz-positions starting-quad) +(define+provide (add-horiz-positions starting-quad) ((and/c quad? fixed-width?) . -> . quad?) (define-values (new-quads final-width) (for/fold ([new-quads empty][width-so-far 0.0])([q (in-list (quad-list starting-quad))])