From ec32b352f9e2fbb2ffa5dbdc08648d0d549b45f0 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Sat, 10 Feb 2018 16:09:30 -0600
Subject: [PATCH] touch

---
 quad/quad/break.rkt | 29 +++++++++++------------------
 1 file changed, 11 insertions(+), 18 deletions(-)

diff --git a/quad/quad/break.rkt b/quad/quad/break.rkt
index 64795e15..42dc68ca 100644
--- a/quad/quad/break.rkt
+++ b/quad/quad/break.rkt
@@ -19,12 +19,6 @@
                      #:mandatory-break-proc procedure?
                      #:optional-break-proc procedure?
                      #:size-proc procedure?) . ->* . (listof any/c))
-  #;(and (pair? xs)
-         (let ([can-be-break? (disjoin mandatory-break? optional-break?)])
-           (for/first ([x (in-list xs)]
-                       [next-x (in-list (cdr xs))]
-                       #:when (and (can-be-break? x) (can-be-break? next-x)))
-             (raise-argument-error 'breaks "no adjacent break possibilities allowed in input" (list x next-x)))))
   (define start-signal (gensym))
   (define last-breakpoint-k #f)
   (define (capture-k!) (let/cc k (set! last-breakpoint-k k) #f))
@@ -32,13 +26,12 @@
              [size-so-far start-signal]
              #:result (reverse (dropf vals optional-break?)))
             ([x (in-list xs)])
-    (define (at-start?) (eq? size-so-far start-signal))
-    (define (underflow?) (<= (+ size-so-far size-end) target-size))
-    (define (add-to-segment)
-      (values (cons x vals) (if (at-start?)
-                                size-start
-                                (+ size-so-far size-mid))))
     (define-values (size-start size-mid size-end) (size-proc x))
+    (define at-start? (eq? size-so-far start-signal))
+    (define underflow? (and (not at-start?) (<= (+ size-so-far size-end) target-size)))
+    (define (add-to-segment) (values (cons x vals) (if at-start?
+                                                       size-start
+                                                       (+ size-so-far size-mid))))
     (define (insert-break)
       ;; when break is found, q is omitted from accumulation
       ;; and any preceding optional breaks are dropped (that would be trailing before the break)
@@ -48,14 +41,14 @@
                             (insert-break)]
       [(optional-break? x)
        (cond
-         [(at-start?) (when debug (report x 'skipping-opt-break-at-beginning)) (values vals size-so-far)]
-         [(and (underflow?) (capture-k!)) (when debug (report x 'resuming-breakpoint))
-                                          (set! last-breakpoint-k #f) ;; prevents continuation loop
-                                          (insert-break)]
+         [at-start? (when debug (report x 'skipping-opt-break-at-beginning)) (values vals size-so-far)]
+         [(and underflow? (capture-k!)) (when debug (report x 'resuming-breakpoint))
+                                        (set! last-breakpoint-k #f) ;; prevents continuation loop
+                                        (insert-break)]
          [else (when debug (report x 'add-optional-break))
                (add-to-segment)])]
-      [(or (at-start?) (underflow?)) (when debug (report x 'add-ordinary-char))
-                                          (add-to-segment)]
+      [(or at-start? underflow?) (when debug (report x 'add-ordinary-char))
+                                 (add-to-segment)]
       [last-breakpoint-k (when debug (report x 'invoking-last-breakpoint))
                          (last-breakpoint-k #t)]
       [else (when debug (report x 'falling-back))