Run.hs

{-# LANGUAGE ForeignFunctionInterface #-}
module Test.LLVM.DSL.Run where

import qualified Test.QuickCheck as QC

import qualified LLVM.DSL.Execution as Exec
import qualified LLVM.DSL.Expression as Expr
import LLVM.DSL.Expression (Exp)

import qualified LLVM.Extra.Nice.Value.Marshal as Marshal
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Core as LLVM

import System.IO.Unsafe (unsafePerformIO)


foreign import ccall safe "dynamic" derefFuncPtr ::
   Exec.Importer (LLVM.Ptr inp -> LLVM.Ptr out -> IO ())


sharedRun ::
   (QC.Testable prop, Marshal.C a, Marshal.C b) =>
   (Expr.Exp a -> Expr.Exp b) -> ((a -> b) -> prop) -> QC.Property
sharedRun f prop =
   QC.idempotentIOProperty $ do
      code <- runIO f
      return $ QC.forAllBlind (return code) prop

run ::
   (Marshal.C a, Marshal.C b) =>
   (Exp a -> Exp b) ->
   a -> b
run = unsafePerformIO . runIO

runIO ::
   (Marshal.C a, Marshal.C b) =>
   (Exp a -> Exp b) ->
   IO (a -> b)
runIO f = do
   code <-
      Exec.compile "doctest" $
      Exec.createFunction derefFuncPtr "func" $ \aPtr bPtr ->
         flip Memory.store bPtr =<< Expr.unliftM1 f =<< Memory.load aPtr

   return $ \a ->
      unsafePerformIO $
      Marshal.alloca $ \bPtr ->
      Marshal.with a $ \aPtr ->
      code aPtr bPtr >> Marshal.peek bPtr