From d06dc0996dcd4b92577a5c389476b57e38ce60ee Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sun, 13 Oct 2013 08:40:50 -0700
Subject: [PATCH] math.extras: adding map-kahan-sum.

---
 extra/math/extras/extras.factor | 15 ++++++++++++---
 1 file changed, 12 insertions(+), 3 deletions(-)

diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor
index 56825f2801..4766eb65f0 100644
--- a/extra/math/extras/extras.factor
+++ b/extra/math/extras/extras.factor
@@ -290,7 +290,16 @@ M: real round-away-from-zero
         ] reduce nip max
     ] if ; inline
 
+<PRIVATE
+
+: kahan+ ( c n elt -- c' n' )
+    rot - 2dup + [ -rot [ - ] bi@ ] keep ;
+
+PRIVATE>
+
 : kahan-sum ( seq -- n )
-    [ 0.0 0.0 ] dip [
-        rot - 2dup + [ -rot [ - ] bi@ ] keep
-    ] each nip ;
+    [ 0.0 0.0 ] dip [ kahan+ ] each nip ;
+
+: map-kahan-sum ( ... seq quot: ( ... elt -- ... n ) -- ... n )
+    [ 0.0 0.0 ] 2dip [ 2dip rot kahan+ ] curry
+    [ -rot ] prepose each nip ; inline