data-reify-0.5: test/Test7.hs

{-# LANGUAGE TypeFamilies, UndecidableInstances, DeriveDataTypeable, RankNTypes, ExistentialQuantification      #-}


import qualified Data.Traversable as T
import qualified Data.Foldable as F
import Data.Monoid
--import Control.Monad
import Control.Applicative hiding (Const)
import Data.Unique

import System.Environment

import Data.Reify
--import Data.Reify
import Control.Monad
import System.CPUTime
import Data.Typeable
import Control.Exception as E

import Data.Dynamic

data Tree = Node Tree Tree | Leaf Int
         deriving (Show,Eq,Typeable)

data T s = N s s | L Int

instance MuRef Tree where
  type DeRef Tree = T
  mapDeRef f (Node t1 t2) = N <$> f t1 <*> f t2
  mapDeRef f (Leaf i)     = pure $ L i

deepTree :: Int -> Int -> Tree
deepTree 1 x = Leaf x
deepTree n x = Node (deepTree (pred n) (x * 37)) (deepTree (pred n) (x * 17))

-- no sharing
deepTree' n = deepTree n 1

deepTree2 :: Int -> Integer -> Tree -> Tree
deepTree2 1 v x = if v == 89235872347 then Leaf 1 else x
deepTree2 n v x = Node (deepTree2 (pred n) (v * 37) x) (deepTree2 (pred n) (v * 17) x)

-- sharing
deepTree2' n = let v = deepTree2 n 1 v in v

timeme :: Int -> (Int -> Tree) -> IO Float
timeme n f = do
        i <- getCPUTime
        let g3 :: Tree
            g3 = f n 
        reifyGraph g3 >>= \ (Graph xs _) -> putStr $ show (length xs)
        j <- getCPUTime
        let t :: Float
            t = fromIntegral ((j - i) `div` 1000000000)
        putStrLn $ " " ++ show n ++ " ==> " ++ show (t / 1000)   
        return t    
        

main = do
  (x:args) <- getArgs
  sequence [ timeme n (case x of
                         "sharing"    -> deepTree2'
                         "no-sharing" -> deepTree')
           | n <- map read args
           ]