Implementation of some higher order functions in Forth

hof.f

: -range ( a-addr1 u -- a-addr2 a-addr1 )
  cells over + ;

: range ( a-addr1 u -- a-addr1 a-addr2)
  -range swap ;

: map! ( xt a-addr u -- )
  range ?do i @ over execute i ! cell +loop ;

: foldl ( xt w1 a-addr u2 -- w2 )
  2over drop >r range ?do i @ j execute cell +loop r> drop ;

: foldr ( xt w1 a-addr u2 -- w3 )
  2over drop >r -range ?do j i @ execute cell negate +loop r> drop ;

: reduce ( xt a-addr u1 -- w )
  over @ -rot foldl ;