Paste: unfold

Author: doublec
Mode: factor
Date: Sun, 12 Oct 2008 23:06:33
Plain Text | 
:: (unfold) 
    ( seed 
      p:   ( seed -- ? )
      f:   ( seed -- o )
      g:   ( seed -- seed' )
      -- )
  seed p call [ 
    seed f call , seed g call p f g (unfold)
  ] unless ; inline recursive

: unfold  ( seed p f g -- seq )
  [ (unfold) ] { } make ; inline

! fib
{ 0 1 } 
[ first 30 > ]
[ first ]
[ first2 swap over + 2array ]  
unfold

! fac
100000 [ 1 < ] [ ] [ 1 - ] unfold 1 [ * ] reduce

Annotation: unfold using linrec

Author: doublec
Mode: factor
Date: Sun, 12 Oct 2008 23:08:35
Plain Text | 
:: linrec 
     ( if-quot:    ( -- ? ) 
       then-quot:  ( -- ) 
       else1-quot: ( -- ) 
       else2-quot: ( -- ) 
       -- )
  if-quot call [ 
    then-quot call 
  ] [ 
    else1-quot call 
    if-quot then-quot else1-quot else2-quot linrec
    else2-quot call
  ] if ; inline recursive

:: unfold
    ( seed 
      p:   ( seed -- ? )
      f:   ( seed -- o )
      g:   ( seed -- seed' )
      -- )
 [ 
    seed [ dup p call ] [ ] [ dup f call , g call ] [ ] linrec 
 ] { } make nip ; inline

New Annotation

Summary:
Author:
Mode:
Body: