llvm-extra 0.7.0.1 → 0.7.1
raw patch · 4 files changed
+236/−53 lines, 4 files
Files
- llvm-extra.cabal +2/−2
- src/LLVM/Extra/Control.hs +6/−6
- src/LLVM/Extra/Multi/Value.hs +146/−38
- src/LLVM/Extra/ScalarOrVector.hs +82/−7
llvm-extra.cabal view
@@ -1,5 +1,5 @@ Name: llvm-extra-Version: 0.7.0.1+Version: 0.7.1 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -71,7 +71,7 @@ default: True Source-Repository this- Tag: 0.7.0.1+ Tag: 0.7.1 Type: darcs Location: http://code.haskell.org/~thielema/llvm-extra/
src/LLVM/Extra/Control.hs view
@@ -51,7 +51,7 @@ -} arrayLoop :: (Phi a, IsType b,- Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i, CmpResult i ~ Bool) =>+ Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) => Value i -> Value (Ptr b) -> a -> (Value (Ptr b) -> a -> CodeGenFunction r a) -> CodeGenFunction r a@@ -64,7 +64,7 @@ arrayLoop2 :: (Phi s, IsType a, IsType b,- Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i, CmpResult i ~ Bool) =>+ Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) => Value i -> Value (Ptr a) -> Value (Ptr b) -> s -> (Value (Ptr a) -> Value (Ptr b) -> s -> CodeGenFunction r s) -> CodeGenFunction r s@@ -79,7 +79,7 @@ arrayLoopWithExit :: (Phi s, IsType a,- Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i, CmpResult i ~ Bool) =>+ Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) => Value i -> Value (Ptr a) -> s -> (Value (Ptr a) -> s -> CodeGenFunction r (Value Bool, s)) -> CodeGenFunction r (Value i, s)@@ -107,7 +107,7 @@ -} _arrayLoopWithExitDecLoop :: (Phi a, IsType b,- Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i, CmpResult i ~ Bool) =>+ Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) => Value i -> Value (Ptr b) -> a -> (Value (Ptr b) -> a -> CodeGenFunction r (Value Bool, a)) -> CodeGenFunction r (Value i, a)@@ -153,7 +153,7 @@ arrayLoop2WithExit :: (Phi s, IsType a, IsType b,- Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i, CmpResult i ~ Bool) =>+ Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) => Value i -> Value (Ptr a) -> Value (Ptr b) -> s -> (Value (Ptr a) -> Value (Ptr b) -> s -> CodeGenFunction r (Value Bool, s)) -> CodeGenFunction r (Value i, s)@@ -168,7 +168,7 @@ fixedLengthLoop :: (Phi s,- Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i, CmpResult i ~ Bool) =>+ Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) => Value i -> s -> (s -> CodeGenFunction r s) -> CodeGenFunction r s
src/LLVM/Extra/Multi/Value.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-} module LLVM.Extra.Multi.Value where import qualified LLVM.Extra.ScalarOrVector as SoV@@ -11,6 +12,8 @@ import qualified LLVM.Util.Loop as Loop import LLVM.Util.Loop (Phi, ) +import Type.Data.Num.Decimal (D1)+ import Foreign.StablePtr (StablePtr, ) import Foreign.Ptr (Ptr, FunPtr, ) @@ -395,6 +398,17 @@ atom = Atom +instance Compose () where+ type Composed () = ()+ compose = cons++instance () => Decompose () where+ decompose () _ = ()++type instance Decomposed f () = ()+type instance PatternTuple () = ()++ instance (Compose a, Compose b) => Compose (a,b) where type Composed (a,b) = (Composed a, Composed b) compose = Tuple.uncurry zip . TupleHT.mapPair (compose, compose)@@ -490,6 +504,16 @@ instance IntegerConstant Float where fromInteger' = Cons . LLVM.value . SoV.constFromInteger instance IntegerConstant Double where fromInteger' = Cons . LLVM.value . SoV.constFromInteger +instance IntegerConstant Word8 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Word16 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Word32 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Word64 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger++instance IntegerConstant Int8 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Int16 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Int32 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Int64 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+ instance RationalConstant Float where fromRational' = Cons . LLVM.value . SoV.constFromRational instance RationalConstant Double where fromRational' = Cons . LLVM.value . SoV.constFromRational @@ -516,6 +540,16 @@ sub = liftM2 LLVM.sub neg = liftM LLVM.neg +instance Additive Word8 where+ add = liftM2 LLVM.add+ sub = liftM2 LLVM.sub+ neg = liftM LLVM.neg++instance Additive Word16 where+ add = liftM2 LLVM.add+ sub = liftM2 LLVM.sub+ neg = liftM LLVM.neg+ instance Additive Word32 where add = liftM2 LLVM.add sub = liftM2 LLVM.sub@@ -526,6 +560,16 @@ sub = liftM2 LLVM.sub neg = liftM LLVM.neg +instance Additive Int8 where+ add = liftM2 LLVM.add+ sub = liftM2 LLVM.sub+ neg = liftM LLVM.neg++instance Additive Int16 where+ add = liftM2 LLVM.add+ sub = liftM2 LLVM.sub+ neg = liftM LLVM.neg+ instance Additive Int32 where add = liftM2 LLVM.add sub = liftM2 LLVM.sub@@ -546,23 +590,16 @@ class (Additive a) => PseudoRing a where mul :: T a -> T a -> LLVM.CodeGenFunction r (T a) -instance PseudoRing Float where- mul = liftM2 LLVM.mul--instance PseudoRing Double where- mul = liftM2 LLVM.mul--instance PseudoRing Word32 where- mul = liftM2 LLVM.mul--instance PseudoRing Word64 where- mul = liftM2 LLVM.mul--instance PseudoRing Int32 where- mul = liftM2 LLVM.mul--instance PseudoRing Int64 where- mul = liftM2 LLVM.mul+instance PseudoRing Float where mul = liftM2 LLVM.mul+instance PseudoRing Double where mul = liftM2 LLVM.mul+instance PseudoRing Word8 where mul = liftM2 LLVM.mul+instance PseudoRing Word16 where mul = liftM2 LLVM.mul+instance PseudoRing Word32 where mul = liftM2 LLVM.mul+instance PseudoRing Word64 where mul = liftM2 LLVM.mul+instance PseudoRing Int8 where mul = liftM2 LLVM.mul+instance PseudoRing Int16 where mul = liftM2 LLVM.mul+instance PseudoRing Int32 where mul = liftM2 LLVM.mul+instance PseudoRing Int64 where mul = liftM2 LLVM.mul instance (PseudoRing a) => A.PseudoRing (T a) where mul = mul@@ -617,6 +654,18 @@ abs = liftM A.abs signum = liftM A.signum +instance Real Word8 where+ min = liftM2 A.min+ max = liftM2 A.max+ abs = liftM A.abs+ signum = liftM A.signum++instance Real Word16 where+ min = liftM2 A.min+ max = liftM2 A.max+ abs = liftM A.abs+ signum = liftM A.signum+ instance Real Word32 where min = liftM2 A.min max = liftM2 A.max@@ -629,6 +678,18 @@ abs = liftM A.abs signum = liftM A.signum +instance Real Int8 where+ min = liftM2 A.min+ max = liftM2 A.max+ abs = liftM A.abs+ signum = liftM A.signum++instance Real Int16 where+ min = liftM2 A.min+ max = liftM2 A.max+ abs = liftM A.abs+ signum = liftM A.signum+ instance Real Int32 where min = liftM2 A.min max = liftM2 A.max@@ -665,6 +726,47 @@ fraction = fraction +class+ (Repr LLVM.Value i ~ LLVM.Value ir,+ LLVM.IsInteger ir, SoV.IntegerConstant ir, LLVM.CmpRet ir,+ LLVM.NumberOfElements ir ~ D1, LLVM.CmpResult ir ~ Bool) =>+ NativeInteger i ir where++instance NativeInteger Word8 Word8 where+instance NativeInteger Word16 Word16 where+instance NativeInteger Word32 Word32 where+instance NativeInteger Word64 Word64 where++instance NativeInteger Int8 Int8 where+instance NativeInteger Int16 Int16 where+instance NativeInteger Int32 Int32 where+instance NativeInteger Int64 Int64 where+++class+ (Repr LLVM.Value a ~ LLVM.Value ar,+ LLVM.IsFloating ar, SoV.RationalConstant ar, LLVM.CmpRet ar,+ LLVM.NumberOfElements ar ~ D1, LLVM.CmpResult ar ~ Bool) =>+ NativeFloating a ar where++instance NativeFloating Float Float where+instance NativeFloating Double Double where+++truncateToInt, floorToInt, ceilingToInt, roundToIntFast ::+ (NativeInteger i ir, NativeFloating a ar) =>+ T a -> LLVM.CodeGenFunction r (T i)+truncateToInt = liftM SoV.truncateToInt+floorToInt = liftM SoV.floorToInt+ceilingToInt = liftM SoV.ceilingToInt+roundToIntFast = liftM SoV.roundToIntFast++splitFractionToInt ::+ (NativeInteger i ir, NativeFloating a ar) =>+ T a -> LLVM.CodeGenFunction r (T (i,a))+splitFractionToInt = liftM SoV.splitFractionToInt++ class Field a => Algebraic a where sqrt :: T a -> LLVM.CodeGenFunction r (T a) @@ -714,23 +816,16 @@ T Bool -> T a -> T a -> LLVM.CodeGenFunction r (T a) -instance Select Float where- select = liftM3 LLVM.select--instance Select Double where- select = liftM3 LLVM.select--instance Select Word32 where- select = liftM3 LLVM.select--instance Select Word64 where- select = liftM3 LLVM.select--instance Select Int32 where- select = liftM3 LLVM.select--instance Select Int64 where- select = liftM3 LLVM.select+instance Select Float where select = liftM3 LLVM.select+instance Select Double where select = liftM3 LLVM.select+instance Select Word8 where select = liftM3 LLVM.select+instance Select Word16 where select = liftM3 LLVM.select+instance Select Word32 where select = liftM3 LLVM.select+instance Select Word64 where select = liftM3 LLVM.select+instance Select Int8 where select = liftM3 LLVM.select+instance Select Int16 where select = liftM3 LLVM.select+instance Select Int32 where select = liftM3 LLVM.select+instance Select Int64 where select = liftM3 LLVM.select instance (Select a, Select b) => Select (a,b) where select b =@@ -764,12 +859,19 @@ LLVM.CmpPredicate -> T a -> T a -> LLVM.CodeGenFunction r (T Bool) -instance Comparison Float where- cmp = liftM2 . LLVM.cmp+instance Comparison Float where cmp = liftM2 . LLVM.cmp+instance Comparison Double where cmp = liftM2 . LLVM.cmp -instance Comparison Double where- cmp = liftM2 . LLVM.cmp+instance Comparison Int8 where cmp = liftM2 . LLVM.cmp+instance Comparison Int16 where cmp = liftM2 . LLVM.cmp+instance Comparison Int32 where cmp = liftM2 . LLVM.cmp+instance Comparison Int64 where cmp = liftM2 . LLVM.cmp +instance Comparison Word8 where cmp = liftM2 . LLVM.cmp+instance Comparison Word16 where cmp = liftM2 . LLVM.cmp+instance Comparison Word32 where cmp = liftM2 . LLVM.cmp+instance Comparison Word64 where cmp = liftM2 . LLVM.cmp+ instance (Comparison a) => A.Comparison (T a) where type CmpResult (T a) = T Bool cmp = cmp@@ -829,3 +931,9 @@ instance Integral Int64 where idiv = liftM2 LLVM.idiv irem = liftM2 LLVM.irem+++fromIntegral ::+ (NativeInteger i ir, NativeFloating a ar) =>+ T i -> LLVM.CodeGenFunction r (T a)+fromIntegral = liftM LLVM.inttofp
src/LLVM/Extra/ScalarOrVector.hs view
@@ -13,6 +13,13 @@ signedFraction, addToPhase, incPhase,++ truncateToInt,+ floorToInt,+ ceilingToInt,+ roundToIntFast,+ splitFractionToInt,+ Scalar, Replicate (replicate, replicateConst), replicateOf,@@ -38,8 +45,9 @@ import qualified LLVM.Core as LLVM import LLVM.Core (Value, ConstValue, valueOf, constOf,+ CmpRet, CmpResult, NumberOfElements, Vector, FP128,- IsConst, IsFloating,+ IsConst, IsInteger, IsFloating, CodeGenFunction, ) import Control.Monad.HT ((<=<), )@@ -111,22 +119,22 @@ A.sub x =<< truncate x fractionGen ::- (IntegerConstant v, Fraction v, LLVM.CmpRet v) =>+ (IntegerConstant v, Fraction v, CmpRet v) => Value v -> CodeGenFunction r (Value v) fractionGen x = do xf <- signedFraction x- b <- A.fcmp LLVM.FPOGE xf (LLVM.value LLVM.zero)+ b <- A.fcmp LLVM.FPOGE xf zero LLVM.select b xf =<< A.add xf (LLVM.value $ constFromInteger 1) fractionLogical ::- (Fraction a, LLVM.IsScalarOrVector a, LLVM.NumberOfElements a ~ D1,- LLVM.IsInteger b, LLVM.IsScalarOrVector b, LLVM.NumberOfElements b ~ D1) =>+ (Fraction a, LLVM.IsScalarOrVector a, NumberOfElements a ~ D1,+ IsInteger b, LLVM.IsScalarOrVector b, NumberOfElements b ~ D1) => (LLVM.FPPredicate -> Value a -> Value a -> CodeGenFunction r (Value b)) -> Value a -> CodeGenFunction r (Value a) fractionLogical cmp x = do xf <- signedFraction x- b <- cmp LLVM.FPOLT xf (LLVM.value LLVM.zero)+ b <- cmp LLVM.FPOLT xf zero A.sub xf =<< LLVM.inttofp b {- |@@ -150,6 +158,73 @@ +truncateToInt ::+ (IsFloating a, IsInteger i,+ NumberOfElements a ~ NumberOfElements i) =>+ Value a -> CodeGenFunction r (Value i)+truncateToInt = LLVM.fptoint++{- |+Rounds to the next integer.+For numbers of the form @n+0.5@,+we choose one of the neighboured integers+such that the overall implementation is most efficient.+-}+roundToIntFast ::+ (IsFloating a, RationalConstant a, CmpRet a,+ IsInteger i, IntegerConstant i, CmpRet i,+ CmpResult a ~ CmpResult i,+ NumberOfElements a ~ NumberOfElements i) =>+ Value a -> CodeGenFunction r (Value i)+roundToIntFast x = do+ pos <- A.cmp LLVM.CmpGT x zero+ truncateToInt =<< A.add x =<<+ LLVM.select pos (ratio 0.5) (ratio (-0.5))++floorToInt ::+ (IsFloating a, CmpRet a,+ IsInteger i, IntegerConstant i, CmpRet i,+ CmpResult a ~ CmpResult i,+ NumberOfElements a ~ NumberOfElements i) =>+ Value a -> CodeGenFunction r (Value i)+floorToInt x = do+ i <- truncateToInt x+ lt <- A.cmp LLVM.CmpLT x =<< LLVM.inttofp i+ A.sub i =<< LLVM.select lt (int 1) (int 0)++splitFractionToInt ::+ (IsFloating a, CmpRet a,+ IsInteger i, IntegerConstant i, CmpRet i,+ CmpResult a ~ CmpResult i,+ NumberOfElements a ~ NumberOfElements i) =>+ Value a -> CodeGenFunction r (Value i, Value a)+splitFractionToInt x = do+ i <- floorToInt x+ frac <- A.sub x =<< LLVM.inttofp i+ return (i, frac)++ceilingToInt ::+ (IsFloating a, CmpRet a,+ IsInteger i, IntegerConstant i, CmpRet i,+ CmpResult a ~ CmpResult i,+ NumberOfElements a ~ NumberOfElements i) =>+ Value a -> CodeGenFunction r (Value i)+ceilingToInt x = do+ i <- truncateToInt x+ gt <- A.cmp LLVM.CmpGT x =<< LLVM.inttofp i+ A.add i =<< LLVM.select gt (int 1) (int 0)+++zero :: (LLVM.IsType a) => Value a+zero = LLVM.value LLVM.zero++int :: (IntegerConstant a) => Integer -> Value a+int = LLVM.value . constFromInteger++ratio :: (RationalConstant a) => Rational -> Value a+ratio = LLVM.value . constFromRational++ type family Scalar vector :: * type instance Scalar Float = Float@@ -320,7 +395,7 @@ instance PseudoModule Double where scale = LLVM.mul; scaleConst = LLVM.mul instance (LLVM.IsArithmetic a, LLVM.IsPrimitive a, TypeNum.Positive n) => PseudoModule (Vector n a) where- scale a v = flip LLVM.mul v . flip asTypeOf v =<< replicate a+ scale a v = flip A.mul v =<< replicate a scaleConst a v = LLVM.mul (replicateConst a `asTypeOf` v) v