Tonight, I was willing to create a while construct in Factor taking two items on the stack:

1. a quotation to execute when the test is true
2. a test quotation

For example, I wanted to be able to find the smallest power of two greater than or equal to an arbitrary number (here 34098) by doing:

1 [ 2 * ] [ dup 34098 < ] while

(of course there are much better ways of doing that, such as 34098 2 * 1 + 2 /i but that’s not the point here)

This would be much easier if we could recurse from within a block (by using a recurse word). Let’s start with that:

SYMBOL: recursive-block

: set-block ( quot -- )
  recursive-block set ;

: recurse ( quot -- )
  recursive-block get call ;

: with-recurse ( quot -- )
  recursive-block get >r
  dup set-block call
  r> set-block ;

A quote passed through with-recurse can use the recurse word and re-execute itself.

Now that we have recursion, it is easy to implement while using currying:

: while ( quot quot -- )
  swap [ call recurse ] curry [ slip when ] 2curry
  with-recurse ; inline

Note that inline is used here to give the optimizing compiler a chance to build the complete quotation at compile-time if both quotations given to while are statically known.

To create a vocabulary recursion containing this code, one can create a file extra/recursion/recursion.factor containing:

USING: kernel namespaces ;
IN: recursion

<PRIVATE

SYMBOL: recursive-block

: set-block ( quot -- )
  recursive-block set ;

: init-block ( -- )
  [ "recurse called without with-recurse" throw ] set-block ;

PRIVATE>

: recurse ( quot -- )
  recursive-block get call ;

: with-recurse ( quot -- )
  recursive-block get >r
  dup set-block call
  r> set-block ;

: while ( quot quot -- )
  swap [ call recurse ] curry [ slip when ] 2curry
  with-recurse ; inline

MAIN: init-block

Loading this library can be done by issuing the following command in the listener: "recursion" run.

That’s all folks.

blog comments powered by Disqus