a step

quad/quad/break.rkt

@@ -33,7 +33,7 @@
                   #:hard-break-proc procedure?
                   #:soft-break-proc procedure?
                   #:finish-wrap-proc procedure?) . ->* . (listof any/c))
-  (break-private xs
+  (break-hards xs
                target-size
                debug
                break-val
@@ -45,7 +45,7 @@
 
 ;; the hard breaks are used to divide the wrap territory into smaller chunks
 ;; that can be cached, parallelized, etc.
-(define (break-private xs
+(define (break-hards xs
                      target-size
                      debug
                      break-val
@@ -54,28 +54,29 @@
                      hard-break?
                      soft-break?
                      finish-wrap-proc)
-  (define break-val-equal? (if (symbol? break-val) eq? equal?))
+  (define break-val=? (if (symbol? break-val) eq? equal?))
-  (define (cleanup-wraplist xs) (dropf-right (append* (reverse xs)) (λ (x) (break-val-equal? break-val x))))
+  (define (cleanup-wraplist xs)
+    (dropf-right (append* (reverse xs)) (λ (x) (break-val=? break-val x))))
   (define wraps
     (for/fold ([wraps null]
-               [xs (dropf xs hard-break?)]
+               [xs xs]
-               #:result (map touch wraps))
+               #:result wraps)
               ([i (in-naturals)]
                #:break (null? xs))
-      (cond
+      (match xs
-        [(hard-break? (car xs))
+        [(cons (? hard-break?) rest)
          (when debug (report x 'hard-break))
-         (values (cons (future (λ () (list break-val))) wraps) (cdr xs))]
+         (values (cons (list break-val) wraps) rest)]
-        [else
+        [_ (define-values (head tail) (splitf-at xs (λ (x) (not (hard-break? x)))))
-         (define-values (head tail) (splitf-at xs (λ (x) (not (hard-break? x)))))
+           (values (cons (cleanup-wraplist (break-softs head
-         (values (cons (future (λ () (cleanup-wraplist (break-softs head
                                                         target-size
                                                         debug
                                                         break-val
                                                         soft-break?
-                                                                    finish-wrap-proc)))) wraps) tail)])))
+                                                        finish-wrap-proc)) wraps) tail)])))
-  (append (if break-before? (list break-val) empty) (cleanup-wraplist wraps) (if break-after? (list break-val) empty)))
+  (append (if break-before? (list break-val) empty)
-
+          (cleanup-wraplist wraps)
+          (if break-after? (list break-val) empty)))
 
 (define (nonprinting-at-start? x) (if (quad? x) (not (printable? x 'start)) #t))
 (define (nonprinting-at-end? x) (if (quad? x) (not (printable? x 'end)) #t))
@@ -90,24 +91,20 @@
   (define (capture-soft-break-k!)
     (when debug (report 'capturing-break))
     (let/cc k (set! last-soft-break-k k) #f))
-  (call/prompt ;; continuation boundary for last-soft-break-k
-   (thunk
   (let loop ([wraps null][wrap-pieces null][dist-so-far start-signal][xs xs])
-      (cond
+    (match xs
-        [(null? xs)
+      [(== empty)
        ;; combine the segments into a flat list, and drop any trailing breaks
        ;; (on the idea that breaks should separate things, and there's nothing left to separate)
        ;; wraps alternate with breaks
-         (for/list ([pcs (in-list (cons wrap-pieces wraps))]
+       (for/list ([pcs (in-list (cons wrap-pieces wraps))])
-                    [proc (in-cycle (list 
+         (match pcs
+           [(list (? nonprinting-at-end?)) pcs] ; matches break signals
            ;; pieces will have been accumulated in reverse order
-                                     ;; dropf drops from beginning of list (representing the end of the wrap)
+           ;; thus beginning of list represents the end of the wrap
-                  
+           [(list (? (conjoin soft-break? nonprinting-at-end?)) ... rest ...)
-                                     (λ (pcs) (finish-wrap-proc (reverse (dropf pcs (λ (x) (and (soft-break? x) (nonprinting-at-end? x)))))))
+            (finish-wrap-proc (reverse rest))]))]
-                                     values))])
+      [(cons x _)
-           (proc pcs))]
-        [else
-         (define x (car xs))
        (define at-start? (eq? dist-so-far start-signal))
        (define underflow? (and (not at-start?) (<= (+ dist-so-far (if (and (quad? x) (printable? x 'end)) (distance x) 0)) target-size)))
        (define (values-for-insert-break [before? #f])
@@ -168,7 +165,7 @@
           (loop (list* (list break-val) pieces-for-this-wrap wraps)
                 null
                 start-signal
-                  next-xs)])])))))
+                next-xs)])])))
 
 
 (define x (q (list 'size (pt 1 1)) #\x))