core/basis/extra: using while* in a few places.

basis/io/encodings/string/string.factor

@@ -13,7 +13,7 @@ IN: io.encodings.string
         ] [
             byte-array encoding <byte-reader> :> reader
             byte-array length encoding guess-decoded-length <sbuf> :> buf
-            [ reader stream-read1 dup ] [ buf push ] while drop
+            [ reader stream-read1 ] [ buf push ] while*
             buf "" like
         ] if
     ] if ; inline

basis/json/reader/reader.factor

@@ -126,7 +126,7 @@ DEFER: (read-json-string)
     } case ;
 
 : json-read-input ( stream -- objects )
-    V{ } clone over '[ _ stream-read1 dup ] [ scan ] while drop nip ;
+    V{ } clone over '[ _ stream-read1 ] [ scan ] while* nip ;
 
 ! If there are no json objects, return an empty hashtable
 ! This happens for empty files.

core/io/io.factor

@@ -103,9 +103,6 @@ SYMBOL: error-stream
 
 : bl ( -- ) output-stream get stream-bl ;
 
-: each-morsel ( ..a handler: ( ..a data -- ..b ) reader: ( ..b -- ..a data ) -- ..a )
-    [ dup ] compose swap while drop ; inline
-
 <PRIVATE
 
 : stream-exemplar ( stream -- exemplar )
@@ -156,7 +153,7 @@ ERROR: invalid-read-buffer buf stream ;
     input-stream get stream-read-partial-into ; inline
 
 : each-stream-line ( ... stream quot: ( ... line -- ... ) -- ... )
-    swap [ stream-readln ] curry each-morsel ; inline
+    [ [ stream-readln ] curry ] dip while* ; inline
 
 : each-line ( ... quot: ( ... line -- ... ) -- ... )
     input-stream get swap each-stream-line ; inline
@@ -172,15 +169,16 @@ ERROR: invalid-read-buffer buf stream ;
 CONSTANT: each-block-size 65536
 
 : (each-stream-block-slice) ( ... stream quot: ( ... block-slice -- ... ) block-size -- ... )
-    [ [ drop ] prepose swap ] dip
+    -rot [
-    [ swap (new-sequence-for-stream) ] keepd
+        [ (new-sequence-for-stream) ] keep
-    [ stream-read-partial-into ] 2curry each-morsel drop ; inline
+        [ stream-read-partial-into ] 2curry
+    ] dip while drop ; inline
 
 : each-stream-block-slice ( ... stream quot: ( ... block-slice -- ... ) -- ... )
     each-block-size (each-stream-block-slice) ; inline
 
 : (each-stream-block) ( ... stream quot: ( ... block -- ... ) block-size -- ... )
-    rot [ stream-read-partial ] 2curry each-morsel ; inline
+    -rot [ [ stream-read-partial ] 2curry ] dip while* ; inline
 
 : each-stream-block ( ... stream quot: ( ... block -- ... ) -- ... )
     each-block-size (each-stream-block) ; inline

extra/audio/wav/wav.factor

@@ -38,12 +38,12 @@ STRUCT: wav-data-chunk
 
 :: read-wav-chunks ( -- fmt data )
     f :> fmt! f :> data!
-    [ { [ fmt data and not ] [ read-chunk ] } 0&& dup ]
+    [ { [ fmt data and not ] [ read-chunk ] } 0&& ]
     [ {
         { [ dup FMT-MAGIC  wav-fmt-chunk  check-chunk ] [ wav-fmt-chunk  memory>struct fmt!  ] }
         { [ dup DATA-MAGIC wav-data-chunk check-chunk ] [ wav-data-chunk memory>struct data! ] }
         [ drop ]
-    } cond ] while drop
+    } cond ] while*
     fmt data 2dup and [ invalid-audio-file ] unless ;
 
 : verify-wav ( chunk -- )

extra/cuesheet/cuesheet.factor

@@ -127,7 +127,7 @@ ERROR: unknown-syntax syntax ;
 PRIVATE>
 
 : read-cuesheet ( -- cuesheet )
-    <cuesheet> [ readln dup ] [ parse-line ] while drop ;
+    <cuesheet> [ readln ] [ parse-line ] while* ;
 
 : file>cuesheet ( path -- cuesheet )
     utf8 [ read-cuesheet ] with-file-reader ;

extra/html/entities/entities.factor

@@ -28,7 +28,7 @@ PRIVATE>
 
 : html-escape ( str -- newstr )
     [
-        [ dup next-escape dup ] [ escape, ] while 2drop ,
+        [ dup next-escape ] [ escape, ] while* drop ,
     ] { } make dup length 1 > [ concat ] [ first ] if ;
 
 <PRIVATE

extra/images/atlas/atlas.factor

@@ -47,7 +47,7 @@ ERROR: atlas-image-formats-dont-match images ;
 :: (pack-images) ( images atlas-width sort-quot -- placements )
     images sort-quot inv-sort-with [ f image-placement boa ] map :> image-placements
     0 :> @y!
-    [ image-placements atlas-width @y (pack-stripe) dup ] [ @y + @y! ] while drop
+    [ image-placements atlas-width @y (pack-stripe) ] [ @y + @y! ] while*
     image-placements ; inline
 
 : atlas-image-format ( image-placements -- component-order component-type upside-down? )

extra/tokyo/assoc-functor/assoc-functor.factor

@@ -37,10 +37,10 @@ M: TYPE assoc-size handle>> DBRNUM ;
 : DBKEYS ( db -- keys )
     [ assoc-size <vector> ] [ handle>> ] bi
     dup DBITERINIT drop 0 int <ref>
-    [ 2dup DBITERNEXT dup ] [
+    [ 2dup DBITERNEXT ] [
         [ memory>object ] [ tcfree ] bi
         reach push
-    ] while 3drop ;
+    ] while* 2drop ;
 
 M: TYPE >alist
     [ DBKEYS dup ] keep '[ dup _ at 2array ] map! drop ;

extra/trees/trees.factor

@@ -238,10 +238,10 @@ PRIVATE>
     [ root>> (nodepath-at) ] { } make ;
 
 : right-extremity ( node -- node' )
-    [ dup right>> dup ] [ nip ] while drop ;
+    [ dup right>> ] [ nip ] while* ;
 
 : left-extremity ( node -- node' )
-    [ dup left>> dup ] [ nip ] while drop ;
+    [ dup left>> ] [ nip ] while* ;
 
 : lower-node-in-child? ( key node -- ? )
     [ nip left>> ] [ key>> = ] 2bi and ;