From 087d931c36ebdc60fafd0c02e77486ea95d289bb Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 18 Feb 2009 02:19:49 +0100 Subject: [PATCH] Remove the tail argument from do/until/while --- basis/bit-arrays/bit-arrays.factor | 2 +- .../tree/propagation/propagation-tests.factor | 2 +- basis/concurrency/mailboxes/mailboxes.factor | 2 +- basis/deques/deques.factor | 2 +- basis/formatting/formatting.factor | 2 +- basis/io/monitors/monitors-tests.factor | 4 ++-- basis/io/pools/pools.factor | 2 +- basis/io/thread/thread.factor | 2 +- basis/math/functions/functions.factor | 2 +- basis/math/primes/factors/factors.factor | 4 ++-- basis/math/primes/primes.factor | 2 +- basis/random/random.factor | 2 +- basis/stack-checker/stack-checker-tests.factor | 2 +- basis/threads/threads.factor | 2 +- basis/tools/walker/walker.factor | 6 +++--- basis/ui/event-loop/event-loop.factor | 2 +- basis/ui/tools/interactor/interactor-tests.factor | 2 +- basis/ui/ui.factor | 2 +- core/io/io.factor | 2 +- core/kernel/kernel-docs.factor | 12 +++--------- core/kernel/kernel.factor | 12 ++++++------ core/math/integers/integers.factor | 4 ++-- core/sequences/sequences.factor | 2 +- core/slots/slots.factor | 2 +- core/sorting/sorting.factor | 2 +- extra/adsoda/adsoda.factor | 2 +- extra/bubble-chamber/bubble-chamber.factor | 8 ++++---- extra/graph-theory/graph-theory.factor | 2 +- extra/irc/ui/ui.factor | 2 +- extra/otug-talk/otug-talk.factor | 2 +- extra/project-euler/012/012.factor | 2 +- extra/project-euler/014/014.factor | 2 +- extra/project-euler/100/100.factor | 2 +- unmaintained/combinators-lib/lib.factor | 7 ++----- 34 files changed, 50 insertions(+), 59 deletions(-) diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor index 3da22e09d6..e7dd6695a7 100644 --- a/basis/bit-arrays/bit-arrays.factor +++ b/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 ) diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index b9a88de34a..f261b8747f 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/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 diff --git a/basis/concurrency/mailboxes/mailboxes.factor b/basis/concurrency/mailboxes/mailboxes.factor index 656fbbb591..6dcf3dc34f 100755 --- a/basis/concurrency/mailboxes/mailboxes.factor +++ b/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 ] diff --git a/basis/deques/deques.factor b/basis/deques/deques.factor index 73769cc4d2..1e1be404a7 100644 --- a/basis/deques/deques.factor +++ b/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 diff --git a/basis/formatting/formatting.factor b/basis/formatting/formatting.factor index 5a1e3650fe..ac0b0850b4 100644 --- a/basis/formatting/formatting.factor +++ b/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 ) diff --git a/basis/io/monitors/monitors-tests.factor b/basis/io/monitors/monitors-tests.factor index 8252b6ef72..576ac7ca30 100644 --- a/basis/io/monitors/monitors-tests.factor +++ b/basis/io/monitors/monitors-tests.factor @@ -101,13 +101,13 @@ os { winnt linux macosx } member? [ ! Non-recursive [ ] [ "monitor-timeout-test" temp-file f "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 "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 diff --git a/basis/io/pools/pools.factor b/basis/io/pools/pools.factor index 2c1f8ea3c3..e03bdeabf9 100644 --- a/basis/io/pools/pools.factor +++ b/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 -- ) diff --git a/basis/io/thread/thread.factor b/basis/io/thread/thread.factor index 7589d4918e..88db135f44 100644 --- a/basis/io/thread/thread.factor +++ b/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 ; [ diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 85b4d711ac..605744b65f 100644 --- a/basis/math/functions/functions.factor +++ b/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 : 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 ; diff --git a/basis/math/primes/primes.factor b/basis/math/primes/primes.factor index 807ebf097b..688fdad713 100644 --- a/basis/math/primes/primes.factor +++ b/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 diff --git a/basis/random/random.factor b/basis/random/random.factor index 17bcc8f1b1..26b328b291 100755 --- a/basis/random/random.factor +++ b/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 ; diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index bc6eb9f092..6cfe80dbf6 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/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 diff --git a/basis/threads/threads.factor b/basis/threads/threads.factor index 305ef0cca3..e168653f1d 100644 --- a/basis/threads/threads.factor +++ b/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 -- ) diff --git a/basis/tools/walker/walker.factor b/basis/tools/walker/walker.factor index 8915d2d611..119a2e8587 100644 --- a/basis/tools/walker/walker.factor +++ b/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 diff --git a/basis/ui/event-loop/event-loop.factor b/basis/ui/event-loop/event-loop.factor index 7c08d802f5..26983e3b95 100644 --- a/basis/ui/event-loop/event-loop.factor +++ b/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 ; diff --git a/basis/ui/tools/interactor/interactor-tests.factor b/basis/ui/tools/interactor/interactor-tests.factor index 628570c3e3..101b7307dd 100644 --- a/basis/ui/tools/interactor/interactor-tests.factor +++ b/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 diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index 78f150987f..769dc9c64e 100644 --- a/basis/ui/ui.factor +++ b/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 ] diff --git a/core/io/io.factor b/core/io/io.factor index 11a2a6d1a8..52ac23622a 100644 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -70,7 +70,7 @@ SYMBOL: error-stream diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index b8191004db..fcc70cc8e5 100644 --- a/core/kernel/kernel-docs.factor +++ b/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 } diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 697000920a..cf4bf95db9 100644 --- a/core/kernel/kernel.factor +++ b/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 ) - over 3dip ; inline +: do ( pred body -- pred body ) + dup 2dip ; inline -: while ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- ) - [ pick 3dip [ do while ] 3curry ] keep if ; inline recursive +: while ( pred: ( -- ? ) body: ( -- ) -- ) + swap do compose [ loop ] curry when ; inline -: until ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- ) - [ [ not ] compose ] 2dip while ; inline +: until ( pred: ( -- ? ) body: ( -- ) -- ) + [ [ not ] compose ] dip while ; inline ! Object protocol GENERIC: hashcode* ( depth obj -- code ) diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor index 6ed945216e..845fdc0fcf 100644 --- a/core/math/integers/integers.factor +++ b/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 ) diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 9e64cfa536..2983520620 100755 --- a/core/sequences/sequences.factor +++ b/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 diff --git a/core/slots/slots.factor b/core/slots/slots.factor index 24ff1b0f8b..ea020c5c55 100755 --- a/core/slots/slots.factor +++ b/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 diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor index 938bf17cd2..043505759e 100644 --- a/core/sorting/sorting.factor +++ b/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 diff --git a/extra/adsoda/adsoda.factor b/extra/adsoda/adsoda.factor index 01e437bc7d..ec77501b8f 100755 --- a/extra/adsoda/adsoda.factor +++ b/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 diff --git a/extra/bubble-chamber/bubble-chamber.factor b/extra/bubble-chamber/bubble-chamber.factor index 4bddd4b632..713bb223e1 100644 --- a/extra/bubble-chamber/bubble-chamber.factor +++ b/extra/bubble-chamber/bubble-chamber.factor @@ -135,7 +135,7 @@ METHOD: collide ( -- ) 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 ( -- ) 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 ( -- ) 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 ( -- ) 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 ; diff --git a/extra/graph-theory/graph-theory.factor b/extra/graph-theory/graph-theory.factor index 842f4d1f38..b14832dc03 100644 --- a/extra/graph-theory/graph-theory.factor +++ b/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 diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 59e4cf6cb4..d788eb3c2c 100755 --- a/extra/irc/ui/ui.factor +++ b/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 ; : ( tab -- tab pane ) diff --git a/extra/otug-talk/otug-talk.factor b/extra/otug-talk/otug-talk.factor index b52749dbe1..716afc0dc2 100644 --- a/extra/otug-talk/otug-talk.factor +++ b/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" } diff --git a/extra/project-euler/012/012.factor b/extra/project-euler/012/012.factor index b25bfc90f1..ff482c6812 100644 --- a/extra/project-euler/012/012.factor +++ b/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) diff --git a/extra/project-euler/014/014.factor b/extra/project-euler/014/014.factor index aa04784151..e93e3d11bc 100644 --- a/extra/project-euler/014/014.factor +++ b/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 ; diff --git a/extra/project-euler/100/100.factor b/extra/project-euler/100/100.factor index 98dbba19fd..ec372add3b 100644 --- a/extra/project-euler/100/100.factor +++ b/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 diff --git a/unmaintained/combinators-lib/lib.factor b/unmaintained/combinators-lib/lib.factor index 5e78d183b0..9b3abe3984 100755 --- a/unmaintained/combinators-lib/lib.factor +++ b/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 ] - swap [ ] do-while ; + '[ dup @ dup [ nip ] unless ] + swap do until ; MACRO: predicates ( seq -- quot/f ) dup [ 1quotation [ drop ] prepend ] map