Remove the tail argument from do/until/while

basis/bit-arrays/bit-arrays.factor

@@ -78,7 +78,7 @@ M: bit-array byte-length length 7 + -3 shift ;
         [ dup 0 = ] [
             [ pick underlying>> pick set-alien-unsigned-1 ] keep
             [ 1+ ] [ -8 shift ] bi*
-        ] [ ] until 2drop
+        ] until 2drop
     ] if ;
 
 : bit-array>integer ( bit-array -- n )

basis/compiler/tree/propagation/propagation-tests.factor

@@ -441,7 +441,7 @@ TUPLE: mixed-mutable-immutable { x integer } { y sequence read-only } ;
 
 [ V{ real } ] [ [ recursive-test-3 ] final-classes ] unit-test
 
-[ V{ real } ] [ [ [ dup 10 < ] [ ] [ ] while ] final-classes ] unit-test
+[ V{ real } ] [ [ [ dup 10 < ] while ] final-classes ] unit-test
 
 [ V{ float } ] [
     [ { float } declare 10 [ 2.3 * ] times ] final-classes

basis/concurrency/mailboxes/mailboxes.factor

@@ -57,7 +57,7 @@ M: mailbox dispose* threads>> notify-all ;
     f mailbox-get-all-timeout ;
 
 : while-mailbox-empty ( mailbox quot -- )
-    [ '[ _ mailbox-empty? ] ] dip [ ] while ; inline
+    [ '[ _ mailbox-empty? ] ] dip while ; inline
 
 : mailbox-get-timeout? ( mailbox timeout pred -- obj )
     [ block-unless-pred ]

basis/deques/deques.factor

@@ -36,6 +36,6 @@ GENERIC: deque-empty? ( deque -- ? )
 : slurp-deque ( deque quot -- )
     [ drop '[ _ deque-empty? not ] ]
     [ '[ _ pop-back @ ] ]
-    2bi [ ] while ; inline
+    2bi while ; inline
 
 MIXIN: deque

basis/formatting/formatting.factor

@@ -41,7 +41,7 @@ IN: formatting
         [ dup 10.0 >=
           [ 10.0 / [ 1+ ] dip ]
           [ 10.0 * [ 1- ] dip ] if
-        ] [ ] while 
+        ] while 
      ] keep 0 < [ neg ] when ;
 
 : exp>string ( exp base digits -- string )

basis/io/monitors/monitors-tests.factor

@@ -101,13 +101,13 @@ os { winnt linux macosx } member? [
         ! Non-recursive
         [ ] [ "monitor-timeout-test" temp-file f <monitor> "m" set ] unit-test
         [ ] [ 3 seconds "m" get set-timeout ] unit-test
-        [ [ t ] [ "m" get next-change drop ] [ ] while ] must-fail
+        [ [ t ] [ "m" get next-change drop ] while ] must-fail
         [ ] [ "m" get dispose ] unit-test
 
         ! Recursive
         [ ] [ "monitor-timeout-test" temp-file t <monitor> "m" set ] unit-test
         [ ] [ 3 seconds "m" get set-timeout ] unit-test
-        [ [ t ] [ "m" get next-change drop ] [ ] while ] must-fail
+        [ [ t ] [ "m" get next-change drop ] while ] must-fail
         [ ] [ "m" get dispose ] unit-test
     ] with-monitors
 ] when

basis/io/pools/pools.factor

@@ -35,7 +35,7 @@ GENERIC: make-connection ( pool -- conn )
 
 : acquire-connection ( pool -- conn )
     dup check-pool
-    [ dup connections>> empty? ] [ dup new-connection ] [ ] while
+    [ dup connections>> empty? ] [ dup new-connection ] while
     connections>> pop ;
 
 : (with-pooled-connection) ( conn pool quot -- )

basis/io/thread/thread.factor

@@ -11,7 +11,7 @@ SYMBOL: io-thread-running?
     sleep-time io-multiplex yield ;
 
 : start-io-thread ( -- )
-    [ [ io-thread-running? get-global ] [ io-thread ] [ ] while ]
+    [ [ io-thread-running? get-global ] [ io-thread ] while ]
     "I/O wait" spawn drop ;
 
 [

basis/math/functions/functions.factor

@@ -39,7 +39,7 @@ M: real sqrt
 : factor-2s ( n -- r s )
     #! factor an integer into 2^r * s
     dup 0 = [ 1 ] [
-        0 swap [ dup even? ] [ [ 1+ ] [ 2/ ] bi* ] [ ] while
+        0 swap [ dup even? ] [ [ 1+ ] [ 2/ ] bi* ] while
     ] if ; inline
 
 <PRIVATE

basis/math/primes/factors/factors.factor

@@ -7,7 +7,7 @@ IN: math.primes.factors
 
 : count-factor ( n d -- n' c )
     [ 1 ] 2dip [ /i ] keep
-    [ dupd /mod zero? ] curry [ nip [ 1+ ] dip ] [ drop ] while
+    [ dupd /mod zero? ] curry [ nip [ 1+ ] dip ] while drop
     swap ;
 
 : write-factor ( n d -- n' d )
@@ -18,7 +18,7 @@ PRIVATE>
 : group-factors ( n -- seq )
     [
         2
-        [ 2dup sq < ] [ write-factor next-prime ] [ ] until
+        [ 2dup sq < ] [ write-factor next-prime ] until
         drop dup 2 < [ drop ] [ 1 2array , ] if
     ] { } make ;
 

basis/math/primes/primes.factor

@@ -21,7 +21,7 @@ PRIVATE>
     } cond ; foldable
 
 : next-prime ( n -- p )
-    next-odd [ dup really-prime? ] [ 2 + ] [ ] until ; foldable
+    next-odd [ dup really-prime? ] [ 2 + ] until ; foldable
 
 : primes-between ( low high -- seq )
     [ dup 3 max dup even? [ 1 + ] when ] dip

basis/random/random.factor

@@ -55,7 +55,7 @@ PRIVATE>
 : randomize ( seq -- seq )
     dup length [ dup 1 > ]
     [ [ random ] [ 1- ] bi [ pick exchange ] keep ]
-    [ ] while drop ;
+    while drop ;
 
 : delete-random ( seq -- elt )
     [ length random-integer ] keep [ nth ] 2keep delete-nth ;

basis/stack-checker/stack-checker-tests.factor

@@ -513,7 +513,7 @@ ERROR: custom-error ;
 ! Corner case
 [ [ [ f dup ] [ dup ] [ ] produce ] infer ] must-fail
 
-[ [ [ f dup ] [ ] [ ] while ] infer ] must-fail
+[ [ [ f dup ] while ] infer ] must-fail
 
 : erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline
 

basis/threads/threads.factor

@@ -115,7 +115,7 @@ DEFER: stop
     sleep-queue
     [ dup expire-sleep? ]
     [ dup heap-pop drop expire-sleep ]
-    [ ] while
+    while
     drop ;
 
 : start ( namestack thread -- )

basis/tools/walker/walker.factor

@@ -205,7 +205,7 @@ SYMBOL: +stopped+
                 ]
             } case
         ] handle-synchronous
-    ] [ ] while ;
+    ] while ;
 
 : step-back-msg ( continuation -- continuation' )
     walker-history tget
@@ -233,7 +233,7 @@ SYMBOL: +stopped+
                 { step-back [ step-back-msg ] }
             } case f
         ] handle-synchronous
