Skip to content

Instantly share code, notes, and snippets.

@adolfopa

adolfopa/hof.f

Created February 10, 2017 23:36
Show Gist options
  • Save adolfopa/64a1a59c28cbd77b71449d68f4c36dc0 to your computer and use it in GitHub Desktop.
Save adolfopa/64a1a59c28cbd77b71449d68f4c36dc0 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. adolfopa created this gist Feb 10, 2017.
    17 changes: 17 additions & 0 deletions hof.f
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,17 @@
    : -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 ;