new unfold word

core/bootstrap/image/image.factor

@@ -153,17 +153,11 @@ GENERIC: ' ( obj -- ptr )
 
 : bignum-radix bignum-bits 2^ 1- ;
 
-: (bignum>seq) ( n -- )
-    dup zero? [
-        drop
-    ] [
-        dup bignum-radix bitand ,
-        bignum-bits neg shift (bignum>seq)
-    ] if ;
-
 : bignum>seq ( n -- seq )
     #! n is positive or zero.
-    [ (bignum>seq) ] { } make ;
+    [ dup 0 > ]
+    [ dup bignum-bits neg shift swap bignum-radix bitand ]
+    { } unfold ;
 
 : emit-bignum ( n -- )
     [ 0 < 1 0 ? ] keep abs bignum>seq

core/classes/classes.factor

@@ -127,15 +127,13 @@ DEFER: (class<)
         curry* subset empty?
     ] curry find [ "Topological sort failed" throw ] unless* ;
 
-: (sort-classes) ( vec -- )
-    dup empty?
-    [ drop ]
-    [ dup largest-class , over delete-nth (sort-classes) ] if ;
-
 PRIVATE>
 
 : sort-classes ( seq -- newseq )
-    [ >vector (sort-classes) ] { } make ;
+    >vector
+    [ dup empty? not ]
+    [ dup largest-class >r over delete-nth r> ]
+    { } unfold ;
 
 : class-or ( class1 class2 -- class )
     {

core/io/io.factor

@@ -85,10 +85,8 @@ SYMBOL: stdio
 : write-object ( str obj -- )
     presented associate format ;
 
-: lines-loop ( -- ) readln [ , lines-loop ] when* ;
-
 : lines ( stream -- seq )
-    [ [ lines-loop ] { } make ] with-stream ;
+    [ [ readln dup ] [ ] { } unfold ] with-stream ;
 
 : contents ( stream -- str )
     2048 <sbuf> [ stream-copy ] keep >string ;

core/kernel/kernel.factor

@@ -60,6 +60,11 @@ DEFER: if
 
 : 2apply ( x y quot -- ) tuck 2slip call ; inline
 
+: while ( pred body tail -- )
+    >r >r dup slip r> r> roll
+    [ >r tuck 2slip r> while ]
+    [ 2nip call ] if ; inline
+
 ! Quotation building
 
 : 2curry ( obj1 obj2 quot -- curry )

core/sequences/sequences.factor

@@ -655,3 +655,10 @@ PRIVATE>
 
 : trim ( seq quot -- newseq )
     [ ltrim ] keep rtrim ; inline
+
+: unfold ( obj pred quot exemplar -- seq )
+    [
+        10 swap new-resizable [
+            [ push ] curry compose [ drop ] while
+        ] keep
+    ] keep like ; inline

core/tuples/tuples.factor

@@ -106,7 +106,8 @@ M: tuple equal?
 : (delegates) ( obj -- )
     [ dup , delegate (delegates) ] when* ;
 
-: delegates ( obj -- seq ) [ (delegates) ] { } make ;
+: delegates ( obj -- seq )
+    [ dup ] [ [ delegate ] keep ] { } unfold ;
 
 : is? ( obj quot -- ? ) >r delegates r> contains? ; inline
 

extra/concurrency/concurrency.factor

@@ -40,17 +40,11 @@ PRIVATE>
     (mailbox-block-if-empty)
     mailbox-data dlist-pop-front ;
 
-<PRIVATE
-: (mailbox-get-all) ( mailbox -- )
-    dup mailbox-empty? [
-        drop
-    ] [
-        dup mailbox-data dlist-pop-front , (mailbox-get-all)
-    ] if ;
-PRIVATE>
 : mailbox-get-all ( mailbox -- array )
     (mailbox-block-if-empty)
-    [ (mailbox-get-all) ] { } make ;
+    [ dup mailbox-empty? ]
+    [ dup mailbox-data dlist-pop-front ]
+    { } unfold ;
 
 : while-mailbox-empty ( mailbox quot -- )
     over mailbox-empty? [

extra/help/crossref/crossref.factor

@@ -13,11 +13,8 @@ M: link uses
     { $subsection $link $see-also }
     collect-elements [ \ f or ] map ;
 
-: (help-path) ( topic -- )
-    article-parent [ dup , (help-path) ] when* ;
-
 : help-path ( topic -- seq )
-    [ (help-path) ] { } make ;
+    [ dup ] [ [ article-parent ] keep ] { } unfold 1 tail ;
 
 : set-article-parents ( parent article -- )
     article-children [ set-article-parent ] curry* each ;

extra/io/sockets/impl/impl.factor

@@ -94,11 +94,10 @@ M: f parse-sockaddr nip ;
     swap addrinfo-family addrspec-of-family
     parse-sockaddr ;
 
-: addrspec, ( addrinfo -- )
-    [ dup addrinfo>addrspec , addrinfo-next addrspec, ] when* ;
-
 : parse-addrinfo-list ( addrinfo -- seq )
-    [ addrspec, ] { } make [ ] subset ;
+    [ dup ]
+    [ dup addrinfo-next swap addrinfo>addrspec ]
+    { } unfold [ ] subset ;
 
 M: object resolve-host ( host serv passive? -- seq )
     >r dup integer? [ number>string ] when

extra/serialize/serialize-tests.factor

@@ -59,3 +59,13 @@ C: <serialize-test> serialize-test
 [ t ] [ objects [ check-serialize-2 ] all? ] unit-test
 
 [ t ] [ pi check-serialize-1 ] unit-test
+
+[ t ] [
+    { 1 2 3 } [
+        [
+            dup (serialize) (serialize)
+        ] with-serialized
+    ] string-out [
+        deserialize-sequence all-eq?
+    ] string-in
+] unit-test

extra/serialize/serialize.factor

@@ -260,11 +260,8 @@ DEFER: (deserialize) ( -- obj )
 : with-serialized ( quot -- )
     V{ } clone serialized rot with-variable ; inline
 
-: (deserialize-sequence)
-    deserialize* [ , (deserialize-sequence) ] [ drop ] if ;
-
 : deserialize-sequence ( -- seq )
-    [ (deserialize-sequence) ] { } make ;
+    [ [ deserialize* ] [ ] { } unfold ] with-serialized ;
 
 : deserialize ( -- obj )
     [ (deserialize) ] with-serialized ;

extra/store/blob/blob.factor

@@ -11,7 +11,7 @@ IN: store.blob
 : (load-blob) ( path -- seq/f )
     dup exists? [
         <file-reader> [
-            [ deserialize-sequence ] with-serialized
+            deserialize-sequence
         ] with-stream
     ] [
         drop f

extra/ui/gadgets/gadgets.factor

@@ -285,11 +285,8 @@ M: gadget ungraft* drop ;
 : add-gadgets ( seq parent -- )
     swap [ over (add-gadget) ] each relayout ;
 
-: (parents) ( gadget -- )
-    [ dup , gadget-parent (parents) ] when* ;
-
 : parents ( gadget -- seq )
-    [ (parents) ] { } make ;
+    [ dup ] [ [ gadget-parent ] keep ] { } unfold ;
 
 : each-parent ( gadget quot -- ? )
     >r parents r> all? ; inline
@@ -335,11 +332,8 @@ M: f request-focus-on 2drop ;
 : request-focus ( gadget -- )
     dup focusable-child swap request-focus-on ;
 
-: (focus-path) ( gadget -- )
-    [ dup , gadget-focus (focus-path) ] when* ;
-
 : focus-path ( world -- seq )
-    [ (focus-path) ] { } make ;
+    [ dup ] [ [ gadget-focus ] keep ] { } unfold ;
 
 : make-gadget ( quot gadget -- gadget )
     [ \ make-gadget rot with-variable ] keep ; inline

extra/xml-rpc/xml-rpc.factor

@@ -35,7 +35,7 @@ M: string item>xml ! This should change < and &
     2array "member" build-tag* ;
 
 M: hashtable item>xml
-    [ [ struct-member , ] assoc-each ] { } make
+    [ struct-member ] { } assoc>map
     "struct" build-tag* ;
 
 M: array item>xml