From a732c2afc5bb759b919d2c85eb5cf3f4f47d166a Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Tue, 9 Jun 2015 08:42:54 -0700
Subject: [PATCH] sequences.deep: adding deep-reduce.

---
 basis/sequences/deep/deep-docs.factor | 5 +++++
 basis/sequences/deep/deep.factor      | 3 +++
 2 files changed, 8 insertions(+)

diff --git a/basis/sequences/deep/deep-docs.factor b/basis/sequences/deep/deep-docs.factor
index d2661d6d41..af33e10179 100644
--- a/basis/sequences/deep/deep-docs.factor
+++ b/basis/sequences/deep/deep-docs.factor
@@ -6,6 +6,11 @@ HELP: deep-each
 { $description "Execute a quotation on each nested element of an object and its children, in preorder." }
 { $see-also each } ;
 
+HELP: deep-reduce
+{ $values { "obj" object } { "identity" object } { "quot" { $quotation ( ... prev elt -- ... next ) } } { "result" "the final result" } }
+{ $description "Execute a quotation on each nested element of an object and its children, in preorder. The first iteration is called with " { $code "identity" } " and the first element. Subsequence iterations are called with the result of the previous iteration and the next element." }
+{ $see-also reduce } ;
+
 HELP: deep-map
 { $values { "obj" object } { "quot" { $quotation ( ... elt -- ... elt' ) } } { "newobj" "the mapped object" } }
 { $description "Execute a quotation on each nested element of an object and its children, in preorder. That is, the result of the execution of the quotation on the outer is used to map the inner elements." }
diff --git a/basis/sequences/deep/deep.factor b/basis/sequences/deep/deep.factor
index d748263b02..86388a8af0 100644
--- a/basis/sequences/deep/deep.factor
+++ b/basis/sequences/deep/deep.factor
@@ -16,6 +16,9 @@ M: object branch? drop f ;
     [ call ] 2keep over branch?
     [ '[ _ deep-each ] each ] [ 2drop ] if ; inline recursive
 
+: deep-reduce ( ... obj identity quot: ( ... prev elt -- ... next ) -- ... result )
+    swapd deep-each ; inline
+
 : deep-map ( ... obj quot: ( ... elt -- ... elt' ) -- ... newobj )
     [ call ] keep over branch?
     [ '[ _ deep-map ] map ] [ drop ] if ; inline recursive