]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'for-slava' of git://git.rfc1149.net/factor
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sat, 28 Feb 2009 20:42:56 +0000 (14:42 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sat, 28 Feb 2009 20:42:56 +0000 (14:42 -0600)
34 files changed:
basis/bit-arrays/bit-arrays.factor
basis/compiler/tree/propagation/propagation-tests.factor
basis/concurrency/mailboxes/mailboxes.factor
basis/deques/deques.factor
basis/formatting/formatting.factor
basis/io/monitors/monitors-tests.factor
basis/io/pools/pools.factor
basis/io/thread/thread.factor
basis/math/functions/functions.factor
basis/math/primes/factors/factors.factor
basis/math/primes/primes.factor
basis/random/random.factor
basis/stack-checker/stack-checker-tests.factor
basis/threads/threads.factor
basis/tools/walker/walker.factor
basis/ui/event-loop/event-loop.factor
basis/ui/tools/interactor/interactor-tests.factor
basis/ui/ui.factor
core/io/io.factor
core/kernel/kernel-docs.factor
core/kernel/kernel.factor
core/math/integers/integers.factor
core/sequences/sequences.factor
core/slots/slots.factor
core/sorting/sorting.factor
extra/adsoda/adsoda.factor
extra/bubble-chamber/bubble-chamber.factor
extra/graph-theory/graph-theory.factor
extra/irc/ui/ui.factor
extra/otug-talk/otug-talk.factor
extra/project-euler/012/012.factor
extra/project-euler/014/014.factor
extra/project-euler/100/100.factor
unmaintained/combinators-lib/lib.factor

index 3da22e09d65854b49ea65cb8869133da7bef547c..e7dd6695a7e90bdfc36c3bb9bdbf290272faa8fa 100644 (file)
@@ -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 )
index b9a88de34aaed1110ec814beecc46ee3812cde12..52ae83eb1251c21d077347d3b0c7f80576b48566 100644 (file)
@@ -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
index 656fbbb5917c8a90353231724a595f762699075a..6dcf3dc34f602ac3c78429c4910d01f47ffc079c 100755 (executable)
@@ -57,7 +57,7 @@ M: mailbox dispose* threads>> notify-all ;
     f mailbox-get-all-timeout ;\r
 \r
 : while-mailbox-empty ( mailbox quot -- )\r
-    [ '[ _ mailbox-empty? ] ] dip [ ] while ; inline\r
+    [ '[ _ mailbox-empty? ] ] dip while ; inline\r
 \r
 : mailbox-get-timeout? ( mailbox timeout pred -- obj )\r
     [ block-unless-pred ]\r
index 73769cc4d21e39a3a98d69164e9014df7a73904d..1e1be404a77f5459215e6455e9d3aa7603b5847d 100644 (file)
@@ -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
index 5a1e3650fecdf5602965f29b2e980fcaa7396806..ac0b0850b492208975abbbb79f3e1af57bcf75a7 100644 (file)
@@ -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 )
index 8252b6ef7208a41ecab64bf532f4893238289aa1..576ac7ca304146f7cf08492d371e613184122f16 100644 (file)
@@ -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
index 2c1f8ea3c3632db3b188679af0c2fcea10c96452..e03bdeabf9d563beb92820b1e60ea857abc152e5 100644 (file)
@@ -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 -- )
index 7589d4918ec29fff8fe0231269b201b9d8a48713..88db135f447c24975117ee9a579dddb384bae4a1 100644 (file)
@@ -11,7 +11,7 @@ SYMBOL: io-thread-running?
     sleep-time io-multiplex yield ;\r
 \r
 : start-io-thread ( -- )\r
-    [ [ io-thread-running? get-global ] [ io-thread ] [ ] while ]\r
+    [ [ io-thread-running? get-global ] [ io-thread ] while ]\r
     "I/O wait" spawn drop ;\r
 \r
 [\r
index 7e2ac0884ca9edae5a042c7507544aa4df370e40..964074512a3bfe7b5dbccd96c47b0ed38bd6c1a7 100644 (file)
@@ -29,7 +29,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
index 4c36fc0a8506a1a609e111a3ab979cf49457d794..beab0ac5a664c9aa40a63e9889768cc1afb996f9 100644 (file)
@@ -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 ;
 
index 807ebf097b4b66a8aaa844b520130d0ad1c94e66..688fdad7138101884a1d6ec055d227c88863ba9b 100644 (file)
@@ -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
index 17bcc8f1b10a142deb5e5bbe1c31c9b9465f19cc..26b328b29134546bcc92ab767226f8d36a1f7f55 100755 (executable)
@@ -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 ;
index fadfadd885e0b2a3c152563e1353edf7ad4faedc..4361052b63baf5648598abbeea2c3b515f780083 100644 (file)
@@ -514,7 +514,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
 
index 8556167009db22850f4256da628c0a32ad40cc9f..3f4267df15e7771614719d259e390d36a1ec737c 100644 (file)
@@ -115,7 +115,7 @@ DEFER: stop
     sleep-queue
     [ dup expire-sleep? ]
     [ dup heap-pop drop expire-sleep ]
-    [ ] while
+    while
     drop ;
 
 : start ( namestack thread -- * )
index 8915d2d611bb19b3690b7248dd530fa80652b60d..119a2e8587f0ae8d90b96b50c249b6b41e0c97da 100644 (file)
@@ -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
index 7c08d802f5212dd54a72721cf237d991c876a9ee..26983e3b9521478be112f009629ba55e5ba3a9a4 100644 (file)
@@ -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 ;
index 628570c3e36b22da93cb4b93b486d30a3b2092c1..101b7307dd09a751209b4dfb3ea5bdbb7837a609 100644 (file)
@@ -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
 
index 78f150987f259f1c9c63937fde38c6142f607e1b..769dc9c64e608eaed67313d9f4680778fa567439 100644 (file)
@@ -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 ]
index 11a2a6d1a805a025a125c81459ad4c5f7a46edf4..52ac23622a6350181402565222aafe76189b0dc5 100644 (file)
@@ -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>
 
