resume in wrap-typed

quad/core-types.rkt

@@ -1,39 +1,7 @@
 #lang typed/racket/base
-(require (for-syntax typed/racket/base racket/syntax) (only-in typed/racket/draw Font-Weight Font-Style))
+(require (for-syntax typed/racket/base racket/syntax) (only-in typed/racket/draw Font-Weight Font-Style) typed/sugar/define)
 (provide (all-defined-out) (all-from-out typed/racket/draw))
 
-(define-syntax (define/typed stx)
-  (syntax-case stx ()
-    [(_ (proc-name arg ... . rest-arg) type-expr body ...)
-     #'(define/typed proc-name type-expr
-         (λ(arg ... . rest-arg) body ...))]
-    [(_ proc-name type-expr body ...)
-     #'(begin
-         (: proc-name type-expr)
-         (define proc-name body ...))]))
-
-(define-syntax (define/typed+provide stx)
-  (syntax-case stx ()
-    [(_ (proc-name arg ... . rest-arg) type-expr body ...)
-     #'(begin
-         (provide proc-name)
-         (define/typed proc-name type-expr
-           (λ(arg ... . rest-arg) body ...)))]
-    [(_ proc-name type-expr body ...)
-     #'(begin
-         (provide proc-name)
-         (begin
-           (: proc-name type-expr)
-           (define proc-name body ...)))]))
-
-(define-syntax (define-type+predicate stx)
-  (syntax-case stx ()
-    [(_ id basetype)
-     (with-syntax ([id? (format-id stx "~a?" #'id)])
-       #'(begin
-           (define-type id basetype)
-           (define-predicate id? id)))]))
-
 (define-type+predicate QuadName Symbol)
 (define-type+predicate QuadAttrKey Symbol)
 (define-type+predicate QuadAttrValue (U Float Index String Symbol Boolean Quad QuadAttrs QuadList Integer))

quad/measure-typed.rkt

@@ -1,8 +1,8 @@
 #lang typed/racket/base
 (require (for-syntax typed/racket/base))
-(require typed/racket/class math/flonum racket/list racket/file typed/racket/draw "core-types.rkt")
-(require/typed racket/serialize [serialize (Any . -> . Any)]
-               [deserialize (Any . -> . (HashTable (List String String Symbol Symbol) Measurement-Result-Type))])
+(require typed/racket/class math/flonum racket/list racket/file typed/racket/draw "core-types.rkt" typed/sugar/define)
+(require/typed racket/serialize [serialize (Any -> Any)]
+               [deserialize (Any -> (HashTable (List String String Symbol Symbol) Measurement-Result-Type))])
 (provide measure-text measure-ascent round-float update-text-cache-file load-text-cache-file)
 
 
@@ -16,7 +16,7 @@
 (define current-font-cache (make-parameter ((inst make-hash (List Font-Name Font-Weight Font-Style) (Instance Font%)) '())))
 
 (define/typed (round-float x)
-  (Float . -> . Float)
+  (Float -> Float)
   (/ (round (* base x)) base))
 
 
@@ -39,7 +39,7 @@
 
 
 (define/typed (get-cached-font font weight style)
-  (Font-Name Font-Weight Font-Style . -> . (Instance Font%))
+  (Font-Name Font-Weight Font-Style -> (Instance Font%))
   (hash-ref! (current-font-cache) (list font weight style) (λ() (make-font #:size max-size #:style style #:weight weight #:face font))))
 
 
@@ -64,7 +64,7 @@
 
 ;; works by taking max size and scaling it down. Allows caching of results.
 (define/typed (measure-text text size font weight style)
-  (String Font-Size Font-Name Font-Weight Font-Style . -> . Float)
+  (String Font-Size Font-Name Font-Weight Font-Style -> Float)
   (define raw-width (width (measure-max-size text font weight style)))
   (round-float (/ (* raw-width size) max-size)))
 

quad/ocm-typed.rkt

@@ -1,25 +1,25 @@
 #lang typed/racket/base
 (require (for-syntax racket/base racket/syntax))
-(require racket/list sugar/debug racket/function racket/vector  "logger-typed.rkt")
+(require racket/list typed/sugar/debug typed/sugar/define racket/function racket/vector  "logger-typed.rkt")
 (define-logger ocm)
 
 (provide minima-idx-key minima-payload-key smawky? Entry->Value-Type Value-Type No-Value-Type Entry-Type Index-Type Matrix-Proc-Type OCM-Type make-ocm reduce reduce2 concave-minima (prefix-out ocm- (combine-out min-entry min-value min-index)))
 
-(: select-elements ((Listof Any) (Listof Index-Type) . -> . (Listof Any)))
-(define (select-elements xs is)
+(define/typed (select-elements xs is)
+  ((Listof Any) (Listof Index-Type) -> (Listof Any))
   (map (λ([i : Index-Type]) ((inst list-ref Any) xs i)) is))
 
-(: odd-elements ((Listof Any) . -> . (Listof Any)))
-(define (odd-elements xs)
+(define/typed (odd-elements xs)
+  ((Listof Any) -> (Listof Any))
   (select-elements xs (range 1 (length xs) 2)))
 
-(: vector-odd-elements ((Vectorof Any) . -> . (Vectorof Any)))
-(define (vector-odd-elements xs)
+(define/typed (vector-odd-elements xs)
+  ((Vectorof Any) -> (Vectorof Any))
   (for/vector ([i (in-range (vector-length xs))] #:when (odd? i))
     (vector-ref xs i)))
 
-(: even-elements ((Listof Any) . -> . (Listof Any)))
-(define (even-elements xs)
+(define/typed (even-elements xs)
+  ((Listof Any) -> (Listof Any))
   (select-elements xs (range 0 (length xs) 2)))
 
 
@@ -40,8 +40,8 @@
   ((inst vector-append (U Index-Type No-Value-Type)) xs (vector value)))
 
 
-(: vector-set (All (a) ((Vectorof a) Integer a -> (Vectorof a))))
-(define (vector-set vec idx val)
+(define/typed (vector-set vec idx val)
+  (All (a) ((Vectorof a) Integer a -> (Vectorof a)))
   (vector-set! vec idx val)
   vec)
 
@@ -55,14 +55,14 @@
 (define (integers? x) (and (list? x) (andmap integer? x)))
 
 ;; Reduce phase: make number of rows at most equal to number of cols
-(: reduce ((Vectorof Index-Type) (Vectorof Index-Type) Matrix-Proc-Type Entry->Value-Type . -> . (Vectorof Index-Type)))
-(define (reduce row-indices col-indices matrix-proc entry->value)
-  ;(vector? vector? procedure? procedure? . -> . vector?)
+(define/typed (reduce row-indices col-indices matrix-proc entry->value)
+  ((Vectorof Index-Type) (Vectorof Index-Type) Matrix-Proc-Type Entry->Value-Type -> (Vectorof Index-Type))
+  ;(vector? vector? procedure? procedure? -> vector?)
   (log-ocm-debug "starting reduce phase with")
   (log-ocm-debug "row-indices = ~a" row-indices)
   (log-ocm-debug "col-indices = ~a" col-indices)
   
-  (: process-stack ((Vectorof Index-Type) Index-Type . -> . (Vectorof Index-Type)))
+  (: process-stack ((Vectorof Index-Type) Index-Type -> (Vectorof Index-Type)))
   (define (process-stack stack row-idx)
     (log-ocm-debug "row stack = ~a" stack)
     (let ([last-stack-idx (sub1 (vector-length stack))])
@@ -91,7 +91,7 @@
   (log-ocm-debug "finished reduce. row indexes = ~v" reduced-row-indexes)
   reduced-row-indexes)
 
-(: reduce2 ((Vectorof Index-Type) (Vectorof Index-Type) Matrix-Proc-Type Entry->Value-Type . -> . (Vectorof Index-Type)))
+(: reduce2 ((Vectorof Index-Type) (Vectorof Index-Type) Matrix-Proc-Type Entry->Value-Type -> (Vectorof Index-Type)))
 (define (reduce2 row-indices col-indices matrix-proc entry->value)
   (let find-survivors ([rows row-indices][survivors : (Listof Index-Type) empty])
     (cond 
@@ -126,8 +126,8 @@
 (define minima-payload-key 'entry)
 
 (define-type Make-Minimum-Input (Pair Any Index-Type)) 
-(: make-minimum (Make-Minimum-Input . -> . (HashTable Any Any)))
-(define (make-minimum value-rowidx-pair)
+(define/typed (make-minimum value-rowidx-pair)
+  (Make-Minimum-Input -> (HashTable Any Any))
   (define ht ((inst make-hash Any Any)))
   (! ht minima-payload-key (car value-rowidx-pair))
   (! ht minima-idx-key (cdr value-rowidx-pair))
@@ -139,9 +139,9 @@
 (define-syntax-rule (vector-last v)
   (vector-ref v (sub1 (vector-length v))))
 
-(: interpolate ((HashTable Any Any) (Vectorof Index-Type) (Vectorof Index-Type) Matrix-Proc-Type Entry->Value-Type . -> . (HashTable Any Any)))
-(define (interpolate minima row-indices col-indices matrix-proc entry->value)
-  ;(hash? vector? vector? procedure? procedure? . -> . hash?)
+(define/typed (interpolate minima row-indices col-indices matrix-proc entry->value)
+  ((HashTable Any Any) (Vectorof Index-Type) (Vectorof Index-Type) Matrix-Proc-Type Entry->Value-Type -> (HashTable Any Any))
+  ;(hash? vector? vector? procedure? procedure? -> hash?)
   (for ([col-idx (in-range 0 (vector-length col-indices) 2)]) ;; even-col-indices
     (define col (vector-ref col-indices col-idx))
     (define idx-of-last-row
@@ -158,8 +158,8 @@
     (! minima col (make-minimum smallest-value-entry)))
   minima)
 
-(: interpolate2 ((HashTable Any Any) (Vectorof Index-Type) (Vectorof Index-Type) Matrix-Proc-Type Entry->Value-Type . -> . (HashTable Any Any)))
-(define (interpolate2 minima row-indices col-indices matrix-proc entry->value)
+(define/typed (interpolate2 minima row-indices col-indices matrix-proc entry->value)
+  ((HashTable Any Any) (Vectorof Index-Type) (Vectorof Index-Type) Matrix-Proc-Type Entry->Value-Type -> (HashTable Any Any))
   (define idx-of-last-col (sub1 (vector-length col-indices)))
   (define (smallest-value-entry [col : Index-Type] [idx-of-last-row : Index-Type])
     ((inst argmin Make-Minimum-Input) (λ(x) (entry->value (car x)))
@@ -177,8 +177,8 @@
 ;; The return value `minima` is a hash:
 ;; the keys are col-indices (integers)
 ;; the values are pairs of (value row-index).
-(: concave-minima ((Vectorof Index-Type) (Vectorof Index-Type) Matrix-Proc-Type Entry->Value-Type . -> . HashTableTop))
-(define (concave-minima row-indices col-indices matrix-proc entry->value)
+(define/typed (concave-minima row-indices col-indices matrix-proc entry->value)
+  ((Vectorof Index-Type) (Vectorof Index-Type) Matrix-Proc-Type Entry->Value-Type -> HashTableTop)
   ;((vector?) ((or/c #f vector?) procedure? procedure?) . ->* . hash?)
   (define reduce-proc reduce2)
   (define interpolate-proc interpolate2)
@@ -202,40 +202,40 @@
 (define-type Value-Type Float)
 (define-type No-Value-Type Symbol)
 (define-type Finished-Value-Type Index-Type)
-(define-type Matrix-Proc-Type (Index-Type Index-Type . -> . Entry-Type))
-(define-type Entry->Value-Type (Entry-Type . -> . Value-Type))
+(define-type Matrix-Proc-Type (Index-Type Index-Type -> Entry-Type))
+(define-type Entry->Value-Type (Entry-Type -> Value-Type))
 
 (struct $ocm ([min-entrys : (Vectorof Entry-Type)] [min-row-indices : (Vectorof (U Index-Type No-Value-Type))] [finished : Finished-Value-Type] [matrix-proc : Matrix-Proc-Type] [entry->value : Entry->Value-Type] [base : Index-Type] [tentative : Index-Type]) #:transparent #:mutable)
 
 (define-type OCM-Type $ocm)
 
-(: make-ocm ((Matrix-Proc-Type Entry->Value-Type) (Entry-Type) . ->* . OCM-Type))
-(define (make-ocm matrix-proc entry->value [initial-entry 0.0])
+(define/typed (make-ocm matrix-proc entry->value [initial-entry 0.0])
+  ((Matrix-Proc-Type Entry->Value-Type) (Entry-Type) . ->* . OCM-Type)
   (log-ocm-debug "making new ocm")
   ($ocm (vector initial-entry) (vector no-value) 0 matrix-proc entry->value 0 0)) 
 
 ;; Return min { Matrix(i,j) | i < j }.
-(: min-entry (OCM-Type Index-Type . -> . Entry-Type))
-(define (min-entry ocm j)
+(define/typed (min-entry ocm j)
+  (OCM-Type Index-Type -> Entry-Type)
   (if (< (cast ($ocm-finished ocm) Real) j)
       (begin (advance! ocm) (min-entry ocm j))
       (vector-ref ($ocm-min-entrys ocm) j)))
 
 ;; same as min-entry, but converts to raw value
-(: min-value (OCM-Type Index-Type . -> . Value-Type))
-(define (min-value ocm j)
+(define/typed (min-value ocm j)
+  (OCM-Type Index-Type -> Value-Type)
   (($ocm-entry->value ocm) (min-entry ocm j)))
 
 ;; Return argmin { Matrix(i,j) | i < j }.
-(: min-index (OCM-Type Index-Type . -> . (U Index-Type No-Value-Type)))
-(define (min-index ocm j)
+(define/typed (min-index ocm j)
+  (OCM-Type Index-Type -> (U Index-Type No-Value-Type))
   (if (< (cast ($ocm-finished ocm) Real) j)     
       (begin (advance! ocm) (min-index ocm j))
       ((inst vector-ref (U Index-Type No-Value-Type)) ($ocm-min-row-indices ocm) j)))
 
 ;; Finish another value,index pair.
-(: advance! (OCM-Type . -> . Void))
-(define (advance! ocm)
+(define/typed (advance! ocm)
+  (OCM-Type -> Void)
   (define next (add1 ($ocm-finished ocm)))  
   (log-ocm-debug "advance! ocm to next = ~a" (add1 ($ocm-finished ocm)))
   (cond
@@ -296,15 +296,14 @@
         (set-$ocm-tentative! ocm next)
         (set-$ocm-finished! ocm next)])]))
 
-(: print (OCM-Type . -> . Void))
-(define (print ocm)
+(define/typed (print ocm)
+  (OCM-Type -> Void)
   (displayln ($ocm-min-entrys ocm))
   (displayln ($ocm-min-row-indices ocm)))
 
-
-(: smawky? ((Listof (Listof Real)) . -> . Boolean))
-(define (smawky? m)
-  (: position-of-minimum ((Listof Real) . -> . Index-Type)) 
+(define/typed (smawky? m)
+  ((Listof (Listof Real)) -> Boolean)
+  (: position-of-minimum ((Listof Real) -> Index-Type)) 
   (define (position-of-minimum xs)
     ;; put each element together with its list index
     (let ([xs : (Listof (Pairof Index-Type Real)) (map (inst cons Index-Type Real) (range (length xs)) xs)]) 

quad/quads-typed.rkt

@@ -4,49 +4,45 @@
 ;; note to self: a require/typed function with proper typing
 ;; is faster than a generic function + type assertion at location of call
 (require/typed racket/list 
-               [flatten ((Listof QuadAttr) . -> . QuadAttrs)])
-(require/typed sugar/list [trimf (All (A) ((Listof A) (A . -> . Boolean) -> (Listof A)))]
-               [filter-split (All (A) ((Listof A) (A . -> . Boolean) -> (Listof (Listof A))))])
-(require/typed racket/string [string-append* ((Listof String) . -> . String)])
-(require/typed sugar/string [ends-with? (String String . -> . Boolean)])
-(require sugar/debug)
+               [flatten ((Listof QuadAttr) -> QuadAttrs)])
+(require/typed racket/string [string-append* ((Listof String) -> String)])
+(require typed/sugar/debug typed/sugar/string typed/sugar/list typed/sugar/define)
 (provide (all-defined-out))
 
-
 (define-syntax-rule (even-members xs)
   (for/list : (Listof Any) ([(x i) (in-indexed xs)] #:when (even? i))
     x))
 
 (define/typed (quad-name q)
-  (Quad . -> . QuadName)
+  (Quad -> QuadName)
   (car q))
 
 (define/typed (quad-attrs q)
-  (Quad . -> . QuadAttrs)
+  (Quad -> QuadAttrs)
   (car (cdr q)))
 
 (define/typed (make-quadattr k v)
-  (QuadAttrKey QuadAttrValue . -> . QuadAttr)
+  (QuadAttrKey QuadAttrValue -> QuadAttr)
   (cons k v))
 
 (define/typed (quadattr-key qa)
-  (QuadAttr . -> . QuadAttrKey)
+  (QuadAttr -> QuadAttrKey)
   (car qa))
 
 (define/typed (quadattr-value qa)
-  (QuadAttr . -> . QuadAttrValue)
+  (QuadAttr -> QuadAttrValue)
   (cdr qa))
 
 (define/typed (quad-attr-keys qas)
-  (QuadAttrs . -> . (Listof QuadAttrKey))
+  (QuadAttrs -> (Listof QuadAttrKey))
   (if (empty? qas)
       qas
       ((inst map QuadAttrKey QuadAttr) car qas)))
 
 (define/typed (quad-list q)
   (case->
-   (GroupQuad . -> . GroupQuadList)
-   (Quad . -> . QuadList))
+   (GroupQuad -> GroupQuadList)
+   (Quad -> QuadList))
   (cdr (cdr q)))
 
 
@@ -70,7 +66,7 @@
 (define cannot-be-common-attrs '(width x y page))
 (define attr-missing (gensym))
 
-(: quad-ends-with? (Quad String . -> . Boolean))
+(: quad-ends-with? (Quad String -> Boolean))
 (define (quad-ends-with? q str)
   (cond
     [(not (empty? (quad-list q)))
@@ -81,12 +77,12 @@
        [else #f])]
     [else #f]))
 
-(: quad-append (Quad QuadListItem . -> . Quad))
+(: quad-append (Quad QuadListItem -> Quad))
 (define (quad-append q new-item)
   (quad (quad-name q) (quad-attrs q) (append (quad-list q) (list new-item))))
 
 
-(: quad->string (Quad . -> . String))
+(: quad->string (Quad -> String))
 (define (quad->string x)
   (let loop : String ([x : (U Quad String) x])
     (cond 
@@ -95,8 +91,8 @@
       [else (string-append* ((inst map String QuadListItem) loop (quad-list x)))])))
 
 (define/typed+provide (gather-common-attrs qs)
-  ((Listof Quad) . -> . QuadAttrs)
-  (: check-cap (Quad QuadAttr . -> . Boolean))
+  ((Listof Quad) -> QuadAttrs)
+  (: check-cap (Quad QuadAttr -> Boolean))
   (define (check-cap q cap) ; cap = candidate-attr-pair
     (equal? (quad-attr-ref q (car cap) attr-missing) (cdr cap)))
   (if (null? qs)
@@ -120,7 +116,7 @@
 (define/typed (make-quadattrs xs)
   ;; no point typing the input as (U QuadAttrKey QuadAttrValue) 
   ;; because QuadAttrValue is Any, so that's the same as plain Any
-  ((Listof Any) . -> . QuadAttrs)
+  ((Listof Any) -> QuadAttrs)
   (let-values ([(ks vs even?) (for/fold 
                                ([ks : (Listof QuadAttrKey) null][vs : (Listof QuadAttrValue) null][even? : Boolean #t])
                                ([x (in-list xs)])
@@ -147,7 +143,7 @@
        #`(begin
            ;; quad converter
            (define/typed (quads->id qs)
-             ((Listof Quad) . -> . IdQuad)
+             ((Listof Quad) -> IdQuad)
              (apply id (gather-common-attrs qs) qs))
         
            (define-type IdQuad (List* 'id QuadAttrs #,(if (syntax->datum #'wants-group?)
@@ -192,7 +188,7 @@
            (define-quad-type id-break) ; break is not necessarily a group
            (define-quad-type multi-id wants-group?) ; multi-id is always a group
            ;; breaker
-           (: split-on-id-breaks ((Listof Quad) . -> . (Listof (Listof Quad))))
+           (: split-on-id-breaks ((Listof Quad) -> (Listof (Listof Quad))))
            (define (split-on-id-breaks xs)
              ;; omit leading & trailing whitespace, because they're superfluous next to a break
              (map (λ([xs : (Listof Quad)]) (trimf xs whitespace?)) (filter-split xs id-break?)))))]))
@@ -201,20 +197,20 @@
 
 
 (define/typed (quad-car q)
-  (Quad . -> . QuadListItem)
+  (Quad -> QuadListItem)
   (define ql (quad-list q))
   (if (not (empty? ql))
       ((inst car QuadListItem QuadList) ql)
       (error 'quad-car "quad-list empty")))
 
 (define/typed (quad-cdr q)
-  (Quad . -> . QuadList)
+  (Quad -> QuadList)
   (define ql (quad-list q))
   (if (not (empty? ql))
       ((inst cdr QuadListItem QuadList) ql)
       (error 'quad-car "quad-list empty")))
 
-(: quad-has-attr? (Quad QuadAttrKey . -> . Boolean))
+(: quad-has-attr? (Quad QuadAttrKey -> Boolean))
 (define (quad-has-attr? q key)
   (and ((inst member QuadAttrKey) key (quad-attr-keys (quad-attrs q))) #t))
 
@@ -234,7 +230,7 @@
 
 (define-break-type word)
 (define/typed (word-string c) 
-  (Quad . -> . String)
+  (Quad -> String)
   (define ql (quad-list c))
   (if (and (not (null? ql)) (string? (car ql)))
       (car ql)

quad/render-typed.rkt

@@ -1,28 +1,6 @@
 #lang typed/racket/base
-(require typed/racket/class racket/file racket/list)
-(require/typed racket/draw
-               [current-ps-setup (Parameterof (Instance (Class (init-field)
-                                                               [set-margin (Number Number . -> . Void)]
-                                                               [set-scaling (Number Number . -> . Void)])))]
-               [the-color-database (Instance (Class 
-                                              (find-color (String . -> . (Option (Instance (Class)))))))]
-               [pdf-dc% (Class (init [interactive Boolean][use-paper-bbox Boolean][as-eps Boolean]
-                                     [output Output-Port]
-                                     [width Float][height Float])
-                               (start-doc (String . -> . Void))
-                               (set-pen (String Real Symbol . -> . Void))
-                               (set-brush (String Symbol . -> . Void))
-                               (set-font ((Instance (Class)) . -> . Void))
-                               (set-text-foreground ((Instance (Class)) . -> . Void))
-                               (set-text-background ((Instance (Class)) . -> . Void))
-                               (set-text-mode (Symbol . -> . Void))
-                               (draw-text (String Float Float Boolean . -> . Void))
-                               (start-page (-> Void))
-                               (end-page (-> Void))
-                               (end-doc (-> Void)))]
-               [make-font ((#:size Nonnegative-Float) (#:style Symbol) (#:weight Symbol) (#:face String) . -> . (Instance (Class (init-field))))])
-(require/typed sugar/cache [make-caching-proc ((String Nonnegative-Float Symbol Symbol -> (Instance (Class))) . -> . (String Nonnegative-Float Symbol Symbol -> (Instance (Class))))])
-(require "utils-typed.rkt" "quads-typed.rkt" "world-typed.rkt")
+(require typed/racket/class racket/file racket/list typed/racket/draw typed/sugar/cache)
+(require "utils-typed.rkt" "quads-typed.rkt" "world-typed.rkt" "core-types.rkt")
 
 (define abstract-renderer%
   
@@ -32,7 +10,7 @@
     (define renderable-quads '(word box))
     
     ;; hash implementation
-    (: render (Quad . -> . Any))
+    (: render (Quad -> Any))
     (define/public (render doc-quad)
       (finalize
        (let ([rendering-input (flatten-quad (setup doc-quad))])
@@ -42,24 +20,24 @@
              ((inst hash-update! Nonnegative-Integer (Listof Quad)) page-quad-hash (cast (quad-attr-ref q world:page-key) Nonnegative-Integer) (λ(v) ((inst cons Quad (Listof Quad)) q v)) (λ() (cast null (Listof Quad))))))
          (map (λ([k : Nonnegative-Integer]) (render-page ((inst hash-ref Nonnegative-Integer (Listof Quad) (Listof Quad)) page-quad-hash k))) (sort (hash-keys page-quad-hash) <)))))
     
-    (: render-element (Quad . -> . Any))
+    (: render-element (Quad -> Any))
     (define/public (render-element q)
       (cond 
         [(word? q) (render-word q)]
         [else q]))
     
-    (: setup (Quad . -> . Quad))
+    (: setup (Quad -> Quad))
     (define/public (setup q) q)
     
     ;; use in lieu of 'abstract' definition
-    (: render-page ((Listof Quad) . -> . Void))
+    (: render-page ((Listof Quad) -> Void))
     (define/public (render-page qs) (void)) 
     
     ;; use in lieu of 'abstract' definition
-    (: render-word (Quad . -> . Any))
+    (: render-word (Quad -> Any))
     (define/public (render-word x) (word)) 
     
-    (: finalize (Any . -> . Any))
+    (: finalize (Any -> Any))
     (define/public (finalize x) x)))
 
 (define-syntax-rule (map/send method xs)
@@ -94,8 +72,8 @@
     (inherit render-element)
     
     
-    (define font-cache ((inst make-hash (List String Nonnegative-Flonum Symbol Symbol) (Instance (Class (init-field)))) '()))
-    (: get-cached-font (String Nonnegative-Flonum Symbol Symbol . -> .  (Instance (Class (init-field)))))
+    (define font-cache ((inst make-hash (List String Nonnegative-Flonum Font-Style Font-Weight) (Instance Font%)) '()))
+    (: get-cached-font (String Nonnegative-Flonum Font-Style Font-Weight ->  (Instance Font%)))
     (define (get-cached-font font size style weight)
       (hash-ref! font-cache (list font size style weight) (λ () (make-font #:face font #:size size #:style style #:weight weight))))
     
@@ -103,8 +81,8 @@
     (define/override (render-word w)
       (define word-font (cast (quad-attr-ref/parameter w world:font-name-key) String))
       (define word-size (cast (quad-attr-ref/parameter w world:font-size-key) Nonnegative-Float))
-      (define word-style (cast (quad-attr-ref/parameter w world:font-style-key) Symbol))
-      (define word-weight (cast (quad-attr-ref/parameter w world:font-weight-key) Symbol))
+      (define word-style (cast (quad-attr-ref/parameter w world:font-style-key) Font-Style))
+      (define word-weight (cast (quad-attr-ref/parameter w world:font-weight-key) Font-Weight))
       (define word-color (cast (quad-attr-ref/parameter w world:font-color-key) String))
       (define word-background (cast (quad-attr-ref/parameter w world:font-background-key) String))
       (send dc set-font (get-cached-font word-font word-size word-style word-weight))
@@ -131,7 +109,7 @@
       (send dc end-doc)
       (get-output-bytes dc-output-port))
     
-    (: render-to-file (Quad Path-String . -> . Void))
+    (: render-to-file (Quad Path-String -> Void))
     (define/public (render-to-file doc-quad path)
       (define result-bytes (send this render doc-quad))
       (display-to-file result-bytes path #:exists 'replace #:mode 'binary))

quad/samples-typed.rkt

@@ -1,5 +1,5 @@
 #lang typed/racket/base
-(require "quads-typed.rkt" racket/file racket/string racket/list)
+(require "quads-typed.rkt" "core-types.rkt" racket/file racket/string racket/list typed/sugar/define)
 (provide (all-defined-out))
 
 ;(define ti (block '(measure 54.0 leading 18.0) "Meg is an ally."))

quad/tests-typed.rkt

@@ -1,6 +1,6 @@
-#lang racket/base
+#lang typed/racket/base
 (require "utils-typed.rkt" "quads-typed.rkt" "world-typed.rkt" "measure-typed.rkt" racket/list racket/format)
-(require rackunit)
+(require typed/rackunit)
 
 (check-equal? (join-attrs (list (box '(width 10.0)) (quad-attrs (box '(x 10.0))) (list 'width 20.0))) 
               (list (cons 'width 10.0) (cons 'x 10.0) (cons 'width 20.0)))
@@ -35,7 +35,7 @@
 
 (check-equal? (compute-absolute-positions (page '(x 100.0 y 100.0) (line '(x 10.0 y 10.0) (word '(x 1.0 y 1.0) "hello")
                                                                      (word '(x 2.0 y 2.0) "world"))))
-              (page '(x 100.0 y 100.0) (line '(x 110.0 y 110.0) (word '(x 111.0 y 111.0) "hello")(word '(x 112.0 y 112.0) "world"))))
+              (page '(y 100.0 x 100.0) (line '(y 110.0 x 110.0) (word '(y 111.0 x 111.0) "hello")(word '(y 112.0 x 112.0) "world"))))
 
 (define b2-exploded (list (word '(x 10.0) "1") (word '(x 10.0) "s") (word '(x 10.0) "t") (word '(x 10.0 foo bar) "2") (word '(x 10.0 foo bar) "n") (word '(x 10.0 foo bar) "d") (word '(x 10.0) "3") (word '(x 10.0) "r") (word '(x 10.0) "d")))
 
@@ -85,8 +85,8 @@
 (check-true (whitespace/nbsp? (word '() (~a #\u00A0))))
 (check-false (whitespace? (format " ~a " #\u00A0)))
 (check-true (whitespace/nbsp? (format " ~a " #\u00A0)))
-(define funny-unicode-spaces (map ~a (list #\u2000 #\u2007 #\u2009 #\u200a #\u202f)))
-(check-true (andmap whitespace? funny-unicode-spaces))
-(check-true (andmap whitespace/nbsp? funny-unicode-spaces))
+;(define funny-unicode-spaces (map ~a (list #\u2000 #\u2007 #\u2009 #\u200a #\u202f)))
+;(check-true (andmap whitespace? funny-unicode-spaces))
+;(check-true (andmap whitespace/nbsp? funny-unicode-spaces))
 
 (check-equal? (measure-text "foobar" 10.0 "Courier" 'normal 'normal) 36.0059)

quad/utils-typed.rkt

@@ -1,27 +1,28 @@
 #lang typed/racket/base
-(require/typed hyphenate [hyphenate (String #:min-length Nonnegative-Integer #:min-left-length Nonnegative-Integer #:min-right-length Nonnegative-Integer . -> . String)])
-(require (for-syntax racket/syntax racket/base) racket/string racket/list sugar/debug racket/bool racket/function math/flonum)
+(require/typed hyphenate [hyphenate (String #:min-length Nonnegative-Integer #:min-left-length Nonnegative-Integer #:min-right-length Nonnegative-Integer -> String)])
+(require (for-syntax racket/syntax racket/base) racket/string racket/list typed/sugar/debug typed/sugar/define racket/bool racket/function math/flonum)
 (require "quads-typed.rkt" "world-typed.rkt" "measure-typed.rkt" "core-types.rkt")
 
 (define/typed+provide (quad-map proc q)
-  ((QuadListItem . -> . QuadListItem) Quad . -> . Quad)
+  ((QuadListItem -> QuadListItem) Quad -> Quad)
   (quad (quad-name q) (quad-attrs q) (map proc (quad-list q))))
 
 
 ;; predicate for use below
-(: list-of-mergeable-attrs? (Any . -> . Boolean))
-(define (list-of-mergeable-attrs? xs)
+(define/typed (list-of-mergeable-attrs? xs)
+  (Any -> Boolean)
   (and (list? xs) (andmap (λ(x) (or (quad? x) (quad-attrs? x) (HashableList? x))) xs)))
 
-;; faster than (listof pair?)
-(: pairs? (Any . -> . Boolean))
-(define (pairs? x) (and (list? x) (andmap pair? x)))
+;; faster than (listof pair?
+(define/typed (pairs? x)
+  (Any -> Boolean)
+  (and (list? x) (andmap pair? x)))
 
 ;; push together multiple attr sources into one list of pairs.
 ;; mostly a helper function for the two attr functions below.
 ;; does not resolve duplicates (see merge-attrs for that)
 (define/typed+provide (join-attrs quads-or-attrs-or-lists)
-  ((Listof JoinableType) . -> . QuadAttrs)
+  ((Listof JoinableType) -> QuadAttrs)
   (append-map (λ([x : JoinableType])
                 (cond
                   [(quad? x) (quad-attrs x)]
@@ -32,7 +33,7 @@
 ;; merge uses join-attrs to concatenate attributes,
 ;; but then resolves duplicates, with later ones overriding earlier.
 (define/typed+provide (merge-attrs . quads-or-attrs-or-lists)
-  (JoinableType * . -> . QuadAttrs)
+  (JoinableType * -> QuadAttrs)
   (define all-attrs (join-attrs quads-or-attrs-or-lists))
   (hash->list (make-hash all-attrs)))
 
@@ -41,7 +42,7 @@
 (define-type QuadAttrFloatPair (Pairof QuadAttrKey Float))
 
 (define/typed+provide (flatten-attrs . joinable-items)
-  (JoinableType * . -> . QuadAttrs)
+  (JoinableType * -> QuadAttrs)
   (define all-attrs (join-attrs joinable-items))
   (define-values (x-attrs y-attrs other-attrs-reversed)
     (for/fold ([xas : (Listof QuadAttrFloatPair) null]
@@ -52,7 +53,7 @@
         [(and (equal? (car attr) world:x-position-key) (flonum? (cdr attr))) (values (cons attr xas) yas oas)]
         [(and (equal? (car attr) world:y-position-key) (flonum? (cdr attr))) (values xas (cons attr yas) oas)]
         [else (values xas yas (cons attr oas))])))
-  (: make-cartesian-attr (QuadAttrKey (Listof QuadAttrFloatPair) . -> . (Listof QuadAttrFloatPair)))
+  (: make-cartesian-attr (QuadAttrKey (Listof QuadAttrFloatPair) -> (Listof QuadAttrFloatPair)))
   (define (make-cartesian-attr key attrs) 
     (if (empty? attrs) 
         empty 
@@ -67,18 +68,17 @@
 ;; and flatten will go too far.
 ;; this version adds a check for quadness to the flattener.
 (define/typed+provide (flatten-quadtree quad-tree)
-  ((Treeof Quad) . -> . (Listof Quad))
+  ((Treeof Quad) -> (Listof Quad))
   (let loop ([sexp quad-tree][acc : (Listof Quad) null])
     (cond [(null? sexp) acc]
           [(quad? sexp) (cons sexp acc)]
           [else (loop (car sexp) (loop (cdr sexp) acc))])))
 
-(require sugar/debug)
 ;; starting with a single nested quad,
 ;; pushes attributes down from parent quads to children, 
 ;; resulting in a flat list of quads.
 (define/typed+provide (flatten-quad q)
-  (Quad . -> . (Listof Quad))
+  (Quad -> (Listof Quad))
   (flatten-quadtree 
    (let loop : (Treeof Quad)
      ([x : QuadListItem q][parent : Quad (quad 'null '() '())])
@@ -98,7 +98,7 @@
 ;; then dissolve it into individual character quads while copying attributes
 ;; input is often large, so macro allows us to avoid allocation
 (define/typed+provide (split-quad q)
-  (Quad . -> . (Listof Quad))
+  (Quad -> (Listof Quad))
   (: do-explode ((QuadListItem) (Quad) . ->* . (Treeof Quad)))
   (define (do-explode x [parent (box)])
     (cond
@@ -116,8 +116,7 @@
 ;; they get merged.
 ;; input is often large, so macro allows us to avoid allocation
 (define/typed+provide (join-quads qs-in)
-  ((Listof Quad) . -> . (Listof Quad))
-  
+  ((Listof Quad) -> (Listof Quad))
   (let ([make-matcher (λ ([base-q : Quad])
                         (λ([q : Quad])
                           (and (member (quad-name q) world:mergeable-quad-types) 
@@ -155,15 +154,14 @@
 ;; propagate x and y adjustments throughout the tree,
 ;; using parent x and y to adjust children, and so on.
 (define/typed+provide (compute-absolute-positions qli)
-  (Quad . -> . Quad)
+  (Quad -> Quad)
   (define result 
     (let loop : QuadListItem ([qli : QuadListItem qli][parent-x : Float 0.0][parent-y : Float 0.0])
       (cond
         [(quad? qli)
-         (display 'foom3)
          (define adjusted-x (round-float (+ (assert (quad-attr-ref qli world:x-position-key 0.0) flonum?) parent-x)))
          (define adjusted-y (round-float (+ (assert (quad-attr-ref qli world:y-position-key 0.0) flonum?) parent-y)))
-         (quad (quad-name qli) (merge-attrs qli (list world:x-position-key adjusted-x world:y-position-key adjusted-y)) ((inst map QuadListItem QuadListItem) (λ(qlii) (loop qlii adjusted-x adjusted-y)) (quad-list qli)))]
+         (quad (quad-name qli) (merge-attrs qli (list world:x-position-key adjusted-x world:y-position-key adjusted-y)) (map (λ([qlii : QuadListItem]) (loop qlii adjusted-x adjusted-y)) (quad-list qli)))]
         [else ;; it's a string
          qli])))
   (if (string? result)
@@ -176,35 +174,35 @@
 ;; is that they strip out type.
 ;; whereas these "surgical" alternatives can be used when preserving type is essential
 (define/typed+provide (attr-change qas kvs)
-  (QuadAttrs HashableList . -> . QuadAttrs)
+  (QuadAttrs HashableList -> QuadAttrs)
   (merge-attrs qas kvs))
 
 (define/typed+provide (attr-delete qas . ks)
-  (QuadAttrs QuadAttrKey * . -> . QuadAttrs)
+  (QuadAttrs QuadAttrKey * -> QuadAttrs)
   (filter (λ([qa : QuadAttr]) (not (ormap (λ(k) (equal? (car qa) k)) ks))) qas))
 
 
 ;; functionally update a quad attr. Similar to hash-set
 (define/typed+provide (quad-attr-set q k v)
   (case->
-   (GroupQuad QuadAttrKey QuadAttrValue . -> . GroupQuad)
-  (Quad QuadAttrKey QuadAttrValue . -> . Quad))
+   (GroupQuad QuadAttrKey QuadAttrValue -> GroupQuad)
+  (Quad QuadAttrKey QuadAttrValue -> Quad))
   (quad-attr-set* q (list k v)))
 
 
 ;; functionally update multiple quad attrs. Similar to hash-set*
 (define/typed+provide (quad-attr-set* q kvs)
   (case->
-   (GroupQuad HashableList . -> . GroupQuad)
-   (Quad HashableList . -> . Quad))
+   (GroupQuad HashableList -> GroupQuad)
+   (Quad HashableList -> Quad))
   (quad (quad-name q) (attr-change (quad-attrs q) kvs) (quad-list q)))
 
 
 ;; functionally remove multiple quad attrs. Similar to hash-remove*
 (define/typed+provide (quad-attr-remove* q . ks)
   (case->
-   (GroupQuad QuadAttrKey * . -> . GroupQuad)
-   (Quad QuadAttrKey * . -> . Quad))
+   (GroupQuad QuadAttrKey * -> GroupQuad)
+   (Quad QuadAttrKey * -> Quad))
   (if (not (empty? (quad-attrs q)))
       ;; test all ks as a set so that iteration through attrs only happens once
       (quad (quad-name q) (apply attr-delete (quad-attrs q) ks) (quad-list q))
@@ -218,7 +216,7 @@
 
 ;; the last char of a quad
 (define/typed+provide (quad-last-char q)
-  (Quad . -> . (Option String))
+  (Quad -> (Option 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))))
       #f
@@ -229,7 +227,7 @@
 
 ;; the first char of a quad
 (define/typed+provide (quad-first-char q)
-  (Quad . -> . (Option String))
+  (Quad -> (Option 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))))
       #f
@@ -241,21 +239,21 @@
 
 ;; todo: how to guarantee line has leading key?
 (define/typed+provide (compute-line-height line)
-  (Quad . -> . Quad)
+  (Quad -> Quad)
   (quad-attr-set line world:height-key (quad-attr-ref/parameter line world:leading-key)))
 
 (define/typed (fixed-height? q)
-  (Quad . -> . Boolean)
+  (Quad -> Boolean)
   (quad-has-attr? q world:height-key))
 
 (define/typed+provide (quad-height q)
-  (Quad . -> . Float)
+  (Quad -> Float)
   (display 'foom)
   (assert (quad-attr-ref q world:height-key 0.0) flonum?))
 
 ;; use heights to compute vertical positions
 (define/typed+provide (add-vert-positions starting-quad)
-  (GroupQuad . -> . GroupQuad)
+  (GroupQuad -> GroupQuad)
   (define-values (new-quads final-height)
     (for/fold ([new-quads : (Listof Quad) empty][height-so-far : Float 0.0])
               ([q (in-list (quad-list starting-quad))])
@@ -265,7 +263,7 @@
 
 ;; recursively hyphenate strings in a quad
 (define/typed+provide (hyphenate-quad x)
-  (QuadListItem . -> . QuadListItem)
+  (QuadListItem -> QuadListItem)
   (cond
     [(quad? x) (quad-map hyphenate-quad x)]
     [(string? x) (hyphenate x

quad/wrap-typed.rkt

@@ -1,31 +1,28 @@
 #lang typed/racket/base
 (require (for-syntax racket/base racket/syntax))
-(require/typed sugar/list [slicef-after ((Listof Quad) (Quad . -> . Boolean) . -> . (Listof (Listof Quad)))]
-               ;; shift: need False in type because shift fills with #f
-               [shift ((Listof Quad) (Listof Integer) . -> . (List (Listof (U False Quad)) (Listof (U False Quad))))]
-               [break-at ((Listof PieceQuad) (Listof Breakpoint) . -> . (Listof (Listof PieceQuad)))])
+(require typed/sugar/list typed/sugar/define)
 (require math/flonum (except-in racket/list flatten) racket/vector math/statistics racket/bool)
 (require/typed racket/list [flatten (All (A) (Rec as (U Any (Listof as))) -> (Listof Any))])
 (require "ocm-typed.rkt" "quads-typed.rkt" "utils-typed.rkt" "measure-typed.rkt" "world-typed.rkt" "logger-typed.rkt" "core-types.rkt" "utils-typed.rkt")
 
 ;; predicate for the soft hyphen
 (define/typed (soft-hyphen? x)
-  (String . -> . Boolean)
+  (String -> Boolean)
   (equal? (format "~a" world:soft-hyphen) x))
 
 ;; visible characters that also mark possible breakpoints
 (define/typed (visible-breakable? x)
-  (String . -> . Boolean)
+  (String -> Boolean)
   (and (member x world:hyphens-and-dashes) #t))
 
 ;; invisible characters that denote possible breakpoints
 (define/typed (invisible-breakable? x)
-  (String . -> . Boolean)
+  (String -> Boolean)
   (and (member x (cons world:empty-string world:spaces)) #t))
 
 ;; union of visible & invisible
 (define/typed (breakable? x)
-  (Any . -> . Boolean)
+  (Any -> Boolean)
   (cond
     [(string? x) (or (visible-breakable? x) (invisible-breakable? x))]
     ;; word? should have a filter that returns a Quad type, then the Quad? check will be unnecessary
@@ -35,20 +32,20 @@
 ;; used by insert-spacers to determine which characters 
 ;; can be surrounded by stretchy spacers 
 (define/typed (takes-justification-space? x)
-  (Any . -> . Boolean)
+  (Any -> 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/typed (possible-word-break-quad? q)
-  (Quad . -> . Boolean)
+  (Quad -> Boolean)
   (or (word-break? q) (breakable? q)))
 
 
 ;; convert a possible word break into an actual one
 (define/typed (convert-to-word-break q)
-  (Quad . -> . Quad)
+  (Quad -> Quad)
   (when (not (possible-word-break-quad? q))
     (error 'convert-to-word-break "input is not a possible word break:" q))
   (define result (cond 
@@ -69,7 +66,7 @@
   (or result (error 'convert-to-word-break "result was a not word break for input:" q)))
 
 (define/typed (make-unbreakable q)
-  (Quad . -> . Quad)
+  (Quad -> Quad)
   (quad-attr-set q world:unbreakable-key #t))
 
 
@@ -78,7 +75,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-type Make-Pieces-Type ((Listof Quad) . -> . (Listof PieceQuad)))
+(define-type Make-Pieces-Type ((Listof Quad) -> (Listof PieceQuad)))
 (define/typed (make-pieces qs)
   Make-Pieces-Type
   (define-values (breakable-items items-to-make-unbreakable) (split-at-right qs (min world:minimum-last-line-chars (length qs))))
@@ -86,7 +83,7 @@
   (define lists-of-quads (slicef-after unbreak-qs (λ([q : Quad]) (and (possible-word-break-quad? q) (not (quad-attr-ref q world:unbreakable-key #f))))))
   (define-values (first-lists-of-quads last-list-of-quads) (split-last lists-of-quads))
   (define/typed (make-first-pieces qs)
-    ((Listof Quad) . -> . PieceQuad) 
+    ((Listof Quad) -> PieceQuad) 
     (let-values ([(first-qs last-q) ((inst split-last Quad) qs)])
       (apply piece (list world:word-break-key (convert-to-word-break last-q)) first-qs)))
   (append (map make-first-pieces first-lists-of-quads) 
@@ -95,7 +92,7 @@
 
 ;; extract font attributes from quad, or get default values
 (define/typed (font-attributes-with-defaults q)
-  (Quad . -> . (List Font-Size Font-Name Font-Weight Font-Style))
+  (Quad -> (List Font-Size Font-Name Font-Weight Font-Style))
   (list
    (assert (let ([size (quad-attr-ref/parameter q world:font-size-key)])
              (if (exact-integer? size) (fl size) size)) Font-Size?)
@@ -108,12 +105,12 @@
 ;; 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-type Measure-Quad-Type (Quad . -> . Float))
+(define-type Measure-Quad-Type (Quad -> Float))
 (define/typed (quad-width q)
   Measure-Quad-Type
   (cond
     [(quad-has-attr? q world:width-key) (fl (assert (quad-attr-ref q world:width-key) flonum?))]
-    [(ormap (λ([pred : (Any . -> . Boolean)]) (pred q)) (list char? run? word? word-break?)) 
+    [(ormap (λ([pred : (Any -> Boolean)]) (pred q)) (list char? run? word? word-break?)) 
      (apply measure-text (word-string q) 
             (font-attributes-with-defaults q))]
     [(LineQuad? q) (foldl fl+ 0.0 (map quad-width (quad-list q)))]
@@ -124,12 +121,12 @@
 ;; consult the attrs, and if not available, compute it.
 ;; not designed to update the source quad.
 (define/typed (ascent q)
-  (Quad . -> . Float)
+  (Quad -> Float)
   (define ascent-value-or-false (quad-attr-ref q world:ascent-key #f))
   (if (and ascent-value-or-false (flonum? ascent-value-or-false))
       ascent-value-or-false
       (cond 
-        [(ormap (λ([pred : (Any . -> . Boolean)]) (pred q)) (list char? run? word? word-break?)) 
+        [(ormap (λ([pred : (Any -> Boolean)]) (pred q)) (list char? run? word? word-break?)) 
          (apply measure-ascent (word-string q) (font-attributes-with-defaults q))]
         [else 0.0])))
 
@@ -161,31 +158,31 @@
 
 ;; shorthand 
 (define/typed (render-piece-before-break p)
-  (PieceQuad . -> . PieceQuad)
+  (PieceQuad -> PieceQuad)
   (render-piece p #t))
 
 
 ;; helper macro to convert quad into word-break.
 ;; look up the break character and convert the quad based on what is found.
 (define/typed (render-word-break wb key)
-  (Word-BreakQuad Symbol . -> . Quad)
+  (Word-BreakQuad Symbol -> Quad)
   (let ([break-char (quad-attr-ref wb key)])
     (quad (if (whitespace? break-char) 'word-break 'word)
           (quad-attrs (quad-attr-remove* wb world:no-break-key world:before-break-key)) (list (assert (quad-attr-ref wb key) string?)))))
 
 ;; uses macro above in no-break mode.
 (define/typed (word-break->no-break wb)
-  (Word-BreakQuad . -> . Quad)
+  (Word-BreakQuad -> Quad)
   (render-word-break wb world:no-break-key))
 
 ;; uses macro above in before-break mode.
 (define/typed (word-break->before-break wb)
-  (Word-BreakQuad . -> . Quad)
+  (Word-BreakQuad -> Quad)
   (render-word-break wb world:before-break-key))
 
 ;; is this the last line? compare current line-idx to total lines 
 (define/typed (last-line? line)
-  (Quad . -> . Boolean)
+  (Quad -> Boolean)
   (define line-idx (assert (quad-attr-ref line world:line-index-key #f) Index?))
   (define lines (assert (quad-attr-ref line world:total-lines-key #f) Index?))
   (and line-idx lines (= (add1 line-idx) lines)))
@@ -200,9 +197,9 @@
 ;; it just looks at quads on both sides and kerns them if appropriate.
 ;; in practice, only one will likely be used.
 (define/typed (render-optical-kerns exploded-line-quads)
-  ((Listof Quad) . -> . (Listof Quad))
+  ((Listof Quad) -> (Listof Quad))
   (define/typed (overhang-width q)
-    ((U Quad False) . -> . Float)
+    ((U Quad False) -> Float)
     (if (and (word? q) (member (word-string q) world:hanging-chars))
         (* -1.0 (world:optical-overhang) (apply measure-text (word-string q) (font-attributes-with-defaults q)))
         0.0))
@@ -243,7 +240,7 @@
                                          [else (values #f #f #f)]))
   
   (define/typed (copy-with-attrs q attr-source)
-    (Quad Quad . -> . Quad)
+    (Quad Quad -> Quad)
     (define keys-to-ignore '(width)) ; width will be determined during fill routine
     (define filtered-attrs (and (quad-attrs attr-source)
                                 (quad-attrs (apply quad-attr-remove* attr-source keys-to-ignore))))
@@ -264,23 +261,23 @@
 ;; installs the width in the quad.
 ;; this becomes the value reported by quad-width.
 (define/typed (embed-width q w)
-  (Quad Float . -> . Quad)
+  (Quad Float -> Quad)
   (quad-attr-set q world:width-key w))
 
 ;; installs the ascent in the quad.
 (define/typed (record-ascent q)
-  (Quad . -> . Quad)
+  (Quad -> Quad)
   (quad-attr-set q world:ascent-key (ascent q)))
 
 ;; helper function: doesn't need contract because it's already covered by the callers
 (define/typed (render-pieces ps)
-  ((Listof PieceQuad) . -> . (Listof PieceQuad))
+  ((Listof PieceQuad) -> (Listof PieceQuad))
   (define-values (initial-ps last-p) ((inst split-last PieceQuad) ps))
   (snoc (map render-piece initial-ps) (render-piece-before-break last-p)))
 
 
 (define/typed (calc-looseness total-width measure)
-  (Float Float . -> . Float)
+  (Float Float -> Float)
   (round-float (fl/ (fl- measure total-width) measure)))
 
 
@@ -288,7 +285,7 @@
 ;; take the contents of the rendered pieces and merge them.
 ;; compute looseness for line as a whole.
 ;; also add ascent to each component quad, which can be different depending on font & size.
-(define-type Compose-Line-Type ((Listof PieceQuad) (Quad . -> . Float) . -> . LineQuad))
+(define-type Compose-Line-Type ((Listof PieceQuad) (Quad -> Float) -> LineQuad))
 (define/typed (pieces->line ps measure-quad-proc)
   Compose-Line-Type
   (define rendered-pieces (render-pieces ps))
@@ -328,12 +325,12 @@
 
 ;; a faster line-measuring function used by the wrapping function to test lines.
 (define/typed (measure-potential-line ps)
-  ((Listof PieceQuad) . -> . Float)
+  ((Listof PieceQuad) -> Float)
   (foldl fl+ 0.0 (append-map (λ([rp : PieceQuad]) (map quad-width (quad-list rp))) (render-pieces ps))))
 
 
 (define/typed (vector-break-at vec bps)
-  ((Vectorof Any) (Listof Nonnegative-Integer) . -> . (Listof (Vectorof Any)))
+  ((Vectorof Any) (Listof Nonnegative-Integer) -> (Listof (Vectorof Any)))
   (define-values (vecs _) ;; loop backward
     (for/fold ([vecs : (Listof (Vectorof Any)) empty][end : Nonnegative-Integer (vector-length vec)])([start (in-list (reverse (cons 0 bps)))])
       (if (= start end)
@@ -368,7 +365,7 @@
 (define (breakpoints? x) (and (list? x) (andmap integer? x)))
 
 (define/typed (install-measurement-keys p)
-  (GroupQuad . -> . Quad)
+  (GroupQuad -> Quad)
   (define basic-width (round-float
                        (foldl fl+ 0.0 (map quad-width (quad-list p)))))
   (define p-word-break (assert (quad-attr-ref p world:word-break-key #f) quad?))
@@ -382,7 +379,7 @@
 
 (require sugar/debug)
 (define/typed (make-piece-vectors pieces)
-  ((Vectorof PieceQuad) . -> . (values (Vectorof Float) (Vectorof Float))) 
+  ((Vectorof PieceQuad) -> (values (Vectorof Float) (Vectorof Float))) 
   (define pieces-measured 
     (for/list : (Listof (Vector Float Float Float)) ([p (in-vector pieces)])
       (define wb (assert (quad-attr-ref p world:word-break-key #f) (λ(wb) (or (false? wb) (quad? wb)))))
@@ -403,20 +400,20 @@
 
 
 (define/typed (make-trial-line pieces-rendered-widths pieces-rendered-before-break-widths i j)
-  ((Vectorof Float) (Vectorof Float) Breakpoint Breakpoint . -> . (Vectorof Float))
+  ((Vectorof Float) (Vectorof Float) Breakpoint Breakpoint -> (Vectorof Float))
   (let ([vec (vector-copy pieces-rendered-widths i j)])
     (vector-set! vec (sub1 (vector-length vec)) (vector-ref pieces-rendered-before-break-widths (sub1 j)))
     vec))
 
 (define/typed (get-line-width line)
-  ((Vectorof Float) . -> . Float)
+  ((Vectorof Float) -> Float)
   (round-float (foldl + 0.0 (vector->list line))))
 
 (struct $penalty ([hyphens : Nonnegative-Integer][width : Value-Type]) #:transparent)
 
 ;; top-level adaptive wrap proc.
 ;; first-fit and best-fit are variants.
-(define-type Find-Breakpoints-Type ((Vectorof PieceQuad) Float . -> . (Listof Breakpoint)))
+(define-type Find-Breakpoints-Type ((Vectorof PieceQuad) Float -> (Listof Breakpoint)))
 (define/typed (adaptive-fit-proc pieces measure [use-first? #t] [use-best? #t])
   (((Vectorof PieceQuad) Float) (Boolean Boolean) . ->* . (Listof Nonnegative-Integer))
   
@@ -469,7 +466,7 @@
     [else
      
      (define/typed ($penalty->value x)
-       ($penalty . -> . Value-Type)
+       ($penalty -> Value-Type)
        ($penalty-width x))
      (define initial-value ($penalty 0 0.0))
      
@@ -559,7 +556,7 @@
 
 
 (define/typed (fixed-width? q) 
-  (Quad . -> . Boolean)
+  (Quad -> Boolean)
   (quad-has-attr? q world:width-key))
 
 
@@ -590,7 +587,7 @@
 ;; add x positions to a list of fixed-width quads
 ;; todo: adjust this to work recursively, so that positioning operation cascades down
 (define/typed+provide (add-horiz-positions starting-quad)
-  (GroupQuad . -> . GroupQuad)
+  (GroupQuad -> GroupQuad)
   (define-values (new-quads final-width)
     (for/fold ([new-quads : (Listof Quad) empty][width-so-far : Float 0.0])([q (in-list (quad-list starting-quad))])
       (values (cons (quad-attr-set q world:x-position-key width-so-far) new-quads) (round-float (fl+ (quad-width q) width-so-far)))))