Target.hs

{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE DeriveDataTypeable #-}
module LLVM.ExecutionEngine.Target(TargetData(..), getTargetData, targetDataFromString, withIntPtrType) where

import LLVM.Core.Data (WordN)
import LLVM.ExecutionEngine.Engine
          (runEngineAccess, getExecutionEngineTargetData)

import qualified LLVM.FFI.Core as FFI
import qualified LLVM.FFI.Target as FFI

import qualified Type.Data.Num.Decimal.Number as Dec
import Type.Base.Proxy (Proxy)

import Foreign.C.String (withCString)
import Data.Typeable (Typeable)
import Data.Maybe (fromMaybe)
import System.IO.Unsafe (unsafePerformIO)


type Type = FFI.TypeRef

data TargetData = TargetData {
    aBIAlignmentOfType         :: Type -> Int,
    aBISizeOfType              :: Type -> Int,
    littleEndian               :: Bool,
    callFrameAlignmentOfType   :: Type -> Int,
--  elementAtOffset            :: Type -> Word64 -> Int,
    intPtrType                 :: Type,
--  offsetOfElements           :: Int -> Word64,
    pointerSize                :: Int,
--  preferredAlignmentOfGlobal :: Value a -> Int,
    preferredAlignmentOfType   :: Type -> Int,
    sizeOfTypeInBits           :: Type -> Int,
    storeSizeOfType            :: Type -> Int
    }
    deriving (Typeable)

withIntPtrType :: (forall n . (Dec.Positive n) => WordN n -> a) -> a
withIntPtrType f =
    fromMaybe (error "withIntPtrType: pointer size must be non-negative") $
        Dec.reifyPositive (fromIntegral sz) (\ n -> f (g n))
  where g :: Proxy n -> WordN n
        g _ = error "withIntPtrType: argument used"
        sz = pointerSize $ unsafePerformIO getTargetData

-- Gets the target data for the JIT target.
getEngineTargetDataRef :: IO FFI.TargetDataRef
getEngineTargetDataRef = runEngineAccess getExecutionEngineTargetData

-- Normally the TargetDataRef never changes, so the operation
-- are really pure functions.
makeTargetData :: FFI.TargetDataRef -> TargetData
makeTargetData r = TargetData {
    aBIAlignmentOfType       = fromIntegral . unsafePerformIO . FFI.aBIAlignmentOfType r,
    aBISizeOfType            = fromIntegral . unsafePerformIO . FFI.aBISizeOfType r,
    littleEndian             = unsafePerformIO (FFI.byteOrder r) /= FFI.bigEndian,
    callFrameAlignmentOfType = fromIntegral . unsafePerformIO . FFI.callFrameAlignmentOfType r,
    intPtrType               = unsafePerformIO $ FFI.intPtrType r,
    pointerSize              = fromIntegral $ unsafePerformIO $ FFI.pointerSize r,
    preferredAlignmentOfType = fromIntegral . unsafePerformIO . FFI.preferredAlignmentOfType r,
    sizeOfTypeInBits         = fromIntegral . unsafePerformIO . FFI.sizeOfTypeInBits r,
    storeSizeOfType          = fromIntegral . unsafePerformIO . FFI.storeSizeOfType r
    }

getTargetData :: IO TargetData
getTargetData = fmap makeTargetData getEngineTargetDataRef

targetDataFromString :: String -> TargetData
targetDataFromString s = makeTargetData $ unsafePerformIO $ withCString s FFI.createTargetData