diff --git a/extra/lisp/conses/conses.factor b/extra/lisp/conses/conses.factor
index 3fdbc25b0e..c715ac890a 100644
--- a/extra/lisp/conses/conses.factor
+++ b/extra/lisp/conses/conses.factor
@@ -20,7 +20,12 @@ TUPLE: cons car cdr ;
     <reversed> cons [ <car> swap >>cdr ] reduce ;
     
 : (map-cons) ( acc cons quot -- seq )    
-    over null? [ 2drop ] [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (map-cons) ] if ;
+    over null? [ 2drop ]
+    [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (map-cons) ] if ;
     
 : map-cons ( cons quot -- seq )
-    [ { } clone ] 2dip (map-cons) ;
\ No newline at end of file
+    [ { } clone ] 2dip (map-cons) ;
+    
+: reduce-cons ( cons identity quot -- result )    
+    pick null? [ drop nip ]
+    [ [ uncons ] 2dip swapd [ call ] keep reduce-cons ] if ;
\ No newline at end of file