kernel: adding while* that passes the predicate result to the body.

diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index ad0009e95f8bbfb17d4bde064377be9c3f9e8755..d06c764758217ce331fb07797f657879003bfabf 100644 (file)
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -885,6 +885,10 @@ HELP: while
 { $values { "pred" { $quotation ( ..a -- ..b ? ) } } { "body" { $quotation ( ..b -- ..a ) } } }
 { $description "Calls " { $snippet "body" } " until " { $snippet "pred" } " returns " { $link f } "." } ;
 
+HELP: while*
+{ $values { "pred" { $quotation ( ..a -- ..b ? ) } } { "body" { $quotation ( ..b ? -- ..a ) } } }
+{ $description "Calls " { $snippet "body" } " until " { $snippet "pred" } " returns " { $link f } "." } ;
+
 HELP: until
 { $values { "pred" { $quotation ( ..a -- ..b ? ) } } { "body" { $quotation ( ..b -- ..a ) } } }
 { $description "Calls " { $snippet "body" } " until " { $snippet "pred" } " returns " { $link t } "." } ;

diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index 7a7db309485a6dffd171374bde136ab67a43864a..35bbfdfb38c0652681b0f1054ce2e220d7e9ee21 100644 (file)
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -284,6 +284,9 @@ UNION: boolean POSTPONE: t POSTPONE: f ;
 : while ( ..a pred: ( ..a -- ..b ? ) body: ( ..b -- ..a ) -- ..b )
     swap do compose [ loop ] curry when ; inline
 
+: while* ( ..a pred: ( ..a -- ..b ? ) body: ( ..b ? -- ..a ) -- ..b )
+    [ [ dup ] compose ] dip while drop ; inline
+
 : until ( ..a pred: ( ..a -- ..b ? ) body: ( ..b -- ..a ) -- ..b )
     [ [ not ] compose ] dip while ; inline