index 342376fb22a424c1e4959aeaa95a5724e4ad240e..c2719c056a0c9b3d3f0a4143f50b416756d7d129 100644 (file)
@@ -638,15 +638,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
@@ -667,12 +667,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 }
index 06fe289281131cb66b7f89031cdfa2c41c59258c..cf4bf95db96afeff4a604aaccd53a2a18664cf9e 100644 (file)
@@ -185,21 +185,20 @@ PRIVATE>
 
 : either? ( x y quot -- ? ) bi@ or ; inline
 
-: most ( x y quot -- z )
-    [ 2dup ] dip call [ drop ] [ nip ] if ; inline
+: most ( x y quot -- z ) 2keep ? ; inline
 
 ! Loops
 : 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 )
index 6ed945216ecb23da817e59f4798181e3f3605c74..845fdc0fcf1f2ec402c10629cc5fb0ca9b364026 100644 (file)
@@ -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 )
index 9e64cfa5361a124b12ad21880a37a095a207e90c..2983520620d47306e3c00b1c475f7b049feace36 100755 (executable)
@@ -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
index 24ff1b0f8b29f454b9374f92eae6d9ce9620ab56..ea020c5c55978f1e2c4d824c3c2e3382d1b8ba80 100755 (executable)
@@ -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
index 938bf17cd2f664f79b65bbc9ddc2cb01b34bef87..043505759e310657768aa6902ab220be979ce96e 100644 (file)
@@ -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
index 01e437bc7d43900030efa1309553d07df8033b72..ec77501b8ffb067dbdfac59d003fe4d654d996ed 100755 (executable)
@@ -337,7 +337,7 @@ TUPLE: solid dimension silhouettes
 : compute-adjacencies ( solid -- solid )\r
     dup dimension>> [ >= ] curry \r
     [ keep swap ] curry MAX-FACE-PER-CORNER swap\r
-    [ [ test-faces-combinaisons ] 2keep 1- ] [ ] while drop ;\r
+    [ [ test-faces-combinaisons ] 2keep 1- ] while drop ;\r
 \r
 : find-adjacencies ( solid -- solid ) \r
     erase-old-adjacencies   \r
index 4bddd4b6328b770072307dcc95aef35d332fe8ef..713bb223e1f2d9da4087e5e4584f92bc29c39b81 100644 (file)
@@ -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 ;
 
index 842f4d1f388e85cda8817aadf8eafce0d319c5cc..b14832dc032d5adde898189cc311fcabda093f81 100644 (file)
@@ -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
index 791639d260f47eef55d33945281c6b903b996022..f360273fdabe9642b44fa0cb3ace35ca9d72edb7 100755 (executable)
@@ -152,7 +152,7 @@ M: object handle-inbox
 : display ( stream tab -- )\r
     '[ _ [ [ t ]\r
            [ _ dup chat>> hear handle-inbox ]\r
-           [  ] while ] with-output-stream ] "ircv" spawn drop ;\r
+           while ] with-output-stream ] "ircv" spawn drop ;\r
 \r
 : <irc-pane> ( tab -- tab pane )\r
     <scrolling-pane>\r
index ef5782dda731394c400ebec28c5d750e576d560b..16ee2b740b0cb764d42026013e0db3e7d5cbd18e 100644 (file)
@@ -223,7 +223,7 @@ CONSTANT: otug-slides
     }
     { $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" }
index b25bfc90f1b4133bf34becb35141646edea40647..ff482c6812ca3a7cd154a9afeeac06c6d29d79d8 100644 (file)
@@ -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)
index aa0478415189afa35bfaf94773ff7ae34dcc6584..e93e3d11bc803019d601fc4844cc3cd8a3c05ced 100644 (file)
@@ -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 ;
index 98dbba19fd27bd1b6b08e0c60682ed8613e587ff..ec372add3bff00f4ded9e71be8bfc223c47aeb6b 100644 (file)
@@ -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
 
index 5e78d183b0b5f2bd791b2c49c43793ba04ab1aac..9b3abe3984d945b2b9823ae475ba28738882ae50 100755 (executable)
@@ -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