gistfile1

import Prelude hiding (and)

import Criterion.Main(defaultMain, bench, B(..))
import Data.Word
import LLVM.Core
import LLVM.Util.Optimize
import LLVM.ExecutionEngine

import Test.QuickCheck


-- naive version
fib_naive :: Word32 -> Word32
fib_naive 0 = 0
fib_naive 1 = 1
fib_naive n = fib_naive (n-1) + fib_naive (n-2)

-- llvm version
fib_llvm :: CodeGenModule (Function (Word32 -> IO Word32))
fib_llvm = do
    fib <- newNamedFunction ExternalLinkage "fib_llvm"
    defineFunction fib $ \arg -> do
        recurse <- newBasicBlock
        exit <- newBasicBlock


        test <- icmp IntUGT arg (2::Word32)
        condBr test recurse exit

        defineBasicBlock exit
        ret (1::Word32)

        defineBasicBlock recurse
        x1 <- sub arg (1::Word32)
        fibx1 <- call fib x1
        x2 <- sub arg (2::Word32)
        fibx2 <- call fib x2
        r <- add fibx1 fibx2
        ret r

    return fib

-- quickcheck based stuff
data Q = Q Word32 deriving (Eq, Show)

instance Arbitrary Q where
    -- we have the dummy 'Q' type because we want
    -- to restrict the possible inputs we can get so we
    -- don't end up doing something crazy
    arbitrary = do
        n <- choose (1,35::Int)
        return $ Q $ fromIntegral n

prop_sanity llvm_fib_func (Q x) = fib_naive x == llvm_fib_func x
  where types = (x::Word32)


-- doin' it!
main :: IO ()
main = do
    putStrLn "initializing llvm jit" >> initializeNativeTarget
    putStr "creating optimized module... "
    _m <- newModule
    _f <- defineModule _m fib_llvm
    optimizeModule 3 _m -- yow! mutability
    putStrLn "done"

    iofib <- runEngineAccess $ generateFunction _f
    let fib_llvm2 = unsafePurify iofib

    putStrLn "running tests"
    quickCheck (prop_sanity fib_llvm2)
    
    putStrLn "running benchmarks"
    defaultMain [ bench "fib_naive 35" $ B fib_naive 35
                , bench "fib_llvm 35"  $ B fib_llvm2 35 ]