better, but vertical line spacing isn't working

quad/main-typed-sample.rkt

@@ -2,7 +2,7 @@
 (require "main-typed.rkt" "logger-typed.rkt" "world-typed.rkt" "samples-typed.rkt" "quads-typed.rkt")
 
 (require/typed profile
-                [profile-thunk ((-> Any) [#:delay Float]  . -> . Quad)])
+               [profile-thunk (All (A) ((-> A) [#:delay Float] -> A))])
 
 (require "render-typed.rkt" typed/racket/class)
 (activate-logger quad-logger)
@@ -11,6 +11,6 @@
                [world:paper-width-default 600.0]
                [world:paper-height-default 700.0])
   (define sample (ti5))
-;  (define to (time (profile-thunk #:delay 0.001 (λ () (typeset sample)))))
+  ;  (define to (time (profile-thunk #:delay 0.001 (λ () (typeset sample)))))
   (define to (time (typeset sample)))
   (time (send (new pdf-renderer%) render-to-file to "foo-typed.pdf")))

quad/main-typed-tests.rkt

@@ -3,7 +3,7 @@
 (require "main-typed.rkt" "quads-typed.rkt" "world-typed.rkt")
 
 
-(check-equal? (input->nested-blocks (input #f (block #f "1" (block-break) "2"))) 
+(check-equal? (input->nested-blocks (input '() (block '() "1" (block-break) "2"))) 
               (list (list (list (list (quad 'word '#hash() '("1"))) (list (quad 'word '#hash() '("2")))))))
 (check-equal? (input->nested-blocks (input #f (block #f "1" (column-break) "2"))) 
               (list (list (list (list (quad 'word '#hash() '("1")))) (list (list (quad 'word '#hash() '("2")))))))

quad/main-typed.rkt

@@ -1,6 +1,22 @@
 #lang typed/racket/base
-(require racket/list math/flonum)
-(require/typed sugar/list [slice-at ((Listof Quad) Positive-Integer . -> . (Listof (Listof Quad)))])
+(require racket/list math/flonum typed/racket/class)
+(require typed/sugar/define typed/sugar/list)
+(require/typed csp
+               [problem%  (Class (init-field [solver Any])
+                                 (field [_solver Any])
+                                 (field [_variable-domains Any])
+                                 (field [_constraints Any])
+                                 [reset (-> Void)]
+                                 [custom-print (Output-Port Integer -> Void)]
+                                 [custom-display (Output-Port -> Void)]
+                                 [custom-write (Output-Port -> Void)]
+                                 [add-variable (Any (Listof Any) . -> . Void)]
+                                 [add-variables ((Listof Any) Any . -> . Void)]
+                                 [add-constraint ((Index . -> . Boolean) (Listof Any) . -> . Void)][get-solution (-> HashTableTop)]
+                                 [get-solutions (-> (Listof (HashTable String Integer)))]
+                                 [get-solution-iter (-> HashTableTop)]
+                                 [set-solver (Any . -> . Void)]
+                                 [get-solver (-> Any)])])
 (require "quads-typed.rkt" "utils-typed.rkt" "wrap-typed.rkt" "measure-typed.rkt" "world-typed.rkt" "logger-typed.rkt" "core-types.rkt")
 
 (define-type Block-Type (Listof Quad))
@@ -108,17 +124,10 @@
   (define doc (quads->doc mapped-pages))
   doc)
 
-(require racket/class)
-(require/typed csp
-               [problem%  (Class (init-field) 
-                                 (reset (-> Void))
-                                 (get-solution (-> HashTableTop))
-                                 (get-solutions (-> (Listof (HashTable String Integer))))
-                                 (add-variable (Any (Listof Any) . -> . Void))
-                                 (add-constraint ((Index . -> . Boolean) (Listof Any) . -> . Void)))])
+
 (define/typed+provide (lines->columns lines)
   ((Listof LineQuad) . -> . (Listof ColumnQuad))
-  (define prob (new problem%))
+  (define prob (new problem% [solver #f]))
   (define max-column-lines world:default-lines-per-column)
   (define-values (columns ignored-return-value)
     (for/fold ([columns : (Listof ColumnQuad) empty][lines-remaining : (Listof LineQuad) lines])
@@ -218,13 +227,21 @@
   ((Listof Quad) . -> . (Listof LineQuad))
   (block->lines (quads->block qs)))
 
+(require typed/sugar/debug)
 (define/typed+provide (typeset x)
-  (InputQuad . -> . DocQuad)
+  (Quad . -> . DocQuad)
   (load-text-cache-file)
-  (define pages (append* (for/list : (Listof (Listof PageQuad)) ([multipage (in-list (input->nested-blocks x))])
-                           (columns->pages (append* (for/list : (Listof (Listof ColumnQuad)) ([multicolumn (in-list multipage)])
-                                                      (lines->columns (append* (for/list : (Listof (Listof LineQuad)) ([block-quads (in-list multicolumn)])
-                                                                                 (block-quads->lines block-quads))))))))))
+  
+  (define pages (append*
+                 (for/list : (Listof (Listof PageQuad))
+                   ([multipage (in-list (input->nested-blocks x))])
+                   (columns->pages (append*
+                                    (for/list : (Listof (Listof ColumnQuad))
+                                      ([multicolumn (in-list multipage)])
+                                      (lines->columns (append*
+                                                       (for/list : (Listof (Listof LineQuad))
+                                                         ([block-quads (in-list multicolumn)])
+                                                         (block-quads->lines block-quads))))))))))
   (define doc (pages->doc pages))
   (update-text-cache-file)
   doc)

quad/quads-typed.rkt

@@ -53,7 +53,7 @@
   (if qa-result 
       ;; car beacause result of memf is a list tail; cadr because second element in pair
       (quadattr-value (car qa-result))
-      (if (not (equal? default attr-missing)) default (error 'key-not-found))))
+      (if (not (equal? default attr-missing)) default (error 'quad-attr-ref (format "Key ~v not found in quad attributes ~v" key qas)))))
 
 
 (define-syntax (quad-attr-ref/parameter stx)
@@ -92,9 +92,6 @@
 
 (define/typed+provide (gather-common-attrs qs)
   ((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)
       qs
       (let loop 
@@ -102,16 +99,16 @@
          ;; start with the set of pairs in the first quad, then filter it down
          [candidate-attr-pairs : (Listof QuadAttr) (let ([first-attrs (quad-attrs (car qs))])
                                                      (if first-attrs
-                                                         (for/fold ([kvps : QuadAttrs null]) ([qa (in-list first-attrs)])  
-                                                           (if (member (car qa) cannot-be-common-attrs)
-                                                               kvps
-                                                               (cons qa kvps)))
+                                                         (for/fold ([caps : QuadAttrs null]) ([cap (in-list first-attrs)])  
+                                                           (if (member (car cap) cannot-be-common-attrs)
+                                                               caps
+                                                               (cons cap caps)))
                                                          null))])
         (cond
           [(null? candidate-attr-pairs) null] ; ran out of possible pairs, so return #f
           [(null? qs) candidate-attr-pairs] ; ran out of quads, so return common-attr-pairs
           ;; todo: reconsider type interface between output of this function and input to quadattrs
-          [else (loop (cdr qs) (filter (λ([cap : QuadAttr]) (check-cap (car qs) cap)) candidate-attr-pairs))]))))
+          [else (loop (cdr qs) (filter (λ([cap : QuadAttr]) (member cap (quad-attrs (car qs)))) candidate-attr-pairs))]))))
 
 (define/typed (make-quadattrs xs)
   ;; no point typing the input as (U QuadAttrKey QuadAttrValue) 
@@ -145,7 +142,7 @@
            (define/typed (quads->id qs)
              ((Listof Quad) -> IdQuad)
              (apply id (gather-common-attrs qs) qs))
-        
+           
            (define-type IdQuad (List* 'id QuadAttrs #,(if (syntax->datum #'wants-group?)
                                                           #'GroupQuadList
                                                           #'QuadList)))
@@ -154,11 +151,11 @@
            
            (define/typed (id [attrs '()] #:zzz [zzz 0] . xs)
              (() ((U QuadAttrs HashableList) #:zzz Zero) #:rest #,(if (syntax->datum #'wants-group?)
-                                                          #'GroupQuadListItem
-                                                          #'QuadListItem) . ->* . IdQuad)
+                                                                      #'GroupQuadListItem
+                                                                      #'QuadListItem) . ->* . IdQuad)
              (quad 'id (if (QuadAttrs? attrs)
-                            attrs
-                            (make-quadattrs attrs)) xs))))]))
+                           attrs
+                           (make-quadattrs attrs)) xs))))]))
 
 (define/typed (whitespace? x [nbsp? #f])
   ((Any) (Boolean) . ->* . Boolean)  

quad/render-typed.rkt

@@ -1,5 +1,5 @@
 #lang typed/racket/base
-(require typed/racket/class racket/file racket/list typed/racket/draw typed/sugar/cache)
+(require typed/racket/class racket/file racket/list typed/racket/draw typed/sugar/cache typed/sugar/debug)
 (require "utils-typed.rkt" "quads-typed.rkt" "world-typed.rkt" "core-types.rkt")
 
 (define abstract-renderer%

quad/samples-typed.rkt

@@ -3,7 +3,7 @@
 (provide (all-defined-out))
 
 ;(define ti (block '(measure 54.0 leading 18.0) "Meg is an ally."))
-(define (ti2) (block '(leading 10.0 measure 400.0  size 13 x-align left x-align-last-line left font "Equity Text B") (block '() "Foo-d" (word '(size 13) "og ") "and " (box) "Zu" (word-break '(nb "c" bb "k-")) "kerman’s. Instead of a circle, the result is a picture of the code that, if it were used as an expression, would produce a circle. In other words, code is not a function, but instead a " (block '(style italic) "new syntactic form") " for creating pictures; the bit between the opening " (block '(weight bold) "parenthesis") " with code is not an expression, but instead manipulated by the code syntactic form. " (word '(font "Triplicate T4" size 22.5 color "Orchid" background "Yellow") "Bangazoom!") " This helps explain what we meant in the previous section when we said that racket provides require and the function-calling syntax.") (block-break) (block '() "Libraries are not restricted to exporting values, such as functions; they can also define new syntactic forms. In this sense, Racket isn’t exactly a language at all; it’s more of an idea for how to structure a language so that you can extend it or create entirely new ones.")))
+(define (ti2) (block '(leading 10.0 measure 400.0  size 13.0 x-align left x-align-last-line left font "Equity Text B") (block '() "Foo-d" (word '(size 13.0) "og ") "and " (box) "Zu" (word-break '(nb "c" bb "k-")) "kerman’s. Instead of a circle, the result is a picture of the code that, if it were used as an expression, would produce a circle. In other words, code is not a function, but instead a " (block '(style italic) "new syntactic form") " for creating pictures; the bit between the opening " (block '(weight bold) "parenthesis") " with code is not an expression, but instead manipulated by the code syntactic form. " (word '(font "Triplicate T4" size 22.5 color "Orchid" background "Yellow") "Bangazoom!") " This helps explain what we meant in the previous section when we said that racket provides require and the function-calling syntax.") (block-break) (block '() "Libraries are not restricted to exporting values, such as functions; they can also define new syntactic forms. In this sense, Racket isn’t exactly a language at all; it’s more of an idea for how to structure a language so that you can extend it or create entirely new ones.")))
 
 (define (ti3) (block '(measure 54.0 leading 18.0) "Meg is an ally."))
 

quad/tests-typed.rkt

@@ -12,6 +12,8 @@
 (check-equal? (flatten-attrs '(dup 100) '(dup 200)) '((dup . 200))) ; later overrides earlier
 
 (check-equal? (gather-common-attrs (list (box '(foo bar)) (box '(foo bar goo bar zam zino)) (box '(foo bar goo rab)))) '((foo . bar)))
+(check-equal? (gather-common-attrs (list (box '(foo bar zim zam)) (box '(foo bar)))) '((foo . bar)))
+(check-equal? (gather-common-attrs (list (box '(foo bar)) (box '(foo bar zim zam)))) '((foo . bar)))
 (check-equal? (gather-common-attrs (list (box) (box '(foo bar goo bar zam zino)) (box '(foo bar)))) empty)
 (check-equal? (gather-common-attrs (list (box '(width bar)) (box '(width bar)) (box '(width bar)))) empty)
 (check-equal? (gather-common-attrs (list (box '(foo bar)) (box '(foo zam)))) empty)
@@ -35,7 +37,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 '(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"))))
+              (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"))))
 
 (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")))
 
@@ -46,8 +48,8 @@
 
 (check-equal? (quad-attr-set (box '(foo bar)) 'foo 'zam) (box '(foo zam)))
 (check-equal? (quad-attr-set (box) 'foo 'zam) (box '(foo zam)))
-(check-equal? (quad-attr-set* (box) '(foo zam bar boo)) (box '(bar boo foo zam)))
-(check-equal? (quad-attr-set* (box '(foo bar)) '(foo zam bar boo)) (box '(bar boo foo zam)))
+(check-equal? (quad-attr-set* (box) '(foo zam bar boo)) (box '(foo zam bar boo)))
+(check-equal? (quad-attr-set* (box '(foo bar)) '(foo zam bar boo)) (box '(foo zam bar boo)))
 
 (check-equal? (quad-attr-remove (box '(foo bar zim zam)) 'foo) (box '(zim zam)))
 (check-equal? (quad-attr-remove (box) 'zim) (box))

quad/world-typed.rkt

@@ -88,7 +88,7 @@
 (define new-line-penalty 5000)
 (define hyphen-penalty 5000)
 
-(define hanging-chars '("." "-" "," "‘" "’" "“" "”" "'" "\"" ")" "(" "[" "]" "{" "}" ":" ";"))
+(define hanging-chars (regexp-match* #rx"." ".-,‘’“”'\"()[]{}:;"))
 
 (define minimum-lines-per-column 4)
 (define min-first-lines 2)