-    ] [ ] while ;
+    ] while ;
 
 : walker-loop ( -- )
     +running+ set-status
@@ -256,7 +256,7 @@ SYMBOL: +stopped+
                 [ walker-suspended ]
             } case
         ] handle-synchronous
-    ] [ ] until ;
+    ] until ;
 
 : associate-thread ( walker -- )
     walker-thread tset

basis/ui/event-loop/event-loop.factor

@@ -13,6 +13,6 @@ IN: ui.event-loop
 
 HOOK: do-events ui-backend ( -- )
 
-: event-loop ( -- ) [ event-loop? ] [ do-events ] [ ] while ;
+: event-loop ( -- ) [ event-loop? ] [ do-events ] while ;
 
 : ui-wait ( -- ) 10 milliseconds sleep ;

basis/ui/tools/interactor/interactor-tests.factor

@@ -22,7 +22,7 @@ tools.test kernel calendar parser accessors calendar io ;
     ! This should not throw an exception
     [ ] [ "interactor" get evaluate-input ] unit-test
 
-    [ ] [ [ "interactor" get interactor-busy? ] [ yield ] [ ] while ] unit-test
+    [ ] [ [ "interactor" get interactor-busy? ] [ yield ] while ] unit-test
 
     [ ] [ "[ 1 2 3 ]" "interactor" get set-editor-string ] unit-test
 

