From 05665e8d1398d6b838fef0325c08503a68735eee Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 13 Dec 2019 14:35:51 -0800
Subject: [PATCH] kernel: adding while* that passes the predicate result to the
 body.

---
 core/kernel/kernel-docs.factor | 4 ++++
 core/kernel/kernel.factor      | 3 +++
 2 files changed, 7 insertions(+)

diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index ad0009e95f..d06c764758 100644
--- 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 7a7db30948..35bbfdfb38 100644
--- 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