: fib-iter ( x y -- x y ) [ + ] keep swap ;
: fib-sum-iter ( x y z -- x y z ) swap [ drop [ + ] keep ] keep swap ;
: fib-even-sum ( -- x ) 
    0 0 1 [ dup 1000000 < ] [ dup even? [ fib-sum-iter ] when fib-iter ] while 2drop ;