packages feed

llvm-tf 3.1.2 → 3.9

raw patch · 11 files changed

+397/−135 lines, 11 filesdep ~llvm-ffi

Dependency ranges changed: llvm-ffi

Files

example/Array.hs view
@@ -5,6 +5,7 @@ import LLVM.Core  import Foreign.Ptr (Ptr)+import Control.Monad (foldM, void) import Data.Word (Word32)  @@ -34,12 +35,12 @@ 	      j <- add ni' li 	      p <- getElementPtr cPtr (j, ()) 	      store x p-	      return ()         ret ()     let _ = matMul :: Function (Word32 -> Word32 -> Word32 -> Ptr Double -> Ptr Double -> Ptr Double -> IO ()) -    let fillArray _ [] = return ()-        fillArray ptr (x:xs) = do store x ptr; ptr' <- getElementPtr ptr (1::Word32,()); fillArray ptr' xs+    let fillArray =+            (void .) .+            foldM (\ptr x -> store x ptr >> getElementPtr ptr (1::Word32,()))      test <- createNamedFunction ExternalLinkage "test" $ \ x -> do         a <- arrayMalloc (4 :: Word32)
example/CallConv.hs view
@@ -18,7 +18,6 @@     _fns <- defineModule m $ setTarget hostTriple >> buildMod     --_ <- optimizeModule 3 m     writeBitcodeToFile "CallConv.bc" m-    return ()  buildMod :: CodeGenModule Mod buildMod = do
example/Fibonacci.hs view
@@ -48,7 +48,6 @@     -- Run fib for the arguments.     forM_ args' $ \num -> do         putStrLn $ "fib " ++ num ++ " = " ++ show (fib (read num))-    return ()  buildMod :: CodeGenModule Mod buildMod = do
example/HelloJIT.hs view
@@ -23,4 +23,3 @@     greet     greet     greet-    return ()
example/Varargs.hs view
@@ -36,4 +36,3 @@     initializeNativeTarget     varargs <- simpleFunction bldVarargs     varargs 42-    return ()
llvm-tf.cabal view
@@ -1,5 +1,5 @@ Name:          llvm-tf-Version:       3.1.2+Version:       3.9 License:       BSD3 License-File:  LICENSE Synopsis:      Bindings to the LLVM compiler toolkit using type families.@@ -39,7 +39,7 @@   Location: http://code.haskell.org/~thielema/llvm-tf/  Source-Repository this-  Tag:      3.1.2+  Tag:      3.9   Type:     darcs   Location: http://code.haskell.org/~thielema/llvm-tf/ @@ -55,7 +55,7 @@ Library   Default-Language: Haskell98   Build-Depends:-    llvm-ffi >= 3.8.1 && <3.9,+    llvm-ffi >=3.9 && <4.0,     tfp >=1.0 && <1.1,     transformers >=0.3 && <0.6,     storable-record >=0.0.2 && <0.1,@@ -98,6 +98,8 @@     LLVM.Core.CodeGenMonad     LLVM.Core.Data     LLVM.Core.Instructions+    LLVM.Core.Instructions.TypeAssisted+    LLVM.Core.Instructions.Private     LLVM.Core.Type     LLVM.Core.Util     LLVM.Core.Vector
src/LLVM/Core/Instructions.hs view
@@ -23,6 +23,7 @@     -- The u instractions are unsigned, the s instructions are signed.     add, sub, mul, neg,     iadd, isub, imul, ineg,+    iaddNoWrap, isubNoWrap, imulNoWrap, inegNoWrap,     fadd, fsub, fmul, fneg,     idiv, irem,     udiv, sdiv, fdiv, urem, srem, frem,@@ -44,6 +45,7 @@     store,     getElementPtr, getElementPtr0,     -- * Conversions+    ValueCons,     trunc, zext, sext, ext, zadapt, sadapt, adapt,     fptrunc, fpext,     fptoui, fptosi, fptoint,@@ -70,7 +72,7 @@      -- * Classes and types     Terminate,-    Ret, CallArgs, AUnOp, ABinOp, ABinOpResult, IsConst,+    Ret, CallArgs, ABinOp, ABinOpResult, IsConst,     FunctionArgs, FunctionCodeGen, FunctionResult,     AllocArg,     GetElementPtr, ElementPtrType, IsIndexArg,@@ -80,6 +82,7 @@  import qualified LLVM.Core.Util as U import qualified LLVM.Util.Proxy as LP+import LLVM.Core.Instructions.Private (ValueCons, convert, aunop) import LLVM.Core.Data import LLVM.Core.Type import LLVM.Core.CodeGenMonad@@ -334,10 +337,6 @@     type ABinOpResult a b :: *     abinop :: FFIConstBinOp -> FFIBinOp -> a -> b -> CodeGenFunction r (ABinOpResult a b) --- |Acceptable arguments to arithmetic unary instructions.-class AUnOp a where-    aunop :: FFIConstUnOp -> FFIUnOp -> a -> CodeGenFunction r a- add :: (IsArithmetic c, ABinOp a b, v c ~ ABinOpResult a b) => a -> b -> CodeGenFunction r (v c) add =     curry $ withArithmeticType $ \typ -> uncurry $ case typ of@@ -363,6 +362,22 @@ imul :: (IsInteger c, ABinOp a b, v c ~ ABinOpResult a b) => a -> b -> CodeGenFunction r (v c) imul = abinop FFI.constMul FFI.buildMul +iaddNoWrap :: forall v a b c r. (IsInteger c, ABinOp a b, v c ~ ABinOpResult a b) => a -> b -> CodeGenFunction r (v c)+iaddNoWrap =+   if isSigned (LP.Proxy :: LP.Proxy c)+     then abinop FFI.constNSWAdd FFI.buildNSWAdd+     else abinop FFI.constNUWAdd FFI.buildNUWAdd+isubNoWrap :: forall v a b c r. (IsInteger c, ABinOp a b, v c ~ ABinOpResult a b) => a -> b -> CodeGenFunction r (v c)+isubNoWrap =+   if isSigned (LP.Proxy :: LP.Proxy c)+     then abinop FFI.constNSWSub FFI.buildNSWSub+     else abinop FFI.constNUWSub FFI.buildNUWSub+imulNoWrap :: forall v a b c r. (IsInteger c, ABinOp a b, v c ~ ABinOpResult a b) => a -> b -> CodeGenFunction r (v c)+imulNoWrap =+   if isSigned (LP.Proxy :: LP.Proxy c)+     then abinop FFI.constNSWMul FFI.buildNSWMul+     else abinop FFI.constNUWMul FFI.buildNUWMul+ -- | signed or unsigned integer division depending on the type idiv ::    forall a b c r v. (IsInteger c, ABinOp a b, v c ~ ABinOpResult a b) =>@@ -451,50 +466,45 @@ --    abinop cop op a1 a2 = abinop cop op (constOf a1) (constOf a2)  -instance AUnOp (Value a) where-    aunop _ op (Value a) = buildUnOp op a--instance AUnOp (ConstValue a) where-    aunop cop _ (ConstValue a) = liftIO $ fmap ConstValue $ cop a-- buildBinOp :: FFIBinOp -> FFI.ValueRef -> FFI.ValueRef -> CodeGenFunction r (Value a) buildBinOp op a1 a2 =     liftM Value $     withCurrentBuilder $ \ bld ->       U.withEmptyCString $ op bld a1 a2 -type FFIUnOp = FFI.BuilderRef -> FFI.ValueRef -> U.CString -> IO FFI.ValueRef-type FFIConstUnOp = FFI.ValueRef -> IO FFI.ValueRef--buildUnOp :: FFIUnOp -> FFI.ValueRef -> CodeGenFunction r (Value a)-buildUnOp op a =-    liftM Value $-    withCurrentBuilder $ \ bld ->-      U.withEmptyCString $ op bld a- neg ::-    (IsArithmetic b, AUnOp a, a ~ v b) =>-    a -> CodeGenFunction r a+    (ValueCons value, IsArithmetic a) =>+    value a -> CodeGenFunction r (value a) neg =     withArithmeticType $ \typ -> case typ of       IntegerType  -> aunop FFI.constNeg FFI.buildNeg       FloatingType -> aunop FFI.constFNeg FFI.buildFNeg  ineg ::-    (IsInteger b, AUnOp a, a ~ v b) =>-    a -> CodeGenFunction r a+    (ValueCons value, IsInteger a) =>+    value a -> CodeGenFunction r (value a) ineg = aunop FFI.constNeg FFI.buildNeg +inegNoWrap ::+    forall value a r.+    (ValueCons value, IsInteger a) =>+    value a -> CodeGenFunction r (value a)+inegNoWrap =+   if isSigned (LP.Proxy :: LP.Proxy a)+     then aunop FFI.constNSWNeg FFI.buildNSWNeg+     else aunop FFI.constNUWNeg FFI.buildNUWNeg+ fneg ::-    (IsFloating b, AUnOp a, a ~ v b) =>-    a -> CodeGenFunction r a+    (ValueCons value, IsFloating a) =>+    value a -> CodeGenFunction r (value a) {- fneg = fsub (value zero :: Value a) -} fneg = aunop FFI.constFNeg FFI.buildFNeg -inv :: (IsInteger b, AUnOp a, a ~ v b) => a -> CodeGenFunction r a+inv ::+    (ValueCons value, IsInteger a) =>+    value a -> CodeGenFunction r (value a) inv = aunop FFI.constNot FFI.buildNot  --------------------------------------@@ -583,147 +593,136 @@  -------------------------------------- --- XXX should allows constants- -- | Truncate a value to a shorter bit width.-trunc :: (IsInteger a, IsInteger b, NumberOfElements a ~ NumberOfElements b, IsSized a, IsSized b, SizeOf a :>: SizeOf b)-      => Value a -> CodeGenFunction r (Value b)-trunc = convert FFI.buildTrunc+trunc :: (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :>: SizeOf b)+      => value a -> CodeGenFunction r (value b)+trunc = convert FFI.constTrunc FFI.buildTrunc  -- | Zero extend a value to a wider width. -- If possible, use 'ext' that chooses the right padding according to the types-zext :: (IsInteger a, IsInteger b, NumberOfElements a ~ NumberOfElements b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)-     => Value a -> CodeGenFunction r (Value b)-zext = convert FFI.buildZExt+zext :: (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)+     => value a -> CodeGenFunction r (value b)+zext = convert FFI.constZExt FFI.buildZExt  -- | Sign extend a value to wider width. -- If possible, use 'ext' that chooses the right padding according to the types-sext :: (IsInteger a, IsInteger b, NumberOfElements a ~ NumberOfElements b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)-     => Value a -> CodeGenFunction r (Value b)-sext = convert FFI.buildSExt+sext :: (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)+     => value a -> CodeGenFunction r (value b)+sext = convert FFI.constSExt FFI.buildSExt  -- | Extend a value to wider width. -- If the target type is signed, then preserve the sign, -- If the target type is unsigned, then extended by zeros.-ext :: forall a b r. (IsInteger a, IsInteger b, NumberOfElements a ~ NumberOfElements b, Signed a ~ Signed b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)-     => Value a -> CodeGenFunction r (Value b)+ext :: forall value a b r. (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, Signed a ~ Signed b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)+     => value a -> CodeGenFunction r (value b) ext =    if isSigned (LP.Proxy :: LP.Proxy b)-     then convert FFI.buildSExt-     else convert FFI.buildZExt+     then convert FFI.constSExt FFI.buildSExt+     else convert FFI.constZExt FFI.buildZExt   -- | It is 'zext', 'trunc' or nop depending on the relation of the sizes.-zadapt :: forall a b r. (IsInteger a, IsInteger b, NumberOfElements a ~ NumberOfElements b)-     => Value a -> CodeGenFunction r (Value b)+zadapt :: forall value a b r. (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b)+     => value a -> CodeGenFunction r (value b) zadapt =    case compare (sizeOf (typeDesc (LP.Proxy :: LP.Proxy a)))                 (sizeOf (typeDesc (LP.Proxy :: LP.Proxy b))) of-      LT -> convert FFI.buildZExt-      EQ -> convert FFI.buildBitCast-      GT -> convert FFI.buildTrunc+      LT -> convert FFI.constZExt FFI.buildZExt+      EQ -> convert FFI.constBitCast FFI.buildBitCast+      GT -> convert FFI.constTrunc FFI.buildTrunc  -- | It is 'sext', 'trunc' or nop depending on the relation of the sizes.-sadapt :: forall a b r. (IsInteger a, IsInteger b, NumberOfElements a ~ NumberOfElements b)-     => Value a -> CodeGenFunction r (Value b)+sadapt :: forall value a b r. (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b)+     => value a -> CodeGenFunction r (value b) sadapt =    case compare (sizeOf (typeDesc (LP.Proxy :: LP.Proxy a)))                 (sizeOf (typeDesc (LP.Proxy :: LP.Proxy b))) of-      LT -> convert FFI.buildSExt-      EQ -> convert FFI.buildBitCast-      GT -> convert FFI.buildTrunc+      LT -> convert FFI.constSExt FFI.buildSExt+      EQ -> convert FFI.constBitCast FFI.buildBitCast+      GT -> convert FFI.constTrunc FFI.buildTrunc  -- | It is 'sadapt' or 'zadapt' depending on the sign mode.-adapt :: forall a b r. (IsInteger a, IsInteger b, NumberOfElements a ~ NumberOfElements b, Signed a ~ Signed b)-     => Value a -> CodeGenFunction r (Value b)+adapt :: forall value a b r. (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, Signed a ~ Signed b)+     => value a -> CodeGenFunction r (value b) adapt =    case compare (sizeOf (typeDesc (LP.Proxy :: LP.Proxy a)))                 (sizeOf (typeDesc (LP.Proxy :: LP.Proxy b))) of       LT ->          if isSigned (LP.Proxy :: LP.Proxy b)-           then convert FFI.buildSExt-           else convert FFI.buildZExt-      EQ -> convert FFI.buildBitCast-      GT -> convert FFI.buildTrunc+           then convert FFI.constSExt FFI.buildSExt+           else convert FFI.constZExt FFI.buildZExt+      EQ -> convert FFI.constBitCast FFI.buildBitCast+      GT -> convert FFI.constTrunc FFI.buildTrunc  -- | Truncate a floating point value.-fptrunc :: (IsFloating a, IsFloating b, NumberOfElements a ~ NumberOfElements b, IsSized a, IsSized b, SizeOf a :>: SizeOf b)-        => Value a -> CodeGenFunction r (Value b)-fptrunc = convert FFI.buildFPTrunc+fptrunc :: (ValueCons value, IsFloating a, IsFloating b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :>: SizeOf b)+        => value a -> CodeGenFunction r (value b)+fptrunc = convert FFI.constFPTrunc FFI.buildFPTrunc  -- | Extend a floating point value.-fpext :: (IsFloating a, IsFloating b, NumberOfElements a ~ NumberOfElements b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)-      => Value a -> CodeGenFunction r (Value b)-fpext = convert FFI.buildFPExt+fpext :: (ValueCons value, IsFloating a, IsFloating b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)+      => value a -> CodeGenFunction r (value b)+fpext = convert FFI.constFPExt FFI.buildFPExt  {-# DEPRECATED fptoui "use fptoint since it is type-safe with respect to signs" #-} -- | Convert a floating point value to an unsigned integer.-fptoui :: (IsFloating a, IsInteger b, NumberOfElements a ~ NumberOfElements b) => Value a -> CodeGenFunction r (Value b)-fptoui = convert FFI.buildFPToUI+fptoui :: (ValueCons value, IsFloating a, IsInteger b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)+fptoui = convert FFI.constFPToUI FFI.buildFPToUI  {-# DEPRECATED fptosi "use fptoint since it is type-safe with respect to signs" #-} -- | Convert a floating point value to a signed integer.-fptosi :: (IsFloating a, IsInteger b, NumberOfElements a ~ NumberOfElements b) => Value a -> CodeGenFunction r (Value b)-fptosi = convert FFI.buildFPToSI+fptosi :: (ValueCons value, IsFloating a, IsInteger b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)+fptosi = convert FFI.constFPToSI FFI.buildFPToSI  -- | Convert a floating point value to an integer. -- It is mapped to @fptosi@ or @fptoui@ depending on the type @a@.-fptoint :: forall r a b. (IsFloating a, IsInteger b, NumberOfElements a ~ NumberOfElements b) => Value a -> CodeGenFunction r (Value b)+fptoint :: forall value a b r. (ValueCons value, IsFloating a, IsInteger b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b) fptoint =    if isSigned (LP.Proxy :: LP.Proxy b)-     then convert FFI.buildFPToSI-     else convert FFI.buildFPToUI+     then convert FFI.constFPToSI FFI.buildFPToSI+     else convert FFI.constFPToUI FFI.buildFPToUI   {- DEPRECATED uitofp "use inttofp since it is type-safe with respect to signs" -} -- | Convert an unsigned integer to a floating point value. -- Although 'inttofp' should be prefered, this function may be useful for conversion from Bool.-uitofp :: (IsInteger a, IsFloating b, NumberOfElements a ~ NumberOfElements b) => Value a -> CodeGenFunction r (Value b)-uitofp = convert FFI.buildUIToFP+uitofp :: (ValueCons value, IsInteger a, IsFloating b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)+uitofp = convert FFI.constUIToFP FFI.buildUIToFP  {- DEPRECATED sitofp "use inttofp since it is type-safe with respect to signs" -} -- | Convert a signed integer to a floating point value. -- Although 'inttofp' should be prefered, this function may be useful for conversion from Bool.-sitofp :: (IsInteger a, IsFloating b, NumberOfElements a ~ NumberOfElements b) => Value a -> CodeGenFunction r (Value b)-sitofp = convert FFI.buildSIToFP+sitofp :: (ValueCons value, IsInteger a, IsFloating b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)+sitofp = convert FFI.constSIToFP FFI.buildSIToFP  -- | Convert an integer to a floating point value. -- It is mapped to @sitofp@ or @uitofp@ depending on the type @a@.-inttofp :: forall r a b. (IsInteger a, IsFloating b, NumberOfElements a ~ NumberOfElements b) => Value a -> CodeGenFunction r (Value b)+inttofp :: forall value a b r. (ValueCons value, IsInteger a, IsFloating b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b) inttofp =    if isSigned (LP.Proxy :: LP.Proxy a)-     then convert FFI.buildSIToFP-     else convert FFI.buildUIToFP+     then convert FFI.constSIToFP FFI.buildSIToFP+     else convert FFI.constUIToFP FFI.buildUIToFP   -- | Convert a pointer to an integer.-ptrtoint :: (IsInteger b, IsPrimitive b) => Value (Ptr a) -> CodeGenFunction r (Value b)-ptrtoint = convert FFI.buildPtrToInt+ptrtoint :: (ValueCons value, IsInteger b, IsPrimitive b) => value (Ptr a) -> CodeGenFunction r (value b)+ptrtoint = convert FFI.constPtrToInt FFI.buildPtrToInt  -- | Convert an integer to a pointer.-inttoptr :: (IsInteger a, IsType b) => Value a -> CodeGenFunction r (Value (Ptr b))-inttoptr = convert FFI.buildIntToPtr+inttoptr :: (ValueCons value, IsInteger a, IsType b) => value a -> CodeGenFunction r (value (Ptr b))+inttoptr = convert FFI.constIntToPtr FFI.buildIntToPtr  -- | Convert between to values of the same size by just copying the bit pattern.-bitcast :: (IsFirstClass a, IsFirstClass b, IsSized a, IsSized b, SizeOf a ~ SizeOf b)-        => Value a -> CodeGenFunction r (Value b)-bitcast = convert FFI.buildBitCast+bitcast :: (ValueCons value, IsFirstClass a, IsFirstClass b, IsSized a, IsSized b, SizeOf a ~ SizeOf b)+        => value a -> CodeGenFunction r (value b)+bitcast = convert FFI.constBitCast FFI.buildBitCast  -- | Like 'bitcast' for vectors but it enforces that the number of elements remains the same.-bitcastElements :: (Dec.Positive n, IsPrimitive a, IsPrimitive b, IsSized a, IsSized b, SizeOf a ~ SizeOf b)-        => Value (Vector n a) -> CodeGenFunction r (Value (Vector n b))-bitcastElements = convert FFI.buildBitCast+bitcastElements :: (ValueCons value, Dec.Positive n, IsPrimitive a, IsPrimitive b, IsSized a, IsSized b, SizeOf a ~ SizeOf b)+        => value (Vector n a) -> CodeGenFunction r (value (Vector n b))+bitcastElements = convert FFI.constBitCast FFI.buildBitCast  -type FFIConvert = FFI.BuilderRef -> FFI.ValueRef -> FFI.TypeRef -> U.CString -> IO FFI.ValueRef--convert :: forall a b r . (IsType b) => FFIConvert -> Value a -> CodeGenFunction r (Value b)-convert conv (Value a) =-    liftM Value $-    withCurrentBuilder $ \ bldPtr -> do-      typ <- typeRef (LP.Proxy :: LP.Proxy b)-      U.withEmptyCString $ conv bldPtr a typ- --------------------------------------  data CmpPredicate =@@ -961,8 +960,9 @@  fastMath ::     (IsFloating a) =>-    (FFI.ValueRef -> CUInt -> IO ()) -> Bool -> Value a -> CodeGenFunction r ()-fastMath setter b (Value v) = liftIO $ setter v $ fromIntegral $ fromEnum b+    (FFI.ValueRef -> FFI.Bool -> IO ()) ->+    Bool -> Value a -> CodeGenFunction r ()+fastMath setter b (Value v) = liftIO $ setter v $ FFI.consBool b   --------------------------------------
+ src/LLVM/Core/Instructions/Private.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ScopedTypeVariables #-}+module LLVM.Core.Instructions.Private where++import qualified LLVM.Core.Util as U+import qualified LLVM.Util.Proxy as LP+import LLVM.Core.Type (IsType, typeRef)+import LLVM.Core.CodeGenMonad (CodeGenFunction)+import LLVM.Core.CodeGen+         (Value(Value), ConstValue(ConstValue), withCurrentBuilder)++import qualified LLVM.FFI.Core as FFI++import Control.Monad.IO.Class (liftIO)+import Control.Monad (liftM)++++type FFIConstConvert = FFI.ValueRef -> FFI.TypeRef -> IO FFI.ValueRef++type FFIConvert =+        FFI.BuilderRef -> FFI.ValueRef -> FFI.TypeRef ->+        U.CString -> IO FFI.ValueRef++type FFIConstUnOp = FFI.ValueRef -> IO FFI.ValueRef+type FFIUnOp = FFI.BuilderRef -> FFI.ValueRef -> U.CString -> IO FFI.ValueRef++type FFIConstTrinOp =+        FFI.ValueRef -> FFI.ValueRef -> FFI.ValueRef -> IO FFI.ValueRef+type FFITrinOp =+        FFI.BuilderRef -> FFI.ValueRef -> FFI.ValueRef -> FFI.ValueRef ->+        U.CString -> IO FFI.ValueRef+++class ValueCons value where+    convert :: (IsType b) =>+        FFIConstConvert -> FFIConvert -> value a -> CodeGenFunction r (value b)+    aunop ::+        FFIConstUnOp -> FFIUnOp -> value a -> CodeGenFunction r (value b)+    trinop ::+        FFIConstTrinOp -> FFITrinOp ->+        value a -> value b -> value c -> CodeGenFunction r (value d)+++instance ValueCons ConstValue where+    convert cnv _ = convertConstValue cnv+    aunop cop _ (ConstValue a) = liftIO $ fmap ConstValue $ cop a+    trinop cop _ (ConstValue a) (ConstValue b) (ConstValue c) =+        liftIO $ fmap ConstValue $ cop a b c++convertConstValue ::+    forall a b r. (IsType b) =>+    FFIConstConvert -> ConstValue a -> CodeGenFunction r (ConstValue b)+convertConstValue conv (ConstValue a) =+    liftM ConstValue $ liftIO $+        conv a =<< typeRef (LP.Proxy :: LP.Proxy b)+++instance ValueCons Value where+    convert _ cnv = convertValue cnv+    aunop _ op (Value a) =+        liftM Value $+        withCurrentBuilder $ \ bld ->+            U.withEmptyCString $ op bld a+    trinop _ op (Value a) (Value b) (Value c) =+        liftM Value $+        withCurrentBuilder $ \ bld ->+            U.withEmptyCString $ op bld a b c++convertValue ::+    forall a b r. (IsType b) =>+    FFIConvert -> Value a -> CodeGenFunction r (Value b)+convertValue conv (Value a) =+    liftM Value $+    withCurrentBuilder $ \ bldPtr -> do+      typ <- typeRef (LP.Proxy :: LP.Proxy b)+      U.withEmptyCString $ conv bldPtr a typ
+ src/LLVM/Core/Instructions/TypeAssisted.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+module LLVM.Core.Instructions.TypeAssisted (+    Assistant,+    scalar,+    vector,+    trunc,+    ext,+    extBool,+    zadapt,+    sadapt,+    adapt,+    fptrunc,+    fpext,+    fptoint,+    inttofp,+    ptrtoint,+    inttoptr,+    bitcast,+    select,+    ) where++import qualified LLVM.Core.Instructions.Private as Priv+import qualified LLVM.Util.Proxy as LP+import LLVM.Core.Instructions.Private (ValueCons)+import LLVM.Core.Data (Vector)+import LLVM.Core.Type+         (IsInteger, IsFloating, IsFirstClass, IsPrimitive,+          Signed, Positive, IsType, IsSized, SizeOf,+          isSigned, sizeOf, typeDesc)+import LLVM.Core.CodeGenMonad (CodeGenFunction)++import qualified LLVM.FFI.Core as FFI++import Type.Data.Num.Decimal.Number ((:<:), (:>:))++import Foreign.Ptr (Ptr)++++data Assistant a b av bv = Assistant++scalar :: Assistant a b a b+scalar = Assistant++vector ::+    (Positive n, IsPrimitive a, IsPrimitive b) =>+    Assistant a b (Vector n a) (Vector n b)+vector = Assistant+++-- | Truncate a value to a shorter bit width.+trunc ::+    (ValueCons value, IsInteger av, IsInteger bv,+     IsSized a, IsSized b, SizeOf a :>: SizeOf b) =>+    Assistant a b av bv -> value av -> CodeGenFunction r (value bv)+trunc = convert FFI.constTrunc FFI.buildTrunc++-- | Extend a value to wider width.+-- If the target type is signed, then preserve the sign,+-- If the target type is unsigned, then extended by zeros.+ext :: forall value a b av bv r.+    (ValueCons value, IsInteger av, IsInteger bv, Signed a ~ Signed b,+     IsSized a, IsSized b, SizeOf a :<: SizeOf b) =>+    Assistant a b av bv -> value av -> CodeGenFunction r (value bv)+ext =+   if isSigned (LP.Proxy :: LP.Proxy bv)+     then convert FFI.constSExt FFI.buildSExt+     else convert FFI.constZExt FFI.buildZExt++extBool :: forall value b av bv r.+    (ValueCons value, IsInteger bv) =>+    Assistant Bool b av bv -> value av -> CodeGenFunction r (value bv)+extBool =+   if isSigned (LP.Proxy :: LP.Proxy bv)+     then convert FFI.constSExt FFI.buildSExt+     else convert FFI.constZExt FFI.buildZExt+++-- | It is 'zext', 'trunc' or nop depending on the relation of the sizes.+zadapt :: forall value a b av bv r.+    (ValueCons value, IsInteger av, IsInteger bv) =>+    Assistant a b av bv -> value av -> CodeGenFunction r (value bv)+zadapt =+   case compare (sizeOf (typeDesc (LP.Proxy :: LP.Proxy av)))+                (sizeOf (typeDesc (LP.Proxy :: LP.Proxy bv))) of+      LT -> convert FFI.constZExt FFI.buildZExt+      EQ -> convert FFI.constBitCast FFI.buildBitCast+      GT -> convert FFI.constTrunc FFI.buildTrunc++-- | It is 'sext', 'trunc' or nop depending on the relation of the sizes.+sadapt :: forall value a b av bv r.+    (ValueCons value, IsInteger av, IsInteger bv) =>+    Assistant a b av bv -> value av -> CodeGenFunction r (value bv)+sadapt =+   case compare (sizeOf (typeDesc (LP.Proxy :: LP.Proxy av)))+                (sizeOf (typeDesc (LP.Proxy :: LP.Proxy bv))) of+      LT -> convert FFI.constSExt FFI.buildSExt+      EQ -> convert FFI.constBitCast FFI.buildBitCast+      GT -> convert FFI.constTrunc FFI.buildTrunc++-- | It is 'sadapt' or 'zadapt' depending on the sign mode.+adapt :: forall value a b av bv r.+    (ValueCons value, IsInteger av, IsInteger bv, Signed a ~ Signed b) =>+    Assistant a b av bv -> value av -> CodeGenFunction r (value bv)+adapt =+   case compare (sizeOf (typeDesc (LP.Proxy :: LP.Proxy av)))+                (sizeOf (typeDesc (LP.Proxy :: LP.Proxy bv))) of+      LT ->+         if isSigned (LP.Proxy :: LP.Proxy bv)+           then convert FFI.constSExt FFI.buildSExt+           else convert FFI.constZExt FFI.buildZExt+      EQ -> convert FFI.constBitCast FFI.buildBitCast+      GT -> convert FFI.constTrunc FFI.buildTrunc++-- | Truncate a floating point value.+fptrunc ::+    (ValueCons value, IsFloating av, IsFloating bv,+     IsSized a, IsSized b, SizeOf a :>: SizeOf b) =>+    Assistant a b av bv -> value av -> CodeGenFunction r (value bv)+fptrunc = convert FFI.constFPTrunc FFI.buildFPTrunc++-- | Extend a floating point value.+fpext ::+    (ValueCons value, IsFloating av, IsFloating bv,+     IsSized a, IsSized b, SizeOf a :<: SizeOf b) =>+    Assistant a b av bv -> value av -> CodeGenFunction r (value bv)+fpext = convert FFI.constFPExt FFI.buildFPExt++-- | Convert a floating point value to an integer.+-- It is mapped to @fptosi@ or @fptoui@ depending on the type @a@.+fptoint :: forall value a b av bv r.+    (ValueCons value, IsFloating av, IsInteger bv) =>+    Assistant a b av bv -> value av -> CodeGenFunction r (value bv)+fptoint =+   if isSigned (LP.Proxy :: LP.Proxy bv)+     then convert FFI.constFPToSI FFI.buildFPToSI+     else convert FFI.constFPToUI FFI.buildFPToUI+++-- | Convert an integer to a floating point value.+-- It is mapped to @sitofp@ or @uitofp@ depending on the type @a@.+inttofp :: forall value a b av bv r.+    (ValueCons value, IsInteger av, IsFloating bv) =>+    Assistant a b av bv -> value av -> CodeGenFunction r (value bv)+inttofp =+   if isSigned (LP.Proxy :: LP.Proxy av)+     then convert FFI.constSIToFP FFI.buildSIToFP+     else convert FFI.constUIToFP FFI.buildUIToFP+++-- | Convert a pointer to an integer.+ptrtoint ::+    (ValueCons value, IsInteger bv) =>+    Assistant (Ptr a) b av bv -> value av -> CodeGenFunction r (value bv)+ptrtoint = convert FFI.constPtrToInt FFI.buildPtrToInt++-- | Convert an integer to a pointer.+inttoptr ::+    (ValueCons value, IsInteger av, IsType bv) =>+    Assistant a (Ptr b) av bv -> value av -> CodeGenFunction r (value bv)+inttoptr = convert FFI.constIntToPtr FFI.buildIntToPtr++-- | Convert between to values of the same size by just copying the bit pattern.+bitcast ::+    (ValueCons value, IsFirstClass a, IsFirstClass bv,+     IsSized a, IsSized b, SizeOf a ~ SizeOf b) =>+    Assistant a b av bv -> value av -> CodeGenFunction r (value bv)+bitcast = convert FFI.constBitCast FFI.buildBitCast+++convert :: (ValueCons value, IsType bv) =>+    Priv.FFIConstConvert -> Priv.FFIConvert -> Assistant a b av bv ->+    value av -> CodeGenFunction r (value bv)+convert cnvConst cnv Assistant = Priv.convert cnvConst cnv++++select ::+    (ValueCons value, IsFirstClass a) =>+    Assistant a Bool av bv ->+    value bv -> value av -> value av -> CodeGenFunction r (value av)+select Assistant = Priv.trinop FFI.constSelect FFI.buildSelect+
src/LLVM/Core/Type.hs view
@@ -29,7 +29,8 @@     IsSized, SizeOf, sizeOf,     IsFunction,     -- ** Others-    IsScalarOrVector, NumberOfElements,+    IsScalarOrVector,+    ShapeOf, ScalarShape, VectorShape,     StructFields,     UnknownSize, -- needed for arrays of structs     -- ** Structs@@ -237,11 +238,14 @@ --  Precondition for Vector -- |Primitive types. -- class (IsType a) => IsPrimitive a-class (IsType a, NumberOfElements a ~ D1) => IsPrimitive a+class (IsType a, ShapeOf a ~ ScalarShape) => IsPrimitive a +data ScalarShape+data VectorShape n+ -- |Number of elements for instructions that handle both primitive and vector types class (IsType a) => IsScalarOrVector a where-    type NumberOfElements a :: *+    type ShapeOf a :: *   -- Usage:@@ -510,27 +514,27 @@   instance (Dec.Positive n) =>-         IsScalarOrVector (IntN n)  where type NumberOfElements (IntN n)  = D1+         IsScalarOrVector (IntN n)  where type ShapeOf (IntN n)  = ScalarShape instance (Dec.Positive n) =>-         IsScalarOrVector (WordN n) where type NumberOfElements (WordN n) = D1-instance IsScalarOrVector Float  where type NumberOfElements Float  = D1-instance IsScalarOrVector Double where type NumberOfElements Double = D1-instance IsScalarOrVector FP128  where type NumberOfElements FP128  = D1-instance IsScalarOrVector Bool   where type NumberOfElements Bool   = D1-instance IsScalarOrVector Int8   where type NumberOfElements Int8   = D1-instance IsScalarOrVector Int16  where type NumberOfElements Int16  = D1-instance IsScalarOrVector Int32  where type NumberOfElements Int32  = D1-instance IsScalarOrVector Int64  where type NumberOfElements Int64  = D1-instance IsScalarOrVector Word8  where type NumberOfElements Word8  = D1-instance IsScalarOrVector Word16 where type NumberOfElements Word16 = D1-instance IsScalarOrVector Word32 where type NumberOfElements Word32 = D1-instance IsScalarOrVector Word64 where type NumberOfElements Word64 = D1-instance IsScalarOrVector Label  where type NumberOfElements Label  = D1-instance IsScalarOrVector ()     where type NumberOfElements ()     = D1+         IsScalarOrVector (WordN n) where type ShapeOf (WordN n) = ScalarShape+instance IsScalarOrVector Float  where type ShapeOf Float  = ScalarShape+instance IsScalarOrVector Double where type ShapeOf Double = ScalarShape+instance IsScalarOrVector FP128  where type ShapeOf FP128  = ScalarShape+instance IsScalarOrVector Bool   where type ShapeOf Bool   = ScalarShape+instance IsScalarOrVector Int8   where type ShapeOf Int8   = ScalarShape+instance IsScalarOrVector Int16  where type ShapeOf Int16  = ScalarShape+instance IsScalarOrVector Int32  where type ShapeOf Int32  = ScalarShape+instance IsScalarOrVector Int64  where type ShapeOf Int64  = ScalarShape+instance IsScalarOrVector Word8  where type ShapeOf Word8  = ScalarShape+instance IsScalarOrVector Word16 where type ShapeOf Word16 = ScalarShape+instance IsScalarOrVector Word32 where type ShapeOf Word32 = ScalarShape+instance IsScalarOrVector Word64 where type ShapeOf Word64 = ScalarShape+instance IsScalarOrVector Label  where type ShapeOf Label  = ScalarShape+instance IsScalarOrVector ()     where type ShapeOf ()     = ScalarShape  instance (Dec.Positive n, IsPrimitive a) =>          IsScalarOrVector (Vector n a) where-    type NumberOfElements (Vector n a) = n+    type ShapeOf (Vector n a) = VectorShape n   -- Functions.
src/LLVM/Core/Util.hs view
@@ -36,11 +36,9 @@     -- * Transformation passes     addCFGSimplificationPass, addConstantPropagationPass, addDemoteMemoryToRegisterPass,     addGVNPass, addInstructionCombiningPass, addPromoteMemoryToRegisterPass, addReassociatePass,-    addTargetData     ) where  import qualified LLVM.FFI.Core as FFI-import qualified LLVM.FFI.Target as FFI import qualified LLVM.FFI.BitWriter as FFI import qualified LLVM.FFI.BitReader as FFI import qualified LLVM.FFI.Transforms.Scalar as FFI@@ -384,9 +382,6 @@  addReassociatePass :: PassManager -> IO () addReassociatePass pm = withPassManager pm FFI.addReassociatePass--addTargetData :: FFI.TargetDataRef -> PassManager -> IO ()-addTargetData td pm = withPassManager pm $ FFI.addTargetData td  runFunctionPassManager :: PassManager -> Function -> IO FFI.Bool runFunctionPassManager pm fcn = withPassManager pm $ \ pmref -> FFI.runFunctionPassManager pmref fcn