Loeb.hs

Loeb.hs

-- http://blog.sigfpe.com/2006/11/from-l-theorem-to-spreadsheet.html

{-# LANGUAGE FlexibleContexts #-}

module Main where

import Control.Applicative
import Control.Monad.Reader

loeb :: Functor a => a (a x -> x) -> a x
loeb x = fmap (\a -> a (loeb x)) x  -- Dan Piponi's version
-- loeb x = xs where xs = fmap ($xs) x  -- Edward Kmett's version

instance (Num a, Eq a) => Num (x -> a) where
  fromInteger = pure . fromInteger
  (+) = liftA2 (+)
  (*) = liftA2 (*)
  negate = fmap negate
  abs = fmap abs
  signum = fmap signum

fact :: (Eq r, Num r) => r -> r
fact n = loeb fact' n where
  fact' :: (Eq r, Num r, MonadReader (r -> r) m) => r -> m r
  fact' 0 = return 1
  fact' n = do
    f <- ask
    return $ n * f (n-1)

main = do
  print $ loeb [length, (!!0) - 1, \x -> 43]
  print $ loeb [(!!5), 3, (!!0)+(!!1), (!!2)*2, sum . take 4, 17]
  print $ fact 7