basis/ui/ui.factor

@@ -155,7 +155,7 @@ SYMBOL: ui-thread
 : update-ui-loop ( -- )
     [ ui-running? ui-thread get-global self eq? and ]
     [ ui-notify-flag get lower-flag update-ui ]
-    [ ] while ;
+    while ;
 
 : start-ui-thread ( -- )
     [ self ui-thread set-global update-ui-loop ]

core/io/io.factor

@@ -70,7 +70,7 @@ SYMBOL: error-stream
 <PRIVATE
 
 : each-morsel ( handler: ( data -- ) reader: ( -- data ) -- )
-    [ dup ] compose swap [ drop ] while ; inline
+    [ dup ] compose swap while drop ; inline
 
 PRIVATE>
 

core/kernel/kernel-docs.factor

@@ -637,15 +637,15 @@ HELP: 4dip
 } ;
 
 HELP: while
-{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
+{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } }
 { $description "Calls " { $snippet "body" } " until " { $snippet "pred" } " returns " { $link f } "." } ;
 
 HELP: until
-{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
+{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } }
 { $description "Calls " { $snippet "body" } " until " { $snippet "pred" } " returns " { $link t } "." } ;
 
 HELP: do
-{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
+{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } }
 { $description "Executes one iteration of a " { $link while } " or " { $link until } " loop." } ;
 
 HELP: loop
@@ -666,12 +666,6 @@ ARTICLE: "looping-combinators" "Looping combinators"
 "In most cases, loops should be written using high-level combinators (such as " { $link "sequences-combinators" } ") or tail recursion. However, sometimes, the best way to express intent is with a loop."
 { $subsection while }
 { $subsection until }
-"The above two combinators take a " { $snippet "tail" } " quotation. Strictly speaking, the " { $snippet "tail" } " is not necessary, since the following are equivalent:"
-{ $code
-    "[ P ] [ Q ] [ T ] while"
-    "[ P ] [ Q ] [ ] while T"
-}
-"However, depending on the stack effects of " { $snippet "pred" } " and " { $snippet "quot" } ", the " { $snippet "tail" } " quotation might need to be non-empty in order to balance out the stack effect of branches for stack effect inference."
 $nl
 "To execute one iteration of a loop, use the following word:"
 { $subsection do }

core/kernel/kernel.factor

@@ -191,14 +191,14 @@ PRIVATE>
 : loop ( pred: ( -- ? ) -- )
     [ call ] keep [ loop ] curry when ; inline recursive
 
-: do ( pred body tail -- pred body tail )
+: do ( pred body -- pred body )
-    over 3dip ; inline
+    dup 2dip ; inline
 
-: while ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
+: while ( pred: ( -- ? ) body: ( -- ) -- )
-    [ pick 3dip [ do while ] 3curry ] keep if ; inline recursive
+    swap do compose [ loop ] curry when ; inline
 
