performance research

quad/main.rkt

@@ -194,7 +194,7 @@
   (coerce/input? . -> . doc?)  
   (cond
     [(input? x) (load-text-cache-file)
-                (define multipages (input->multipages x)) ; 125 = timings for jude0
+                (define multipages (time (input->multipages x))) ; 125 = timings for jude0
                 (define pages (append-map typeset multipages)) ; 1446
                 (define doc (typeset pages)) ; 250
                 (update-text-cache-file)

quad/measure.rkt

@@ -1,5 +1,5 @@
 #lang racket/base
-(require math/flonum racket/draw racket/class racket/contract sugar/debug sugar/list racket/list sugar/cache racket/serialize racket/file)
+(require math/flonum racket/draw racket/class sugar/debug sugar/list racket/list sugar/cache racket/serialize racket/file)
 (provide measure-text measure-ascent round-float update-text-cache-file load-text-cache-file)
 
 (define precision 4.0)
@@ -10,7 +10,7 @@
 
 (define dc (new record-dc%))
 
-(define max-size 1000.0)
+(define max-size 1024) ; use fixnum to trigger faster bitshift division
 
 (define/caching (make-font/caching font weight style)
   (make-font #:size max-size #:style style #:weight weight #:face font))
@@ -26,8 +26,8 @@
 (define (load-text-cache-file) 
   (define cache-file-path (get-cache-file-path))
   (current-text-cache (if (file-exists? cache-file-path)
-      (deserialize (file->value cache-file-path))
+                          (deserialize (file->value cache-file-path))
-      (make-hash))))
+                          (make-hash))))
 
 (define current-text-cache (make-parameter (make-hash)))
 (define current-text-cache-changed? (make-parameter #f))
@@ -36,32 +36,32 @@
 (define/caching (measure-max-size text font [weight 'normal] [style 'normal])
   ;((string? string?) (symbol? symbol?) . ->* . number?)
   (define font-instance (hash-ref! (current-font-cache) (list font weight style) (λ() (make-font #:size max-size #:style style #:weight weight #:face font))))
-  ;; combine boolean only makes a difference for two or more chars
+  ;; 'combine' boolean only makes a difference for two or more chars
   (hash-ref! (current-text-cache) (list text font weight style) (λ() (current-text-cache-changed? #t)
                                                                   (values->list (send dc get-text-extent text font-instance (>= (string-length text) 1))))))
 
-(define (width x) (first x))
+(define-syntax-rule (width x) (first x))
-(define (height x) (second x))
+(define-syntax-rule (height x) (second x))
-(define (descent x) (third x))
+(define-syntax-rule (descent x) (third x))
-(define (extra x) (fourth x)) 
+(define-syntax-rule (extra x) (fourth x)) 
 
-(define (measure-text-max-size text font [weight 'normal] [style 'normal])
+(define-syntax-rule (measure-text-max-size text font weight style)
   (width (measure-max-size text font weight style)))
 
-(define/contract (measure-text text size font [weight 'normal] [style 'normal])
+(define (measure-text text size font [weight 'normal] [style 'normal])
-  ((string? flonum? string?) (symbol? symbol?) . ->* . flonum?)
+  ;  ((string? flonum? string?) (symbol? symbol?) . ->* . flonum?)
   ;; Native function only accepts integers, so get max-size and scale down to size needed.
   (define raw-measure (measure-text-max-size text font weight style))
-  (round-float (fl/ (fl* (fl raw-measure) size) max-size)))
+  (round-float (/ (* (exact->inexact raw-measure) (exact->inexact size)) max-size)))
 
 
-(define (measure-ascent-max-size text font [weight 'normal] [style 'normal])
+(define-syntax-rule (measure-ascent-max-size text font weight style)
-  (define result-list (measure-max-size text font weight style))
+  (let ([result-list (measure-max-size text font weight style)])
-  (- (height result-list) (descent result-list)))
+    (- (height result-list) (descent result-list))))
 
 
-(define/contract (measure-ascent text size font [weight 'normal] [style 'normal])
+(define (measure-ascent text size font [weight 'normal] [style 'normal])
-  ((string? flonum? string?) (symbol? symbol?) . ->* . flonum?)
+  ;  ((string? flonum? string?) (symbol? symbol?) . ->* . flonum?)
   ;; Native function only accepts integers, so get max-size and scale down to size needed.
   (define raw-baseline-distance (measure-ascent-max-size text font weight style))
-  (round-float (fl/ (fl* (fl raw-baseline-distance) size) max-size)))
+  (round-float (/ (* (exact->inexact raw-baseline-distance) (exact->inexact size)) max-size)))

quad/utils.rkt

@@ -96,8 +96,7 @@
 ;; flatten quad as above, 
 ;; then dissolve it into individual character quads while copying attributes
 ;; input is often large, so macro allows us to avoid allocation
-(provide split-quad)
+(define+provide (split-quad q)
-(define-syntax-rule (split-quad q)
   ;(quad? . -> . quads?)
   (letrec ([do-explode (λ(x [parent #f])
                          (cond
@@ -105,9 +104,11 @@
                             (if (empty? (quad-list x))
                                 x ; no subelements, so stop here
                                 (map (λ(xi) (do-explode xi x)) (quad-list x)))] ; replace quad with its elements, exploded
-                           [(string? x) (map (λ(xc) (quad 'word (quad-attrs parent) (list xc))) (regexp-match* #px"." x))]))])
+                           [else (map (λ(xc) (quad 'word (quad-attrs parent) (list xc))) (regexp-match* #px"." x))]))])
     (flatten (map do-explode (flatten-quad q)))))
 
+
+
 ;; merge chars into words (and boxes), leave the rest
 ;; if two quads are mergeable types, and have the same attributes,
 ;; they get merged.

quad/world.rkt

@@ -94,4 +94,4 @@
 (define min-last-lines 2)
 (define default-lines-per-column 36)
 
-(define-parameter logging-level 'debug)
+(define-parameter logging-level 'info)