rats.hs

import Numeric.Natural
import Data.Function

-- R a = Fix (ContT a [])
newtype R a = R { r :: (R a -> [a]) -> [a] }

bfUnfold :: (a -> (b,a,a)) -> a -> [b]
bfUnfold f t = g t (fix (R . flip id)) (fix (flip r))
  where
    g b fw bw = x : r fw (bw . R . g ys . R . g zs)
      where
        (x,ys,zs) = f b

-- Stern-Brocot
rats1 :: [(Natural,Natural)]
rats1 = bfUnfold step ((0,1),(1,0))
  where
    step (lb,rb) = (m,(lb,m),(m,rb))
      where
        m = adj lb rb
    adj (w,x) (y,z) = (w+y,x+z)
    
-- Calkin-Wilf
rats2 :: [(Natural,Natural)]
rats2 = bfUnfold step (1,1)
  where
    step (m,n) = ((m,n),(m,m+n),(n+m,n))