PRIVATE>
+<PRIVATE
+
+: (binary-reduce2) ( ... seq start quot: ( ... elt1 elt2 -- ... newelt ) from length -- ... value )
+ #! We can't use case here since combinators depends on
+ #! sequences
+ dup 4 < [
+ integer>fixnum {
+ [ 2drop nip ]
+ [ 2nip swap nth-unsafe ]
+ [ -rot [ drop swap nth2-unsafe ] dip call ]
+ [ -rot [ drop swap nth3-unsafe ] dip bi@ ]
+ } dispatch
+ ] [
+ [ 2/ ] [ over - ] bi [ 2dup + ] dip
+ [ (binary-reduce) ] [ 2curry ] curry 2bi@
+ pick [
+ [ 3curry ] bi-curry@ 3bi
+ [ call ] dip swap [ call ] dip
+ ] dip call
+ ] if ; inline recursive
+
+PRIVATE>
+
+: binary-reduce2 ( ... seq start quot: ( ... elt1 elt2 -- ... newelt ) -- ... value )
+ pick length 0 max 0 swap (binary-reduce2) ; inline
+
+GENERIC: sum2 ( seq -- n )
+M: object sum2 0 [ + ] binary-reduce2 ;
+
+GENERIC: sum3 ( seq -- n )
+M: object sum3 0 [ + ] binary-reduce ;
+
+: product2 ( seq -- n )
+ 0 swap 1 [
+ dup even? [ 2/ * [ 1 + ] dip ] [ * ] if
+ ] binary-reduce2 swap shift ;
+
+TUPLE: factorials n length ;
+: <factorials> ( n -- factorials )
+ dup dup odd? [ 1 + ] when 2/ factorials boa ; inline
+M: factorials length length>> ; inline
+M: factorials nth-unsafe
+ n>> swap [ - ] keep 1 + 2dup = [ drop ] [ * ] if ; inline
+INSTANCE: factorials sequence
+
+: factorial-product ( n -- n! )
+ dup 1 > [ [1,b] product2 ] [ drop 1 ] if ;
+
+: factorial1 ( n -- n! )
+ dup 1 > [
+ [ 0 1 ] dip [ dup 1 > ] [
+ [ dup even? [ 2/ [ 1 + ] 2dip ] when * ]
+ [ 1 - ] bi
+ ] while drop swap shift
+ ] [ drop 1 ] if ;
+
+: factorial0 ( n -- n! )
+ dup 1 > [ [1,b] product ] [ drop 1 ] if ;
+
+:: factorial2 ( n -- n! )
+ n n n [ 2 - dup 1 > ] [
+ [ + [ * ] keep ] keep
+ ] while nip 1 = [ n 1 + 2/ * ] when ;
+
+! http://www.luschny.de/math/factorial/scala/FactorialScalaCsharp.htm
+
MEMO: factorial ( n -- n! )
dup 1 > [ [1,b] product ] [ drop 1 ] if ;