-: until ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
+: until ( pred: ( -- ? ) body: ( -- ) -- )
-    [ [ not ] compose ] 2dip while ; inline
+    [ [ not ] compose ] dip while ; inline
 
 ! Object protocol
 GENERIC: hashcode* ( depth obj -- code )

core/math/integers/integers.factor

@@ -41,7 +41,7 @@ M: fixnum bitnot fixnum-bitnot ;
 M: fixnum bit? neg shift 1 bitand 0 > ;
 
 : fixnum-log2 ( x -- n )
-    0 swap [ dup 1 eq? ] [ [ 1+ ] [ 2/ ] bi* ] [ ] until drop ;
+    0 swap [ dup 1 eq? ] [ [ 1+ ] [ 2/ ] bi* ] until drop ;
 
 M: fixnum (log2) fixnum-log2 ;
 
@@ -103,7 +103,7 @@ M: bignum (log2) bignum-log2 ;
 : /f-loop ( scale mantissa den -- scale' fraction-and-guard rem )
     [ 2dup /i log2 53 > ]
     [ [ shift-mantissa ] dip ]
-    [ ] while /mod ; inline
+    while /mod ; inline
 
 ! Third step: post-scaling
 : unscaled-float ( mantissa -- n )

core/sequences/sequences.factor

@@ -488,7 +488,7 @@ PRIVATE>
     V{ } clone [ [ push ] curry compose ] keep ; inline
 
 : produce-as ( pred quot tail exemplar -- seq )
-    [ swap accumulator [ swap while ] dip ] dip like ; inline
+    [ [ accumulator [ while ] dip ] dip dip ] dip like ; inline
 
 : produce ( pred quot tail -- seq )
     { } produce-as ; inline

core/slots/slots.factor

@@ -199,7 +199,7 @@ M: array make-slot
         swap
         peel-off-name
         peel-off-class
-        [ dup empty? ] [ peel-off-attributes ] [ ] until drop
+        [ dup empty? ] [ peel-off-attributes ] until drop
     check-initial-value ;
 
 M: slot-spec make-slot

core/sorting/sorting.factor

@@ -126,7 +126,7 @@ TUPLE: merge
 : sort-loop ( merge quot -- )
     [ 2 [ over seq>> length over > ] ] dip
     [ [ 1 shift 2dup ] dip sort-pass ] curry
-    [ ] while 2drop ; inline
+    while 2drop ; inline
 
 : each-pair ( seq quot -- )
     [ [ length 1+ 2/ ] keep ] dip

extra/adsoda/adsoda.factor

@@ -337,7 +337,7 @@ TUPLE: solid dimension silhouettes
 : compute-adjacencies ( solid -- solid )
     dup dimension>> [ >= ] curry 
     [ keep swap ] curry MAX-FACE-PER-CORNER swap
-    [ [ test-faces-combinaisons ] 2keep 1- ] [ ] while drop ;
+    [ [ test-faces-combinaisons ] 2keep 1- ] while drop ;
 
 : find-adjacencies ( solid -- solid ) 
     erase-old-adjacencies   

extra/bubble-chamber/bubble-chamber.factor

@@ -135,7 +135,7 @@ METHOD: collide ( <axion> -- )
   0                   >>theta-d
   0                   >>theta-dd
 
-  [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
+  [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while
 
   drop ;
 
@@ -201,7 +201,7 @@ METHOD: collide ( <hadron> -- )
   0                   >>theta-d
   0                   >>theta-dd
 
-  [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
+  [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while
 
   0 1 0 1 rgba boa >>myc
 
@@ -302,7 +302,7 @@ METHOD: collide ( <muon> -- )
   0                                    >>theta-d
   0                                    >>theta-dd
 
-  [ 0.001 theta-dd-small? ] [ -0.1 0.1 random-theta-dd ] [ ] while
+  [ 0.001 theta-dd-small? ] [ -0.1 0.1 random-theta-dd ] while
 
   set-good-color
   set-anti-color
@@ -355,7 +355,7 @@ METHOD: collide ( <quark> -- )
   0                                      >>theta-d
   0                                      >>theta-dd
 
-  [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
+  [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while
 
   drop ;
 

extra/graph-theory/graph-theory.factor

@@ -78,7 +78,7 @@ PRIVATE>
 : full-depth-first ( graph pre post tail -- ? )
     '[ [ visited? get [ nip not ] assoc-find ] 
        [ drop _ _ (depth-first) @ ] 
-       [ 2drop ] while ] swap search-wrap ; inline
+       while 2drop ] swap search-wrap ; inline
 
 : dag? ( graph -- ? )
     V{ } clone swap [ 2dup swap push dupd

extra/irc/ui/ui.factor

@@ -152,7 +152,7 @@ M: object handle-inbox
 : display ( stream tab -- )
     '[ _ [ [ t ]
            [ _ dup chat>> hear handle-inbox ]
-           [  ] while ] with-output-stream ] "ircv" spawn drop ;
+           while ] with-output-stream ] "ircv" spawn drop ;
 
 : <irc-pane> ( tab -- tab pane )
     <scrolling-pane>

extra/otug-talk/otug-talk.factor

@@ -223,7 +223,7 @@ M: png-gadget ungraft* ( gadget -- )
     }
     { $slide "Modifiers"
         { $code ": bank ( n -- n )" "    readln string>number +" "    dup \"Balance: $\" write . ;" }
-        { $code "0 [ dup 0 > ] [ bank ] [ ] while" }
+        { $code "0 [ dup 0 > ] [ bank ] while" }
     }
     { $slide "Modifiers"
         { $code "0 [ dup 0 > ] [ bank ] [ ] do while" }

extra/project-euler/012/012.factor

@@ -34,7 +34,7 @@ IN: project-euler.012
 ! --------
 
 : euler012 ( -- answer )
-    8 [ dup nth-triangle tau* 500 < ] [ 1+ ] [ ] while nth-triangle ;
+    8 [ dup nth-triangle tau* 500 < ] [ 1+ ] while nth-triangle ;
 
 ! [ euler012 ] 10 ave-time
 ! 6573 ms ave run time - 346.27 SD (10 trials)

extra/project-euler/014/014.factor

@@ -43,7 +43,7 @@ IN: project-euler.014
 PRIVATE>
 
 : collatz ( n -- seq )
-    [ [ dup 1 > ] [ dup , next-collatz ] [ ] while , ] { } make ;
+    [ [ dup 1 > ] [ dup , next-collatz ] while , ] { } make ;
 
 : euler014 ( -- answer )
     1000000 [1,b] 0 [ collatz longest ] reduce first ;

extra/project-euler/100/100.factor

@@ -26,7 +26,7 @@ IN: project-euler.100
 : euler100 ( -- answer )
     1 1
     [ dup dup 1- * 2 * 10 24 ^ <= ]
-    [ tuck 6 * swap - 2 - ] [ ] while nip ;
+    [ tuck 6 * swap - 2 - ] while nip ;
 
 ! TODO: solution needs generalization
 

unmaintained/combinators-lib/lib.factor

@@ -126,12 +126,9 @@ MACRO: multikeep ( word out-indexes -- ... )
         r> [ drop \ r> , ] each
     ] [ ] make ;
 
-: do-while ( pred body tail -- )
-    [ tuck 2slip ] dip while ; inline
-
 : generate ( generator predicate -- obj )
-    '[ dup @ dup [ nip ] unless not ]
+    '[ dup @ dup [ nip ] unless ]
-    swap [ ] do-while ;
+    swap do until ;
 
 MACRO: predicates ( seq -- quot/f )
     dup [ 1quotation [ drop ] prepend ] map