packages feed

llvm-extra 0.3.0.1 → 0.4.1

raw patch · 19 files changed

+4017/−1663 lines, 19 filesdep +llvm-extradep +llvm-tfdep +parsecdep −llvmdep −type-leveldep ~containersdep ~cpuidnew-component:exe:prepare-intrinsics

Dependencies added: llvm-extra, llvm-tf, parsec, tfp, unsafe

Dependencies removed: llvm, type-level

Dependency ranges changed: containers, cpuid

Files

Makefile view
@@ -1,8 +1,19 @@ .PHONY:	sharedobj  ghci:-	ghci -Wall -i:src:x86/cpuid src/Array.hs+	ghci -Wall -i:src:x86/none src/Run.hs +ghci-cpuid:+	ghci -Wall -i:src:x86/cpuid src/Run.hs++testbuild:+	runhaskell Setup.lhs configure --user -fbuildExamples -fbuildTools -fcpuid+	runhaskell Setup.lhs build+	runhaskell Setup.lhs haddock++	runhaskell Setup.lhs configure --user -f-cpuid+	runhaskell Setup.lhs build+ llvmversion = 2.6  sharedobj:	libLLVM.so@@ -17,7 +28,7 @@ 	rm *.o  %.s:	%.bc-	llc -f $<+	llc  $<  # This would lead to a cycle with llvm-as. # %.ll:	%.bc
llvm-extra.cabal view
@@ -1,5 +1,5 @@ Name:           llvm-extra-Version:        0.3.0.1+Version:        0.4.1 License:        BSD3 License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de>@@ -14,7 +14,8 @@   This package provides various utility functions   for the Haskell interface to LLVM, for example:   .-  * arithmetic operations with better type inference than the @llvm@ interface+  * arithmetic operations with more general types+    but better type inference than the @llvm@ interface     in "LLVM.Extra.Arithmetic",   .   * a type class for loading and storing sets of values with one command (macro)@@ -48,8 +49,9 @@   * a Makefile and a description     of how to run LLVM code from within GHCi. Stability:      Experimental-Tested-With:    GHC==6.10.4, GHC==6.12.3, GHC==7.0.4-Cabal-Version:  >=1.6+Tested-With:    GHC==6.10.4, GHC==6.12.3+Tested-With:    GHC==7.0.4, GHC==7.4.1, GHC==7.6.3+Cabal-Version:  >=1.14 Build-Type:     Simple Extra-Source-Files:   Makefile@@ -61,6 +63,19 @@   description: Build example executables   default:     False +Flag buildTools+  description: Build intrinsic translator+  default:     False++Flag cpuid+  description: Use CPUID for host feature detection if available on the architecture+  default:     True++Source-Repository this+  Tag:         0.4.1+  Type:        darcs+  Location:    http://code.haskell.org/~thielema/llvm-extra/+ Source-Repository head   Type:        darcs   Location:    http://code.haskell.org/~thielema/llvm-extra/@@ -69,17 +84,19 @@   Build-Depends:     -- llvm must be imported with restrictive version bounds,     -- because we import implicitly and unqualified-    llvm >=0.10 && <0.10.1,-    type-level >=0.2.3 && <0.3,-    containers >=0.1 && <0.5,+    llvm-tf >=3.0 && <3.0.1,+    tfp >=0.7 && <0.8,+    containers >=0.1 && <0.6,     transformers >=0.1.1 && <0.4,     utility-ht >=0.0.1 && <0.1    Build-Depends:-    base >= 3 && <5+    base >=3 && <5 -  If arch(i386)-    Build-Depends: cpuid >=0.2.2 && <0.3+  If (arch(i386) || arch(x86_64)) && flag(cpuid)+    Build-Depends:+      unsafe >=0.0 && <0.1,+      cpuid >=0.2.3 && <0.3     Hs-Source-Dirs: x86/cpuid   Else     -- Instead of calling the cpuid instruction directly@@ -88,8 +105,7 @@     -- However in LLVM-2.6 this is only available in the C++ interface.     Hs-Source-Dirs: x86/none -  -- large context stack needed for LLVM.Extra.Extension.X86 on GHC-7.0.4-  GHC-Options: -fcontext-stack=1000+  Default-Language: Haskell98   GHC-Options: -Wall   Hs-source-dirs: src   Exposed-Modules:@@ -108,11 +124,34 @@     LLVM.Extra.ScalarOrVector   Other-Modules:     LLVM.Extra.ArithmeticPrivate+    LLVM.Extra.Extension.X86Auto  Executable tone-llvm-  If !flag(buildExamples)+  If flag(buildExamples)+    Build-Depends:+      llvm-extra,+      llvm-tf >=3.0 && <3.0.1,+      tfp >=0.7 && <0.8,+      containers >=0.1 && <0.6,+      transformers >=0.1.1 && <0.4,+      utility-ht >=0.0.1 && <0.1,+      base >=3 && <5+  Else     Buildable: False-  GHC-Options: -fcontext-stack=1000+  Default-Language: Haskell98   GHC-Options: -Wall-  Hs-Source-Dirs: src, x86/none-  Main-Is: Array.hs+  Main-Is: src/Array.hs++Executable prepare-intrinsics+  If flag(buildTools)+    Build-Depends:+      parsec >=2.1 && <3.2,+      containers >=0.1 && <0.6,+      transformers >=0.1.1 && <0.4,+      utility-ht >=0.0.1 && <0.1,+      base >=3 && <5+  Else+    Buildable: False+  Default-Language: Haskell98+  GHC-Options: -Wall+  Main-Is: src/PrepareIntrinsics.hs
src/Array.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} module Main where @@ -15,9 +16,9 @@ import LLVM.ExecutionEngine (simpleFunction, ) import qualified System.IO as IO -import Data.TypeLevel.Num(D4, )+import Types.Data.Num(D4, ) import Data.Word (Word32, )-import Foreign.Storable (Storable, sizeOf, )+import qualified Foreign.Storable as St import Foreign.Marshal.Array (allocaArray, )  import Control.Monad.Trans.State (StateT(StateT), runStateT, )@@ -47,7 +48,8 @@ because 'frem' is only available in the FPU. -} fractionVector0 ::-   (IsFloating c, ABinOp a (Value (Vector D4 Float)) (v c)) =>+   (IsFloating c, ABinOp a (Value (Vector D4 Float)),+    ABinOpResult a (Value (Vector D4 Float)) ~ (v c)) =>    a -> CodeGenFunction r (v c) fractionVector0 x =    frem x =<< constVec 1@@ -218,7 +220,7 @@     let len = 10000000     in  allocaArray len $ \ ptr ->           fill (fromIntegral len) ptr 0.01003 0.01001 0.00999 0.00997 >>-          IO.hPutBuf h ptr (len*sizeOf(undefined::Float))+          IO.hPutBuf h ptr (len*St.sizeOf(undefined::Float))   mSaw :: CodeGenModule (Function (Word32 -> Ptr Float -> Float -> IO Float))@@ -237,7 +239,7 @@     let len = 10000000     in  allocaArray len $ \ ptr ->           fill (fromIntegral len) ptr 0.01 >>-          IO.hPutBuf h ptr (len*sizeOf(undefined::Float))+          IO.hPutBuf h ptr (len*St.sizeOf(undefined::Float))   mRamp :: CodeGenModule (Function (Word32 -> Ptr Float -> Float -> IO Float))@@ -255,7 +257,7 @@     let len = 10000000     in  allocaArray len $ \ ptr ->           fill (fromIntegral len) ptr (recip $ fromIntegral len) >>-          IO.hPutBuf h ptr (len*sizeOf(undefined::Float))+          IO.hPutBuf h ptr (len*St.sizeOf(undefined::Float))  main :: IO () main = do
src/LLVM/Extra/Arithmetic.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleContexts #-} module LLVM.Extra.Arithmetic (    -- * arithmetic: generalized and improved type inference    Additive (zero, add, sub, neg), one, inc, dec,@@ -9,22 +8,23 @@    IntegerConstant(fromInteger'),    RationalConstant(fromRational'),    idiv, irem,-   fcmp, cmp,+   fcmp, cmp, LLVM.CmpPredicate(..),    and, or,-   Real (min, max, abs),+   Real (min, max, abs, signum),    Fraction (truncate, fraction),    signedFraction, addToPhase, incPhase,    -- * pointer arithmetic    advanceArrayElementPtr,    -- * transcendental functions    Algebraic (sqrt),-   Transcendental (sin, cos, exp, log, pow),+   Transcendental (pi, sin, cos, exp, log, pow),    ) where  import LLVM.Extra.ArithmeticPrivate    (cmp, fcmp, and, or,     inc, dec, advanceArrayElementPtr, ) +import qualified LLVM.Extra.Class as Class import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Core as LLVM import LLVM.Core@@ -53,7 +53,7 @@ Disadvantage: You cannot use constant values directly, but you have to convert them all to 'Value'. -}-class Additive a where+class (Class.Zero a) => Additive a where    zero :: a    add :: a -> a -> CodeGenFunction r a    sub :: a -> a -> CodeGenFunction r a@@ -186,11 +186,13 @@    min :: a -> a -> CodeGenFunction r a    max :: a -> a -> CodeGenFunction r a    abs :: a -> CodeGenFunction r a+   signum :: a -> CodeGenFunction r a  instance (SoV.Real a) => Real (Value a) where    min = SoV.min    max = SoV.max    abs = SoV.abs+   signum = SoV.signum   class (Real a) => Fraction a where@@ -228,7 +230,7 @@    (IsType a) =>    Value a -> String valueTypeName =-   LLVM.typeName . (undefined :: Value a -> a)+   LLVM.intrinsicTypeName . (undefined :: Value a -> a)   callIntrinsic1 ::@@ -276,10 +278,12 @@   class Algebraic a => Transcendental a where+   pi :: CodeGenFunction r a    sin, cos, exp, log :: a -> CodeGenFunction r a    pow :: a -> a -> CodeGenFunction r a -instance (IsFloating a) => Transcendental (Value a) where+instance (IsFloating a, SoV.TranscendentalConstant a) => Transcendental (Value a) where+   pi = return $ value SoV.constPi    sin = callIntrinsic1 "sin"    cos = callIntrinsic1 "cos"    exp = callIntrinsic1 "exp"
src/LLVM/Extra/ArithmeticPrivate.hs view
@@ -1,10 +1,10 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-} module LLVM.Extra.ArithmeticPrivate where  import qualified LLVM.Core as LLVM import LLVM.Core-   (CodeGenFunction, value, valueOf, Value,-    CmpPredicate(CmpLE, CmpGE), FPPredicate, CmpRet,+   (CodeGenFunction, valueOf, Value,+    CmpPredicate(CmpLE, CmpGE), FPPredicate, CmpRet, CmpResult,     IsConst, IsFirstClass, IsArithmetic, IsInteger, IsFloating,     Ptr, getElementPtr, ) @@ -50,38 +50,56 @@  {- | This would also work for vectors,-if LLVM would support 'select' with bool vectors as condition.+but LLVM-3.1 crashes when actually doing this. -}-min :: (IsFirstClass a, CmpRet a Bool) =>+min :: (IsFirstClass a, CmpRet a) =>    Value a -> Value a -> CodeGenFunction r (Value a) min = cmpSelect (cmp CmpLE) -max :: (IsFirstClass a, CmpRet a Bool) =>+max :: (IsFirstClass a, CmpRet a) =>    Value a -> Value a -> CodeGenFunction r (Value a) max = cmpSelect (cmp CmpGE) -abs :: (IsArithmetic a, CmpRet a Bool) =>+abs :: (IsArithmetic a, CmpRet a) =>    Value a -> CodeGenFunction r (Value a)-abs x = do-   b <- cmp CmpGE x (value LLVM.zero)-   LLVM.select b x =<< LLVM.neg x+abs x = max x =<< LLVM.neg x  +signumGen ::+   (LLVM.IsFirstClass a,+    LLVM.CmpRet a, LLVM.CmpResult a ~ Bool) =>+   LLVM.Value a -> LLVM.Value a ->+   Value a -> CodeGenFunction r (Value a)+signumGen minusOne one x = do+   let zero = LLVM.value LLVM.zero+   negative <- cmp LLVM.CmpLT x zero+   positive <- cmp LLVM.CmpGT x zero+   LLVM.select negative minusOne+      =<< LLVM.select positive one zero++signum ::+   (Num a,+    LLVM.IsConst a, LLVM.IsFirstClass a,+    LLVM.CmpRet a, LLVM.CmpResult a ~ Bool) =>+   Value a -> CodeGenFunction r (Value a)+signum = signumGen (LLVM.valueOf (-1)) (LLVM.valueOf 1)++ cmpSelect ::-   (IsFirstClass a, CmpRet a Bool) =>-   (Value a -> Value a -> CodeGenFunction r (Value Bool)) ->+   (IsFirstClass a, CmpRet a) =>+   (Value a -> Value a -> CodeGenFunction r (Value (CmpResult a))) ->    (Value a -> Value a -> CodeGenFunction r (Value a)) cmpSelect f x y =    f x y >>= \b -> LLVM.select b x y   fcmp ::-   (IsFloating a, CmpRet a b) =>+   (IsFloating a, CmpRet a, CmpResult a ~ b) =>    FPPredicate -> Value a -> Value a -> CodeGenFunction r (Value b) fcmp = LLVM.fcmp  cmp ::-   (CmpRet a b) =>+   (CmpRet a, CmpResult a ~ b) =>    CmpPredicate -> Value a -> Value a -> CodeGenFunction r (Value b) cmp = LLVM.cmp 
src/LLVM/Extra/Array.hs view
@@ -10,7 +10,7 @@ import qualified LLVM.Core as LLVM import LLVM.Core (Value, Array, CodeGenFunction, ) -import qualified Data.TypeLevel.Num as TypeNum+import qualified Types.Data.Num as TypeNum import Control.Monad.HT ((<=<), ) import Control.Monad (foldM, ) import qualified Data.List as List@@ -25,11 +25,11 @@ -- * target independent functions  size ::-   (TypeNum.Nat n) =>+   (TypeNum.NaturalT n) =>    Value (Array n a) -> Int size =-   let sz :: (TypeNum.Nat n) => n -> Value (Array n a) -> Int-       sz n _ = TypeNum.toInt n+   let sz :: (TypeNum.NaturalT n) => n -> Value (Array n a) -> Int+       sz n _ = TypeNum.fromIntegerT n    in  sz undefined  {- |@@ -40,7 +40,7 @@ This can be considered the inverse of 'extractAll'. -} assemble ::-   (TypeNum.Nat n, LLVM.IsFirstClass a, LLVM.IsSized a s) =>+   (TypeNum.NaturalT n, LLVM.IsFirstClass a, LLVM.IsSized a) =>    [Value a] -> CodeGenFunction r (Value (Array n a)) assemble =    foldM (\v (k,x) -> LLVM.insertvalue v x (k::Word32)) Class.undefTuple .@@ -52,7 +52,7 @@ This can be considered the inverse of 'assemble'. -} extractAll ::-   (TypeNum.Nat n, LLVM.IsFirstClass a, LLVM.IsSized a s) =>+   (TypeNum.NaturalT n, LLVM.IsFirstClass a, LLVM.IsSized a) =>    Value (Array n a) -> LLVM.CodeGenFunction r [Value a] extractAll x =    mapM@@ -64,9 +64,9 @@ since 'LLVM.insertvalue' and 'LLVM.extractvalue' expect constant indices. -} map ::-   (TypeNum.Nat n,-    LLVM.IsFirstClass a, LLVM.IsSized a asize,-    LLVM.IsFirstClass b, LLVM.IsSized b bsize) =>+   (TypeNum.NaturalT n,+    LLVM.IsFirstClass a, LLVM.IsSized a,+    LLVM.IsFirstClass b, LLVM.IsSized b) =>    (Value a -> CodeGenFunction r (Value b)) ->    (Value (Array n a) -> CodeGenFunction r (Value (Array n b))) map f =
src/LLVM/Extra/Class.hs view
@@ -1,18 +1,16 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} module LLVM.Extra.Class where  import qualified LLVM.Core as LLVM import LLVM.Core    (Value, value, valueOf, undef,+    ConstValue,     Vector,     IsConst, IsType, IsFirstClass, IsPrimitive,     CodeGenFunction, BasicBlock, ) import LLVM.Util.Loop (Phi, phis, addPhis, )-import qualified Data.TypeLevel.Num as TypeNum+import qualified Types.Data.Num as TypeNum  import Control.Applicative (pure, liftA2, ) import qualified Control.Applicative as App@@ -39,6 +37,9 @@ instance (IsFirstClass a) => Undefined (Value a) where    undefTuple = value undef +instance (IsFirstClass a) => Undefined (ConstValue a) where+   undefTuple = undef+ instance (Undefined a, Undefined b) => Undefined (a, b) where    undefTuple = (undefTuple, undefTuple) @@ -57,6 +58,9 @@ instance (LLVM.IsFirstClass a) => Zero (Value a) where    zeroTuple = LLVM.value LLVM.zero +instance (LLVM.IsFirstClass a) => Zero (ConstValue a) where+   zeroTuple = LLVM.zero+ instance (Zero a, Zero b) => Zero (a, b) where    zeroTuple = (zeroTuple, zeroTuple) @@ -72,57 +76,62 @@  -- * class for creating tuples of constant values -{--ToDo: flip type parameter order in order to match good style--}--- class (IsTuple haskellValue, ValueTuple llvmValue) =>---      MakeValueTuple haskellValue llvmValue | haskellValue -> llvmValue where-class (Undefined llvmValue) =>-      MakeValueTuple haskellValue llvmValue | haskellValue -> llvmValue where-   valueTupleOf :: haskellValue -> llvmValue+class (Undefined (ValueTuple haskellValue)) =>+      MakeValueTuple haskellValue where+   type ValueTuple haskellValue :: *+   valueTupleOf :: haskellValue -> ValueTuple haskellValue -instance (MakeValueTuple ah al, MakeValueTuple bh bl) =>-      MakeValueTuple (ah,bh) (al,bl) where+instance (MakeValueTuple ah, MakeValueTuple bh) =>+      MakeValueTuple (ah,bh) where+   type ValueTuple (ah,bh) = (ValueTuple ah, ValueTuple bh)    valueTupleOf ~(a,b) = (valueTupleOf a, valueTupleOf b) -instance (MakeValueTuple ah al, MakeValueTuple bh bl, MakeValueTuple ch cl) =>-      MakeValueTuple (ah,bh,ch) (al,bl,cl) where+instance (MakeValueTuple ah, MakeValueTuple bh, MakeValueTuple ch) =>+      MakeValueTuple (ah,bh,ch) where+   type ValueTuple (ah,bh,ch) = (ValueTuple ah, ValueTuple bh, ValueTuple ch)    valueTupleOf ~(a,b,c) = (valueTupleOf a, valueTupleOf b, valueTupleOf c) -instance MakeValueTuple Float        (Value Float)  where valueTupleOf = valueOf-instance MakeValueTuple Double       (Value Double) where valueTupleOf = valueOf--- instance MakeValueTuple FP128        (Value FP128)  where valueTupleOf = valueOf-instance MakeValueTuple Bool         (Value Bool)   where valueTupleOf = valueOf-instance MakeValueTuple Int8         (Value Int8)   where valueTupleOf = valueOf-instance MakeValueTuple Int16        (Value Int16)  where valueTupleOf = valueOf-instance MakeValueTuple Int32        (Value Int32)  where valueTupleOf = valueOf-instance MakeValueTuple Int64        (Value Int64)  where valueTupleOf = valueOf-instance MakeValueTuple Word8        (Value Word8)  where valueTupleOf = valueOf-instance MakeValueTuple Word16       (Value Word16) where valueTupleOf = valueOf-instance MakeValueTuple Word32       (Value Word32) where valueTupleOf = valueOf-instance MakeValueTuple Word64       (Value Word64) where valueTupleOf = valueOf-instance MakeValueTuple ()           ()             where valueTupleOf = id+instance MakeValueTuple Float  where type ValueTuple Float  = Value Float  ; valueTupleOf = valueOf+instance MakeValueTuple Double where type ValueTuple Double = Value Double ; valueTupleOf = valueOf+-- instance MakeValueTuple FP128  where type ValueTuple FP128  = Value FP128  ; valueTupleOf = valueOf+instance MakeValueTuple Bool   where type ValueTuple Bool   = Value Bool   ; valueTupleOf = valueOf+instance MakeValueTuple Int8   where type ValueTuple Int8   = Value Int8   ; valueTupleOf = valueOf+instance MakeValueTuple Int16  where type ValueTuple Int16  = Value Int16  ; valueTupleOf = valueOf+instance MakeValueTuple Int32  where type ValueTuple Int32  = Value Int32  ; valueTupleOf = valueOf+instance MakeValueTuple Int64  where type ValueTuple Int64  = Value Int64  ; valueTupleOf = valueOf+instance MakeValueTuple Word8  where type ValueTuple Word8  = Value Word8  ; valueTupleOf = valueOf+instance MakeValueTuple Word16 where type ValueTuple Word16 = Value Word16 ; valueTupleOf = valueOf+instance MakeValueTuple Word32 where type ValueTuple Word32 = Value Word32 ; valueTupleOf = valueOf+instance MakeValueTuple Word64 where type ValueTuple Word64 = Value Word64 ; valueTupleOf = valueOf+instance MakeValueTuple ()     where type ValueTuple ()     = ()           ; valueTupleOf = id  {- I'm not sure about this instance. Maybe it is better to convert the pointer target type according to a class that maps Haskell tuples to LLVM structs. -}-instance IsType a =>-         MakeValueTuple (Ptr a) (Value (Ptr a)) where valueTupleOf = valueOf-instance MakeValueTuple (StablePtr a) (Value (StablePtr a)) where valueTupleOf = valueOf+instance IsType a => MakeValueTuple (Ptr a) where+   type ValueTuple (Ptr a) = (Value (Ptr a))+   valueTupleOf = valueOf +instance MakeValueTuple (StablePtr a) where+   type ValueTuple (StablePtr a) = Value (StablePtr a)+   valueTupleOf = valueOf+ {- instance (MakeValueTuple haskellValue llvmValue, Memory llvmValue llvmStruct) =>          MakeValueTuple (Ptr haskellValue) (Value (Ptr llvmStruct)) where    valueTupleOf = valueOf . castStorablePtr-instance (Pos n) =>-         MakeValueTuple (IntN n)     (Value (IntN n)) where-instance (Pos n) =>-         MakeValueTuple (WordN n)    (Value (WordN n)) where++instance (Pos n) => MakeValueTuple (IntN n) where+   type ValueTuple (IntN n) = (Value (IntN n))+instance (Pos n) => MakeValueTuple (WordN n) where+   type ValueTuple (WordN n) = (Value (WordN n)) -}-instance (TypeNum.Pos n, IsPrimitive a, IsConst a) =>-         MakeValueTuple (Vector n a) (Value (Vector n a)) where valueTupleOf = valueOf+instance (TypeNum.PositiveT n, IsPrimitive a, IsConst a) =>+         MakeValueTuple (Vector n a) where+   type ValueTuple (Vector n a) = Value (Vector n a)+   valueTupleOf = valueOf   -- * default methods for LLVM classes@@ -158,8 +167,8 @@    pure undefTuple  valueTupleOfFunctor ::-   (MakeValueTuple h l, Functor f) =>-   f h -> f l+   (MakeValueTuple h, Functor f) =>+   f h -> f (ValueTuple h) valueTupleOfFunctor =    fmap valueTupleOf @@ -182,5 +191,3 @@    BasicBlock -> f a -> f a -> CodeGenFunction r () addPhisFoldable bb x y =    Fold.sequence_ (liftA2 (addPhis bb) x y)--
src/LLVM/Extra/Control.hs view
@@ -1,8 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-} {- | Useful control structures additionally to those in "LLVM.Util.Loop". -}@@ -29,7 +25,7 @@     br, condBr,     Ptr, Value, value, valueOf,     phi, addPhiInputs,-    CmpPredicate(CmpGT), CmpRet,+    CmpPredicate(CmpGT), CmpRet, CmpResult,     IsInteger, IsType, IsConst, IsFirstClass,     CodeGenFunction,     CodeGenModule, newModule, defineModule, writeBitcodeToFile, )@@ -51,7 +47,7 @@ -} arrayLoop ::    (Phi a, IsType b,-    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i Bool) =>+    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i, CmpResult i ~ Bool) =>    Value i -> Value (Ptr b) -> a ->    (Value (Ptr b) -> a -> CodeGenFunction r a) ->    CodeGenFunction r a@@ -65,7 +61,7 @@  arrayLoopWithExit ::    (Phi s, IsType a,-    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i Bool) =>+    Num i, IsConst i, IsInteger i, IsFirstClass 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)@@ -93,7 +89,7 @@ -} _arrayLoopWithExitDecLoop ::    (Phi a, IsType b,-    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i Bool) =>+    Num i, IsConst i, IsInteger i, IsFirstClass 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)@@ -139,7 +135,7 @@  arrayLoop2WithExit ::    (Phi s, IsType a, IsType b,-    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i Bool) =>+    Num i, IsConst i, IsInteger i, IsFirstClass 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)@@ -154,7 +150,7 @@  fixedLengthLoop ::    (Phi s,-    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i Bool) =>+    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i, CmpResult i ~ Bool) =>    Value i -> s ->    (s -> CodeGenFunction r s) ->    CodeGenFunction r s@@ -267,7 +263,7 @@ class Phi a => Select a where    select :: Value Bool -> a -> a -> CodeGenFunction r a -instance (IsFirstClass a, CmpRet a Bool) => Select (Value a) where+instance (IsFirstClass a, CmpRet a, CmpResult a ~ Bool) => Select (Value a) where    select = LLVM.select  instance Select () where
src/LLVM/Extra/Extension.hs view
@@ -1,12 +1,10 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE Rank2Types #-} module LLVM.Extra.Extension (-   T, CallArgs,+   T, Result, CallArgs,    Subtarget(Subtarget), wrap,    intrinsic, intrinsicAttr,    run, runWhen, runUnsafe,@@ -73,21 +71,26 @@    writer (cgf, Map.singleton (name tar) tar)  +type family Result g :: *+type instance Result (a -> g) = Result g+type instance Result (CodeGenFunction r a) = r++ {- | Analogous to 'LLVM.FunctionArgs'  The type parameter @r@ and its functional dependency are necessary since @g@ must be a function of the form @a -> ... -> c -> CodeGenFunction r d@ and we must ensure that the explicit @r@ and the implicit @r@ in the @g@ do match. -}-class CallArgs g r | g -> r where-   buildIntrinsic :: [Attribute] -> CodeGenFunction r g -> g+class CallArgs g where+   buildIntrinsic :: [Attribute] -> CodeGenFunction (Result g) g -> g -instance (CallArgs g r) =>-      CallArgs (Value a -> g) r where+instance (CallArgs g) =>+      CallArgs (Value a -> g) where    buildIntrinsic attrs g x =       buildIntrinsic attrs (fmap ($x) g) -instance CallArgs (CodeGenFunction r (Value a)) r where+instance CallArgs (CodeGenFunction r (Value a)) where    buildIntrinsic attrs g = do       z <- join g       addAttributes z 0 attrs@@ -102,13 +105,13 @@ and it also checks the signature. -} intrinsic ::-   (LLVM.IsFunction f, LLVM.CallArgs f g r, CallArgs g r) =>+   (LLVM.IsFunction f, LLVM.CallArgs f g (Result g), CallArgs g) =>    Subtarget -> String -> T g intrinsic =    intrinsicAttr [{- ReadNoneAttribute -}]  intrinsicAttr ::-   (LLVM.IsFunction f, LLVM.CallArgs f g r, CallArgs g r) =>+   (LLVM.IsFunction f, LLVM.CallArgs f g (Result g), CallArgs g) =>    [Attribute] -> Subtarget -> String -> T g intrinsicAttr attrs tar intr =    wrap tar $@@ -139,7 +142,7 @@ {- | Convenient variant of 'run': Only run the code with extended instructions-if an additional condition is given.+if an additional condition is satisfied. -} runWhen ::    Bool ->
src/LLVM/Extra/Extension/X86.hs view
@@ -1,7 +1,8 @@+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {- | Some special operations on X86 processors.-If you want to use them in algorithm+If you want to use them in algorithms you will always have to prepare an alternative implementation in terms of plain LLVM instructions. You will then run them with 'Ext.run'@@ -12,11 +13,15 @@ that is cross compilation will fail! For cross compilation we would need access to the SubTarget detection of LLVM that is only available in the C++ interface in version 2.6.++ToDo:+A function that selects the native vector size of the target+and runs an action with it. -} module LLVM.Extra.Extension.X86 (-   maxss, minss, maxps, minps,-   maxsd, minsd, maxpd, minpd,-   cmpss, cmpps, cmpsd, cmppd,+   X86.maxss, X86.minss, X86.maxps, X86.minps,+   X86.maxsd, X86.minsd, X86.maxpd, X86.minpd,+   cmpss, cmpps, cmpsd, cmppd, cmpps256, cmppd256,    pcmpgtb,  pcmpgtw,  pcmpgtd,  pcmpgtq,    pcmpugtb, pcmpugtw, pcmpugtd, pcmpugtq,    pminsb, pminsw, pminsd,@@ -24,17 +29,27 @@    pminub, pminuw, pminud,    pmaxub, pmaxuw, pmaxud,    pabsb, pabsw, pabsd,-   pmuludq, pmulld,+   pmuludq, pmuldq,+   pmulld,    cvtps2dq, cvtpd2dq,+   cvtdq2ps, cvtdq2pd,    ldmxcsr, stmxcsr, withMXCSR,-   haddps, haddpd, dpps, dppd,-   roundss, roundps, roundsd, roundpd,+   X86.haddps, X86.haddpd, X86.dpps, X86.dppd,+   roundss, X86.roundps, roundsd, X86.roundpd,    absss, abssd, absps, abspd,    ) where +import qualified LLVM.Extra.Extension.X86Auto as X86 import qualified LLVM.Extra.Extension as Ext+import LLVM.Extra.Extension.X86Auto (+          V2Double, V4Float,+          V2Int64, V2Word64,+          V4Int32, V4Word32,+          V8Int16, V8Word16,+          V16Int8, V16Word8,+          ) import LLVM.Extra.ExtensionCheck.X86-          (sse1, sse2, sse3, ssse3, sse41, sse42, )+          (sse1, sse2, sse41, sse42, )  import qualified LLVM.Extra.Monad as M import qualified LLVM.Extra.ArithmeticPrivate as A@@ -43,53 +58,27 @@    (Value, Vector, value, valueOf, constOf, constVector,     CodeGenFunction, FPPredicate, ) -import qualified Data.TypeLevel.Num as TypeNum-import Data.TypeLevel.Num (D2, D4, D8, D16, )+import qualified Types.Data.Bool as TypeBool+import qualified Types.Data.Num as TypeNum  import Data.Bits (clearBit, complement, )-import Data.Int  (Int8, Int16, Int32, Int64, )-import Data.Word (Word8, Word16, Word32, Word64, )+import Data.Word (Word8, Word32, Word64, )  import Control.Monad.HT ((<=<), )  import Foreign.Ptr (Ptr, )  --- * target dependent functions--type VFloat  = Value (Vector D4 Float)-type VDouble = Value (Vector D2 Double)---maxss, minss, maxps, minps ::-   Ext.T (VFloat -> VFloat -> CodeGenFunction r VFloat)-maxss = Ext.intrinsic sse1 "max.ss"-minss = Ext.intrinsic sse1 "min.ss"-maxps = Ext.intrinsic sse1 "max.ps"-minps = Ext.intrinsic sse1 "min.ps"--{- here r would be unified-[maxss, minss, maxps, minps] =-   map (Ext.intrinsic sse1)-     ["max.ss", "min.ss", "max.ps", "min.ps"]--}--maxsd, minsd, maxpd, minpd ::-   Ext.T (VDouble -> VDouble -> CodeGenFunction r VDouble)-maxsd = Ext.intrinsic sse1 "max.sd"-minsd = Ext.intrinsic sse1 "min.sd"-maxpd = Ext.intrinsic sse1 "max.pd"-minpd = Ext.intrinsic sse1 "min.pd"- switchFPPred ::    (Num i, LLVM.IsConst i, LLVM.IsInteger i, LLVM.IsPrimitive i,     LLVM.IsFirstClass v,-    TypeNum.Pos n,-    LLVM.IsSized v s, LLVM.IsSized (Vector n i) s) =>+    TypeNum.PositiveT n,+    LLVM.IsSized v, LLVM.IsSized (Vector n i),+    LLVM.SizeOf v ~ LLVM.SizeOf (Vector n i)) =>    (Value v -> Value v -> Value Word8 -> CodeGenFunction r (Value v)) ->    FPPredicate -> Value v -> Value v -> CodeGenFunction r (Value (Vector n i)) switchFPPred g p x y =-   let f i x0 y0 = LLVM.bitcastUnify =<< g x0 y0 (valueOf i)+   let f i x0 y0 = LLVM.bitcast =<< g x0 y0 (valueOf i)    in  case p of           LLVM.FPFalse -> return (LLVM.value LLVM.zero)           LLVM.FPOEQ   -> f 0 x y@@ -108,124 +97,128 @@           LLVM.FPUNE   -> f 4 x y           LLVM.FPT     -> return (LLVM.value (LLVM.constVector [LLVM.constOf (-1)])) -cmpss :: Ext.T (FPPredicate -> VFloat -> VFloat -> CodeGenFunction r (Value (Vector D4 Int32)))-cmpss = fmap switchFPPred (Ext.intrinsic sse1 "cmp.ss")+cmpss :: Ext.T (FPPredicate -> V4Float -> V4Float -> CodeGenFunction r V4Int32)+cmpss = fmap switchFPPred X86.cmpss -cmpps :: Ext.T (FPPredicate -> VFloat -> VFloat -> CodeGenFunction r (Value (Vector D4 Int32)))-cmpps = fmap switchFPPred (Ext.intrinsic sse1 "cmp.ps")+cmpps :: Ext.T (FPPredicate -> V4Float -> V4Float -> CodeGenFunction r V4Int32)+cmpps = fmap switchFPPred X86.cmpps -cmpsd :: Ext.T (FPPredicate -> VDouble -> VDouble -> CodeGenFunction r (Value (Vector D2 Int64)))-cmpsd = fmap switchFPPred (Ext.intrinsic sse2 "cmp.sd")+cmpsd :: Ext.T (FPPredicate -> V2Double -> V2Double -> CodeGenFunction r V2Int64)+cmpsd = fmap switchFPPred X86.cmpsd -cmppd :: Ext.T (FPPredicate -> VDouble -> VDouble -> CodeGenFunction r (Value (Vector D2 Int64)))-cmppd = fmap switchFPPred (Ext.intrinsic sse2 "cmp.pd")+cmppd :: Ext.T (FPPredicate -> V2Double -> V2Double -> CodeGenFunction r V2Int64)+cmppd = fmap switchFPPred X86.cmppd +cmpps256 :: Ext.T (FPPredicate -> X86.V8Float -> X86.V8Float -> CodeGenFunction r X86.V8Int32)+cmpps256 = fmap switchFPPred X86.cmpps256 -pcmpgtb :: Ext.T (Value (Vector D16 Int8) -> Value (Vector D16 Int8) -> CodeGenFunction r (Value (Vector D16 Int8)))+cmppd256 :: Ext.T (FPPredicate -> X86.V4Double -> X86.V4Double -> CodeGenFunction r X86.V4Int64)+cmppd256 = fmap switchFPPred X86.cmppd256+++pcmpgtb :: Ext.T (V16Int8 -> V16Int8 -> CodeGenFunction r V16Int8) pcmpgtb = Ext.intrinsic sse2 "pcmpgt.b" -pcmpgtw :: Ext.T (Value (Vector D8 Int16) -> Value (Vector D8 Int16) -> CodeGenFunction r (Value (Vector D8 Int16)))+pcmpgtw :: Ext.T (V8Int16 -> V8Int16 -> CodeGenFunction r V8Int16) pcmpgtw = Ext.intrinsic sse2 "pcmpgt.w" -pcmpgtd :: Ext.T (Value (Vector D4 Int32) -> Value (Vector D4 Int32) -> CodeGenFunction r (Value (Vector D4 Int32)))+pcmpgtd :: Ext.T (V4Int32 -> V4Int32 -> CodeGenFunction r V4Int32) pcmpgtd = Ext.intrinsic sse2 "pcmpgt.d" -pcmpgtq :: Ext.T (Value (Vector D2 Int64) -> Value (Vector D2 Int64) -> CodeGenFunction r (Value (Vector D2 Int64)))+pcmpgtq :: Ext.T (V2Int64 -> V2Int64 -> CodeGenFunction r V2Int64) pcmpgtq = Ext.intrinsic sse42 "pcmpgtq"   pcmpuFromPcmp ::-   (TypeNum.Pos n,+   (TypeNum.IntegerT n, TypeNum.IsPositive n ~ TypeBool.True,     LLVM.IsPrimitive s,     LLVM.IsPrimitive u, LLVM.IsArithmetic u, LLVM.IsConst u,     Bounded u, Integral u,-    LLVM.IsSized (Vector n s) size,-    LLVM.IsSized (Vector n u) size) =>+    LLVM.IsSized (Vector n s), LLVM.IsSized (Vector n u),+    LLVM.SizeOf (Vector n s) ~ LLVM.SizeOf (Vector n u)) =>    Ext.T (Value (Vector n s) -> Value (Vector n s) -> CodeGenFunction r (Value (Vector n s))) ->    Ext.T (Value (Vector n u) -> Value (Vector n u) -> CodeGenFunction r (Value (Vector n u))) pcmpuFromPcmp pcmp =    Ext.with pcmp $ \cmp x y -> do       let offset = value (constVector [constOf (1 + div maxBound 2)])-      xa <- LLVM.bitcastUnify =<< A.sub x offset-      ya <- LLVM.bitcastUnify =<< A.sub y offset-      LLVM.bitcastUnify =<< cmp xa ya+      xa <- LLVM.bitcast =<< A.sub x offset+      ya <- LLVM.bitcast =<< A.sub y offset+      LLVM.bitcast =<< cmp xa ya -pcmpugtb :: Ext.T (Value (Vector D16 Word8) -> Value (Vector D16 Word8) -> CodeGenFunction r (Value (Vector D16 Word8)))+pcmpugtb :: Ext.T (V16Word8 -> V16Word8 -> CodeGenFunction r V16Word8) pcmpugtb = pcmpuFromPcmp pcmpgtb -pcmpugtw :: Ext.T (Value (Vector D8 Word16) -> Value (Vector D8 Word16) -> CodeGenFunction r (Value (Vector D8 Word16)))+pcmpugtw :: Ext.T (V8Word16 -> V8Word16 -> CodeGenFunction r V8Word16) pcmpugtw = pcmpuFromPcmp pcmpgtw -pcmpugtd :: Ext.T (Value (Vector D4 Word32) -> Value (Vector D4 Word32) -> CodeGenFunction r (Value (Vector D4 Word32)))+pcmpugtd :: Ext.T (V4Word32 -> V4Word32 -> CodeGenFunction r V4Word32) pcmpugtd = pcmpuFromPcmp pcmpgtd -pcmpugtq :: Ext.T (Value (Vector D2 Word64) -> Value (Vector D2 Word64) -> CodeGenFunction r (Value (Vector D2 Word64)))+pcmpugtq :: Ext.T (V2Word64 -> V2Word64 -> CodeGenFunction r V2Word64) pcmpugtq = pcmpuFromPcmp pcmpgtq  -pminsb :: Ext.T (Value (Vector D16 Int8) -> Value (Vector D16 Int8) -> CodeGenFunction r (Value (Vector D16 Int8)))-pminsb = Ext.intrinsic sse41 "pminsb"--pminsw :: Ext.T (Value (Vector D8 Int16) -> Value (Vector D8 Int16) -> CodeGenFunction r (Value (Vector D8 Int16)))-pminsw = Ext.intrinsic sse2 "pmins.w"--pminsd :: Ext.T (Value (Vector D4 Int32) -> Value (Vector D4 Int32) -> CodeGenFunction r (Value (Vector D4 Int32)))-pminsd = Ext.intrinsic sse41 "pminsd"---pmaxsb :: Ext.T (Value (Vector D16 Int8) -> Value (Vector D16 Int8) -> CodeGenFunction r (Value (Vector D16 Int8)))-pmaxsb = Ext.intrinsic sse41 "pmaxsb"+pminsb, pmaxsb :: Ext.T (V16Int8 -> V16Int8 -> CodeGenFunction r V16Int8)+pminsb = X86.pminsb128+pmaxsb = X86.pmaxsb128 -pmaxsw :: Ext.T (Value (Vector D8 Int16) -> Value (Vector D8 Int16) -> CodeGenFunction r (Value (Vector D8 Int16)))-pmaxsw = Ext.intrinsic sse2 "pmaxs.w"+pminsw, pmaxsw :: Ext.T (V8Int16 -> V8Int16 -> CodeGenFunction r V8Int16)+pminsw = X86.pminsw128+pmaxsw = X86.pmaxsw128 -pmaxsd :: Ext.T (Value (Vector D4 Int32) -> Value (Vector D4 Int32) -> CodeGenFunction r (Value (Vector D4 Int32)))-pmaxsd = Ext.intrinsic sse41 "pmaxsd"+pminsd, pmaxsd :: Ext.T (V4Int32 -> V4Int32 -> CodeGenFunction r V4Int32)+pminsd = X86.pminsd128+pmaxsd = X86.pmaxsd128  -pminub :: Ext.T (Value (Vector D16 Word8) -> Value (Vector D16 Word8) -> CodeGenFunction r (Value (Vector D16 Word8)))-pminub = Ext.intrinsic sse2 "pminu.b"+pminub, pmaxub :: Ext.T (V16Word8 -> V16Word8 -> CodeGenFunction r V16Word8)+pminub = X86.pminub128+pmaxub = X86.pmaxub128 -pminuw :: Ext.T (Value (Vector D8 Word16) -> Value (Vector D8 Word16) -> CodeGenFunction r (Value (Vector D8 Word16)))-pminuw = Ext.intrinsic sse41 "pminuw"+pminuw, pmaxuw :: Ext.T (V8Word16 -> V8Word16 -> CodeGenFunction r V8Word16)+pminuw = X86.pminuw128+pmaxuw = X86.pmaxuw128 -pminud :: Ext.T (Value (Vector D4 Word32) -> Value (Vector D4 Word32) -> CodeGenFunction r (Value (Vector D4 Word32)))-pminud = Ext.intrinsic sse41 "pminud"+pminud, pmaxud :: Ext.T (V4Word32 -> V4Word32 -> CodeGenFunction r V4Word32)+pminud = X86.pminud128+pmaxud = X86.pmaxud128  -pmaxub :: Ext.T (Value (Vector D16 Word8) -> Value (Vector D16 Word8) -> CodeGenFunction r (Value (Vector D16 Word8)))-pmaxub = Ext.intrinsic sse2 "pmaxu.b"+pabsb :: Ext.T (V16Int8 -> CodeGenFunction r V16Int8)+pabsb = X86.pabsb128 -pmaxuw :: Ext.T (Value (Vector D8 Word16) -> Value (Vector D8 Word16) -> CodeGenFunction r (Value (Vector D8 Word16)))-pmaxuw = Ext.intrinsic sse41 "pmaxuw"+pabsw :: Ext.T (V8Int16 -> CodeGenFunction r V8Int16)+pabsw = X86.pabsw128 -pmaxud :: Ext.T (Value (Vector D4 Word32) -> Value (Vector D4 Word32) -> CodeGenFunction r (Value (Vector D4 Word32)))-pmaxud = Ext.intrinsic sse41 "pmaxud"+pabsd :: Ext.T (V4Int32 -> CodeGenFunction r V4Int32)+pabsd = X86.pabsd128  -pabsb :: Ext.T (Value (Vector D16 Int8) -> CodeGenFunction r (Value (Vector D16 Int8)))-pabsb = Ext.intrinsic ssse3 "pabs.b"+pmuludq :: Ext.T (V4Word32 -> V4Word32 -> CodeGenFunction r V2Word64)+pmuludq = X86.pmuludq128 -pabsw :: Ext.T (Value (Vector D8 Int16) -> CodeGenFunction r (Value (Vector D8 Int16)))-pabsw = Ext.intrinsic ssse3 "pabs.w"+pmuldq :: Ext.T (V4Int32 -> V4Int32 -> CodeGenFunction r V2Int64)+pmuldq = X86.pmuldq128 -pabsd :: Ext.T (Value (Vector D4 Int32) -> CodeGenFunction r (Value (Vector D4 Int32)))-pabsd = Ext.intrinsic ssse3 "pabs.d"+pmulld :: Ext.T (V4Word32 -> V4Word32 -> CodeGenFunction r V4Word32)+pmulld = Ext.wrap sse41 LLVM.mul+-- pmulld = Ext.intrinsic sse41 "pmulld"  -pmuludq :: Ext.T (Value (Vector D4 Word32) -> Value (Vector D4 Word32) -> CodeGenFunction r (Value (Vector D2 Word64)))-pmuludq = Ext.intrinsic sse2 "pmulu.dq"+cvtps2dq :: Ext.T (V4Float -> CodeGenFunction r V4Int32)+cvtps2dq = X86.cvtps2dq -pmulld :: Ext.T (Value (Vector D4 Word32) -> Value (Vector D4 Word32) -> CodeGenFunction r (Value (Vector D4 Word32)))-pmulld = Ext.intrinsic sse41 "pmulld"+-- | the upper two integers are set to zero, there is no instruction that converts to Int64+cvtpd2dq :: Ext.T (V2Double -> CodeGenFunction r V4Int32)+cvtpd2dq = X86.cvtpd2dq  -cvtps2dq :: Ext.T (VFloat -> CodeGenFunction r (Value (Vector D4 Int32)))-cvtps2dq = Ext.intrinsic sse2 "cvtps2dq"+cvtdq2ps :: Ext.T (V4Int32 -> CodeGenFunction r V4Float)+cvtdq2ps = X86.cvtdq2ps --- | the upper two integers are set to zero, there is no instruction that converts to Int64-cvtpd2dq :: Ext.T (VDouble -> CodeGenFunction r (Value (Vector D4 Int32)))-cvtpd2dq = Ext.intrinsic sse2 "cvtpd2dq"+-- | the upper two integers are ignored, there is no instruction that converts from Int64+cvtdq2pd :: Ext.T (V4Int32 -> CodeGenFunction r V2Double)+cvtdq2pd = X86.cvtdq2pd   valueUnit :: Value () -> ()@@ -266,25 +259,13 @@      ["max.ss", "min.ss", "max.ps", "min.ps"] -} -haddps :: Ext.T (VFloat -> VFloat -> CodeGenFunction r VFloat)-haddps = Ext.intrinsic sse3 "hadd.ps"--haddpd :: Ext.T (VDouble -> VDouble -> CodeGenFunction r VDouble)-haddpd = Ext.intrinsic sse3 "hadd.pd"--dpps :: Ext.T (VFloat -> VFloat -> Value Word32 -> CodeGenFunction r VFloat)-dpps = Ext.intrinsic sse41 "dpps"--dppd :: Ext.T (VDouble -> VDouble -> Value Word32 -> CodeGenFunction r VDouble)-dppd = Ext.intrinsic sse41 "dppd"--roundss, roundps :: Ext.T (VFloat -> Value Word32 -> CodeGenFunction r VFloat)-roundss = Ext.intrinsic sse41 "round.ss"-roundps = Ext.intrinsic sse41 "round.ps"+roundss :: Ext.T (V4Float -> Value Word32 -> CodeGenFunction r V4Float)+roundss =+   fmap (\f -> f (LLVM.value LLVM.undef)) X86.roundss -roundsd, roundpd :: Ext.T (VDouble -> Value Word32 -> CodeGenFunction r VDouble)-roundsd = Ext.intrinsic sse41 "round.sd"-roundpd = Ext.intrinsic sse41 "round.pd"+roundsd :: Ext.T (V2Double -> Value Word32 -> CodeGenFunction r V2Double)+roundsd =+   fmap (\f -> f (LLVM.value LLVM.undef)) X86.roundsd   @@ -295,13 +276,13 @@ The absolute value can be computed very efficiently by clearing the sign bit. Actually, LLVM's codegen implements neg by an XOR on the sign bit. -}-absss :: Ext.T (VFloat -> CodeGenFunction r VFloat)+absss :: Ext.T (V4Float -> CodeGenFunction r V4Float) absss =    Ext.wrap sse1 $-   LLVM.bitcastUnify+   LLVM.bitcast      <=< A.and (LLVM.value $ constVector $ map constOf $ (flip clearBit 31 $ complement 0) : repeat (complement 0)-            :: Value (Vector D4 Word32))-     <=< LLVM.bitcastUnify+            :: V4Word32)+     <=< LLVM.bitcast  {- This function works on a single Float,@@ -310,46 +291,54 @@  absss =    flip LLVM.extractelement (valueOf 0)-     . flip asTypeOf (undefined :: VFloat)-     <=< LLVM.bitcastUnify---        <=< A.and (LLVM.value $ constVector [constOf 0x7FFFFFFF] :: Value (Vector D4 Word32))---        <=< A.and (LLVM.value $ constVector [constOf 0x7FFFFFFF, LLVM.undef, LLVM.undef, LLVM.undef] :: Value (Vector D4 Word32))-     <=< A.and (LLVM.value $ constVector [constOf 0x7FFFFFFF, LLVM.zero, LLVM.zero, LLVM.zero] :: Value (Vector D4 Word32))-     <=< LLVM.bitcastUnify-     . flip asTypeOf (undefined :: VFloat)+     . flip asTypeOf (undefined :: V4Float)+     <=< LLVM.bitcast+--        <=< A.and (LLVM.value $ constVector [constOf 0x7FFFFFFF] :: V4Word32)+--        <=< A.and (LLVM.value $ constVector [constOf 0x7FFFFFFF, LLVM.undef, LLVM.undef, LLVM.undef] :: V4Word32)+     <=< A.and (LLVM.value $ constVector [constOf 0x7FFFFFFF, LLVM.zero, LLVM.zero, LLVM.zero] :: V4Word32)+     <=< LLVM.bitcast+     . flip asTypeOf (undefined :: V4Float)      <=< flip (LLVM.insertelement (LLVM.value LLVM.undef)) (valueOf 0) -} {- This moves the value to a general purpose register and performs the bit masking there absss =-   LLVM.bitcastUnify+   LLVM.bitcast      <=< A.and (valueOf 0x7FFFFFFF :: Value Word32)-     <=< LLVM.bitcastUnify+     <=< LLVM.bitcast -} -abssd :: Ext.T (VDouble -> CodeGenFunction r VDouble)+abssd :: Ext.T (V2Double -> CodeGenFunction r V2Double) abssd =    Ext.wrap sse2 $-   LLVM.bitcastUnify+   LLVM.bitcast      <=< A.and (LLVM.value $ constVector $ map constOf $ (flip clearBit 63 $ complement 0) : repeat (complement 0)-            :: Value (Vector D2 Word64))-     <=< LLVM.bitcastUnify+            :: V2Word64)+     <=< LLVM.bitcast -absps :: Ext.T (VFloat -> CodeGenFunction r VFloat)++mask ::+   (TypeNum.PositiveT n, LLVM.IsConst w, LLVM.IsPrimitive w, LLVM.IsInteger w) =>+   w -> Value (Vector n w) -> CodeGenFunction r (Value (Vector n w))+mask x =+   A.and (LLVM.value $ constVector [constOf x])++absps ::+   (TypeNum.PositiveT n) =>+   Ext.T (Value (Vector n Float) -> CodeGenFunction r (Value (Vector n Float))) absps =    Ext.wrap sse1 $-   LLVM.bitcastUnify-     <=< A.and (LLVM.value $ constVector [constOf $ flip clearBit 31 $ complement 0]-            :: Value (Vector D4 Word32))-     <=< LLVM.bitcastUnify+   LLVM.bitcastElements+     <=< mask (flip clearBit 31 $ complement 0 :: Word32)+     <=< LLVM.bitcastElements -abspd :: Ext.T (VDouble -> CodeGenFunction r VDouble)+abspd ::+   (TypeNum.PositiveT n) =>+   Ext.T (Value (Vector n Double) -> CodeGenFunction r (Value (Vector n Double))) abspd =    Ext.wrap sse2 $-   LLVM.bitcastUnify-     <=< A.and (LLVM.value $ constVector [constOf $ flip clearBit 63 $ complement 0]-            :: Value (Vector D2 Word64))-     <=< LLVM.bitcastUnify-+   LLVM.bitcastElements+     <=< mask (flip clearBit 63 $ complement 0 :: Word64)+     <=< LLVM.bitcastElements  {- | cumulative sum:@@ -358,8 +347,8 @@ I try to cleverly use horizontal add, but the generic version in the Vector module is better. -}-_cumulate1s :: Ext.T (VFloat -> CodeGenFunction r VFloat)-_cumulate1s = Ext.with haddps $ \haddp x -> do+_cumulate1s :: Ext.T (V4Float -> CodeGenFunction r V4Float)+_cumulate1s = Ext.with X86.haddps $ \haddp x -> do    y <- haddp x (LLVM.value LLVM.undef)    z <- LLVM.shufflevector x y $       constVector $ map constOf [0,4,2,5]
+ src/LLVM/Extra/Extension/X86Auto.hs view
@@ -0,0 +1,1530 @@+{- Do not edit! This file was created with the PrepareIntrinsics tool. -}+module LLVM.Extra.Extension.X86Auto where++import qualified LLVM.Extra.Extension as Ext+import qualified LLVM.Extra.ExtensionCheck.X86 as ExtX86+import qualified LLVM.Core as LLVM+import qualified Types.Data.Num as TypeNum+import qualified Data.Int as I+import qualified Data.Word as W+import Foreign.Ptr (Ptr, )++type MMX = LLVM.Value (LLVM.Vector TypeNum.D8 W.Word8)+type V16Int16 = LLVM.Value (LLVM.Vector TypeNum.D16 I.Int16)+type V16Int8 = LLVM.Value (LLVM.Vector TypeNum.D16 I.Int8)+type V16Word16 = LLVM.Value (LLVM.Vector TypeNum.D16 W.Word16)+type V16Word8 = LLVM.Value (LLVM.Vector TypeNum.D16 W.Word8)+type V2Double = LLVM.Value (LLVM.Vector TypeNum.D2 Double)+type V2Int64 = LLVM.Value (LLVM.Vector TypeNum.D2 I.Int64)+type V2Word64 = LLVM.Value (LLVM.Vector TypeNum.D2 W.Word64)+type V32Int8 = LLVM.Value (LLVM.Vector TypeNum.D32 I.Int8)+type V32Word8 = LLVM.Value (LLVM.Vector TypeNum.D32 W.Word8)+type V4Double = LLVM.Value (LLVM.Vector TypeNum.D4 Double)+type V4Float = LLVM.Value (LLVM.Vector TypeNum.D4 Float)+type V4Int32 = LLVM.Value (LLVM.Vector TypeNum.D4 I.Int32)+type V4Int64 = LLVM.Value (LLVM.Vector TypeNum.D4 I.Int64)+type V4Word32 = LLVM.Value (LLVM.Vector TypeNum.D4 W.Word32)+type V4Word64 = LLVM.Value (LLVM.Vector TypeNum.D4 W.Word64)+type V8Float = LLVM.Value (LLVM.Vector TypeNum.D8 Float)+type V8Int16 = LLVM.Value (LLVM.Vector TypeNum.D8 I.Int16)+type V8Int32 = LLVM.Value (LLVM.Vector TypeNum.D8 I.Int32)+type V8Word16 = LLVM.Value (LLVM.Vector TypeNum.D8 W.Word16)+type V8Word32 = LLVM.Value (LLVM.Vector TypeNum.D8 W.Word32)++pavgusb :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pavgusb = Ext.intrinsic ExtX86.amd3dnow "pavgusb"++pf2id :: Ext.T (MMX -> LLVM.CodeGenFunction r (MMX))+pf2id = Ext.intrinsic ExtX86.amd3dnow "pf2id"++pfacc :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfacc = Ext.intrinsic ExtX86.amd3dnow "pfacc"++pfadd :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfadd = Ext.intrinsic ExtX86.amd3dnow "pfadd"++pfcmpeq :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfcmpeq = Ext.intrinsic ExtX86.amd3dnow "pfcmpeq"++pfcmpge :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfcmpge = Ext.intrinsic ExtX86.amd3dnow "pfcmpge"++pfcmpgt :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfcmpgt = Ext.intrinsic ExtX86.amd3dnow "pfcmpgt"++pfmax :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfmax = Ext.intrinsic ExtX86.amd3dnow "pfmax"++pfmin :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfmin = Ext.intrinsic ExtX86.amd3dnow "pfmin"++pfmul :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfmul = Ext.intrinsic ExtX86.amd3dnow "pfmul"++pfrcp :: Ext.T (MMX -> LLVM.CodeGenFunction r (MMX))+pfrcp = Ext.intrinsic ExtX86.amd3dnow "pfrcp"++pfrcpit1 :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfrcpit1 = Ext.intrinsic ExtX86.amd3dnow "pfrcpit1"++pfrcpit2 :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfrcpit2 = Ext.intrinsic ExtX86.amd3dnow "pfrcpit2"++pfrsqrt :: Ext.T (MMX -> LLVM.CodeGenFunction r (MMX))+pfrsqrt = Ext.intrinsic ExtX86.amd3dnow "pfrsqrt"++pfrsqit1 :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfrsqit1 = Ext.intrinsic ExtX86.amd3dnow "pfrsqit1"++pfsub :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfsub = Ext.intrinsic ExtX86.amd3dnow "pfsub"++pfsubr :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfsubr = Ext.intrinsic ExtX86.amd3dnow "pfsubr"++pi2fd :: Ext.T (MMX -> LLVM.CodeGenFunction r (MMX))+pi2fd = Ext.intrinsic ExtX86.amd3dnow "pi2fd"++pmulhrw :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pmulhrw = Ext.intrinsic ExtX86.amd3dnow "pmulhrw"++pf2iw :: Ext.T (MMX -> LLVM.CodeGenFunction r (MMX))+pf2iw = Ext.intrinsic ExtX86.amd3dnowa "pf2iw"++pfnacc :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfnacc = Ext.intrinsic ExtX86.amd3dnowa "pfnacc"++pfpnacc :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pfpnacc = Ext.intrinsic ExtX86.amd3dnowa "pfpnacc"++pi2fw :: Ext.T (MMX -> LLVM.CodeGenFunction r (MMX))+pi2fw = Ext.intrinsic ExtX86.amd3dnowa "pi2fw"++addss :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+addss = Ext.intrinsic ExtX86.sse1 "add.ss"++subss :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+subss = Ext.intrinsic ExtX86.sse1 "sub.ss"++mulss :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+mulss = Ext.intrinsic ExtX86.sse1 "mul.ss"++divss :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+divss = Ext.intrinsic ExtX86.sse1 "div.ss"++sqrtss :: Ext.T (V4Float -> LLVM.CodeGenFunction r (V4Float))+sqrtss = Ext.intrinsic ExtX86.sse1 "sqrt.ss"++sqrtps :: Ext.T (V4Float -> LLVM.CodeGenFunction r (V4Float))+sqrtps = Ext.intrinsic ExtX86.sse1 "sqrt.ps"++rcpss :: Ext.T (V4Float -> LLVM.CodeGenFunction r (V4Float))+rcpss = Ext.intrinsic ExtX86.sse1 "rcp.ss"++rcpps :: Ext.T (V4Float -> LLVM.CodeGenFunction r (V4Float))+rcpps = Ext.intrinsic ExtX86.sse1 "rcp.ps"++rsqrtss :: Ext.T (V4Float -> LLVM.CodeGenFunction r (V4Float))+rsqrtss = Ext.intrinsic ExtX86.sse1 "rsqrt.ss"++rsqrtps :: Ext.T (V4Float -> LLVM.CodeGenFunction r (V4Float))+rsqrtps = Ext.intrinsic ExtX86.sse1 "rsqrt.ps"++minss :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+minss = Ext.intrinsic ExtX86.sse1 "min.ss"++minps :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+minps = Ext.intrinsic ExtX86.sse1 "min.ps"++maxss :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+maxss = Ext.intrinsic ExtX86.sse1 "max.ss"++maxps :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+maxps = Ext.intrinsic ExtX86.sse1 "max.ps"++cmpss :: Ext.T (V4Float -> V4Float -> LLVM.Value W.Word8 -> LLVM.CodeGenFunction r (V4Float))+cmpss = Ext.intrinsic ExtX86.sse1 "cmp.ss"++cmpps :: Ext.T (V4Float -> V4Float -> LLVM.Value W.Word8 -> LLVM.CodeGenFunction r (V4Float))+cmpps = Ext.intrinsic ExtX86.sse1 "cmp.ps"++comieq :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+comieq = Ext.intrinsic ExtX86.sse1 "comieq.ss"++comilt :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+comilt = Ext.intrinsic ExtX86.sse1 "comilt.ss"++comile :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+comile = Ext.intrinsic ExtX86.sse1 "comile.ss"++comigt :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+comigt = Ext.intrinsic ExtX86.sse1 "comigt.ss"++comige :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+comige = Ext.intrinsic ExtX86.sse1 "comige.ss"++comineq :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+comineq = Ext.intrinsic ExtX86.sse1 "comineq.ss"++ucomieq :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ucomieq = Ext.intrinsic ExtX86.sse1 "ucomieq.ss"++ucomilt :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ucomilt = Ext.intrinsic ExtX86.sse1 "ucomilt.ss"++ucomile :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ucomile = Ext.intrinsic ExtX86.sse1 "ucomile.ss"++ucomigt :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ucomigt = Ext.intrinsic ExtX86.sse1 "ucomigt.ss"++ucomige :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ucomige = Ext.intrinsic ExtX86.sse1 "ucomige.ss"++ucomineq :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ucomineq = Ext.intrinsic ExtX86.sse1 "ucomineq.ss"++cvtss2si :: Ext.T (V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+cvtss2si = Ext.intrinsic ExtX86.sse1 "cvtss2si"++cvtss2si64 :: Ext.T (V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int64))+cvtss2si64 = Ext.intrinsic ExtX86.sse1 "cvtss2si64"++cvttss2si :: Ext.T (V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+cvttss2si = Ext.intrinsic ExtX86.sse1 "cvttss2si"++cvttss2si64 :: Ext.T (V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int64))+cvttss2si64 = Ext.intrinsic ExtX86.sse1 "cvttss2si64"++cvtsi2ss :: Ext.T (V4Float -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Float))+cvtsi2ss = Ext.intrinsic ExtX86.sse1 "cvtsi2ss"++cvtsi642ss :: Ext.T (V4Float -> LLVM.Value I.Int64 -> LLVM.CodeGenFunction r (V4Float))+cvtsi642ss = Ext.intrinsic ExtX86.sse1 "cvtsi642ss"++cvtps2pi :: Ext.T (V4Float -> LLVM.CodeGenFunction r (MMX))+cvtps2pi = Ext.intrinsic ExtX86.sse1 "cvtps2pi"++cvttps2pi :: Ext.T (V4Float -> LLVM.CodeGenFunction r (MMX))+cvttps2pi = Ext.intrinsic ExtX86.sse1 "cvttps2pi"++cvtpi2ps :: Ext.T (V4Float -> MMX -> LLVM.CodeGenFunction r (V4Float))+cvtpi2ps = Ext.intrinsic ExtX86.sse1 "cvtpi2ps"++storeups :: Ext.T (LLVM.Value (Ptr ()) -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value ()))+storeups = Ext.intrinsic ExtX86.sse1 "storeu.ps"++sfence :: Ext.T (LLVM.CodeGenFunction r (LLVM.Value ()))+sfence = Ext.intrinsic ExtX86.sse1 "sfence"++movmskps :: Ext.T (V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+movmskps = Ext.intrinsic ExtX86.sse1 "movmsk.ps"++addsd :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+addsd = Ext.intrinsic ExtX86.sse2 "add.sd"++subsd :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+subsd = Ext.intrinsic ExtX86.sse2 "sub.sd"++mulsd :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+mulsd = Ext.intrinsic ExtX86.sse2 "mul.sd"++divsd :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+divsd = Ext.intrinsic ExtX86.sse2 "div.sd"++sqrtsd :: Ext.T (V2Double -> LLVM.CodeGenFunction r (V2Double))+sqrtsd = Ext.intrinsic ExtX86.sse2 "sqrt.sd"++sqrtpd :: Ext.T (V2Double -> LLVM.CodeGenFunction r (V2Double))+sqrtpd = Ext.intrinsic ExtX86.sse2 "sqrt.pd"++minsd :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+minsd = Ext.intrinsic ExtX86.sse2 "min.sd"++minpd :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+minpd = Ext.intrinsic ExtX86.sse2 "min.pd"++maxsd :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+maxsd = Ext.intrinsic ExtX86.sse2 "max.sd"++maxpd :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+maxpd = Ext.intrinsic ExtX86.sse2 "max.pd"++cmpsd :: Ext.T (V2Double -> V2Double -> LLVM.Value W.Word8 -> LLVM.CodeGenFunction r (V2Double))+cmpsd = Ext.intrinsic ExtX86.sse2 "cmp.sd"++cmppd :: Ext.T (V2Double -> V2Double -> LLVM.Value W.Word8 -> LLVM.CodeGenFunction r (V2Double))+cmppd = Ext.intrinsic ExtX86.sse2 "cmp.pd"++comisdeq :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+comisdeq = Ext.intrinsic ExtX86.sse2 "comieq.sd"++comisdlt :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+comisdlt = Ext.intrinsic ExtX86.sse2 "comilt.sd"++comisdle :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+comisdle = Ext.intrinsic ExtX86.sse2 "comile.sd"++comisdgt :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+comisdgt = Ext.intrinsic ExtX86.sse2 "comigt.sd"++comisdge :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+comisdge = Ext.intrinsic ExtX86.sse2 "comige.sd"++comisdneq :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+comisdneq = Ext.intrinsic ExtX86.sse2 "comineq.sd"++ucomisdeq :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ucomisdeq = Ext.intrinsic ExtX86.sse2 "ucomieq.sd"++ucomisdlt :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ucomisdlt = Ext.intrinsic ExtX86.sse2 "ucomilt.sd"++ucomisdle :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ucomisdle = Ext.intrinsic ExtX86.sse2 "ucomile.sd"++ucomisdgt :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ucomisdgt = Ext.intrinsic ExtX86.sse2 "ucomigt.sd"++ucomisdge :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ucomisdge = Ext.intrinsic ExtX86.sse2 "ucomige.sd"++ucomisdneq :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ucomisdneq = Ext.intrinsic ExtX86.sse2 "ucomineq.sd"++paddsb128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.CodeGenFunction r (V16Int8))+paddsb128 = Ext.intrinsic ExtX86.sse2 "padds.b"++paddsw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+paddsw128 = Ext.intrinsic ExtX86.sse2 "padds.w"++paddusb128 :: Ext.T (V16Word8 -> V16Word8 -> LLVM.CodeGenFunction r (V16Word8))+paddusb128 = Ext.intrinsic ExtX86.sse2 "paddus.b"++paddusw128 :: Ext.T (V8Word16 -> V8Word16 -> LLVM.CodeGenFunction r (V8Word16))+paddusw128 = Ext.intrinsic ExtX86.sse2 "paddus.w"++psubsb128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.CodeGenFunction r (V16Int8))+psubsb128 = Ext.intrinsic ExtX86.sse2 "psubs.b"++psubsw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+psubsw128 = Ext.intrinsic ExtX86.sse2 "psubs.w"++psubusb128 :: Ext.T (V16Word8 -> V16Word8 -> LLVM.CodeGenFunction r (V16Word8))+psubusb128 = Ext.intrinsic ExtX86.sse2 "psubus.b"++psubusw128 :: Ext.T (V8Word16 -> V8Word16 -> LLVM.CodeGenFunction r (V8Word16))+psubusw128 = Ext.intrinsic ExtX86.sse2 "psubus.w"++pmulhuw128 :: Ext.T (V8Word16 -> V8Word16 -> LLVM.CodeGenFunction r (V8Word16))+pmulhuw128 = Ext.intrinsic ExtX86.sse2 "pmulhu.w"++pmulhw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+pmulhw128 = Ext.intrinsic ExtX86.sse2 "pmulh.w"++pmuludq128 :: Ext.T (V4Word32 -> V4Word32 -> LLVM.CodeGenFunction r (V2Word64))+pmuludq128 = Ext.intrinsic ExtX86.sse2 "pmulu.dq"++pmaddwd128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V4Int32))+pmaddwd128 = Ext.intrinsic ExtX86.sse2 "pmadd.wd"++pavgb128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.CodeGenFunction r (V16Int8))+pavgb128 = Ext.intrinsic ExtX86.sse2 "pavg.b"++pavgw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+pavgw128 = Ext.intrinsic ExtX86.sse2 "pavg.w"++pmaxub128 :: Ext.T (V16Word8 -> V16Word8 -> LLVM.CodeGenFunction r (V16Word8))+pmaxub128 = Ext.intrinsic ExtX86.sse2 "pmaxu.b"++pmaxsw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+pmaxsw128 = Ext.intrinsic ExtX86.sse2 "pmaxs.w"++pminub128 :: Ext.T (V16Word8 -> V16Word8 -> LLVM.CodeGenFunction r (V16Word8))+pminub128 = Ext.intrinsic ExtX86.sse2 "pminu.b"++pminsw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+pminsw128 = Ext.intrinsic ExtX86.sse2 "pmins.w"++psadbw128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.CodeGenFunction r (V2Int64))+psadbw128 = Ext.intrinsic ExtX86.sse2 "psad.bw"++psllw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+psllw128 = Ext.intrinsic ExtX86.sse2 "psll.w"++pslld128 :: Ext.T (V4Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V4Int32))+pslld128 = Ext.intrinsic ExtX86.sse2 "psll.d"++psllq128 :: Ext.T (V2Int64 -> V2Int64 -> LLVM.CodeGenFunction r (V2Int64))+psllq128 = Ext.intrinsic ExtX86.sse2 "psll.q"++psrlw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+psrlw128 = Ext.intrinsic ExtX86.sse2 "psrl.w"++psrld128 :: Ext.T (V4Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V4Int32))+psrld128 = Ext.intrinsic ExtX86.sse2 "psrl.d"++psrlq128 :: Ext.T (V2Int64 -> V2Int64 -> LLVM.CodeGenFunction r (V2Int64))+psrlq128 = Ext.intrinsic ExtX86.sse2 "psrl.q"++psraw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+psraw128 = Ext.intrinsic ExtX86.sse2 "psra.w"++psrad128 :: Ext.T (V4Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V4Int32))+psrad128 = Ext.intrinsic ExtX86.sse2 "psra.d"++psllwi128 :: Ext.T (V8Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Int16))+psllwi128 = Ext.intrinsic ExtX86.sse2 "pslli.w"++pslldi128 :: Ext.T (V4Int32 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Int32))+pslldi128 = Ext.intrinsic ExtX86.sse2 "pslli.d"++psllqi128 :: Ext.T (V2Int64 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V2Int64))+psllqi128 = Ext.intrinsic ExtX86.sse2 "pslli.q"++psrlwi128 :: Ext.T (V8Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Int16))+psrlwi128 = Ext.intrinsic ExtX86.sse2 "psrli.w"++psrldi128 :: Ext.T (V4Int32 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Int32))+psrldi128 = Ext.intrinsic ExtX86.sse2 "psrli.d"++psrlqi128 :: Ext.T (V2Int64 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V2Int64))+psrlqi128 = Ext.intrinsic ExtX86.sse2 "psrli.q"++psrawi128 :: Ext.T (V8Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Int16))+psrawi128 = Ext.intrinsic ExtX86.sse2 "psrai.w"++psradi128 :: Ext.T (V4Int32 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Int32))+psradi128 = Ext.intrinsic ExtX86.sse2 "psrai.d"++pslldqi128 :: Ext.T (V2Int64 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V2Int64))+pslldqi128 = Ext.intrinsic ExtX86.sse2 "psll.dq"++psrldqi128 :: Ext.T (V2Int64 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V2Int64))+psrldqi128 = Ext.intrinsic ExtX86.sse2 "psrl.dq"++pslldqi128_byteshift :: Ext.T (V2Int64 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V2Int64))+pslldqi128_byteshift = Ext.intrinsic ExtX86.sse2 "psll.dq.bs"++psrldqi128_byteshift :: Ext.T (V2Int64 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V2Int64))+psrldqi128_byteshift = Ext.intrinsic ExtX86.sse2 "psrl.dq.bs"++cvtdq2pd :: Ext.T (V4Int32 -> LLVM.CodeGenFunction r (V2Double))+cvtdq2pd = Ext.intrinsic ExtX86.sse2 "cvtdq2pd"++cvtdq2ps :: Ext.T (V4Int32 -> LLVM.CodeGenFunction r (V4Float))+cvtdq2ps = Ext.intrinsic ExtX86.sse2 "cvtdq2ps"++cvtpd2dq :: Ext.T (V2Double -> LLVM.CodeGenFunction r (V4Int32))+cvtpd2dq = Ext.intrinsic ExtX86.sse2 "cvtpd2dq"++cvttpd2dq :: Ext.T (V2Double -> LLVM.CodeGenFunction r (V4Int32))+cvttpd2dq = Ext.intrinsic ExtX86.sse2 "cvttpd2dq"++cvtpd2ps :: Ext.T (V2Double -> LLVM.CodeGenFunction r (V4Float))+cvtpd2ps = Ext.intrinsic ExtX86.sse2 "cvtpd2ps"++cvtps2dq :: Ext.T (V4Float -> LLVM.CodeGenFunction r (V4Int32))+cvtps2dq = Ext.intrinsic ExtX86.sse2 "cvtps2dq"++cvttps2dq :: Ext.T (V4Float -> LLVM.CodeGenFunction r (V4Int32))+cvttps2dq = Ext.intrinsic ExtX86.sse2 "cvttps2dq"++cvtps2pd :: Ext.T (V4Float -> LLVM.CodeGenFunction r (V2Double))+cvtps2pd = Ext.intrinsic ExtX86.sse2 "cvtps2pd"++cvtsd2si :: Ext.T (V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+cvtsd2si = Ext.intrinsic ExtX86.sse2 "cvtsd2si"++cvtsd2si64 :: Ext.T (V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int64))+cvtsd2si64 = Ext.intrinsic ExtX86.sse2 "cvtsd2si64"++cvttsd2si :: Ext.T (V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+cvttsd2si = Ext.intrinsic ExtX86.sse2 "cvttsd2si"++cvttsd2si64 :: Ext.T (V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int64))+cvttsd2si64 = Ext.intrinsic ExtX86.sse2 "cvttsd2si64"++cvtsi2sd :: Ext.T (V2Double -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V2Double))+cvtsi2sd = Ext.intrinsic ExtX86.sse2 "cvtsi2sd"++cvtsi642sd :: Ext.T (V2Double -> LLVM.Value I.Int64 -> LLVM.CodeGenFunction r (V2Double))+cvtsi642sd = Ext.intrinsic ExtX86.sse2 "cvtsi642sd"++cvtsd2ss :: Ext.T (V4Float -> V2Double -> LLVM.CodeGenFunction r (V4Float))+cvtsd2ss = Ext.intrinsic ExtX86.sse2 "cvtsd2ss"++cvtss2sd :: Ext.T (V2Double -> V4Float -> LLVM.CodeGenFunction r (V2Double))+cvtss2sd = Ext.intrinsic ExtX86.sse2 "cvtss2sd"++cvtpd2pi :: Ext.T (V2Double -> LLVM.CodeGenFunction r (MMX))+cvtpd2pi = Ext.intrinsic ExtX86.sse1 "cvtpd2pi"++cvttpd2pi :: Ext.T (V2Double -> LLVM.CodeGenFunction r (MMX))+cvttpd2pi = Ext.intrinsic ExtX86.sse1 "cvttpd2pi"++cvtpi2pd :: Ext.T (MMX -> LLVM.CodeGenFunction r (V2Double))+cvtpi2pd = Ext.intrinsic ExtX86.sse1 "cvtpi2pd"++storeupd :: Ext.T (LLVM.Value (Ptr ()) -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value ()))+storeupd = Ext.intrinsic ExtX86.sse2 "storeu.pd"++storedqu :: Ext.T (LLVM.Value (Ptr ()) -> V16Int8 -> LLVM.CodeGenFunction r (LLVM.Value ()))+storedqu = Ext.intrinsic ExtX86.sse2 "storeu.dq"++storelv4si :: Ext.T (LLVM.Value (Ptr ()) -> V4Int32 -> LLVM.CodeGenFunction r (LLVM.Value ()))+storelv4si = Ext.intrinsic ExtX86.sse2 "storel.dq"++packsswb128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V16Int8))+packsswb128 = Ext.intrinsic ExtX86.sse2 "packsswb.128"++packssdw128 :: Ext.T (V4Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V8Int16))+packssdw128 = Ext.intrinsic ExtX86.sse2 "packssdw.128"++packuswb128 :: Ext.T (V8Word16 -> V8Word16 -> LLVM.CodeGenFunction r (V16Word8))+packuswb128 = Ext.intrinsic ExtX86.sse2 "packuswb.128"++movmskpd :: Ext.T (V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+movmskpd = Ext.intrinsic ExtX86.sse2 "movmsk.pd"++pmovmskb128 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+pmovmskb128 = Ext.intrinsic ExtX86.sse2 "pmovmskb.128"++maskmovdqu :: Ext.T (V16Int8 -> V16Int8 -> LLVM.Value (Ptr ()) -> LLVM.CodeGenFunction r (LLVM.Value ()))+maskmovdqu = Ext.intrinsic ExtX86.sse2 "maskmov.dqu"++clflush :: Ext.T (LLVM.Value (Ptr ()) -> LLVM.CodeGenFunction r (LLVM.Value ()))+clflush = Ext.intrinsic ExtX86.sse2 "clflush"++lfence :: Ext.T (LLVM.CodeGenFunction r (LLVM.Value ()))+lfence = Ext.intrinsic ExtX86.sse2 "lfence"++mfence :: Ext.T (LLVM.CodeGenFunction r (LLVM.Value ()))+mfence = Ext.intrinsic ExtX86.sse2 "mfence"++addsubps :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+addsubps = Ext.intrinsic ExtX86.sse3 "addsub.ps"++addsubpd :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+addsubpd = Ext.intrinsic ExtX86.sse3 "addsub.pd"++haddps :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+haddps = Ext.intrinsic ExtX86.sse3 "hadd.ps"++haddpd :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+haddpd = Ext.intrinsic ExtX86.sse3 "hadd.pd"++hsubps :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+hsubps = Ext.intrinsic ExtX86.sse3 "hsub.ps"++hsubpd :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+hsubpd = Ext.intrinsic ExtX86.sse3 "hsub.pd"++lddqu :: Ext.T (LLVM.Value (Ptr ()) -> LLVM.CodeGenFunction r (V16Int8))+lddqu = Ext.intrinsic ExtX86.sse3 "ldu.dq"++monitor :: Ext.T (LLVM.Value (Ptr ()) -> LLVM.Value I.Int32 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (LLVM.Value ()))+monitor = Ext.intrinsic ExtX86.sse3 "monitor"++mwait :: Ext.T (LLVM.Value I.Int32 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (LLVM.Value ()))+mwait = Ext.intrinsic ExtX86.sse3 "mwait"++phaddw :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+phaddw = Ext.intrinsic ExtX86.ssse3 "phadd.w"++phaddw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+phaddw128 = Ext.intrinsic ExtX86.ssse3 "phadd.w.128"++phaddd :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+phaddd = Ext.intrinsic ExtX86.ssse3 "phadd.d"++phaddd128 :: Ext.T (V4Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V4Int32))+phaddd128 = Ext.intrinsic ExtX86.ssse3 "phadd.d.128"++phaddsw :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+phaddsw = Ext.intrinsic ExtX86.ssse3 "phadd.sw"++phaddsw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+phaddsw128 = Ext.intrinsic ExtX86.ssse3 "phadd.sw.128"++phsubw :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+phsubw = Ext.intrinsic ExtX86.ssse3 "phsub.w"++phsubw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+phsubw128 = Ext.intrinsic ExtX86.ssse3 "phsub.w.128"++phsubd :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+phsubd = Ext.intrinsic ExtX86.ssse3 "phsub.d"++phsubd128 :: Ext.T (V4Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V4Int32))+phsubd128 = Ext.intrinsic ExtX86.ssse3 "phsub.d.128"++phsubsw :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+phsubsw = Ext.intrinsic ExtX86.ssse3 "phsub.sw"++phsubsw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+phsubsw128 = Ext.intrinsic ExtX86.ssse3 "phsub.sw.128"++pmaddubsw :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pmaddubsw = Ext.intrinsic ExtX86.ssse3 "pmadd.ub.sw"++pmaddubsw128 :: Ext.T (V16Word8 -> V16Word8 -> LLVM.CodeGenFunction r (V8Word16))+pmaddubsw128 = Ext.intrinsic ExtX86.ssse3 "pmadd.ub.sw.128"++pmulhrsw :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pmulhrsw = Ext.intrinsic ExtX86.ssse3 "pmul.hr.sw"++pmulhrsw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+pmulhrsw128 = Ext.intrinsic ExtX86.ssse3 "pmul.hr.sw.128"++pshufb :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+pshufb = Ext.intrinsic ExtX86.ssse3 "pshuf.b"++pshufb128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.CodeGenFunction r (V16Int8))+pshufb128 = Ext.intrinsic ExtX86.ssse3 "pshuf.b.128"++pshufw :: Ext.T (MMX -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (MMX))+pshufw = Ext.intrinsic ExtX86.sse1 "pshuf.w"++psignb :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+psignb = Ext.intrinsic ExtX86.ssse3 "psign.b"++psignb128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.CodeGenFunction r (V16Int8))+psignb128 = Ext.intrinsic ExtX86.ssse3 "psign.b.128"++psignw :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+psignw = Ext.intrinsic ExtX86.ssse3 "psign.w"++psignw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+psignw128 = Ext.intrinsic ExtX86.ssse3 "psign.w.128"++psignd :: Ext.T (MMX -> MMX -> LLVM.CodeGenFunction r (MMX))+psignd = Ext.intrinsic ExtX86.ssse3 "psign.d"++psignd128 :: Ext.T (V4Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V4Int32))+psignd128 = Ext.intrinsic ExtX86.ssse3 "psign.d.128"++pabsb :: Ext.T (MMX -> LLVM.CodeGenFunction r (MMX))+pabsb = Ext.intrinsic ExtX86.ssse3 "pabs.b"++pabsb128 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V16Int8))+pabsb128 = Ext.intrinsic ExtX86.ssse3 "pabs.b.128"++pabsw :: Ext.T (MMX -> LLVM.CodeGenFunction r (MMX))+pabsw = Ext.intrinsic ExtX86.ssse3 "pabs.w"++pabsw128 :: Ext.T (V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+pabsw128 = Ext.intrinsic ExtX86.ssse3 "pabs.w.128"++pabsd :: Ext.T (MMX -> LLVM.CodeGenFunction r (MMX))+pabsd = Ext.intrinsic ExtX86.ssse3 "pabs.d"++pabsd128 :: Ext.T (V4Int32 -> LLVM.CodeGenFunction r (V4Int32))+pabsd128 = Ext.intrinsic ExtX86.ssse3 "pabs.d.128"++roundss :: Ext.T (V4Float -> V4Float -> LLVM.Value W.Word32 -> LLVM.CodeGenFunction r (V4Float))+roundss = Ext.intrinsic ExtX86.sse41 "round.ss"++roundps :: Ext.T (V4Float -> LLVM.Value W.Word32 -> LLVM.CodeGenFunction r (V4Float))+roundps = Ext.intrinsic ExtX86.sse41 "round.ps"++roundsd :: Ext.T (V2Double -> V2Double -> LLVM.Value W.Word32 -> LLVM.CodeGenFunction r (V2Double))+roundsd = Ext.intrinsic ExtX86.sse41 "round.sd"++roundpd :: Ext.T (V2Double -> LLVM.Value W.Word32 -> LLVM.CodeGenFunction r (V2Double))+roundpd = Ext.intrinsic ExtX86.sse41 "round.pd"++pmovsxbd128 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V4Int32))+pmovsxbd128 = Ext.intrinsic ExtX86.sse41 "pmovsxbd"++pmovsxbq128 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V2Int64))+pmovsxbq128 = Ext.intrinsic ExtX86.sse41 "pmovsxbq"++pmovsxbw128 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V8Int16))+pmovsxbw128 = Ext.intrinsic ExtX86.sse41 "pmovsxbw"++pmovsxdq128 :: Ext.T (V4Int32 -> LLVM.CodeGenFunction r (V2Int64))+pmovsxdq128 = Ext.intrinsic ExtX86.sse41 "pmovsxdq"++pmovsxwd128 :: Ext.T (V8Int16 -> LLVM.CodeGenFunction r (V4Int32))+pmovsxwd128 = Ext.intrinsic ExtX86.sse41 "pmovsxwd"++pmovsxwq128 :: Ext.T (V8Int16 -> LLVM.CodeGenFunction r (V2Int64))+pmovsxwq128 = Ext.intrinsic ExtX86.sse41 "pmovsxwq"++pmovzxbd128 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V4Int32))+pmovzxbd128 = Ext.intrinsic ExtX86.sse41 "pmovzxbd"++pmovzxbq128 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V2Int64))+pmovzxbq128 = Ext.intrinsic ExtX86.sse41 "pmovzxbq"++pmovzxbw128 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V8Int16))+pmovzxbw128 = Ext.intrinsic ExtX86.sse41 "pmovzxbw"++pmovzxdq128 :: Ext.T (V4Int32 -> LLVM.CodeGenFunction r (V2Int64))+pmovzxdq128 = Ext.intrinsic ExtX86.sse41 "pmovzxdq"++pmovzxwd128 :: Ext.T (V8Int16 -> LLVM.CodeGenFunction r (V4Int32))+pmovzxwd128 = Ext.intrinsic ExtX86.sse41 "pmovzxwd"++pmovzxwq128 :: Ext.T (V8Int16 -> LLVM.CodeGenFunction r (V2Int64))+pmovzxwq128 = Ext.intrinsic ExtX86.sse41 "pmovzxwq"++phminposuw128 :: Ext.T (V8Word16 -> LLVM.CodeGenFunction r (V8Word16))+phminposuw128 = Ext.intrinsic ExtX86.sse41 "phminposuw"++pmaxsb128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.CodeGenFunction r (V16Int8))+pmaxsb128 = Ext.intrinsic ExtX86.sse41 "pmaxsb"++pmaxsd128 :: Ext.T (V4Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V4Int32))+pmaxsd128 = Ext.intrinsic ExtX86.sse41 "pmaxsd"++pmaxud128 :: Ext.T (V4Word32 -> V4Word32 -> LLVM.CodeGenFunction r (V4Word32))+pmaxud128 = Ext.intrinsic ExtX86.sse41 "pmaxud"++pmaxuw128 :: Ext.T (V8Word16 -> V8Word16 -> LLVM.CodeGenFunction r (V8Word16))+pmaxuw128 = Ext.intrinsic ExtX86.sse41 "pmaxuw"++pminsb128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.CodeGenFunction r (V16Int8))+pminsb128 = Ext.intrinsic ExtX86.sse41 "pminsb"++pminsd128 :: Ext.T (V4Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V4Int32))+pminsd128 = Ext.intrinsic ExtX86.sse41 "pminsd"++pminud128 :: Ext.T (V4Word32 -> V4Word32 -> LLVM.CodeGenFunction r (V4Word32))+pminud128 = Ext.intrinsic ExtX86.sse41 "pminud"++pminuw128 :: Ext.T (V8Word16 -> V8Word16 -> LLVM.CodeGenFunction r (V8Word16))+pminuw128 = Ext.intrinsic ExtX86.sse41 "pminuw"++aesimc128 :: Ext.T (V2Int64 -> LLVM.CodeGenFunction r (V2Int64))+aesimc128 = Ext.intrinsic ExtX86.aes "aesimc"++aesenc128 :: Ext.T (V2Int64 -> V2Int64 -> LLVM.CodeGenFunction r (V2Int64))+aesenc128 = Ext.intrinsic ExtX86.aes "aesenc"++aesenclast128 :: Ext.T (V2Int64 -> V2Int64 -> LLVM.CodeGenFunction r (V2Int64))+aesenclast128 = Ext.intrinsic ExtX86.aes "aesenclast"++aesdec128 :: Ext.T (V2Int64 -> V2Int64 -> LLVM.CodeGenFunction r (V2Int64))+aesdec128 = Ext.intrinsic ExtX86.aes "aesdec"++aesdeclast128 :: Ext.T (V2Int64 -> V2Int64 -> LLVM.CodeGenFunction r (V2Int64))+aesdeclast128 = Ext.intrinsic ExtX86.aes "aesdeclast"++aeskeygenassist128 :: Ext.T (V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))+aeskeygenassist128 = Ext.intrinsic ExtX86.aes "aeskeygenassist"++packusdw128 :: Ext.T (V4Word32 -> V4Word32 -> LLVM.CodeGenFunction r (V8Word16))+packusdw128 = Ext.intrinsic ExtX86.sse41 "packusdw"++pmuldq128 :: Ext.T (V4Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V2Int64))+pmuldq128 = Ext.intrinsic ExtX86.sse41 "pmuldq"++extractps128 :: Ext.T (V4Float -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+extractps128 = Ext.intrinsic ExtX86.sse41 "extractps"++insertps128 :: Ext.T (V4Float -> V4Float -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Float))+insertps128 = Ext.intrinsic ExtX86.sse41 "insertps"++pblendvb128 :: Ext.T (V16Int8 -> V16Int8 -> V16Int8 -> LLVM.CodeGenFunction r (V16Int8))+pblendvb128 = Ext.intrinsic ExtX86.sse41 "pblendvb"++pblendw128 :: Ext.T (V8Int16 -> V8Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Int16))+pblendw128 = Ext.intrinsic ExtX86.sse41 "pblendw"++blendpd :: Ext.T (V2Double -> V2Double -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V2Double))+blendpd = Ext.intrinsic ExtX86.sse41 "blendpd"++blendps :: Ext.T (V4Float -> V4Float -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Float))+blendps = Ext.intrinsic ExtX86.sse41 "blendps"++blendvpd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+blendvpd = Ext.intrinsic ExtX86.sse41 "blendvpd"++blendvps :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+blendvps = Ext.intrinsic ExtX86.sse41 "blendvps"++dppd :: Ext.T (V2Double -> V2Double -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V2Double))+dppd = Ext.intrinsic ExtX86.sse41 "dppd"++dpps :: Ext.T (V4Float -> V4Float -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Float))+dpps = Ext.intrinsic ExtX86.sse41 "dpps"++mpsadbw128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Int16))+mpsadbw128 = Ext.intrinsic ExtX86.sse41 "mpsadbw"++movntdqa :: Ext.T (LLVM.Value (Ptr ()) -> LLVM.CodeGenFunction r (V2Int64))+movntdqa = Ext.intrinsic ExtX86.sse41 "movntdqa"++ptestz128 :: Ext.T (V2Int64 -> V2Int64 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ptestz128 = Ext.intrinsic ExtX86.sse41 "ptestz"++ptestc128 :: Ext.T (V2Int64 -> V2Int64 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ptestc128 = Ext.intrinsic ExtX86.sse41 "ptestc"++ptestnzc128 :: Ext.T (V2Int64 -> V2Int64 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ptestnzc128 = Ext.intrinsic ExtX86.sse41 "ptestnzc"++crc32qi :: Ext.T (LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+crc32qi = Ext.intrinsic ExtX86.sse42 "crc32.32.8"++crc32hi :: Ext.T (LLVM.Value I.Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+crc32hi = Ext.intrinsic ExtX86.sse42 "crc32.32.16"++crc32si :: Ext.T (LLVM.Value I.Int32 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+crc32si = Ext.intrinsic ExtX86.sse42 "crc32.32.32"++crc32di :: Ext.T (LLVM.Value I.Int64 -> LLVM.Value I.Int64 -> LLVM.CodeGenFunction r (LLVM.Value I.Int64))+crc32di = Ext.intrinsic ExtX86.sse42 "crc32.64.64"++pcmpistrm128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V16Int8))+pcmpistrm128 = Ext.intrinsic ExtX86.sse42 "pcmpistrm128"++pcmpistri128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+pcmpistri128 = Ext.intrinsic ExtX86.sse42 "pcmpistri128"++pcmpistria128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+pcmpistria128 = Ext.intrinsic ExtX86.sse42 "pcmpistria128"++pcmpistric128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+pcmpistric128 = Ext.intrinsic ExtX86.sse42 "pcmpistric128"++pcmpistrio128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+pcmpistrio128 = Ext.intrinsic ExtX86.sse42 "pcmpistrio128"++pcmpistris128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+pcmpistris128 = Ext.intrinsic ExtX86.sse42 "pcmpistris128"++pcmpistriz128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+pcmpistriz128 = Ext.intrinsic ExtX86.sse42 "pcmpistriz128"++pcmpestrm128 :: Ext.T (V16Int8 -> LLVM.Value I.Int32 -> V16Int8 -> LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V16Int8))+pcmpestrm128 = Ext.intrinsic ExtX86.sse42 "pcmpestrm128"++pcmpestri128 :: Ext.T (V16Int8 -> LLVM.Value I.Int32 -> V16Int8 -> LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+pcmpestri128 = Ext.intrinsic ExtX86.sse42 "pcmpestri128"++pcmpestria128 :: Ext.T (V16Int8 -> LLVM.Value I.Int32 -> V16Int8 -> LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+pcmpestria128 = Ext.intrinsic ExtX86.sse42 "pcmpestria128"++pcmpestric128 :: Ext.T (V16Int8 -> LLVM.Value I.Int32 -> V16Int8 -> LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+pcmpestric128 = Ext.intrinsic ExtX86.sse42 "pcmpestric128"++pcmpestrio128 :: Ext.T (V16Int8 -> LLVM.Value I.Int32 -> V16Int8 -> LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+pcmpestrio128 = Ext.intrinsic ExtX86.sse42 "pcmpestrio128"++pcmpestris128 :: Ext.T (V16Int8 -> LLVM.Value I.Int32 -> V16Int8 -> LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+pcmpestris128 = Ext.intrinsic ExtX86.sse42 "pcmpestris128"++pcmpestriz128 :: Ext.T (V16Int8 -> LLVM.Value I.Int32 -> V16Int8 -> LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+pcmpestriz128 = Ext.intrinsic ExtX86.sse42 "pcmpestriz128"++addsubpd256 :: Ext.T (V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))+addsubpd256 = Ext.intrinsic ExtX86.avx "addsub.pd.256"++addsubps256 :: Ext.T (V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))+addsubps256 = Ext.intrinsic ExtX86.avx "addsub.ps.256"++maxpd256 :: Ext.T (V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))+maxpd256 = Ext.intrinsic ExtX86.avx "max.pd.256"++maxps256 :: Ext.T (V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))+maxps256 = Ext.intrinsic ExtX86.avx "max.ps.256"++minpd256 :: Ext.T (V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))+minpd256 = Ext.intrinsic ExtX86.avx "min.pd.256"++minps256 :: Ext.T (V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))+minps256 = Ext.intrinsic ExtX86.avx "min.ps.256"++sqrtpd256 :: Ext.T (V4Double -> LLVM.CodeGenFunction r (V4Double))+sqrtpd256 = Ext.intrinsic ExtX86.avx "sqrt.pd.256"++sqrtps256 :: Ext.T (V8Float -> LLVM.CodeGenFunction r (V8Float))+sqrtps256 = Ext.intrinsic ExtX86.avx "sqrt.ps.256"++rsqrtps256 :: Ext.T (V8Float -> LLVM.CodeGenFunction r (V8Float))+rsqrtps256 = Ext.intrinsic ExtX86.avx "rsqrt.ps.256"++rcpps256 :: Ext.T (V8Float -> LLVM.CodeGenFunction r (V8Float))+rcpps256 = Ext.intrinsic ExtX86.avx "rcp.ps.256"++roundpd256 :: Ext.T (V4Double -> LLVM.Value W.Word32 -> LLVM.CodeGenFunction r (V4Double))+roundpd256 = Ext.intrinsic ExtX86.avx "round.pd.256"++roundps256 :: Ext.T (V8Float -> LLVM.Value W.Word32 -> LLVM.CodeGenFunction r (V8Float))+roundps256 = Ext.intrinsic ExtX86.avx "round.ps.256"++haddpd256 :: Ext.T (V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))+haddpd256 = Ext.intrinsic ExtX86.avx "hadd.pd.256"++hsubps256 :: Ext.T (V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))+hsubps256 = Ext.intrinsic ExtX86.avx "hsub.ps.256"++hsubpd256 :: Ext.T (V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))+hsubpd256 = Ext.intrinsic ExtX86.avx "hsub.pd.256"++haddps256 :: Ext.T (V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))+haddps256 = Ext.intrinsic ExtX86.avx "hadd.ps.256"++vpermilvarpd :: Ext.T (V2Double -> V2Int64 -> LLVM.CodeGenFunction r (V2Double))+vpermilvarpd = Ext.intrinsic ExtX86.avx "vpermilvar.pd"++vpermilvarps :: Ext.T (V4Float -> V4Int32 -> LLVM.CodeGenFunction r (V4Float))+vpermilvarps = Ext.intrinsic ExtX86.avx "vpermilvar.ps"++vpermilvarpd256 :: Ext.T (V4Double -> V4Int64 -> LLVM.CodeGenFunction r (V4Double))+vpermilvarpd256 = Ext.intrinsic ExtX86.avx "vpermilvar.pd.256"++vpermilvarps256 :: Ext.T (V8Float -> V8Int32 -> LLVM.CodeGenFunction r (V8Float))+vpermilvarps256 = Ext.intrinsic ExtX86.avx "vpermilvar.ps.256"++vperm2f128_pd256 :: Ext.T (V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))+vperm2f128_pd256 = Ext.intrinsic ExtX86.avx "vperm2f128.pd.256"++vperm2f128_ps256 :: Ext.T (V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))+vperm2f128_ps256 = Ext.intrinsic ExtX86.avx "vperm2f128.ps.256"++vperm2f128_si256 :: Ext.T (V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))+vperm2f128_si256 = Ext.intrinsic ExtX86.avx "vperm2f128.si.256"++blendpd256 :: Ext.T (V4Double -> V4Double -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Double))+blendpd256 = Ext.intrinsic ExtX86.avx "blend.pd.256"++blendps256 :: Ext.T (V8Float -> V8Float -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Float))+blendps256 = Ext.intrinsic ExtX86.avx "blend.ps.256"++blendvpd256 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))+blendvpd256 = Ext.intrinsic ExtX86.avx "blendv.pd.256"++blendvps256 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))+blendvps256 = Ext.intrinsic ExtX86.avx "blendv.ps.256"++dpps256 :: Ext.T (V8Float -> V8Float -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Float))+dpps256 = Ext.intrinsic ExtX86.avx "dp.ps.256"++cmppd256 :: Ext.T (V4Double -> V4Double -> LLVM.Value W.Word8 -> LLVM.CodeGenFunction r (V4Double))+cmppd256 = Ext.intrinsic ExtX86.avx "cmp.pd.256"++cmpps256 :: Ext.T (V8Float -> V8Float -> LLVM.Value W.Word8 -> LLVM.CodeGenFunction r (V8Float))+cmpps256 = Ext.intrinsic ExtX86.avx "cmp.ps.256"++vextractf128_pd256 :: Ext.T (V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))+vextractf128_pd256 = Ext.intrinsic ExtX86.avx "vextractf128.pd.256"++vextractf128_ps256 :: Ext.T (V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))+vextractf128_ps256 = Ext.intrinsic ExtX86.avx "vextractf128.ps.256"++vextractf128_si256 :: Ext.T (V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))+vextractf128_si256 = Ext.intrinsic ExtX86.avx "vextractf128.si.256"++vinsertf128_pd256 :: Ext.T (V4Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))+vinsertf128_pd256 = Ext.intrinsic ExtX86.avx "vinsertf128.pd.256"++vinsertf128_ps256 :: Ext.T (V8Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))+vinsertf128_ps256 = Ext.intrinsic ExtX86.avx "vinsertf128.ps.256"++vinsertf128_si256 :: Ext.T (V8Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))+vinsertf128_si256 = Ext.intrinsic ExtX86.avx "vinsertf128.si.256"++cvtdq2pd256 :: Ext.T (V4Int32 -> LLVM.CodeGenFunction r (V4Double))+cvtdq2pd256 = Ext.intrinsic ExtX86.avx "cvtdq2.pd.256"++cvtdq2ps256 :: Ext.T (V8Int32 -> LLVM.CodeGenFunction r (V8Float))+cvtdq2ps256 = Ext.intrinsic ExtX86.avx "cvtdq2.ps.256"++cvtpd2ps256 :: Ext.T (V4Double -> LLVM.CodeGenFunction r (V4Float))+cvtpd2ps256 = Ext.intrinsic ExtX86.avx "cvt.pd2.ps.256"++cvtps2dq256 :: Ext.T (V8Float -> LLVM.CodeGenFunction r (V8Int32))+cvtps2dq256 = Ext.intrinsic ExtX86.avx "cvt.ps2dq.256"++cvtps2pd256 :: Ext.T (V4Float -> LLVM.CodeGenFunction r (V4Double))+cvtps2pd256 = Ext.intrinsic ExtX86.avx "cvt.ps2.pd.256"++cvttpd2dq256 :: Ext.T (V4Double -> LLVM.CodeGenFunction r (V4Int32))+cvttpd2dq256 = Ext.intrinsic ExtX86.avx "cvtt.pd2dq.256"++cvtpd2dq256 :: Ext.T (V4Double -> LLVM.CodeGenFunction r (V4Int32))+cvtpd2dq256 = Ext.intrinsic ExtX86.avx "cvt.pd2dq.256"++cvttps2dq256 :: Ext.T (V8Float -> LLVM.CodeGenFunction r (V8Int32))+cvttps2dq256 = Ext.intrinsic ExtX86.avx "cvtt.ps2dq.256"++vtestzpd :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+vtestzpd = Ext.intrinsic ExtX86.avx "vtestz.pd"++vtestcpd :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+vtestcpd = Ext.intrinsic ExtX86.avx "vtestc.pd"++vtestnzcpd :: Ext.T (V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+vtestnzcpd = Ext.intrinsic ExtX86.avx "vtestnzc.pd"++vtestzps :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+vtestzps = Ext.intrinsic ExtX86.avx "vtestz.ps"++vtestcps :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+vtestcps = Ext.intrinsic ExtX86.avx "vtestc.ps"++vtestnzcps :: Ext.T (V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+vtestnzcps = Ext.intrinsic ExtX86.avx "vtestnzc.ps"++vtestzpd256 :: Ext.T (V4Double -> V4Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+vtestzpd256 = Ext.intrinsic ExtX86.avx "vtestz.pd.256"++vtestcpd256 :: Ext.T (V4Double -> V4Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+vtestcpd256 = Ext.intrinsic ExtX86.avx "vtestc.pd.256"++vtestnzcpd256 :: Ext.T (V4Double -> V4Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+vtestnzcpd256 = Ext.intrinsic ExtX86.avx "vtestnzc.pd.256"++vtestzps256 :: Ext.T (V8Float -> V8Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+vtestzps256 = Ext.intrinsic ExtX86.avx "vtestz.ps.256"++vtestcps256 :: Ext.T (V8Float -> V8Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+vtestcps256 = Ext.intrinsic ExtX86.avx "vtestc.ps.256"++vtestnzcps256 :: Ext.T (V8Float -> V8Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+vtestnzcps256 = Ext.intrinsic ExtX86.avx "vtestnzc.ps.256"++ptestz256 :: Ext.T (V4Int64 -> V4Int64 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ptestz256 = Ext.intrinsic ExtX86.avx "ptestz.256"++ptestc256 :: Ext.T (V4Int64 -> V4Int64 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ptestc256 = Ext.intrinsic ExtX86.avx "ptestc.256"++ptestnzc256 :: Ext.T (V4Int64 -> V4Int64 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+ptestnzc256 = Ext.intrinsic ExtX86.avx "ptestnzc.256"++movmskpd256 :: Ext.T (V4Double -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+movmskpd256 = Ext.intrinsic ExtX86.avx "movmsk.pd.256"++movmskps256 :: Ext.T (V8Float -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+movmskps256 = Ext.intrinsic ExtX86.avx "movmsk.ps.256"++vzeroall :: Ext.T (LLVM.CodeGenFunction r (LLVM.Value ()))+vzeroall = Ext.intrinsic ExtX86.avx "vzeroall"++vzeroupper :: Ext.T (LLVM.CodeGenFunction r (LLVM.Value ()))+vzeroupper = Ext.intrinsic ExtX86.avx "vzeroupper"++vbroadcastss :: Ext.T (LLVM.Value (Ptr ()) -> LLVM.CodeGenFunction r (V4Float))+vbroadcastss = Ext.intrinsic ExtX86.avx "vbroadcast.ss"++vbroadcastsd256 :: Ext.T (LLVM.Value (Ptr ()) -> LLVM.CodeGenFunction r (V4Double))+vbroadcastsd256 = Ext.intrinsic ExtX86.avx "vbroadcast.sd.256"++vbroadcastss256 :: Ext.T (LLVM.Value (Ptr ()) -> LLVM.CodeGenFunction r (V8Float))+vbroadcastss256 = Ext.intrinsic ExtX86.avx "vbroadcast.ss.256"++vbroadcastf128_pd256 :: Ext.T (LLVM.Value (Ptr ()) -> LLVM.CodeGenFunction r (V4Double))+vbroadcastf128_pd256 = Ext.intrinsic ExtX86.avx "vbroadcastf128.pd.256"++vbroadcastf128_ps256 :: Ext.T (LLVM.Value (Ptr ()) -> LLVM.CodeGenFunction r (V8Float))+vbroadcastf128_ps256 = Ext.intrinsic ExtX86.avx "vbroadcastf128.ps.256"++lddqu256 :: Ext.T (LLVM.Value (Ptr ()) -> LLVM.CodeGenFunction r (V32Int8))+lddqu256 = Ext.intrinsic ExtX86.avx "ldu.dq.256"++storeupd256 :: Ext.T (LLVM.Value (Ptr ()) -> V4Double -> LLVM.CodeGenFunction r (LLVM.Value ()))+storeupd256 = Ext.intrinsic ExtX86.avx "storeu.pd.256"++storeups256 :: Ext.T (LLVM.Value (Ptr ()) -> V8Float -> LLVM.CodeGenFunction r (LLVM.Value ()))+storeups256 = Ext.intrinsic ExtX86.avx "storeu.ps.256"++storedqu256 :: Ext.T (LLVM.Value (Ptr ()) -> V32Int8 -> LLVM.CodeGenFunction r (LLVM.Value ()))+storedqu256 = Ext.intrinsic ExtX86.avx "storeu.dq.256"++movntdq256 :: Ext.T (LLVM.Value (Ptr ()) -> V4Int64 -> LLVM.CodeGenFunction r (LLVM.Value ()))+movntdq256 = Ext.intrinsic ExtX86.avx "movnt.dq.256"++movntpd256 :: Ext.T (LLVM.Value (Ptr ()) -> V4Double -> LLVM.CodeGenFunction r (LLVM.Value ()))+movntpd256 = Ext.intrinsic ExtX86.avx "movnt.pd.256"++movntps256 :: Ext.T (LLVM.Value (Ptr ()) -> V8Float -> LLVM.CodeGenFunction r (LLVM.Value ()))+movntps256 = Ext.intrinsic ExtX86.avx "movnt.ps.256"++maskloadpd :: Ext.T (LLVM.Value (Ptr ()) -> V2Double -> LLVM.CodeGenFunction r (V2Double))+maskloadpd = Ext.intrinsic ExtX86.avx "maskload.pd"++maskloadps :: Ext.T (LLVM.Value (Ptr ()) -> V4Float -> LLVM.CodeGenFunction r (V4Float))+maskloadps = Ext.intrinsic ExtX86.avx "maskload.ps"++maskloadpd256 :: Ext.T (LLVM.Value (Ptr ()) -> V4Double -> LLVM.CodeGenFunction r (V4Double))+maskloadpd256 = Ext.intrinsic ExtX86.avx "maskload.pd.256"++maskloadps256 :: Ext.T (LLVM.Value (Ptr ()) -> V8Float -> LLVM.CodeGenFunction r (V8Float))+maskloadps256 = Ext.intrinsic ExtX86.avx "maskload.ps.256"++maskstorepd :: Ext.T (LLVM.Value (Ptr ()) -> V2Double -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value ()))+maskstorepd = Ext.intrinsic ExtX86.avx "maskstore.pd"++maskstoreps :: Ext.T (LLVM.Value (Ptr ()) -> V4Float -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value ()))+maskstoreps = Ext.intrinsic ExtX86.avx "maskstore.ps"++maskstorepd256 :: Ext.T (LLVM.Value (Ptr ()) -> V4Double -> V4Double -> LLVM.CodeGenFunction r (LLVM.Value ()))+maskstorepd256 = Ext.intrinsic ExtX86.avx "maskstore.pd.256"++maskstoreps256 :: Ext.T (LLVM.Value (Ptr ()) -> V8Float -> V8Float -> LLVM.CodeGenFunction r (LLVM.Value ()))+maskstoreps256 = Ext.intrinsic ExtX86.avx "maskstore.ps.256"++paddsb256 :: Ext.T (V32Int8 -> V32Int8 -> LLVM.CodeGenFunction r (V32Int8))+paddsb256 = Ext.intrinsic ExtX86.avx2 "padds.b"++paddsw256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.CodeGenFunction r (V16Int16))+paddsw256 = Ext.intrinsic ExtX86.avx2 "padds.w"++paddusb256 :: Ext.T (V32Word8 -> V32Word8 -> LLVM.CodeGenFunction r (V32Word8))+paddusb256 = Ext.intrinsic ExtX86.avx2 "paddus.b"++paddusw256 :: Ext.T (V16Word16 -> V16Word16 -> LLVM.CodeGenFunction r (V16Word16))+paddusw256 = Ext.intrinsic ExtX86.avx2 "paddus.w"++psubsb256 :: Ext.T (V32Int8 -> V32Int8 -> LLVM.CodeGenFunction r (V32Int8))+psubsb256 = Ext.intrinsic ExtX86.avx2 "psubs.b"++psubsw256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.CodeGenFunction r (V16Int16))+psubsw256 = Ext.intrinsic ExtX86.avx2 "psubs.w"++psubusb256 :: Ext.T (V32Word8 -> V32Word8 -> LLVM.CodeGenFunction r (V32Word8))+psubusb256 = Ext.intrinsic ExtX86.avx2 "psubus.b"++psubusw256 :: Ext.T (V16Word16 -> V16Word16 -> LLVM.CodeGenFunction r (V16Word16))+psubusw256 = Ext.intrinsic ExtX86.avx2 "psubus.w"++pmulhuw256 :: Ext.T (V16Word16 -> V16Word16 -> LLVM.CodeGenFunction r (V16Word16))+pmulhuw256 = Ext.intrinsic ExtX86.avx2 "pmulhu.w"++pmulhw256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.CodeGenFunction r (V16Int16))+pmulhw256 = Ext.intrinsic ExtX86.avx2 "pmulh.w"++pmuludq256 :: Ext.T (V8Word32 -> V8Word32 -> LLVM.CodeGenFunction r (V4Word64))+pmuludq256 = Ext.intrinsic ExtX86.avx2 "pmulu.dq"++pmuldq256 :: Ext.T (V8Int32 -> V8Int32 -> LLVM.CodeGenFunction r (V4Int64))+pmuldq256 = Ext.intrinsic ExtX86.avx2 "pmul.dq"++pmaddwd256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.CodeGenFunction r (V8Int32))+pmaddwd256 = Ext.intrinsic ExtX86.avx2 "pmadd.wd"++pavgb256 :: Ext.T (V32Int8 -> V32Int8 -> LLVM.CodeGenFunction r (V32Int8))+pavgb256 = Ext.intrinsic ExtX86.avx2 "pavg.b"++pavgw256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.CodeGenFunction r (V16Int16))+pavgw256 = Ext.intrinsic ExtX86.avx2 "pavg.w"++psadbw256 :: Ext.T (V32Int8 -> V32Int8 -> LLVM.CodeGenFunction r (V4Int64))+psadbw256 = Ext.intrinsic ExtX86.avx2 "psad.bw"++pmaxub256 :: Ext.T (V32Word8 -> V32Word8 -> LLVM.CodeGenFunction r (V32Word8))+pmaxub256 = Ext.intrinsic ExtX86.avx2 "pmaxu.b"++pmaxuw256 :: Ext.T (V16Word16 -> V16Word16 -> LLVM.CodeGenFunction r (V16Word16))+pmaxuw256 = Ext.intrinsic ExtX86.avx2 "pmaxu.w"++pmaxud256 :: Ext.T (V8Word32 -> V8Word32 -> LLVM.CodeGenFunction r (V8Word32))+pmaxud256 = Ext.intrinsic ExtX86.avx2 "pmaxu.d"++pmaxsb256 :: Ext.T (V32Int8 -> V32Int8 -> LLVM.CodeGenFunction r (V32Int8))+pmaxsb256 = Ext.intrinsic ExtX86.avx2 "pmaxs.b"++pmaxsw256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.CodeGenFunction r (V16Int16))+pmaxsw256 = Ext.intrinsic ExtX86.avx2 "pmaxs.w"++pmaxsd256 :: Ext.T (V8Int32 -> V8Int32 -> LLVM.CodeGenFunction r (V8Int32))+pmaxsd256 = Ext.intrinsic ExtX86.avx2 "pmaxs.d"++pminub256 :: Ext.T (V32Word8 -> V32Word8 -> LLVM.CodeGenFunction r (V32Word8))+pminub256 = Ext.intrinsic ExtX86.avx2 "pminu.b"++pminuw256 :: Ext.T (V16Word16 -> V16Word16 -> LLVM.CodeGenFunction r (V16Word16))+pminuw256 = Ext.intrinsic ExtX86.avx2 "pminu.w"++pminud256 :: Ext.T (V8Word32 -> V8Word32 -> LLVM.CodeGenFunction r (V8Word32))+pminud256 = Ext.intrinsic ExtX86.avx2 "pminu.d"++pminsb256 :: Ext.T (V32Int8 -> V32Int8 -> LLVM.CodeGenFunction r (V32Int8))+pminsb256 = Ext.intrinsic ExtX86.avx2 "pmins.b"++pminsw256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.CodeGenFunction r (V16Int16))+pminsw256 = Ext.intrinsic ExtX86.avx2 "pmins.w"++pminsd256 :: Ext.T (V8Int32 -> V8Int32 -> LLVM.CodeGenFunction r (V8Int32))+pminsd256 = Ext.intrinsic ExtX86.avx2 "pmins.d"++psllw256 :: Ext.T (V16Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V16Int16))+psllw256 = Ext.intrinsic ExtX86.avx2 "psll.w"++pslld256 :: Ext.T (V8Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V8Int32))+pslld256 = Ext.intrinsic ExtX86.avx2 "psll.d"++psllq256 :: Ext.T (V4Int64 -> V2Int64 -> LLVM.CodeGenFunction r (V4Int64))+psllq256 = Ext.intrinsic ExtX86.avx2 "psll.q"++psrlw256 :: Ext.T (V16Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V16Int16))+psrlw256 = Ext.intrinsic ExtX86.avx2 "psrl.w"++psrld256 :: Ext.T (V8Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V8Int32))+psrld256 = Ext.intrinsic ExtX86.avx2 "psrl.d"++psrlq256 :: Ext.T (V4Int64 -> V2Int64 -> LLVM.CodeGenFunction r (V4Int64))+psrlq256 = Ext.intrinsic ExtX86.avx2 "psrl.q"++psraw256 :: Ext.T (V16Int16 -> V8Int16 -> LLVM.CodeGenFunction r (V16Int16))+psraw256 = Ext.intrinsic ExtX86.avx2 "psra.w"++psrad256 :: Ext.T (V8Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V8Int32))+psrad256 = Ext.intrinsic ExtX86.avx2 "psra.d"++psllwi256 :: Ext.T (V16Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Int16))+psllwi256 = Ext.intrinsic ExtX86.avx2 "pslli.w"++pslldi256 :: Ext.T (V8Int32 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Int32))+pslldi256 = Ext.intrinsic ExtX86.avx2 "pslli.d"++psllqi256 :: Ext.T (V4Int64 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Int64))+psllqi256 = Ext.intrinsic ExtX86.avx2 "pslli.q"++psrlwi256 :: Ext.T (V16Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Int16))+psrlwi256 = Ext.intrinsic ExtX86.avx2 "psrli.w"++psrldi256 :: Ext.T (V8Int32 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Int32))+psrldi256 = Ext.intrinsic ExtX86.avx2 "psrli.d"++psrlqi256 :: Ext.T (V4Int64 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Int64))+psrlqi256 = Ext.intrinsic ExtX86.avx2 "psrli.q"++psrawi256 :: Ext.T (V16Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Int16))+psrawi256 = Ext.intrinsic ExtX86.avx2 "psrai.w"++psradi256 :: Ext.T (V8Int32 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Int32))+psradi256 = Ext.intrinsic ExtX86.avx2 "psrai.d"++pslldqi256 :: Ext.T (V4Int64 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Int64))+pslldqi256 = Ext.intrinsic ExtX86.avx2 "psll.dq"++psrldqi256 :: Ext.T (V4Int64 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Int64))+psrldqi256 = Ext.intrinsic ExtX86.avx2 "psrl.dq"++pslldqi256_byteshift :: Ext.T (V4Int64 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Int64))+pslldqi256_byteshift = Ext.intrinsic ExtX86.avx2 "psll.dq.bs"++psrldqi256_byteshift :: Ext.T (V4Int64 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Int64))+psrldqi256_byteshift = Ext.intrinsic ExtX86.avx2 "psrl.dq.bs"++packsswb256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.CodeGenFunction r (V32Int8))+packsswb256 = Ext.intrinsic ExtX86.avx2 "packsswb"++packssdw256 :: Ext.T (V8Int32 -> V8Int32 -> LLVM.CodeGenFunction r (V16Int16))+packssdw256 = Ext.intrinsic ExtX86.avx2 "packssdw"++packuswb256 :: Ext.T (V16Word16 -> V16Word16 -> LLVM.CodeGenFunction r (V32Word8))+packuswb256 = Ext.intrinsic ExtX86.avx2 "packuswb"++packusdw256 :: Ext.T (V8Word32 -> V8Word32 -> LLVM.CodeGenFunction r (V16Word16))+packusdw256 = Ext.intrinsic ExtX86.avx2 "packusdw"++pabsb256 :: Ext.T (V32Int8 -> LLVM.CodeGenFunction r (V32Int8))+pabsb256 = Ext.intrinsic ExtX86.avx2 "pabs.b"++pabsw256 :: Ext.T (V16Int16 -> LLVM.CodeGenFunction r (V16Int16))+pabsw256 = Ext.intrinsic ExtX86.avx2 "pabs.w"++pabsd256 :: Ext.T (V8Int32 -> LLVM.CodeGenFunction r (V8Int32))+pabsd256 = Ext.intrinsic ExtX86.avx2 "pabs.d"++phaddw256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.CodeGenFunction r (V16Int16))+phaddw256 = Ext.intrinsic ExtX86.avx2 "phadd.w"++phaddd256 :: Ext.T (V8Int32 -> V8Int32 -> LLVM.CodeGenFunction r (V8Int32))+phaddd256 = Ext.intrinsic ExtX86.avx2 "phadd.d"++phaddsw256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.CodeGenFunction r (V16Int16))+phaddsw256 = Ext.intrinsic ExtX86.avx2 "phadd.sw"++phsubw256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.CodeGenFunction r (V16Int16))+phsubw256 = Ext.intrinsic ExtX86.avx2 "phsub.w"++phsubd256 :: Ext.T (V8Int32 -> V8Int32 -> LLVM.CodeGenFunction r (V8Int32))+phsubd256 = Ext.intrinsic ExtX86.avx2 "phsub.d"++phsubsw256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.CodeGenFunction r (V16Int16))+phsubsw256 = Ext.intrinsic ExtX86.avx2 "phsub.sw"++pmaddubsw256 :: Ext.T (V32Word8 -> V32Word8 -> LLVM.CodeGenFunction r (V16Word16))+pmaddubsw256 = Ext.intrinsic ExtX86.avx2 "pmadd.ub.sw"++psignb256 :: Ext.T (V32Int8 -> V32Int8 -> LLVM.CodeGenFunction r (V32Int8))+psignb256 = Ext.intrinsic ExtX86.avx2 "psign.b"++psignw256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.CodeGenFunction r (V16Int16))+psignw256 = Ext.intrinsic ExtX86.avx2 "psign.w"++psignd256 :: Ext.T (V8Int32 -> V8Int32 -> LLVM.CodeGenFunction r (V8Int32))+psignd256 = Ext.intrinsic ExtX86.avx2 "psign.d"++pmulhrsw256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.CodeGenFunction r (V16Int16))+pmulhrsw256 = Ext.intrinsic ExtX86.avx2 "pmul.hr.sw"++pmovsxbd256 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V8Int32))+pmovsxbd256 = Ext.intrinsic ExtX86.avx2 "pmovsxbd"++pmovsxbq256 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V4Int64))+pmovsxbq256 = Ext.intrinsic ExtX86.avx2 "pmovsxbq"++pmovsxbw256 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V16Int16))+pmovsxbw256 = Ext.intrinsic ExtX86.avx2 "pmovsxbw"++pmovsxdq256 :: Ext.T (V4Int32 -> LLVM.CodeGenFunction r (V4Int64))+pmovsxdq256 = Ext.intrinsic ExtX86.avx2 "pmovsxdq"++pmovsxwd256 :: Ext.T (V8Int16 -> LLVM.CodeGenFunction r (V8Int32))+pmovsxwd256 = Ext.intrinsic ExtX86.avx2 "pmovsxwd"++pmovsxwq256 :: Ext.T (V8Int16 -> LLVM.CodeGenFunction r (V4Int64))+pmovsxwq256 = Ext.intrinsic ExtX86.avx2 "pmovsxwq"++pmovzxbd256 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V8Int32))+pmovzxbd256 = Ext.intrinsic ExtX86.avx2 "pmovzxbd"++pmovzxbq256 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V4Int64))+pmovzxbq256 = Ext.intrinsic ExtX86.avx2 "pmovzxbq"++pmovzxbw256 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V16Int16))+pmovzxbw256 = Ext.intrinsic ExtX86.avx2 "pmovzxbw"++pmovzxdq256 :: Ext.T (V4Int32 -> LLVM.CodeGenFunction r (V4Int64))+pmovzxdq256 = Ext.intrinsic ExtX86.avx2 "pmovzxdq"++pmovzxwd256 :: Ext.T (V8Int16 -> LLVM.CodeGenFunction r (V8Int32))+pmovzxwd256 = Ext.intrinsic ExtX86.avx2 "pmovzxwd"++pmovzxwq256 :: Ext.T (V8Int16 -> LLVM.CodeGenFunction r (V4Int64))+pmovzxwq256 = Ext.intrinsic ExtX86.avx2 "pmovzxwq"++pblendvb256 :: Ext.T (V32Int8 -> V32Int8 -> V32Int8 -> LLVM.CodeGenFunction r (V32Int8))+pblendvb256 = Ext.intrinsic ExtX86.avx2 "pblendvb"++pblendw256 :: Ext.T (V16Int16 -> V16Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Int16))+pblendw256 = Ext.intrinsic ExtX86.avx2 "pblendw"++pblendd128 :: Ext.T (V4Int32 -> V4Int32 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V4Int32))+pblendd128 = Ext.intrinsic ExtX86.avx2 "pblendd.128"++pblendd256 :: Ext.T (V8Int32 -> V8Int32 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Int32))+pblendd256 = Ext.intrinsic ExtX86.avx2 "pblendd.256"++vbroadcastss_ps :: Ext.T (V4Float -> LLVM.CodeGenFunction r (V4Float))+vbroadcastss_ps = Ext.intrinsic ExtX86.avx2 "vbroadcast.ss.ps"++vbroadcastsd_pd256 :: Ext.T (V2Double -> LLVM.CodeGenFunction r (V4Double))+vbroadcastsd_pd256 = Ext.intrinsic ExtX86.avx2 "vbroadcast.sd.pd.256"++vbroadcastss_ps256 :: Ext.T (V4Float -> LLVM.CodeGenFunction r (V8Float))+vbroadcastss_ps256 = Ext.intrinsic ExtX86.avx2 "vbroadcast.ss.ps.256"++vbroadcastsi256 :: Ext.T (LLVM.Value (Ptr ()) -> LLVM.CodeGenFunction r (V4Int64))+vbroadcastsi256 = Ext.intrinsic ExtX86.avx2 "vbroadcasti128"++pbroadcastb128 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V16Int8))+pbroadcastb128 = Ext.intrinsic ExtX86.avx2 "pbroadcastb.128"++pbroadcastb256 :: Ext.T (V16Int8 -> LLVM.CodeGenFunction r (V32Int8))+pbroadcastb256 = Ext.intrinsic ExtX86.avx2 "pbroadcastb.256"++pbroadcastw128 :: Ext.T (V8Int16 -> LLVM.CodeGenFunction r (V8Int16))+pbroadcastw128 = Ext.intrinsic ExtX86.avx2 "pbroadcastw.128"++pbroadcastw256 :: Ext.T (V8Int16 -> LLVM.CodeGenFunction r (V16Int16))+pbroadcastw256 = Ext.intrinsic ExtX86.avx2 "pbroadcastw.256"++pbroadcastd128 :: Ext.T (V4Int32 -> LLVM.CodeGenFunction r (V4Int32))+pbroadcastd128 = Ext.intrinsic ExtX86.avx2 "pbroadcastd.128"++pbroadcastd256 :: Ext.T (V4Int32 -> LLVM.CodeGenFunction r (V8Int32))+pbroadcastd256 = Ext.intrinsic ExtX86.avx2 "pbroadcastd.256"++pbroadcastq128 :: Ext.T (V2Int64 -> LLVM.CodeGenFunction r (V2Int64))+pbroadcastq128 = Ext.intrinsic ExtX86.avx2 "pbroadcastq.128"++pbroadcastq256 :: Ext.T (V2Int64 -> LLVM.CodeGenFunction r (V4Int64))+pbroadcastq256 = Ext.intrinsic ExtX86.avx2 "pbroadcastq.256"++permvarsi256 :: Ext.T (V8Int32 -> V8Int32 -> LLVM.CodeGenFunction r (V8Int32))+permvarsi256 = Ext.intrinsic ExtX86.avx2 "permd"++permvarsf256 :: Ext.T (V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))+permvarsf256 = Ext.intrinsic ExtX86.avx2 "permps"++permti256 :: Ext.T (V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))+permti256 = Ext.intrinsic ExtX86.avx2 "vperm2i128"++extract128i256 :: Ext.T (V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))+extract128i256 = Ext.intrinsic ExtX86.avx2 "vextracti128"++insert128i256 :: Ext.T (V4Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))+insert128i256 = Ext.intrinsic ExtX86.avx2 "vinserti128"++maskloadd :: Ext.T (LLVM.Value (Ptr ()) -> V4Int32 -> LLVM.CodeGenFunction r (V4Int32))+maskloadd = Ext.intrinsic ExtX86.avx2 "maskload.d"++maskloadq :: Ext.T (LLVM.Value (Ptr ()) -> V2Int64 -> LLVM.CodeGenFunction r (V2Int64))+maskloadq = Ext.intrinsic ExtX86.avx2 "maskload.q"++maskloadd256 :: Ext.T (LLVM.Value (Ptr ()) -> V8Int32 -> LLVM.CodeGenFunction r (V8Int32))+maskloadd256 = Ext.intrinsic ExtX86.avx2 "maskload.d.256"++maskloadq256 :: Ext.T (LLVM.Value (Ptr ()) -> V4Int64 -> LLVM.CodeGenFunction r (V4Int64))+maskloadq256 = Ext.intrinsic ExtX86.avx2 "maskload.q.256"++maskstored :: Ext.T (LLVM.Value (Ptr ()) -> V4Int32 -> V4Int32 -> LLVM.CodeGenFunction r (LLVM.Value ()))+maskstored = Ext.intrinsic ExtX86.avx2 "maskstore.d"++maskstoreq :: Ext.T (LLVM.Value (Ptr ()) -> V2Int64 -> V2Int64 -> LLVM.CodeGenFunction r (LLVM.Value ()))+maskstoreq = Ext.intrinsic ExtX86.avx2 "maskstore.q"++maskstored256 :: Ext.T (LLVM.Value (Ptr ()) -> V8Int32 -> V8Int32 -> LLVM.CodeGenFunction r (LLVM.Value ()))+maskstored256 = Ext.intrinsic ExtX86.avx2 "maskstore.d.256"++maskstoreq256 :: Ext.T (LLVM.Value (Ptr ()) -> V4Int64 -> V4Int64 -> LLVM.CodeGenFunction r (LLVM.Value ()))+maskstoreq256 = Ext.intrinsic ExtX86.avx2 "maskstore.q.256"++psllv4si :: Ext.T (V4Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V4Int32))+psllv4si = Ext.intrinsic ExtX86.avx2 "psllv.d"++psllv8si :: Ext.T (V8Int32 -> V8Int32 -> LLVM.CodeGenFunction r (V8Int32))+psllv8si = Ext.intrinsic ExtX86.avx2 "psllv.d.256"++psllv2di :: Ext.T (V2Int64 -> V2Int64 -> LLVM.CodeGenFunction r (V2Int64))+psllv2di = Ext.intrinsic ExtX86.avx2 "psllv.q"++psllv4di :: Ext.T (V4Int64 -> V4Int64 -> LLVM.CodeGenFunction r (V4Int64))+psllv4di = Ext.intrinsic ExtX86.avx2 "psllv.q.256"++psrlv4si :: Ext.T (V4Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V4Int32))+psrlv4si = Ext.intrinsic ExtX86.avx2 "psrlv.d"++psrlv8si :: Ext.T (V8Int32 -> V8Int32 -> LLVM.CodeGenFunction r (V8Int32))+psrlv8si = Ext.intrinsic ExtX86.avx2 "psrlv.d.256"++psrlv2di :: Ext.T (V2Int64 -> V2Int64 -> LLVM.CodeGenFunction r (V2Int64))+psrlv2di = Ext.intrinsic ExtX86.avx2 "psrlv.q"++psrlv4di :: Ext.T (V4Int64 -> V4Int64 -> LLVM.CodeGenFunction r (V4Int64))+psrlv4di = Ext.intrinsic ExtX86.avx2 "psrlv.q.256"++psrav4si :: Ext.T (V4Int32 -> V4Int32 -> LLVM.CodeGenFunction r (V4Int32))+psrav4si = Ext.intrinsic ExtX86.avx2 "psrav.d"++psrav8si :: Ext.T (V8Int32 -> V8Int32 -> LLVM.CodeGenFunction r (V8Int32))+psrav8si = Ext.intrinsic ExtX86.avx2 "psrav.d.256"++pmovmskb256 :: Ext.T (V32Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int32))+pmovmskb256 = Ext.intrinsic ExtX86.avx2 "pmovmskb"++pshufb256 :: Ext.T (V32Int8 -> V32Int8 -> LLVM.CodeGenFunction r (V32Int8))+pshufb256 = Ext.intrinsic ExtX86.avx2 "pshuf.b"++mpsadbw256 :: Ext.T (V32Int8 -> V32Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Int16))+mpsadbw256 = Ext.intrinsic ExtX86.avx2 "mpsadbw"++movntdqa256 :: Ext.T (LLVM.Value (Ptr ()) -> LLVM.CodeGenFunction r (V4Int64))+movntdqa256 = Ext.intrinsic ExtX86.avx2 "movntdqa"++vfmaddss :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+vfmaddss = Ext.intrinsic ExtX86.fma4 "vfmadd.ss"++vfmaddsd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+vfmaddsd = Ext.intrinsic ExtX86.fma4 "vfmadd.sd"++vfmaddps :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+vfmaddps = Ext.intrinsic ExtX86.fma4 "vfmadd.ps"++vfmaddpd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+vfmaddpd = Ext.intrinsic ExtX86.fma4 "vfmadd.pd"++vfmaddps256 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))+vfmaddps256 = Ext.intrinsic ExtX86.fma4 "vfmadd.ps.256"++vfmaddpd256 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))+vfmaddpd256 = Ext.intrinsic ExtX86.fma4 "vfmadd.pd.256"++vfmsubss :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+vfmsubss = Ext.intrinsic ExtX86.fma4 "vfmsub.ss"++vfmsubsd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+vfmsubsd = Ext.intrinsic ExtX86.fma4 "vfmsub.sd"++vfmsubps :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+vfmsubps = Ext.intrinsic ExtX86.fma4 "vfmsub.ps"++vfmsubpd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+vfmsubpd = Ext.intrinsic ExtX86.fma4 "vfmsub.pd"++vfmsubps256 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))+vfmsubps256 = Ext.intrinsic ExtX86.fma4 "vfmsub.ps.256"++vfmsubpd256 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))+vfmsubpd256 = Ext.intrinsic ExtX86.fma4 "vfmsub.pd.256"++vfnmaddss :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+vfnmaddss = Ext.intrinsic ExtX86.fma4 "vfnmadd.ss"++vfnmaddsd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+vfnmaddsd = Ext.intrinsic ExtX86.fma4 "vfnmadd.sd"++vfnmaddps :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+vfnmaddps = Ext.intrinsic ExtX86.fma4 "vfnmadd.ps"++vfnmaddpd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+vfnmaddpd = Ext.intrinsic ExtX86.fma4 "vfnmadd.pd"++vfnmaddps256 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))+vfnmaddps256 = Ext.intrinsic ExtX86.fma4 "vfnmadd.ps.256"++vfnmaddpd256 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))+vfnmaddpd256 = Ext.intrinsic ExtX86.fma4 "vfnmadd.pd.256"++vfnmsubss :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+vfnmsubss = Ext.intrinsic ExtX86.fma4 "vfnmsub.ss"++vfnmsubsd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+vfnmsubsd = Ext.intrinsic ExtX86.fma4 "vfnmsub.sd"++vfnmsubps :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+vfnmsubps = Ext.intrinsic ExtX86.fma4 "vfnmsub.ps"++vfnmsubpd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+vfnmsubpd = Ext.intrinsic ExtX86.fma4 "vfnmsub.pd"++vfnmsubps256 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))+vfnmsubps256 = Ext.intrinsic ExtX86.fma4 "vfnmsub.ps.256"++vfnmsubpd256 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))+vfnmsubpd256 = Ext.intrinsic ExtX86.fma4 "vfnmsub.pd.256"++vfmaddsubps :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+vfmaddsubps = Ext.intrinsic ExtX86.fma4 "vfmaddsub.ps"++vfmaddsubpd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+vfmaddsubpd = Ext.intrinsic ExtX86.fma4 "vfmaddsub.pd"++vfmaddsubps256 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))+vfmaddsubps256 = Ext.intrinsic ExtX86.fma4 "vfmaddsub.ps.256"++vfmaddsubpd256 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))+vfmaddsubpd256 = Ext.intrinsic ExtX86.fma4 "vfmaddsub.pd.256"++vfmsubaddps :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))+vfmsubaddps = Ext.intrinsic ExtX86.fma4 "vfmsubadd.ps"++vfmsubaddpd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))+vfmsubaddpd = Ext.intrinsic ExtX86.fma4 "vfmsubadd.pd"++vfmsubaddps256 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))+vfmsubaddps256 = Ext.intrinsic ExtX86.fma4 "vfmsubadd.ps.256"++vfmsubaddpd256 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))+vfmsubaddpd256 = Ext.intrinsic ExtX86.fma4 "vfmsubadd.pd.256"+
src/LLVM/Extra/ForeignPtr.hs view
@@ -1,11 +1,12 @@ {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE FlexibleContexts #-} module LLVM.Extra.ForeignPtr (    newInit, newParam,    new, with,    ) where  import qualified LLVM.Extra.Memory as Memory-import LLVM.Extra.Class (MakeValueTuple, )+import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )  import qualified Foreign.Marshal.Utils as Marshal import qualified Foreign.ForeignPtr as FPtr@@ -36,9 +37,9 @@ Instead we must add a Finalizer to the ForeignPtr. -} newParam ::-   (Storable b, MakeValueTuple b bl, Memory.C bl bp) =>+   (Storable b, MakeValueTuple b, Memory.C (ValueTuple b)) =>    FunPtr (Ptr a -> IO ()) ->-   FunPtr (Ptr bp -> IO (Ptr a)) ->+   FunPtr (Ptr (Memory.Struct (ValueTuple b)) -> IO (Ptr a)) ->    b -> IO (FPtr.ForeignPtr a) newParam stop start b =    FPtr.newForeignPtr stop =<<@@ -78,7 +79,7 @@    return ptr  with ::-   (Storable a, MakeValueTuple a al, Memory.C al ap) =>-   FPtr.ForeignPtr a -> (Ptr ap -> IO b) -> IO b+   (Storable a, MakeValueTuple a, Memory.C (ValueTuple a)) =>+   FPtr.ForeignPtr a -> (Ptr (Memory.Struct (ValueTuple a)) -> IO b) -> IO b with fp func =    FPtr.withForeignPtr fp (func . Memory.castStorablePtr)
src/LLVM/Extra/MaybeContinuation.hs view
@@ -1,7 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-} {- | Maybe datatype implemented in continuation passing style. -}@@ -119,7 +116,7 @@ -} arrayLoop ::    (Phi s, Undefined s, IsType a,-    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i Bool) =>+    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i, CmpResult i ~ Bool) =>    Value i ->    Value (Ptr a) -> s ->    (Value (Ptr a) -> s -> T r (Value Bool, s) s) ->@@ -130,7 +127,7 @@  arrayLoop2 ::    (Phi s, Undefined s, IsType a, IsType b,-    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i Bool) =>+    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i, CmpResult i ~ Bool) =>    Value i ->    Value (Ptr a) -> Value (Ptr b) -> s ->    (Value (Ptr a) -> Value (Ptr b) -> s ->@@ -146,7 +143,7 @@  fixedLengthLoop ::    (Phi s, Undefined s,-    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i Bool) =>+    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i, CmpResult i ~ Bool) =>    Value i -> s ->    (s -> T r (Value Bool, (Value i, s)) s) ->    CodeGenFunction r (Value i, s)
src/LLVM/Extra/Memory.hs view
@@ -1,32 +1,33 @@+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} module LLVM.Extra.Memory (    C(load, store, decompose, compose), modify, castStorablePtr,+   Struct,    Record, Element, element,    loadRecord, storeRecord, decomposeRecord, composeRecord,    loadNewtype, storeNewtype, decomposeNewtype, composeNewtype,-   FirstClass,+   FirstClass, Stored,    ) where -import LLVM.Extra.Class (MakeValueTuple, Undefined, )+import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, ) import qualified LLVM.Extra.ArithmeticPrivate as A import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.Array as Array  import qualified LLVM.Core as LLVM import LLVM.Core-   (Struct, getElementPtr0,+   (getElementPtr0,     extractvalue, insertvalue,     Value, -- valueOf, Vector,     IsType, IsSized,     CodeGenFunction, ) import LLVM.Util.Loop (Phi, ) -import qualified Data.TypeLevel.Num as TypeNum-import Data.TypeLevel.Num (d0, d1, d2, )+import qualified Types.Data.Num as TypeNum+import Types.Data.Num (d0, d1, d2, )  import Foreign.StablePtr (StablePtr, ) import Foreign.Ptr (Ptr, castPtr, )@@ -43,26 +44,28 @@  {- | An implementation of both 'MakeValueTuple' and 'Memory.C'-must ensure that @haskellValue@ is compatible with @llvmStruct@.+must ensure that @haskellValue@ is compatible+with @Stored (Struct haskellValue)@ (which we want to call @llvmStruct@). That is, writing and reading @llvmStruct@ by LLVM must be the same as accessing @haskellValue@ by 'Storable' methods.-ToDo: In future we may also require Storable constraint for llvmStruct.+ToDo: In future we may also require Storable constraint for @llvmStruct@.  We use a functional dependency in order to let type inference work nicely. -}-class (Phi llvmValue, Undefined llvmValue, IsType llvmStruct) =>-      C llvmValue llvmStruct | llvmValue -> llvmStruct where-   load :: Value (Ptr llvmStruct) -> CodeGenFunction r llvmValue+class (Phi llvmValue, Undefined llvmValue, IsType (Struct llvmValue), IsSized (Struct llvmValue)) =>+      C llvmValue where+   type Struct llvmValue :: *+   load :: Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue    load ptr  =  decompose =<< LLVM.load ptr-   store :: llvmValue -> Value (Ptr llvmStruct) -> CodeGenFunction r ()+   store :: llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()    store r ptr  =  flip LLVM.store ptr =<< compose r-   decompose :: Value llvmStruct -> CodeGenFunction r llvmValue-   compose :: llvmValue -> CodeGenFunction r (Value llvmStruct)+   decompose :: Value (Struct llvmValue) -> CodeGenFunction r llvmValue+   compose :: llvmValue -> CodeGenFunction r (Value (Struct llvmValue))  modify ::-   (C llvmValue llvmStruct) =>+   (C llvmValue) =>    (llvmValue -> CodeGenFunction r llvmValue) ->-   Value (Ptr llvmStruct) -> CodeGenFunction r ()+   Value (Ptr (Struct llvmValue)) -> CodeGenFunction r () modify f ptr =    flip store ptr =<< f =<< load ptr @@ -79,9 +82,9 @@    }  element ::-   (C x llvmStruct,-    LLVM.GetValue o n llvmStruct,-    LLVM.GetElementPtr o (n, ()) llvmStruct) =>+   (C x,+    LLVM.GetValue o n, LLVM.ValueType o n ~ Struct x,+    LLVM.GetElementPtr o (n, ()), LLVM.ElementPtrType o (n, ()) ~ Struct x) =>    (v -> x) -> n -> Element r o v x element field n =    Element {@@ -143,18 +146,15 @@   pair ::-   (C al as, C bl bs,-    IsSized as sas, IsSized bs sbs) =>-   Record r (Struct (as, (bs, ()))) (al, bl)+   (C a, C b) =>+   Record r (LLVM.Struct (Struct a, (Struct b, ()))) (a, b) pair =    liftA2 (,)       (element fst d0)       (element snd d1) -instance-      (C al as, C bl bs,-       IsSized as sas, IsSized bs sbs) =>-      C (al, bl) (Struct (as, (bs, ()))) where+instance (C a, C b) => C (a, b) where+   type Struct (a, b) = LLVM.Struct (Struct a, (Struct b, ()))    load = loadRecord pair    store = storeRecord pair    decompose = decomposeRecord pair@@ -162,19 +162,17 @@   triple ::-   (C al as, C bl bs, C cl cs,-    IsSized as sas, IsSized bs sbs, IsSized cs scs) =>-   Record r (Struct (as, (bs, (cs, ())))) (al, bl, cl)+   (C a, C b, C c) =>+   Record r (LLVM.Struct (Struct a, (Struct b, (Struct c, ())))) (a, b, c) triple =    liftA3 (,,)       (element fst3 d0)       (element snd3 d1)       (element thd3 d2) -instance-      (C al as, C bl bs, C cl cs,-       IsSized as sas, IsSized bs sbs, IsSized cs scs) =>-      C (al, bl, cl) (Struct (as, (bs, (cs, ())))) where+instance (C a, C b, C c) => C (a, b, c) where+   type Struct (a, b, c) =+           LLVM.Struct (Struct a, (Struct b, (Struct c, ())))    load = loadRecord triple    store = storeRecord triple    decompose = decomposeRecord triple@@ -194,142 +192,151 @@ -}  -class (LLVM.IsFirstClass llvmType, IsType llvmStruct) =>-      FirstClass llvmType llvmStruct | llvmType -> llvmStruct where-   fromStorable :: Value llvmStruct -> CodeGenFunction r (Value llvmType)-   toStorable :: Value llvmType -> CodeGenFunction r (Value llvmStruct)+class (LLVM.IsFirstClass llvmType, IsType (Stored llvmType)) =>+      FirstClass llvmType where+   type Stored llvmType :: *+   fromStorable :: Value (Stored llvmType) -> CodeGenFunction r (Value llvmType)+   toStorable :: Value llvmType -> CodeGenFunction r (Value (Stored llvmType)) -instance FirstClass Float  Float  where fromStorable = return; toStorable = return-instance FirstClass Double Double where fromStorable = return; toStorable = return-instance FirstClass Int8   Int8   where fromStorable = return; toStorable = return-instance FirstClass Int16  Int16  where fromStorable = return; toStorable = return-instance FirstClass Int32  Int32  where fromStorable = return; toStorable = return-instance FirstClass Int64  Int64  where fromStorable = return; toStorable = return-instance FirstClass Word8  Word8  where fromStorable = return; toStorable = return-instance FirstClass Word16 Word16 where fromStorable = return; toStorable = return-instance FirstClass Word32 Word32 where fromStorable = return; toStorable = return-instance FirstClass Word64 Word64 where fromStorable = return; toStorable = return-instance FirstClass Bool   Word32 where+instance FirstClass Float  where type Stored Float  = Float  ; fromStorable = return; toStorable = return+instance FirstClass Double where type Stored Double = Double ; fromStorable = return; toStorable = return+instance FirstClass Int8   where type Stored Int8   = Int8   ; fromStorable = return; toStorable = return+instance FirstClass Int16  where type Stored Int16  = Int16  ; fromStorable = return; toStorable = return+instance FirstClass Int32  where type Stored Int32  = Int32  ; fromStorable = return; toStorable = return+instance FirstClass Int64  where type Stored Int64  = Int64  ; fromStorable = return; toStorable = return+instance FirstClass Word8  where type Stored Word8  = Word8  ; fromStorable = return; toStorable = return+instance FirstClass Word16 where type Stored Word16 = Word16 ; fromStorable = return; toStorable = return+instance FirstClass Word32 where type Stored Word32 = Word32 ; fromStorable = return; toStorable = return+instance FirstClass Word64 where type Stored Word64 = Word64 ; fromStorable = return; toStorable = return+instance FirstClass Bool   where+   type Stored Bool = Word32    fromStorable = A.cmp LLVM.CmpNE (LLVM.value LLVM.zero)    toStorable = LLVM.zext instance-   (LLVM.Pos n, LLVM.IsPrimitive a, LLVM.IsPrimitive am, FirstClass a am) =>-      FirstClass (LLVM.Vector n a) (LLVM.Vector n am) where+   (TypeNum.PositiveT n, LLVM.IsPrimitive a, LLVM.IsPrimitive (Stored a), FirstClass a) =>+      FirstClass (LLVM.Vector n a) where+   type Stored (LLVM.Vector n a) = LLVM.Vector n (Stored a)    fromStorable = Vector.map fromStorable    toStorable = Vector.map toStorable instance-   (LLVM.Nat n, LLVM.IsFirstClass am,-    FirstClass a am, IsSized a asize, IsSized am amsize) =>-      FirstClass (LLVM.Array n a) (LLVM.Array n am) where+   (TypeNum.NaturalT n, LLVM.IsFirstClass (Stored a),+    FirstClass a, IsSized a, IsSized (Stored a)) =>+      FirstClass (LLVM.Array n a) where+   type Stored (LLVM.Array n a) = LLVM.Array n (Stored a)    fromStorable = Array.map fromStorable    toStorable = Array.map toStorable -instance (IsType a) => FirstClass (Ptr a) (Ptr a) where+instance (IsType a) => FirstClass (Ptr a) where+   type Stored (Ptr a) = Ptr a    fromStorable = return; toStorable = return-instance FirstClass (StablePtr a) (StablePtr a) where+instance FirstClass (StablePtr a) where+   type Stored (StablePtr a) = StablePtr a    fromStorable = return; toStorable = return   instance-   (LLVM.IsFirstClass (Struct s),-    IsType (Struct sm),-    ConvertStruct s sm TypeNum.D0 s sm) =>-      FirstClass (Struct s) (Struct sm) where+   (LLVM.IsFirstClass (LLVM.Struct s),+    IsType (LLVM.Struct (StoredStruct s)),+    ConvertStruct s TypeNum.D0 s) =>+      FirstClass (LLVM.Struct s) where+   type Stored (LLVM.Struct s) = LLVM.Struct (StoredStruct s)    fromStorable sm =       case undefined of          sfields -> do-            s <- decomposeField sfields (fields sm) d0 sm+            s <- decomposeField sfields d0 sm             let _ = asTypeOf (fields s) sfields             return s    toStorable s =-      case undefined of-         smfields -> do-            sm <- composeField (fields s) smfields d0 s-            let _ = asTypeOf (fields sm) smfields-            return sm+      composeField (fields s) d0 s -fields :: Value (Struct s) -> s+fields :: Value (LLVM.Struct s) -> s fields _ = undefined ++type family StoredStruct s :: *+type instance StoredStruct () = ()+type instance StoredStruct (s,rem) = (Stored s, StoredStruct rem)+ class-   ConvertStruct s sm i rem remm |-      s -> sm, rem -> remm, s rem -> i, sm remm -> i where+   ConvertStruct s i rem where    decomposeField ::-      rem -> remm ->-      i -> Value (Struct sm) ->-      CodeGenFunction r (Value (Struct s))+      rem -> i -> Value (LLVM.Struct (StoredStruct s)) ->+      CodeGenFunction r (Value (LLVM.Struct s))    composeField ::-      rem -> remm ->-      i -> Value (Struct s) ->-      CodeGenFunction r (Value (Struct sm))+      rem -> i -> Value (LLVM.Struct s) ->+      CodeGenFunction r (Value (LLVM.Struct (StoredStruct s)))  instance-   (LLVM.GetValue (Struct s) i a,-    LLVM.GetValue (Struct sm) i am,-    FirstClass a am,-    ConvertStruct s sm i' rem remm,-    TypeNum.Succ i i') =>-      ConvertStruct s sm i (a,rem) (am,remm) where-   decomposeField ~(_,rem_) ~(_,remm) i sm = do-      s <- decomposeField rem_ remm (TypeNum.succ i) sm+   (sm ~ StoredStruct s,+    LLVM.GetValue (LLVM.Struct s) i, LLVM.ValueType (LLVM.Struct s) i ~ a,+    LLVM.GetValue (LLVM.Struct sm) i, LLVM.ValueType (LLVM.Struct sm) i ~ am,+    FirstClass a, am ~ Stored a,+    ConvertStruct s (TypeNum.Succ i) rem) =>+      ConvertStruct s i (a,rem) where+   decomposeField ~(_,rem_) i sm = do+      s <- decomposeField rem_ (TypeNum.succT i) sm       a <- fromStorable =<< LLVM.extractvalue sm i       LLVM.insertvalue s a i-   composeField ~(_,rem_) ~(_,remm) i s = do-      sm <- composeField rem_ remm (TypeNum.succ i) s+   composeField ~(_,rem_) i s = do+      sm <- composeField rem_ (TypeNum.succT i) s       am <- toStorable =<< LLVM.extractvalue s i       LLVM.insertvalue sm am i  instance-   (IsType (Struct s),-    IsType (Struct sm)) =>-      ConvertStruct s sm i () () where-   decomposeField _ _ _ _ =+   (sm ~ StoredStruct s,+    IsType (LLVM.Struct s),+    IsType (LLVM.Struct sm)) =>+      ConvertStruct s i () where+   decomposeField _ _ _ =       return (LLVM.value LLVM.undef)-   composeField _ _ _ _ =+   composeField _ _ _ =       return (LLVM.value LLVM.undef) -instance (FirstClass a am) => C (Value a) am where++instance (FirstClass a, IsSized (Stored a)) => C (Value a) where+   type Struct (Value a) = Stored a    decompose = fromStorable    compose = toStorable  -instance C () (Struct ()) where+instance C () where+   type Struct () = LLVM.Struct ()    load _ = return ()    store _ _ = return ()    decompose _ = return ()    compose _ = return (LLVM.value LLVM.undef)  castStorablePtr ::-   (MakeValueTuple haskellValue llvmValue, C llvmValue llvmStruct) =>-   Ptr haskellValue -> Ptr llvmStruct+   (MakeValueTuple haskellValue, C (ValueTuple haskellValue)) =>+   Ptr haskellValue -> Ptr (Struct (ValueTuple haskellValue)) castStorablePtr = castPtr    loadNewtype ::-   (C a o) =>+   (C a) =>    (a -> llvmValue) ->-   Value (Ptr o) -> CodeGenFunction r llvmValue+   Value (Ptr (Struct a)) -> CodeGenFunction r llvmValue loadNewtype wrap ptr =    fmap wrap $ load ptr  storeNewtype ::-   (C a o) =>+   (C a) =>    (llvmValue -> a) ->-   llvmValue -> Value (Ptr o) -> CodeGenFunction r ()+   llvmValue -> Value (Ptr (Struct a)) -> CodeGenFunction r () storeNewtype unwrap y ptr =    store (unwrap y) ptr  decomposeNewtype ::-   (C a o) =>+   (C a) =>    (a -> llvmValue) ->-   Value o -> CodeGenFunction r llvmValue+   Value (Struct a) -> CodeGenFunction r llvmValue decomposeNewtype wrap y =    fmap wrap $ decompose y  composeNewtype ::-   (C a o) =>+   (C a) =>    (llvmValue -> a) ->-   llvmValue -> CodeGenFunction r (Value o)+   llvmValue -> CodeGenFunction r (Value (Struct a)) composeNewtype unwrap y =    compose (unwrap y)
src/LLVM/Extra/ScalarOrVector.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {- |@@ -15,14 +15,18 @@    signedFraction,    addToPhase,    incPhase,+   Scalar,    Replicate (replicate, replicateConst),    replicateOf,-   Real (min, max, abs),+   Real (min, max, abs, signum),    PseudoModule (scale, scaleConst),    IntegerConstant(constFromInteger),    RationalConstant(constFromRational),+   TranscendentalConstant(constPi),    ) where +import LLVM.Extra.Vector (Element, Size, )+ import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.Extension.X86 as X86 import qualified LLVM.Extra.Extension as Ext@@ -30,8 +34,8 @@ import qualified LLVM.Extra.Class as Class import qualified LLVM.Extra.ArithmeticPrivate as A -import qualified Data.TypeLevel.Num as TypeNum-import Data.TypeLevel.Num (D1, )+import qualified Types.Data.Num as TypeNum+import Types.Data.Num (D1, ) import qualified LLVM.Core as LLVM import LLVM.Core    (Value, ConstValue, valueOf, constOf,@@ -84,13 +88,13 @@ instead of the lower 64 bit, since x86 supports only conversion from 32 bit natively.       (Ext.with X86.cmpsd $ \cmp -> fractionLogical-         (\x y -> cmp x y >>= LLVM.bitcastUnify )+         (\x y -> cmp x y >>= LLVM.bitcast ) -}       `mapAuto`       (Ext.with X86.roundsd $ \round x ->          A.sub x =<< round x (valueOf 1)) -instance (TypeNum.Pos n, Vector.Real a, IsFloating a, IsConst a) =>+instance (TypeNum.PositiveT n, Vector.Real a, IsFloating a, IsConst a) =>       Fraction (Vector n a) where    truncate = Vector.truncate    fraction = Vector.fraction@@ -107,16 +111,16 @@    A.sub x =<< truncate x  fractionGen ::-   (Num a, Fraction v, Replicate a v, IsConst a, LLVM.CmpRet v b) =>+   (IntegerConstant v, Fraction v, LLVM.CmpRet v) =>    Value v -> CodeGenFunction r (Value v) fractionGen x =    do xf <- signedFraction x       b <- A.fcmp LLVM.FPOGE xf (LLVM.value LLVM.zero)-      LLVM.select b xf =<< A.add xf (replicateOf 1)+      LLVM.select b xf =<< A.add xf (LLVM.value $ constFromInteger 1)  fractionLogical ::-   (Fraction a, LLVM.NumberOfElements D1 a,-    LLVM.IsInteger b, LLVM.NumberOfElements D1 b) =>+   (Fraction a, LLVM.IsScalarOrVector a, LLVM.NumberOfElements a ~ D1,+    LLVM.IsInteger b, LLVM.IsScalarOrVector b, LLVM.NumberOfElements b ~ D1) =>    (LLVM.FPPredicate ->     Value a -> Value a -> CodeGenFunction r (Value b)) ->    Value a -> CodeGenFunction r (Value a)@@ -146,23 +150,42 @@   -class Replicate scalar vector | vector -> scalar where-   replicate :: Value scalar -> CodeGenFunction r (Value vector)-   replicateConst :: ConstValue scalar -> ConstValue vector+type family Scalar vector :: * -instance Replicate Float  Float  where replicate = return; replicateConst = id;-instance Replicate Double Double where replicate = return; replicateConst = id;-instance Replicate FP128  FP128  where replicate = return; replicateConst = id;-instance Replicate Bool   Bool   where replicate = return; replicateConst = id;-instance Replicate Int8   Int8   where replicate = return; replicateConst = id;-instance Replicate Int16  Int16  where replicate = return; replicateConst = id;-instance Replicate Int32  Int32  where replicate = return; replicateConst = id;-instance Replicate Int64  Int64  where replicate = return; replicateConst = id;-instance Replicate Word8  Word8  where replicate = return; replicateConst = id;-instance Replicate Word16 Word16 where replicate = return; replicateConst = id;-instance Replicate Word32 Word32 where replicate = return; replicateConst = id;-instance Replicate Word64 Word64 where replicate = return; replicateConst = id;-instance (TypeNum.Pos n, LLVM.IsPrimitive a) => Replicate a (Vector n a) where+type instance Scalar Float  = Float+type instance Scalar Double = Double+type instance Scalar FP128  = FP128+type instance Scalar Bool   = Bool+type instance Scalar Int8   = Int8+type instance Scalar Int16  = Int16+type instance Scalar Int32  = Int32+type instance Scalar Int64  = Int64+type instance Scalar Word8  = Word8+type instance Scalar Word16 = Word16+type instance Scalar Word32 = Word32+type instance Scalar Word64 = Word64+type instance Scalar (Vector n a) = a++++class Replicate vector where+   -- | an alternative is using the 'Vector.Constant' vector type+   replicate :: Value (Scalar vector) -> CodeGenFunction r (Value vector)+   replicateConst :: ConstValue (Scalar vector) -> ConstValue vector++instance Replicate Float  where replicate = return; replicateConst = id;+instance Replicate Double where replicate = return; replicateConst = id;+instance Replicate FP128  where replicate = return; replicateConst = id;+instance Replicate Bool   where replicate = return; replicateConst = id;+instance Replicate Int8   where replicate = return; replicateConst = id;+instance Replicate Int16  where replicate = return; replicateConst = id;+instance Replicate Int32  where replicate = return; replicateConst = id;+instance Replicate Int64  where replicate = return; replicateConst = id;+instance Replicate Word8  where replicate = return; replicateConst = id;+instance Replicate Word16 where replicate = return; replicateConst = id;+instance Replicate Word32 where replicate = return; replicateConst = id;+instance Replicate Word64 where replicate = return; replicateConst = id;+instance (TypeNum.PositiveT n, LLVM.IsPrimitive a) => Replicate (Vector n a) where {- crashes LLVM-2.5, seems to be fixed in LLVM-2.6 -}    replicate x = do       v <- singleton x@@ -188,8 +211,8 @@    LLVM.insertelement (LLVM.value LLVM.undef) x (valueOf 0)  replicateOf ::-   (IsConst a, Replicate a v) =>-   a -> Value v+   (IsConst (Scalar v), Replicate v) =>+   Scalar v -> Value v replicateOf a =    LLVM.value (replicateConst (LLVM.constOf a)) @@ -198,6 +221,7 @@    min :: Value a -> Value a -> CodeGenFunction r (Value a)    max :: Value a -> Value a -> CodeGenFunction r (Value a)    abs :: Value a -> CodeGenFunction r (Value a)+   signum :: Value a -> CodeGenFunction r (Value a)   instance Real Float  where@@ -206,13 +230,24 @@    abs = mapAuto     A.abs X86.absss    -- abs x = max x =<< LLVM.neg x    -- abs x = A.abs+   signum = A.signum  instance Real Double where    min = zipAutoWith A.min X86.minsd    max = zipAutoWith A.max X86.maxsd    abs = mapAuto     A.abs X86.abssd+   signum = A.signum +instance Real FP128  where+   min = A.min+   max = A.max+   abs = A.abs+   signum x = do+      minusOne <- LLVM.inttofp $ LLVM.valueOf (-1 :: Int8)+      one      <- LLVM.inttofp $ LLVM.valueOf ( 1 :: Int8)+      A.signumGen minusOne one x + infixl 1 `mapAuto`  {- |@@ -222,52 +257,53 @@ by accessing the lowest vector element. -} runScalar ::-   (Vector.Access n a va, Vector.Access n b vb) =>-   (va -> CodeGenFunction r vb) ->-   (a -> CodeGenFunction r b)+   (Vector.C v, Vector.C w, Size v ~ Size w) =>+   (v -> CodeGenFunction r w) ->+   (Element v -> CodeGenFunction r (Element w)) runScalar op a =    Vector.extract (valueOf 0)      =<< op      =<< Vector.insert (valueOf 0) a Class.undefTuple  mapAuto ::-   (Vector.Access n a va, Vector.Access n b vb) =>-   (a -> CodeGenFunction r b) ->-   Ext.T (va -> CodeGenFunction r vb) ->-   (a -> CodeGenFunction r b)+   (Vector.C v, Vector.C w, Size v ~ Size w) =>+   (Element v -> CodeGenFunction r (Element w)) ->+   Ext.T (v -> CodeGenFunction r w) ->+   (Element v -> CodeGenFunction r (Element w)) mapAuto f g a =    Ext.run (f a) $    Ext.with g $ \op -> runScalar op a  zipAutoWith ::-   (Vector.Access n a va, Vector.Access n b vb, Vector.Access n c vc) =>-   (a -> b -> CodeGenFunction r c) ->-   Ext.T (va -> vb -> CodeGenFunction r vc) ->-   (a -> b -> CodeGenFunction r c)+   (Vector.C u, Vector.C v, Vector.C w,+    Size u ~ Size v, Size v ~ Size w) =>+   (Element u -> Element v -> CodeGenFunction r (Element w)) ->+   Ext.T (u -> v -> CodeGenFunction r w) ->+   (Element u -> Element v -> CodeGenFunction r (Element w)) zipAutoWith f g =    curry $ mapAuto (uncurry f) (fmap uncurry g)  -instance Real FP128  where min = A.min; max = A.max; abs = A.abs;-instance Real Int8   where min = A.min; max = A.max; abs = A.abs;-instance Real Int16  where min = A.min; max = A.max; abs = A.abs;-instance Real Int32  where min = A.min; max = A.max; abs = A.abs;-instance Real Int64  where min = A.min; max = A.max; abs = A.abs;-instance Real Word8  where min = A.min; max = A.max; abs = return;-instance Real Word16 where min = A.min; max = A.max; abs = return;-instance Real Word32 where min = A.min; max = A.max; abs = return;-instance Real Word64 where min = A.min; max = A.max; abs = return;+instance Real Int8   where min = A.min; max = A.max; signum = A.signum; abs = A.abs;+instance Real Int16  where min = A.min; max = A.max; signum = A.signum; abs = A.abs;+instance Real Int32  where min = A.min; max = A.max; signum = A.signum; abs = A.abs;+instance Real Int64  where min = A.min; max = A.max; signum = A.signum; abs = A.abs;+instance Real Word8  where min = A.min; max = A.max; signum = A.signum; abs = return;+instance Real Word16 where min = A.min; max = A.max; signum = A.signum; abs = return;+instance Real Word32 where min = A.min; max = A.max; signum = A.signum; abs = return;+instance Real Word64 where min = A.min; max = A.max; signum = A.signum; abs = return; -instance (TypeNum.Pos n, Vector.Real a) =>+instance (TypeNum.PositiveT n, Vector.Real a) =>          Real (Vector n a) where    min = Vector.min    max = Vector.max    abs = Vector.abs+   signum = Vector.signum    class-   (Replicate a v, LLVM.IsArithmetic a, LLVM.IsArithmetic v) =>+   (LLVM.IsArithmetic a, LLVM.IsArithmetic v) =>       PseudoModule a v where    scale :: Value a -> Value v -> CodeGenFunction r (Value v)    scaleConst :: ConstValue a -> ConstValue v -> CodeGenFunction r (ConstValue v)@@ -282,7 +318,7 @@ instance PseudoModule Int64  Int64  where scale = LLVM.mul; scaleConst = LLVM.mul instance PseudoModule Float  Float  where scale = LLVM.mul; scaleConst = LLVM.mul instance PseudoModule Double Double where scale = LLVM.mul; scaleConst = LLVM.mul-instance (LLVM.IsArithmetic a, LLVM.IsPrimitive a, TypeNum.Pos n) =>+instance (LLVM.IsArithmetic a, LLVM.IsPrimitive a, TypeNum.PositiveT n) =>          PseudoModule a (Vector n a) where    scale a v = flip LLVM.mul v . flip asTypeOf v =<< replicate a    scaleConst a v = LLVM.mul (replicateConst a `asTypeOf` v) v@@ -302,7 +338,7 @@ instance IntegerConstant Int64  where constFromInteger = constOf . fromInteger instance IntegerConstant Float  where constFromInteger = constOf . fromInteger instance IntegerConstant Double where constFromInteger = constOf . fromInteger-instance (IntegerConstant a, LLVM.IsPrimitive a, TypeNum.Pos n) =>+instance (IntegerConstant a, LLVM.IsPrimitive a, TypeNum.PositiveT n) =>          IntegerConstant (Vector n a) where    constFromInteger x = constVector [constFromInteger x] @@ -312,6 +348,16 @@  instance RationalConstant Float  where constFromRational = constOf . fromRational instance RationalConstant Double where constFromRational = constOf . fromRational-instance (RationalConstant a, LLVM.IsPrimitive a, TypeNum.Pos n) =>+instance (RationalConstant a, LLVM.IsPrimitive a, TypeNum.PositiveT n) =>          RationalConstant (Vector n a) where    constFromRational x = constVector [constFromRational x]+++class (RationalConstant a) => TranscendentalConstant a where+   constPi :: ConstValue a++instance TranscendentalConstant Float  where constPi = constOf pi+instance TranscendentalConstant Double where constPi = constOf pi+instance (TranscendentalConstant a, LLVM.IsPrimitive a, TypeNum.PositiveT n) =>+         TranscendentalConstant (Vector n a) where+   constPi = constVector [constPi]
src/LLVM/Extra/Vector.hs view
@@ -1,1220 +1,1554 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}-module LLVM.Extra.Vector (-   size, sizeInTuple,-   replicate, iterate, assemble,--   shuffle,-   rotateUp, rotateDown, reverse,-   shiftUp, shiftDown,-   shiftUpMultiZero, shiftDownMultiZero,-   ShuffleMatch (shuffleMatch),-   shuffleMatchTraversable,-   shuffleMatchAccess,-   shuffleMatchPlain1,-   shuffleMatchPlain2,--   Access (insert, extract),-   insertTraversable,-   extractTraversable,-   extractAll,--   insertChunk, modify,-   map, mapChunks, zipChunksWith,-   chop, concat, select,-   signedFraction,-   cumulate1, umul32to64,-   Arithmetic-      (sum, sumToPair, sumInterleavedToPair,-       cumulate, dotProduct, mul),-   Real-      (min, max, abs,-       truncate, floor, fraction),-   ) where--import qualified LLVM.Extra.Extension.X86 as X86-import qualified LLVM.Extra.Extension as Ext--import qualified LLVM.Extra.Class as Class-import qualified LLVM.Extra.Monad as M-import qualified LLVM.Extra.ArithmeticPrivate as A--import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, )-import LLVM.Core-   (Value, ConstValue, valueOf, value, constOf, undef,-    Vector, insertelement, extractelement, constVector,-    IsConst, IsArithmetic, IsFloating,-    IsPrimitive,-    CodeGenFunction, )--import Data.TypeLevel.Num (D2, )-import qualified Data.TypeLevel.Num as TypeNum-import Control.Monad.HT ((<=<), )-import Control.Monad (liftM2, liftM3, foldM, )-import Data.Tuple.HT (uncurry3, )-import qualified Data.List.HT as ListHT-import qualified Data.List as List--import Control.Applicative (liftA2, )-import qualified Control.Applicative as App-import qualified Data.Traversable as Trav---- import qualified Data.Bits as Bit-import Data.Int  (Int8, Int16, Int32, Int64, )-import Data.Word (Word8, Word16, Word32, Word64, )--import Prelude hiding-          (Real, truncate, floor, round,-           map, zipWith, iterate, replicate, reverse, concat, sum, )----- * target independent functions--size ::-   (TypeNum.Pos n) =>-   Value (Vector n a) -> Int-size =-   let sz :: (TypeNum.Pos n) => n -> Value (Vector n a) -> Int-       sz n _ = TypeNum.toInt n-   in  sz undefined--{- |-Manually assemble a vector of equal values.-Better use ScalarOrVector.replicate.--}-replicate ::-   (Access n a va) =>-   a -> CodeGenFunction r va-replicate = replicateCore undefined--replicateCore ::-   (Access n a va) =>-   n -> a -> CodeGenFunction r va-replicateCore n =-   assemble . List.replicate (TypeNum.toInt n)--{- |-construct a vector out of single elements--You must assert that the length of the list matches the vector size.--This can be considered the inverse of 'extractAll'.--}-assemble ::-   (Access n a va) =>-   [a] -> CodeGenFunction r va-assemble =-   foldM (\v (k,x) -> insert (valueOf k) x v) Class.undefTuple .-   List.zip [0..]-{- sends GHC into an infinite loop-   foldM (\(k,x) -> insert (valueOf k) x) Class.undefTuple .-   List.zip [0..]--}--insertChunk ::-   (Access m a ca, Access n a va) =>-   Int -> ca ->-   va -> CodeGenFunction r va-insertChunk k x =-   M.chain $-   List.zipWith-      (\i j -> \v ->-          extract (valueOf i) x >>= \e ->-          insert (valueOf j) e v)-      (take (sizeInTuple x) [0..])-      [fromIntegral k ..]--iterate ::-   (Access n a va) =>-   (a -> CodeGenFunction r a) ->-   a -> CodeGenFunction r va-iterate f x =-   fmap snd $-   iterateCore f x Class.undefTuple--iterateCore ::-   (Access n a va) =>-   (a -> CodeGenFunction r a) ->-   a -> va ->-   CodeGenFunction r (a, va)-iterateCore f x0 v0 =-   foldM-      (\(x,v) k ->-         liftM2 (,) (f x)-            (insert (valueOf k) x v))-      (x0,v0)-      (take (sizeInTuple v0) [0..])--{- |-Manually implement vector shuffling using insertelement and extractelement.-In contrast to LLVM's built-in instruction it supports distinct vector sizes,-but it allows only one input vector-(or a tuple of vectors, but we cannot shuffle between them).-For more complex shuffling we recommend 'extractAll' and 'assemble'.--}-shuffle ::-   (Access m a ca, Access n a va) =>-   va ->-   ConstValue (Vector m Word32) ->-   CodeGenFunction r ca-shuffle x i =-   assemble =<<-   mapM-      (flip extract x <=< extractelement (value i) . valueOf)-      (take (size (value i)) [0..])---sizeInTuple :: ShuffleMatch n v => v -> Int-sizeInTuple =-   let sz :: (ShuffleMatch n v) => n -> v -> Int-       sz n _ = TypeNum.toInt n-   in  sz undefined--{- |-Rotate one element towards the higher elements.--I don't want to call it rotateLeft or rotateRight,-because there is no prefered layout for the vector elements.-In Intel's instruction manual vector-elements are indexed like the bits,-that is from right to left.-However, when working with Haskell list and enumeration syntax,-the start index is left.--}-rotateUp ::-   (ShuffleMatch n v) =>-   v -> CodeGenFunction r v-rotateUp x =-   shuffleMatch-      (constVector $ List.map constOf $-       (fromIntegral (sizeInTuple x) - 1) : [0..]) x--rotateDown ::-   (ShuffleMatch n v) =>-   v -> CodeGenFunction r v-rotateDown x =-   shuffleMatch-      (constVector $ List.map constOf $-       List.take (sizeInTuple x - 1) [1..] ++ [0]) x--reverse ::-   (ShuffleMatch n v) =>-   v -> CodeGenFunction r v-reverse x =-   shuffleMatch-      (constVector $ List.map constOf $-       List.reverse $-       List.take (sizeInTuple x) [0..]) x--shiftUp ::-   (Access n a v) =>-   a -> v -> CodeGenFunction r (a, v)-shiftUp x0 x = do-   y <--      shuffleMatch-         (constVector $ undef : List.map constOf [0..]) x-   liftM2 (,)-      (extract (LLVM.valueOf (fromIntegral (sizeInTuple x) - 1)) x)-      (insert (value LLVM.zero) x0 y)--shiftDown ::-   (Access n a v) =>-   a -> v -> CodeGenFunction r (a, v)-shiftDown x0 x = do-   y <--      shuffleMatch-         (constVector $-          List.map constOf (List.take (sizeInTuple x - 1) [1..]) ++ [undef]) x-   liftM2 (,)-      (extract (value LLVM.zero) x)-      (insert (LLVM.valueOf (fromIntegral (sizeInTuple x) - 1)) x0 y)--shiftUpMultiZero ::-   (IsPrimitive a, TypeNum.Pos n) =>-   Int ->-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector n a))-shiftUpMultiZero k x =-   shuffleMatchPlain2 (LLVM.value LLVM.zero) x-      (constVector $ List.map constOf $-       take k [0..] ++ [(fromIntegral (sizeInTuple x)) ..])--shiftDownMultiZero ::-   (IsPrimitive a, TypeNum.Pos n) =>-   Int ->-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector n a))-shiftDownMultiZero k x =-   shuffleMatchPlain2 x (LLVM.value LLVM.zero)-      (constVector $ List.map constOf $-       [(fromIntegral k) ..])---class-   (TypeNum.Pos n, Phi v, Class.Undefined v) =>-      ShuffleMatch n v | v -> n where-   shuffleMatch ::-      ConstValue (Vector n Word32) -> v -> CodeGenFunction r v--shuffleMatchTraversable ::-   (ShuffleMatch n v, Trav.Traversable f) =>-   ConstValue (Vector n Word32) -> f v -> CodeGenFunction r (f v)-shuffleMatchTraversable is v =-   Trav.mapM (shuffleMatch is) v--{- |-Implement the 'shuffleMatch' method using the methods of the 'Access' class.--}-shuffleMatchAccess ::-   (Access n a v) =>-   ConstValue (Vector n Word32) -> v -> CodeGenFunction r v-shuffleMatchAccess is v =-   assemble =<<-   mapM-      (flip extract v <=<-       flip extract (value is) . valueOf)-      (take (size (value is)) [0..])---shuffleMatchPlain1 ::-   (TypeNum.Pos n, IsPrimitive a) =>-   Value (Vector n a) ->-   ConstValue (Vector n Word32) ->-   CodeGenFunction r (Value (Vector n a))-shuffleMatchPlain1 x =-   shuffleMatchPlain2 x (value undef)--shuffleMatchPlain2 ::-   (TypeNum.Pos n, IsPrimitive a) =>-   Value (Vector n a) ->-   Value (Vector n a) ->-   ConstValue (Vector n Word32) ->-   CodeGenFunction r (Value (Vector n a))-shuffleMatchPlain2 =-   LLVM.shufflevector--{- |-Allow to work on records of vectors as if they are vectors of records.-This is a reasonable approach for records of different element types-since processor vectors can only be built from elements of the same type.-But also say for chunked stereo signal this makes sense.-In this case we would work on @Stereo (Value a)@.--}-class-   (ShuffleMatch n v) =>-      Access n a v | v -> a n, a n -> v where-   insert :: Value Word32 -> a -> v -> CodeGenFunction r v-   extract :: Value Word32 -> v -> CodeGenFunction r a--insertTraversable ::-   (Access n a v, Trav.Traversable f, App.Applicative f) =>-   Value Word32 -> f a -> f v -> CodeGenFunction r (f v)-insertTraversable n a v =-   Trav.sequence (liftA2 (insert n) a v)--extractTraversable ::-   (Access n a v, Trav.Traversable f) =>-   Value Word32 -> f v -> CodeGenFunction r (f a)-extractTraversable n v =-   Trav.mapM (extract n) v--{- |-provide the elements of a vector as a list of individual virtual registers--This can be considered the inverse of 'assemble'.--}-extractAll ::-   (Access n a v) =>-   v -> LLVM.CodeGenFunction r [a]-extractAll x =-   mapM-      (flip extract x . LLVM.valueOf)-      (take (sizeInTuple x) [0..])---instance-   (TypeNum.Pos n, LLVM.IsPrimitive a) =>-      ShuffleMatch n (Value (Vector n a)) where-   shuffleMatch is v = shuffleMatchPlain1 v is--instance-   (TypeNum.Pos n, LLVM.IsPrimitive a) =>-      Access n (Value a) (Value (Vector n a)) where-   insert  k a v = insertelement v a k-   extract k v   = extractelement v k---instance-   (ShuffleMatch n v0, ShuffleMatch n v1) =>-      ShuffleMatch n (v0, v1) where-   shuffleMatch is (v0,v1) =-      liftM2 (,)-         (shuffleMatch is v0)-         (shuffleMatch is v1)--instance-   (Access n a0 v0, Access n a1 v1) =>-      Access n (a0, a1) (v0, v1) where-   insert k (a0,a1) (v0,v1) =-      liftM2 (,)-         (insert k a0 v0)-         (insert k a1 v1)-   extract k (v0,v1) =-      liftM2 (,)-         (extract k v0)-         (extract k v1)---instance-   (ShuffleMatch n v0, ShuffleMatch n v1, ShuffleMatch n v2) =>-      ShuffleMatch n (v0, v1, v2) where-   shuffleMatch is (v0,v1,v2) =-      liftM3 (,,)-         (shuffleMatch is v0)-         (shuffleMatch is v1)-         (shuffleMatch is v2)--instance-   (Access n a0 v0, Access n a1 v1, Access n a2 v2) =>-      Access n (a0, a1, a2) (v0, v1, v2) where-   insert k (a0,a1,a2) (v0,v1,v2) =-      liftM3 (,,)-         (insert k a0 v0)-         (insert k a1 v1)-         (insert k a2 v2)-   extract k (v0,v1,v2) =-      liftM3 (,,)-         (extract k v0)-         (extract k v1)-         (extract k v2)---modify ::-   (Access n a va) =>-   Value Word32 ->-   (a -> CodeGenFunction r a) ->-   (va -> CodeGenFunction r va)-modify k f v =-   flip (insert k) v =<< f =<< extract k v--{- |-Like LLVM.Util.Loop.mapVector but the loop is unrolled,-which is faster since it can be packed by the code generator.--}-map, _mapByFold ::-   (Access n a va, Access n b vb) =>-   (a -> CodeGenFunction r b) ->-   (va -> CodeGenFunction r vb)-map f =-   assemble <=< mapM f <=< extractAll--_mapByFold f a =-   foldM-      (\b n ->-         extract (valueOf n) a >>=-         f >>=-         flip (insert (valueOf n)) b)-      Class.undefTuple-      (take (sizeInTuple a) [0..])--mapChunks ::-   (Access m a ca, Access m b cb,-    Access n a va, Access n b vb) =>-   (ca -> CodeGenFunction r cb) ->-   (va -> CodeGenFunction r vb)-mapChunks f a =-   foldM-      (\b (am,k) ->-         am >>= \ac ->-         f ac >>= \bc ->-         insertChunk (k * sizeInTuple ac) bc b)-      Class.undefTuple $-   List.zip (chop a) [0..]--zipChunksWith ::-   (Access m a ca, Access m b cb, Access m c cc,-    Access n a va, Access n b vb, Access n c vc) =>-   (ca -> cb -> CodeGenFunction r cc) ->-   (va -> vb -> CodeGenFunction r vc)-zipChunksWith f a b =-   mapChunks (uncurry f) (a,b)---mapAuto ::-   (Access m a ca, Access m b cb,-    Access n a va, Access n b vb) =>-   (a -> CodeGenFunction r b) ->-   Ext.T (ca -> CodeGenFunction r cb) ->-   (va -> CodeGenFunction r vb)-mapAuto f g a =-   Ext.run (map f a) $-   Ext.with g $ \op -> mapChunks op a--zipAutoWith ::-   (Access m a ca, Access m b cb, Access m c cc,-    Access n a va, Access n b vb, Access n c vc) =>-   (a -> b -> CodeGenFunction r c) ->-   Ext.T (ca -> cb -> CodeGenFunction r cc) ->-   (va -> vb -> CodeGenFunction r vc)-zipAutoWith f g a b =-   mapAuto (uncurry f) (fmap uncurry g) (a,b)---{- |-Ideally on ix86 with SSE41 this would be translated to 'dpps'.--}-dotProductPartial ::-   (TypeNum.Pos n, LLVM.IsPrimitive a, LLVM.IsArithmetic a) =>-   Int ->-   Value (Vector n a) ->-   Value (Vector n a) ->-   CodeGenFunction r (Value a)-dotProductPartial n x y =-   sumPartial n =<< A.mul x y--sumPartial ::-   (TypeNum.Pos n, LLVM.IsPrimitive a, LLVM.IsArithmetic a) =>-   Int ->-   Value (Vector n a) ->-   CodeGenFunction r (Value a)-sumPartial n x =-   foldl1-      {- quite the same as (+) using LLVM.Arithmetic instances,-         but requires less type constraints -}-      (M.liftR2 A.add)-      (List.map (LLVM.extractelement x . valueOf) $ take n $ [0..])---{- |-If the target vector type is a native type-then the chop operation produces no actual machine instruction. (nop)-If the vector cannot be evenly divided into chunks-the last chunk will be padded with undefined values.--}-chop ::-   (Access m a ca, Access n a va) =>-   va -> [CodeGenFunction r ca]-chop = chopCore undefined--chopCore ::-   (Access m a ca, Access n a va) =>-   m -> va -> [CodeGenFunction r ca]-chopCore m x =-   List.map (shuffle x . constVector) $-   ListHT.sliceVertical (TypeNum.toInt m) $-   List.map constOf $-   take (sizeInTuple x) [0..]--{- |-The target size is determined by the type.-If the chunk list provides more data, the exceeding data is dropped.-If the chunk list provides too few data,-the target vector is filled with undefined elements.--}-concat ::-   (Access m a ca, Access n a va) =>-   [ca] -> CodeGenFunction r va-concat xs =-   foldM-      (\v0 (js,c) ->-         foldM-            (\v (i,j) -> do-               x <- extract (valueOf i) c-               insert (valueOf j) x v)-            v0 $-         List.zip [0..] js)-      Class.undefTuple $-   List.zip-      (ListHT.sliceVertical (sizeInTuple (head xs)) [0..])-      xs---getLowestPair ::-   (TypeNum.Pos n) =>-   Value (Vector n a) ->-   CodeGenFunction r (Value a, Value a)-getLowestPair x =-   liftM2 (,)-      (extractelement x (valueOf 0))-      (extractelement x (valueOf 1))---_reduceAddInterleaved ::-   (IsArithmetic a, IsPrimitive a,-    TypeNum.Pos n, TypeNum.Pos m, TypeNum.Mul D2 m n) =>-   m ->-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector m a))-_reduceAddInterleaved tm v = do-   let m = TypeNum.toInt tm-   x <- shuffle v (constVector $ List.map constOf $ take m [0..])-   y <- shuffle v (constVector $ List.map constOf $ take m [fromIntegral m ..])-   A.add x y--sumGeneric ::-   (IsArithmetic a, IsPrimitive a, TypeNum.Pos n) =>-   Value (Vector n a) ->-   CodeGenFunction r (Value a)-sumGeneric =-   flip extractelement (valueOf 0) <=<-   reduceSumInterleaved 1--sumToPairGeneric ::-   (Arithmetic a, TypeNum.Pos n) =>-   Value (Vector n a) ->-   CodeGenFunction r (Value a, Value a)-sumToPairGeneric v =-   let n2 = div (size v) 2-   in  sumInterleavedToPair =<<-       shuffleMatchPlain1 v-          (constVector $-           List.map (constOf . fromIntegral) $-           concatMap (\k -> [k, k+n2]) $-           take n2 [0..])--{- |-We partition a vector of size n into chunks of size m-and add these chunks using vector additions.-We do this by repeated halving of the vector,-since this way we do not need assumptions about the native vector size.--We reduce the vector size only virtually,-that is we maintain the vector size and fill with undefined values.-This is reasonable-since LLVM-2.5 and LLVM-2.6 does not allow shuffling between vectors of different size-and because it likes to do computations on Vector D2 Float-in MMX registers on ix86 CPU's,-which interacts badly with FPU usage.-Since we fill the vector with undefined values,-LLVM actually treats the vectors like vectors of smaller size.--}-reduceSumInterleaved ::-   (IsArithmetic a, IsPrimitive a, TypeNum.Pos n) =>-   Int ->-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector n a))-reduceSumInterleaved m x0 =-   let go ::-          (IsArithmetic a, IsPrimitive a, TypeNum.Pos n) =>-          Int ->-          Value (Vector n a) ->-          CodeGenFunction r (Value (Vector n a))-       go n x =-          if m==n-            then return x-            else-               let n2 = div n 2-               in  go n2-                      =<< A.add x-                      =<< shuffleMatchPlain1 x-                             (constVector $ List.map constOf (take n2 [fromIntegral n2 ..])-                                 ++ List.repeat undef)-   in  go (size x0) x0--cumulateGeneric, _cumulateSimple ::-   (IsArithmetic a, IsPrimitive a, TypeNum.Pos n) =>-   Value a -> Value (Vector n a) ->-   CodeGenFunction r (Value a, Value (Vector n a))-_cumulateSimple a x =-   foldM-      (\(a0,y0) k -> do-         a1 <- A.add a0 =<< extract (valueOf k) x-         y1 <- insert (valueOf k) a0 y0-         return (a1,y1))-      (a, Class.undefTuple)-      (take (sizeInTuple x) $ [0..])--cumulateGeneric =-   cumulateFrom1 cumulate1--cumulateFrom1 ::-   (IsArithmetic a, IsPrimitive a, TypeNum.Pos n) =>-   (Value (Vector n a) ->-    CodeGenFunction r (Value (Vector n a))) ->-   Value a -> Value (Vector n a) ->-   CodeGenFunction r (Value a, Value (Vector n a))-cumulateFrom1 cum a x0 = do-   (b,x1) <- shiftUp a x0-   y <- cum x1-   z <- A.add b =<< extract (valueOf (fromIntegral (sizeInTuple x0) - 1)) y-   return (z,y)---{- |-Needs (log n) vector additions--}-cumulate1 ::-   (IsArithmetic a, IsPrimitive a, TypeNum.Pos n) =>-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector n a))-cumulate1 x =-   foldM-      (\y k -> A.add y =<< shiftUpMultiZero k y)-      x-      (takeWhile (<sizeInTuple x) $ List.iterate (2*) 1)---signedFraction ::-   (IsFloating a, IsConst a, Real a, TypeNum.Pos n) =>-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector n a))-signedFraction x =-   A.sub x =<< truncate x--floorGeneric ::-   (IsFloating a, IsConst a, Real a, TypeNum.Pos n) =>-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector n a))-floorGeneric = floorLogical A.fcmp--{- |-On LLVM-2.6 and X86 this produces branch-free-but even slower code than 'fractionSelect',-since the comparison to booleans and-back to a floating point number is translated literally-to elementwise comparison, conversion to a 0 or -1 byte-and then to a floating point number.--}-fractionGeneric ::-   (IsFloating a, IsConst a, Real a, TypeNum.Pos n) =>-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector n a))-fractionGeneric = fractionLogical A.fcmp---{- |-LLVM.select on boolean vectors cannot be translated to X86 code in LLVM-2.6,-thus I code my own version that calls select on all elements.-This is slow but works.-When this issue is fixed, this function will be replaced by LLVM.select.--}-select ::-   (LLVM.IsFirstClass a, IsPrimitive a, TypeNum.Pos n,-    LLVM.CmpRet a Bool) =>-   Value (Vector n Bool) ->-   Value (Vector n a) ->-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector n a))-select b x y =-   map (uncurry3 LLVM.select) (b, x, y)--{- |-'floor' implemented using 'select'.-This will need jumps.--}-_floorSelect ::-   (Num a, IsFloating a, IsConst a, Real a, TypeNum.Pos n) =>-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector n a))-_floorSelect x =-   do xr <- truncate x-      b <- A.fcmp LLVM.FPOLE xr x-      select b xr =<< A.sub xr =<< replicate (valueOf 1)--{- |-'fraction' implemented using 'select'.-This will need jumps.--}-_fractionSelect ::-   (Num a, IsFloating a, IsConst a, Real a, TypeNum.Pos n) =>-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector n a))-_fractionSelect x =-   do xf <- signedFraction x-      b <- A.fcmp LLVM.FPOGE xf (value LLVM.zero)-      select b xf =<< A.add xf =<< replicate (valueOf 1)---{- |-Another implementation of 'select',-this time in terms of binary logical operations.-The selecting integers must be-(-1) for selecting an element from the first operand-and 0 for selecting an element from the second operand.-This leads to optimal code.--On SSE41 this could be done with blendvps or blendvpd.--}-selectLogical ::-   (LLVM.IsFirstClass a, IsPrimitive a,-    LLVM.IsInteger i, IsPrimitive i,---    LLVM.IsSized a sa, LLVM.IsSized i si, sa :==: si, si :==: sa,---    LLVM.IsSized a s, LLVM.IsSized i s,-    LLVM.IsSized (Vector n a) s, LLVM.IsSized (Vector n i) s,-    TypeNum.Pos n) =>-   Value (Vector n i) ->-   Value (Vector n a) ->-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector n a))-selectLogical b x y = do---   bneg <- A.xor b-   bneg <- LLVM.inv b-   xm <- A.and b    =<< LLVM.bitcastUnify x-   ym <- A.and bneg =<< LLVM.bitcastUnify y-   LLVM.bitcastUnify =<< A.or xm ym---floorLogical ::-   (IsFloating a, IsConst a, Real a,-    IsPrimitive i, LLVM.IsInteger i, TypeNum.Pos n) =>-   (LLVM.FPPredicate ->-    Value (Vector n a) ->-    Value (Vector n a) ->-    CodeGenFunction r (Value (Vector n i))) ->-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector n a))-floorLogical cmp x =-   do xr <- truncate x-      b <- cmp LLVM.FPOGT xr x-      A.add xr =<< LLVM.inttofp b--fractionLogical ::-   (IsFloating a, IsConst a, Real a,-    IsPrimitive i, LLVM.IsInteger i, TypeNum.Pos n) =>-   (LLVM.FPPredicate ->-    Value (Vector n a) ->-    Value (Vector n a) ->-    CodeGenFunction r (Value (Vector n i))) ->-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector n a))-fractionLogical cmp x =-   do xf <- signedFraction x-      b <- cmp LLVM.FPOLT xf (value LLVM.zero)-      A.sub xf =<< LLVM.inttofp b---orderBy ::-   (TypeNum.Pos m,-    LLVM.IsFirstClass a, IsPrimitive a,-    LLVM.IsInteger i, IsPrimitive i,-    LLVM.IsSized (Vector m a) s, LLVM.IsSized (Vector m i) s) =>-   Ext.T (Value (Vector m a) -> Value (Vector m a) -> CodeGenFunction r (Value (Vector m i))) ->-   Ext.T (Value (Vector m a) -> Value (Vector m a) -> CodeGenFunction r (Value (Vector m a)))-orderBy cmp =-   Ext.with cmp $ \pcmpgt x y ->-      pcmpgt x y >>= \b -> selectLogical b y x--order ::-   (TypeNum.Pos n, TypeNum.Pos m,-    LLVM.IsFirstClass a, IsPrimitive a,-    LLVM.IsInteger i, IsPrimitive i,-    LLVM.IsSized (Vector m a) s, LLVM.IsSized (Vector m i) s) =>-   (Value a -> Value a -> CodeGenFunction r (Value a)) ->-   Ext.T (Value (Vector m a) -> Value (Vector m a) -> CodeGenFunction r (Value (Vector m i))) ->-   Ext.T (Value (Vector m a) -> Value (Vector m a) -> CodeGenFunction r (Value (Vector m a))) ->-   (Value (Vector n a) -> Value (Vector n a) -> CodeGenFunction r (Value (Vector n a)))-order byScalar byCmp byChunk x y =-   map (uncurry byScalar) (x,y)-   `Ext.run`-   (Ext.with byCmp $ \pcmpgt ->-      mapChunks (\(cx,cy) ->-         pcmpgt cx cy >>= \b -> selectLogical b cy cx) (x,y))-{--This is not nice, because selectLogical uses bitcast-and bitcast requires ugly type constraints for equal vector sizes.-Thus we restrict selectLogical to chunks and thus monomorphic types.-   (Ext.with byCmp $ \pcmpgt -> do-       b <- mapChunks (uncurry pcmpgt) (x,y)-       selectLogical b y x)--}-   `Ext.run`-   (Ext.with byChunk $ \psel ->-       zipChunksWith psel x y)----- * target independent functions with target dependent optimizations--{- |-The order of addition is chosen for maximum efficiency.-We do not try to prevent cancelations.--}-class (IsArithmetic a, IsPrimitive a) => Arithmetic a where-   sum ::-      (TypeNum.Pos n) =>-      Value (Vector n a) ->-      CodeGenFunction r (Value a)-   sum = sumGeneric--   {- |-   The first result value is the sum of all vector elements from 0 to @div n 2 + 1@-   and the second result value is the sum of vector elements from @div n 2@ to @n-1@.-   n must be at least D2.-   -}-   sumToPair ::-      (TypeNum.Pos n) =>-      Value (Vector n a) ->-      CodeGenFunction r (Value a, Value a)-   sumToPair = sumToPairGeneric--   {- |-   Treat the vector as concatenation of pairs and all these pairs are added.-   Useful for stereo signal processing.-   n must be at least D2.-   -}-   sumInterleavedToPair ::-      (TypeNum.Pos n) =>-      Value (Vector n a) ->-      CodeGenFunction r (Value a, Value a)-   sumInterleavedToPair v =-      getLowestPair =<< reduceSumInterleaved 2 v--   cumulate ::-      (TypeNum.Pos n) =>-      Value a -> Value (Vector n a) ->-      CodeGenFunction r (Value a, Value (Vector n a))-   cumulate = cumulateGeneric--   dotProduct ::-      (TypeNum.Pos n) =>-      Value (Vector n a) ->-      Value (Vector n a) ->-      CodeGenFunction r (Value a)-   dotProduct x y =-      dotProductPartial (size x) x y--   mul ::-      (TypeNum.Pos n) =>-      Value (Vector n a) ->-      Value (Vector n a) ->-      CodeGenFunction r (Value (Vector n a))-   mul = A.mul--instance Arithmetic Float where-   sum x =-      Ext.runWhen (size x >= 4) (sumGeneric x) $-      Ext.with X86.haddps $ \haddp ->-          {--          We can make use of the following facts:-          SSE3 has Float vectors of size 4,-          there is an instruction for horizontal add.-          -}-          do chunkSum <--                foldl1 (M.liftR2 A.add) $ chop x-             y <- haddp chunkSum (value undef)-             z <- haddp y        (value undef)-{--             y <- haddp chunkSum chunkSum-             z <- haddp y y--}-             extractelement z (valueOf 0)--   sumToPair x =-      Ext.runWhen (size x >= 4) (getLowestPair x) $-      Ext.with X86.haddps $ \haddp ->-          let {--              reduce ::-                 [CodeGenFunction r (Value (Vector D4 Float))] ->-                 [CodeGenFunction r (Value (Vector D4 Float))]-              -}-              reduce [] = []-              reduce [_] = error "vector must have size power of two"-              reduce (x0:x1:xs) =-                 M.liftR2 haddp x0 x1 : reduce xs-              go []  = error "vector must not be empty"-              go [c] =-                 getLowestPair-                    =<< flip haddp (value undef)-                    =<< c-              go cs  = go (reduce cs)-          in  go $ chop x--{--The haddps based implementation cumulate is slower than the generic one.-However, one day the x86 processors may implement a cumulative sum-which we could employ with this frame.--   cumulate a x =-      Ext.runWhen (size x >= 4) (cumulateGeneric a x) $-      Ext.with X86.cumulate1s $ \cumulate1s -> do-         (b,ys) <--            foldr-               (\chunk0 cont a0 -> do-                  (a1,chunk1) <- cumulateFrom1 cumulate1s a0 =<< chunk0-                  fmap (mapSnd (chunk1:)) (cont a1))-               (\a0 -> return (a0,[]))-               (chop x)-               a-         y <- concat ys-         return (b,y)--}--   dotProduct x y =-      Ext.run (sum =<< A.mul x y) $-      Ext.with X86.dpps $ \dpp ->-         foldl1 (M.liftR2 A.add) $-         List.zipWith-            (\mx my -> do-               cx <- mx-               cy <- my-               flip extractelement (valueOf 0)-                =<< dpp cx cy (valueOf 0xF1))-            (chop x)-            (chop y)--instance Arithmetic Double where--instance Arithmetic Int8   where-instance Arithmetic Int16  where-instance Arithmetic Int32  where-instance Arithmetic Int64  where-instance Arithmetic Word8  where-instance Arithmetic Word16 where-instance Arithmetic Word64 where--instance Arithmetic Word32 where-   mul x y =-      A.mul x y-      `Ext.run`-      (Ext.with X86.pmuludq $ \pmul ->-         zipChunksWith-            (\cx cy -> do-               evenX <- shuffleMatchPlain1 cx-                  (constVector [constOf 0, undef, constOf 2, undef])-               evenY <- shuffleMatchPlain1 cy-                  (constVector [constOf 0, undef, constOf 2, undef])-               evenZ64 <- pmul evenX evenY-               evenZ <- LLVM.bitcastUnify evenZ64-               oddX <- shuffleMatchPlain1 cx-                  (constVector [constOf 1, undef, constOf 3, undef])-               oddY <- shuffleMatchPlain1 cy-                  (constVector [constOf 1, undef, constOf 3, undef])-               oddZ64 <- pmul oddX oddY-               oddZ <- LLVM.bitcastUnify oddZ64-               shuffleMatchPlain2 evenZ oddZ-                  (constVector [constOf 0, constOf 4, constOf 2, constOf 6]))-            x y)-      `Ext.run`-      (Ext.with X86.pmulld $ \pmul ->-         zipChunksWith pmul x y)---umul32to64 ::-   (TypeNum.Pos n) =>-   Value (Vector n Word32) ->-   Value (Vector n Word32) ->-   CodeGenFunction r (Value (Vector n Word64))-umul32to64 x y =-   (do x64 <- map LLVM.zext x-       y64 <- map LLVM.zext y-       A.mul x64 y64)-   `Ext.run`-   (Ext.with X86.pmuludq $ \pmul ->-      zipChunksWith-         -- save an initial shuffle-         (\cx cy -> do-            evenX <- shuffleMatchPlain1 cx-               (constVector [constOf 0, undef, constOf 2, undef])-            evenY <- shuffleMatchPlain1 cy-               (constVector [constOf 0, undef, constOf 2, undef])-            evenZ <- pmul evenX evenY-            oddX <- shuffleMatchPlain1 cx-               (constVector [constOf 1, undef, constOf 3, undef])-            oddY <- shuffleMatchPlain1 cy-               (constVector [constOf 1, undef, constOf 3, undef])-            oddZ <- pmul oddX oddY-{--            shuffleMatchPlain2 evenZ oddZ-               (constVector [constOf 0, constOf 2, constOf 1, constOf 3])--}-            assemble =<< (sequence $-               extract (valueOf 0) evenZ :-               extract (valueOf 0) oddZ :-               extract (valueOf 1) evenZ :-               extract (valueOf 1) oddZ :-               []))-{--         -- save the final shuffle-         (\cx cy -> do-            lowerX <- shuffleMatchPlain1 cx-               (constVector [constOf 0, undef, constOf 1, undef])-            lowerY <- shuffleMatchPlain1 cy-               (constVector [constOf 0, undef, constOf 1, undef])-            lowerZ <- pmul lowerX lowerY-            upperX <- shuffleMatchPlain1 cx-               (constVector [constOf 2, undef, constOf 3, undef])-            upperY <- shuffleMatchPlain1 cy-               (constVector [constOf 2, undef, constOf 3, undef])-            upperZ <- pmul upperX upperY-{--            shuffleMatchPlain2 lowerZ upperZ-               (constVector [constOf 0, constOf 1, constOf 2, constOf 3])--}-            concat [lowerZ, upperZ])--}-         x y)---{- |-Attention:-The rounding and fraction functions only work-for floating point values with maximum magnitude of @maxBound :: Int32@.-This way we safe expensive handling of possibly seldom cases.--}-class (Arithmetic a, LLVM.CmpRet a Bool, IsConst a) =>-         Real a where-   min, max ::-      (TypeNum.Pos n) =>-      Value (Vector n a) ->-      Value (Vector n a) ->-      CodeGenFunction r (Value (Vector n a))--   abs ::-      (TypeNum.Pos n) =>-      Value (Vector n a) ->-      CodeGenFunction r (Value (Vector n a))--   truncate, floor, fraction ::-      (TypeNum.Pos n) =>-      Value (Vector n a) ->-      CodeGenFunction r (Value (Vector n a))--instance Real Float where-   min = zipAutoWith A.min X86.minps-   max = zipAutoWith A.max X86.maxps-   abs = mapAuto A.abs X86.absps-   {--   An IEEE specific implementation could do some bit manipulation:-   s eeeeeeee mmmmmmmmmmmmmmmmmmmmmmm-   Generate a pure power of two by clearing mantissa:-   s eeeeeeee 00000000000000000000000-   Now subtract 1 in order to get the required bit mask for the mantissa-   s eeeeeeee 11111111110000000000000-   multiply with 2 in order to correct exponent-   and then do bitwise AND of the mask with the original number.-   This method only works for numbers from 1 to 2^23-1,-   that is the range is even more smaller-   than that for the rounding via Int32.-   -}-   truncate x =-      (LLVM.inttofp .-       (id :: Value (Vector n Int32) -> Value (Vector n Int32))-       <=< LLVM.fptoint) x-      `Ext.run`-      (Ext.with X86.roundps $ \round ->-          mapChunks (flip round (valueOf 3)) x)-   floor x =-      floorGeneric x-      `Ext.run`-      (Ext.with X86.cmpps $ \cmp ->-          mapChunks (floorLogical cmp) x)-{- LLVM-2.6 rearranges the MXCSR manipulations in an invalid way-      `Ext.run`-      (Ext.with2 (X86.withMXCSR (Bit.shiftL 1 13)) X86.cvtps2dq $-          \ with cvtps2dq -> with $-             LLVM.inttofp =<< mapChunks cvtps2dq x)--}-      `Ext.run`-      (Ext.with X86.roundps $ \round ->-          mapChunks (flip round (valueOf 1)) x)-   fraction x =-      fractionGeneric x-      `Ext.run`-      (Ext.with X86.cmpps $ \cmp ->-          mapChunks (fractionLogical cmp) x)-{--      `Ext.run`-      (Ext.with2 (X86.withMXCSR (Bit.shiftL 1 13)) X86.cvtps2dq $-          \ with cvtps2dq -> with $-             A.sub x =<< LLVM.inttofp =<< mapChunks cvtps2dq x)--}-      `Ext.run`-      (Ext.with X86.roundps $ \round ->-          mapChunks (\c -> A.sub c =<< flip round (valueOf 1) c) x)--instance Real Double where-   min = zipAutoWith A.min X86.minpd-   max = zipAutoWith A.max X86.maxpd-   abs = mapAuto A.abs X86.abspd-   truncate x =-      (LLVM.inttofp .-       (id :: Value (Vector n Int64) -> Value (Vector n Int64))-       <=< LLVM.fptoint) x-      `Ext.run`-      (Ext.with X86.roundpd $ \round ->-          mapChunks (flip round (valueOf 3)) x)-   floor x =-      floorGeneric x-      `Ext.run`-      (Ext.with X86.cmppd $ \cmp ->-          mapChunks (floorLogical cmp) x)-      `Ext.run`-      (Ext.with X86.roundpd $ \round ->-          mapChunks (flip round (valueOf 1)) x)-   fraction x =-      fractionGeneric x-      `Ext.run`-      (Ext.with X86.cmppd $ \cmp ->-          mapChunks (fractionLogical cmp) x)-      `Ext.run`-      (Ext.with X86.roundpd $ \round ->-          mapChunks (\c -> A.sub c =<< flip round (valueOf 1) c) x)--instance Real Int8 where-   min = order A.min X86.pcmpgtb X86.pminsb-   max = order A.max (fmap flip X86.pcmpgtb) X86.pmaxsb-   abs = mapAuto A.abs X86.pabsb-   truncate = return-   floor = return-   fraction = const $ return (value LLVM.zero)--instance Real Int16 where-   min = order A.min X86.pcmpgtw X86.pminsw-   max = order A.max (fmap flip X86.pcmpgtw) X86.pmaxsw-   abs = mapAuto A.abs X86.pabsw-   truncate = return-   floor = return-   fraction = const $ return (value LLVM.zero)--instance Real Int32 where-   min = order A.min X86.pcmpgtd X86.pminsd-   max = order A.max (fmap flip X86.pcmpgtd) X86.pmaxsd-   abs = mapAuto A.abs X86.pabsd-   truncate = return-   floor = return-   fraction = const $ return (value LLVM.zero)--instance Real Int64 where-   min = zipAutoWith A.min (orderBy X86.pcmpgtq)-   max = zipAutoWith A.max (orderBy (fmap flip X86.pcmpgtq))-   abs = mapAuto A.abs $-      Ext.with (orderBy (fmap flip X86.pcmpgtq)) $-         \smax x -> smax x =<< LLVM.neg x-   truncate = return-   floor = return-   fraction = const $ return (value LLVM.zero)--instance Real Word8 where-   min = order A.min X86.pcmpugtb X86.pminub-   max = order A.max (fmap flip X86.pcmpugtb) X86.pmaxub-   abs = return-   truncate = return-   floor = return-   fraction = const $ return (value LLVM.zero)--instance Real Word16 where-   min = order A.min X86.pcmpugtw X86.pminuw-   max = order A.max (fmap flip X86.pcmpugtw) X86.pmaxuw-   abs = return-   truncate = return-   floor = return-   fraction = const $ return (value LLVM.zero)--instance Real Word32 where-   min = order A.min X86.pcmpugtd X86.pminud-   max = order A.max (fmap flip X86.pcmpugtd) X86.pmaxud-   abs = return-   truncate = return-   floor = return-   fraction = const $ return (value LLVM.zero)--instance Real Word64 where-   min = zipAutoWith A.min (orderBy X86.pcmpugtq)-   max = zipAutoWith A.max (orderBy (fmap flip X86.pcmpugtq))-   abs = return+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+module LLVM.Extra.Vector (+   Simple (shuffleMatch, extract), C (insert),+   Element, Size,+   Canonical, Construct,++   size, sizeInTuple,+   replicate, iterate, assemble,++   shuffle,+   rotateUp, rotateDown, reverse,+   shiftUp, shiftDown,+   shiftUpMultiZero, shiftDownMultiZero,++   shuffleMatchTraversable,+   shuffleMatchAccess,+   shuffleMatchPlain1,+   shuffleMatchPlain2,++   insertTraversable,+   extractTraversable,+   extractAll,++   Constant, constant,++   insertChunk, modify,+   map, mapChunks, zipChunksWith,+   chop, concat, select,+   signedFraction,+   cumulate1, umul32to64,+   Arithmetic+      (sum, sumToPair, sumInterleavedToPair,+       cumulate, dotProduct, mul),+   Real+      (min, max, abs, signum,+       truncate, floor, fraction),+   ) where++import qualified LLVM.Extra.Extension.X86Auto as X86A+import qualified LLVM.Extra.ExtensionCheck.X86 as X86C+import qualified LLVM.Extra.Extension.X86 as X86+import qualified LLVM.Extra.Extension as Ext++import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Monad as M+import qualified LLVM.Extra.ArithmeticPrivate as A++import qualified LLVM.Core as LLVM+import LLVM.Util.Loop (Phi(phis, addPhis), )+import LLVM.Core+   (Value, ConstValue, valueOf, value, constOf, undef,+    Vector, insertelement, extractelement, constVector,+    IsConst, IsArithmetic, IsFloating,+    IsPrimitive,+    CodeGenFunction, )++import Types.Data.Num (D4, (:+:), )+import qualified Types.Data.Num as TypeNum+import Control.Monad.HT ((<=<), )+import Control.Monad (liftM2, liftM3, foldM, )+import Data.Tuple.HT (uncurry3, )+import qualified Data.List.HT as ListHT+import qualified Data.List as List++import Control.Applicative (liftA2, )+import qualified Control.Applicative as App+import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold++-- import qualified Data.Bits as Bit+import Data.Int  (Int8, Int16, Int32, Int64, )+import Data.Word (Word8, Word16, Word32, Word64, )++import Prelude hiding+          (Real, truncate, floor, round,+           map, zipWith, iterate, replicate, reverse, concat, sum, )+++-- * target independent functions++{- |+Allow to work on records of vectors as if they are vectors of records.+This is a reasonable approach for records of different element types+since processor vectors can only be built from elements of the same type.+But also, say, for chunked stereo signal this makes sense.+In this case we would work on @Stereo (Value a)@.++Formerly we used a two-way dependency Vector <-> (Element, Size).+Now we have only the dependency Vector -> (Element, Size).+This means that we need some more type annotations+as in umul32to64/assemble,+on the other hand we can allow multiple vector types+with respect to the same element type.+E.g. we can provide a vector type with pair elements+where the pair elements are interleaved in the vector.+-}+class (Simple v) => C v where+   insert :: Value Word32 -> Element v -> v -> CodeGenFunction r v++class+   (TypeNum.PositiveT (Size v), Phi v, Class.Undefined v) =>+      Simple v where++   type Element v :: *+   type Size v :: *++   shuffleMatch ::+      ConstValue (Vector (Size v) Word32) -> v -> CodeGenFunction r v++   extract :: Value Word32 -> v -> CodeGenFunction r (Element v)+++instance+   (TypeNum.PositiveT n, LLVM.IsPrimitive a) =>+      Simple (Value (Vector n a)) where++   type Element (Value (Vector n a)) = Value a+   type Size (Value (Vector n a)) = n++   shuffleMatch is v = shuffleMatchPlain1 v is+   extract k v = extractelement v k++instance+   (TypeNum.PositiveT n, LLVM.IsPrimitive a) =>+      C (Value (Vector n a)) where++   insert k a v = insertelement v a k+++instance+   (Simple v0, Simple v1, Size v0 ~ Size v1) =>+      Simple (v0, v1) where++   type Element (v0, v1) = (Element v0, Element v1)+   type Size (v0, v1) = Size v0++   shuffleMatch is (v0,v1) =+      liftM2 (,)+         (shuffleMatch is v0)+         (shuffleMatch is v1)++   extract k (v0,v1) =+      liftM2 (,)+         (extract k v0)+         (extract k v1)++instance+   (C v0, C v1, Size v0 ~ Size v1) =>+      C (v0, v1) where++   insert k (a0,a1) (v0,v1) =+      liftM2 (,)+         (insert k a0 v0)+         (insert k a1 v1)+++instance+   (Simple v0, Simple v1, Simple v2, Size v0 ~ Size v1, Size v1 ~ Size v2) =>+      Simple (v0, v1, v2) where++   type Element (v0, v1, v2) = (Element v0, Element v1, Element v2)+   type Size (v0, v1, v2) = Size v0++   shuffleMatch is (v0,v1,v2) =+      liftM3 (,,)+         (shuffleMatch is v0)+         (shuffleMatch is v1)+         (shuffleMatch is v2)++   extract k (v0,v1,v2) =+      liftM3 (,,)+         (extract k v0)+         (extract k v1)+         (extract k v2)++instance+   (C v0, C v1, C v2, Size v0 ~ Size v1, Size v1 ~ Size v2) =>+      C (v0, v1, v2) where++   insert k (a0,a1,a2) (v0,v1,v2) =+      liftM3 (,,)+         (insert k a0 v0)+         (insert k a1 v1)+         (insert k a2 v2)+++newtype Constant n a = Constant a++constant :: (TypeNum.PositiveT n) => a -> Constant n a+constant = Constant++instance Functor (Constant n) where+   {-# INLINE fmap #-}+   fmap f (Constant a) = Constant (f a)++instance App.Applicative (Constant n) where+   {-# INLINE pure #-}+   pure = Constant+   {-# INLINE (<*>) #-}+   Constant f <*> Constant a = Constant (f a)++instance Fold.Foldable (Constant n) where+   {-# INLINE foldMap #-}+   foldMap = Trav.foldMapDefault++instance Trav.Traversable (Constant n) where+   {-# INLINE sequenceA #-}+   sequenceA (Constant a) = fmap Constant a++instance (Phi a) => Phi (Constant n a) where+   phis = Class.phisTraversable+   addPhis = Class.addPhisFoldable++instance (Class.Undefined a) => Class.Undefined (Constant n a) where+   undefTuple = Class.undefTuplePointed++instance (TypeNum.PositiveT n, Phi a, Class.Undefined a) => Simple (Constant n a) where++   type Element (Constant n a) = a+   type Size (Constant n a) = n++   shuffleMatch _ = return+   extract _ (Constant a) = return a+++class (n ~ Size (Construct n a), a ~ Element (Construct n a),+       C (Construct n a)) =>+         Canonical n a where+   type Construct n a :: *++instance+   (TypeNum.PositiveT n, LLVM.IsPrimitive a) =>+      Canonical n (Value a) where+   type Construct n (Value a) = Value (Vector n a)++instance (Canonical n a0, Canonical n a1) => Canonical n (a0, a1) where+   type Construct n (a0, a1) = (Construct n a0, Construct n a1)++instance (Canonical n a0, Canonical n a1, Canonical n a2) => Canonical n (a0, a1, a2) where+   type Construct n (a0, a1, a2) = (Construct n a0, Construct n a1, Construct n a2)+++size ::+   (TypeNum.PositiveT n) =>+   Value (Vector n a) -> Int+size =+   let sz :: (TypeNum.PositiveT n) => n -> Value (Vector n a) -> Int+       sz n _ = TypeNum.fromIntegerT n+   in  sz undefined++{- |+Manually assemble a vector of equal values.+Better use ScalarOrVector.replicate.+-}+replicate ::+   (C v) =>+   Element v -> CodeGenFunction r v+replicate = replicateCore undefined++replicateCore ::+   (C v) =>+   Size v -> Element v -> CodeGenFunction r v+replicateCore n =+   assemble . List.replicate (TypeNum.fromIntegerT n)++{- |+construct a vector out of single elements++You must assert that the length of the list matches the vector size.++This can be considered the inverse of 'extractAll'.+-}+assemble ::+   (C v) =>+   [Element v] -> CodeGenFunction r v+assemble =+   foldM (\v (k,x) -> insert (valueOf k) x v) Class.undefTuple .+   List.zip [0..]+{- sends GHC into an infinite loop+   foldM (\(k,x) -> insert (valueOf k) x) Class.undefTuple .+   List.zip [0..]+-}++insertChunk ::+   (C c, C v, Element c ~ Element v) =>+   Int -> c ->+   v -> CodeGenFunction r v+insertChunk k x =+   M.chain $+   List.zipWith+      (\i j -> \v ->+          extract (valueOf i) x >>= \e ->+          insert (valueOf j) e v)+      (take (sizeInTuple x) [0..])+      [fromIntegral k ..]++iterate ::+   (C v) =>+   (Element v -> CodeGenFunction r (Element v)) ->+   Element v -> CodeGenFunction r v+iterate f x =+   fmap snd $+   iterateCore f x Class.undefTuple++iterateCore ::+   (C v) =>+   (Element v -> CodeGenFunction r (Element v)) ->+   Element v -> v ->+   CodeGenFunction r (Element v, v)+iterateCore f x0 v0 =+   foldM+      (\(x,v) k ->+         liftM2 (,) (f x)+            (insert (valueOf k) x v))+      (x0,v0)+      (take (sizeInTuple v0) [0..])++{- |+Manually implement vector shuffling using insertelement and extractelement.+In contrast to LLVM's built-in instruction it supports distinct vector sizes,+but it allows only one input vector+(or a tuple of vectors, but we cannot shuffle between them).+For more complex shuffling we recommend 'extractAll' and 'assemble'.+-}+shuffle ::+   (C v, C w, Element v ~ Element w) =>+   v ->+   ConstValue (Vector (Size w) Word32) ->+   CodeGenFunction r w+shuffle x i =+   assemble =<<+   mapM+      (flip extract x <=< extractelement (value i) . valueOf)+      (take (size (value i)) [0..])+++sizeInTuple :: Simple v => v -> Int+sizeInTuple =+   let sz :: Simple v => Size v -> v -> Int+       sz n _ = TypeNum.fromIntegerT n+   in  sz undefined++{- |+Rotate one element towards the higher elements.++I don't want to call it rotateLeft or rotateRight,+because there is no prefered layout for the vector elements.+In Intel's instruction manual vector+elements are indexed like the bits,+that is from right to left.+However, when working with Haskell list and enumeration syntax,+the start index is left.+-}+rotateUp ::+   (Simple v) =>+   v -> CodeGenFunction r v+rotateUp x =+   shuffleMatch+      (constVector $ List.map constOf $+       (fromIntegral (sizeInTuple x) - 1) : [0..]) x++rotateDown ::+   (Simple v) =>+   v -> CodeGenFunction r v+rotateDown x =+   shuffleMatch+      (constVector $ List.map constOf $+       List.take (sizeInTuple x - 1) [1..] ++ [0]) x++reverse ::+   (Simple v) =>+   v -> CodeGenFunction r v+reverse x =+   shuffleMatch+      (constVector $ List.map constOf $+       List.reverse $+       List.take (sizeInTuple x) [0..]) x++shiftUp ::+   (C v) =>+   Element v -> v -> CodeGenFunction r (Element v, v)+shiftUp x0 x = do+   y <-+      shuffleMatch+         (constVector $ undef : List.map constOf [0..]) x+   liftM2 (,)+      (extract (LLVM.valueOf (fromIntegral (sizeInTuple x) - 1)) x)+      (insert (value LLVM.zero) x0 y)++shiftDown ::+   (C v) =>+   Element v -> v -> CodeGenFunction r (Element v, v)+shiftDown x0 x = do+   y <-+      shuffleMatch+         (constVector $+          List.map constOf (List.take (sizeInTuple x - 1) [1..]) ++ [undef]) x+   liftM2 (,)+      (extract (value LLVM.zero) x)+      (insert (LLVM.valueOf (fromIntegral (sizeInTuple x) - 1)) x0 y)++shiftUpMultiZero ::+   (C v, Class.Zero (Element v)) =>+   Int -> v -> LLVM.CodeGenFunction r v+shiftUpMultiZero n v =+   assemble . take (sizeInTuple v) .+   (List.replicate n Class.zeroTuple ++) =<< extractAll v++shiftDownMultiZero ::+   (C v, Class.Zero (Element v)) =>+   Int -> v -> LLVM.CodeGenFunction r v+shiftDownMultiZero n v =+   assemble . take (sizeInTuple v) .+   (++ List.repeat Class.zeroTuple) . List.drop n+      =<< extractAll v+++shuffleMatchTraversable ::+   (Simple v, Trav.Traversable f) =>+   ConstValue (Vector (Size v) Word32) -> f v -> CodeGenFunction r (f v)+shuffleMatchTraversable is v =+   Trav.mapM (shuffleMatch is) v++{- |+Implement the 'shuffleMatch' method using the methods of the 'C' class.+-}+shuffleMatchAccess ::+   (C v) =>+   ConstValue (Vector (Size v) Word32) -> v -> CodeGenFunction r v+shuffleMatchAccess is v =+   assemble =<<+   mapM+      (flip extract v <=<+       flip extract (value is) . valueOf)+      (take (size (value is)) [0..])+++shuffleMatchPlain1 ::+   (TypeNum.PositiveT n, IsPrimitive a) =>+   Value (Vector n a) ->+   ConstValue (Vector n Word32) ->+   CodeGenFunction r (Value (Vector n a))+shuffleMatchPlain1 x =+   shuffleMatchPlain2 x (value undef)++shuffleMatchPlain2 ::+   (TypeNum.PositiveT n, IsPrimitive a) =>+   Value (Vector n a) ->+   Value (Vector n a) ->+   ConstValue (Vector n Word32) ->+   CodeGenFunction r (Value (Vector n a))+shuffleMatchPlain2 =+   LLVM.shufflevector+++insertTraversable ::+   (C v, Trav.Traversable f, App.Applicative f) =>+   Value Word32 -> f (Element v) -> f v -> CodeGenFunction r (f v)+insertTraversable n a v =+   Trav.sequence (liftA2 (insert n) a v)++extractTraversable ::+   (Simple v, Trav.Traversable f) =>+   Value Word32 -> f v -> CodeGenFunction r (f (Element v))+extractTraversable n v =+   Trav.mapM (extract n) v++{- |+provide the elements of a vector as a list of individual virtual registers++This can be considered the inverse of 'assemble'.+-}+extractAll ::+   (Simple v) =>+   v -> LLVM.CodeGenFunction r [Element v]+extractAll x =+   mapM+      (flip extract x . LLVM.valueOf)+      (take (sizeInTuple x) [0..])+++modify ::+   (C v) =>+   Value Word32 ->+   (Element v -> CodeGenFunction r (Element v)) ->+   (v -> CodeGenFunction r v)+modify k f v =+   flip (insert k) v =<< f =<< extract k v++{- |+Like LLVM.Util.Loop.mapVector but the loop is unrolled,+which is faster since it can be packed by the code generator.+-}+map, _mapByFold ::+   (C v, C w, Size v ~ Size w) =>+   (Element v -> CodeGenFunction r (Element w)) ->+   (v -> CodeGenFunction r w)+map f =+   assemble <=< mapM f <=< extractAll++_mapByFold f a =+   foldM+      (\b n ->+         extract (valueOf n) a >>=+         f >>=+         flip (insert (valueOf n)) b)+      Class.undefTuple+      (take (sizeInTuple a) [0..])++mapChunks ::+   (C ca, C cb, Size ca ~ Size cb,+    C va, C vb, Size va ~ Size vb,+    Element ca ~ Element va, Element cb ~ Element vb) =>+   (ca -> CodeGenFunction r cb) ->+   (va -> CodeGenFunction r vb)+mapChunks f a =+   foldM+      (\b (am,k) ->+         am >>= \ac ->+         f ac >>= \bc ->+         insertChunk (k * sizeInTuple ac) bc b)+      Class.undefTuple $+   List.zip (chop a) [0..]++zipChunksWith ::+   (C ca, C cb, C cc, Size ca ~ Size cb, Size cb ~ Size cc,+    C va, C vb, C vc, Size va ~ Size vb, Size vb ~ Size vc,+    Element ca ~ Element va, Element cb ~ Element vb, Element cc ~ Element vc) =>+   (ca -> cb -> CodeGenFunction r cc) ->+   (va -> vb -> CodeGenFunction r vc)+zipChunksWith f a b =+   mapChunks (uncurry f) (a,b)+++mapChunks2 ::+   (C ca, C cb, Size ca ~ Size cb,+    C la, C lb, Size la ~ Size lb,+    C va, C vb, Size va ~ Size vb,+    Element ca ~ Element va, Element la ~ Element va,+    Element cb ~ Element vb, Element lb ~ Element vb) =>+   (ca -> CodeGenFunction r cb) ->+   (la -> CodeGenFunction r lb) ->+   (va -> CodeGenFunction r vb)+mapChunks2 f g a = do+   let chunkSize :: C ca => (ca -> cgf) -> Size ca -> Int+       chunkSize _ = TypeNum.fromIntegerT+   xs <- extractAll a+   case ListHT.viewR $+        ListHT.sliceVertical (chunkSize g undefined) xs of+      Nothing -> assemble []+      Just (cs,c) -> do+         ds <- mapM (extractAll <=< g <=< assemble) cs+         d <-+            if List.length c <= chunkSize f undefined+              then fmap List.concat $+                   mapM (extractAll <=< f <=< assemble) $+                   ListHT.sliceVertical (chunkSize f undefined) c+              else extractAll =<< g =<< assemble c+         assemble $ List.concat ds ++ d++zipChunks2With ::+   (C ca, C cb, C cc, Size ca ~ Size cb, Size cb ~ Size cc,+    C la, C lb, C lc, Size la ~ Size lb, Size lb ~ Size lc,+    C va, C vb, C vc, Size va ~ Size vb, Size vb ~ Size vc,+    Element ca ~ Element va, Element la ~ Element va,+    Element cb ~ Element vb, Element lb ~ Element vb,+    Element cc ~ Element vc, Element lc ~ Element vc) =>+   (ca -> cb -> CodeGenFunction r cc) ->+   (la -> lb -> CodeGenFunction r lc) ->+   (va -> vb -> CodeGenFunction r vc)+zipChunks2With f g a b =+   mapChunks2 (uncurry f) (uncurry g) (a,b)+++infixl 1 `withRound`++withRound ::+   (IsPrimitive a, IsPrimitive b,+    TypeNum.PositiveT k, TypeNum.PositiveT m, TypeNum.PositiveT n) =>+   CodeGenFunction r x ->+   Ext.T (Value (Vector m a) -> Value Word32 -> CodeGenFunction r (Value (Vector m b))) ->+   Ext.T (Value (Vector k a) -> Value Word32 -> CodeGenFunction r (Value (Vector k b))) ->+   (Value (Vector n b) -> CodeGenFunction r x) ->+   Word32 ->+   Value (Vector n a) -> CodeGenFunction r x+withRound generic roundSmallExt _roundLargeExt post mode x =+   generic+   `Ext.run`+   (Ext.with roundSmallExt $ \round ->+       post =<< mapChunks (flip round (valueOf mode)) x)+{- crashes LLVM-3.1 in JIT mode+Stack dump:+0.      Running pass 'X86 DAG->DAG Instruction Selection' on function '@_fun1'+segmentation fault++   `Ext.run`+   (Ext.with2 roundSmallExt roundLargeExt $ \round roundLarge ->+       post =<< mapChunks2 (flip round (valueOf mode)) (flip roundLarge (valueOf mode)) x)+-}+++{- |+Ideally on ix86 with SSE41 this would be translated to 'dpps'.+-}+dotProductPartial ::+   (TypeNum.PositiveT n, LLVM.IsPrimitive a, LLVM.IsArithmetic a) =>+   Int ->+   Value (Vector n a) ->+   Value (Vector n a) ->+   CodeGenFunction r (Value a)+dotProductPartial n x y =+   sumPartial n =<< A.mul x y++sumPartial ::+   (TypeNum.PositiveT n, LLVM.IsPrimitive a, LLVM.IsArithmetic a) =>+   Int ->+   Value (Vector n a) ->+   CodeGenFunction r (Value a)+sumPartial n x =+   foldl1+      {- quite the same as (+) using LLVM.Arithmetic instances,+         but requires less type constraints -}+      (M.liftR2 A.add)+      (List.map (LLVM.extractelement x . valueOf) $ take n $ [0..])+++{- |+If the target vector type is a native type+then the chop operation produces no actual machine instruction. (nop)+If the vector cannot be evenly divided into chunks+the last chunk will be padded with undefined values.+-}+chop ::+   (C c, C v, Element c ~ Element v) =>+   v -> [CodeGenFunction r c]+chop = chopCore undefined++chopCore ::+   (C c, C v, Element c ~ Element v) =>+   Size c -> v -> [CodeGenFunction r c]+chopCore m x =+   List.map (shuffle x . constVector) $+   ListHT.sliceVertical (TypeNum.fromIntegerT m) $+   List.map constOf $+   take (sizeInTuple x) [0..]++{- |+The target size is determined by the type.+If the chunk list provides more data, the exceeding data is dropped.+If the chunk list provides too few data,+the target vector is filled with undefined elements.+-}+concat ::+   (C c, C v, Element c ~ Element v) =>+   [c] -> CodeGenFunction r v+concat xs =+   foldM+      (\v0 (js,c) ->+         foldM+            (\v (i,j) -> do+               x <- extract (valueOf i) c+               insert (valueOf j) x v)+            v0 $+         List.zip [0..] js)+      Class.undefTuple $+   List.zip+      (ListHT.sliceVertical (sizeInTuple (head xs)) [0..])+      xs+++getLowestPair ::+   (TypeNum.PositiveT n) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value a, Value a)+getLowestPair x =+   liftM2 (,)+      (extractelement x (valueOf 0))+      (extractelement x (valueOf 1))+++_reduceAddInterleaved ::+   (IsArithmetic a, IsPrimitive a,+    TypeNum.PositiveT n, TypeNum.PositiveT m, (m :+: m) ~ n) =>+   m ->+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector m a))+_reduceAddInterleaved tm v = do+   let m = TypeNum.fromIntegerT tm+   x <- shuffle v (constVector $ List.map constOf $ take m [0..])+   y <- shuffle v (constVector $ List.map constOf $ take m [fromIntegral m ..])+   A.add x y++sumGeneric ::+   (IsArithmetic a, IsPrimitive a, TypeNum.PositiveT n) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value a)+sumGeneric =+   flip extractelement (valueOf 0) <=<+   reduceSumInterleaved 1++sumToPairGeneric ::+   (Arithmetic a, TypeNum.PositiveT n) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value a, Value a)+sumToPairGeneric v =+   let n2 = div (size v) 2+   in  sumInterleavedToPair =<<+       shuffleMatchPlain1 v+          (constVector $+           List.map (constOf . fromIntegral) $+           concatMap (\k -> [k, k+n2]) $+           take n2 [0..])++{- |+We partition a vector of size n into chunks of size m+and add these chunks using vector additions.+We do this by repeated halving of the vector,+since this way we do not need assumptions about the native vector size.++We reduce the vector size only virtually,+that is we maintain the vector size and fill with undefined values.+This is reasonable+since LLVM-2.5 and LLVM-2.6 does not allow shuffling between vectors of different size+and because it likes to do computations on Vector D2 Float+in MMX registers on ix86 CPU's,+which interacts badly with FPU usage.+Since we fill the vector with undefined values,+LLVM actually treats the vectors like vectors of smaller size.+-}+reduceSumInterleaved ::+   (IsArithmetic a, IsPrimitive a, TypeNum.PositiveT n) =>+   Int ->+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+reduceSumInterleaved m x0 =+   let go ::+          (IsArithmetic a, IsPrimitive a, TypeNum.PositiveT n) =>+          Int ->+          Value (Vector n a) ->+          CodeGenFunction r (Value (Vector n a))+       go n x =+          if m==n+            then return x+            else+               let n2 = div n 2+               in  go n2+                      =<< A.add x+                      =<< shuffleMatchPlain1 x+                             (constVector $ List.map constOf (take n2 [fromIntegral n2 ..])+                                 ++ List.repeat undef)+   in  go (size x0) x0++cumulateGeneric, _cumulateSimple ::+   (IsArithmetic a, IsPrimitive a, TypeNum.PositiveT n) =>+   Value a -> Value (Vector n a) ->+   CodeGenFunction r (Value a, Value (Vector n a))+_cumulateSimple a x =+   foldM+      (\(a0,y0) k -> do+         a1 <- A.add a0 =<< extract (valueOf k) x+         y1 <- insert (valueOf k) a0 y0+         return (a1,y1))+      (a, Class.undefTuple)+      (take (sizeInTuple x) $ [0..])++cumulateGeneric =+   cumulateFrom1 cumulate1++cumulateFrom1 ::+   (IsArithmetic a, IsPrimitive a, TypeNum.PositiveT n) =>+   (Value (Vector n a) ->+    CodeGenFunction r (Value (Vector n a))) ->+   Value a -> Value (Vector n a) ->+   CodeGenFunction r (Value a, Value (Vector n a))+cumulateFrom1 cum a x0 = do+   (b,x1) <- shiftUp a x0+   y <- cum x1+   z <- A.add b =<< extract (valueOf (fromIntegral (sizeInTuple x0) - 1)) y+   return (z,y)+++{- |+Needs (log n) vector additions+-}+cumulate1 ::+   (IsArithmetic a, IsPrimitive a, TypeNum.PositiveT n) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+cumulate1 x =+   foldM+      (\y k -> A.add y =<< shiftUpMultiZero k y)+      x+      (takeWhile (<sizeInTuple x) $ List.iterate (2*) 1)++++inttofp ::+   (LLVM.PositiveT n,+    IsPrimitive a, IsPrimitive b,+    LLVM.IsInteger a, IsFloating b) =>+   Value (Vector n a) -> CodeGenFunction r (Value (Vector n b))+inttofp = LLVM.inttofp++{-+Can be used for both integer and float types,+but we need it only for Float types,+because LLVM produces ugly code for Float and even more ugly code for Double.+-}+signumLogical ::+   (TypeNum.PositiveT n,+    IsPrimitive a, IsPrimitive b, IsArithmetic b) =>+   (Value (Vector n a) ->+    Value (Vector n a) ->+    CodeGenFunction r (Value (Vector n b))) ->+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n b))+signumLogical gt x = do+   let zero = LLVM.value LLVM.zero+   negative <- gt zero x+   positive <- gt x zero+   A.sub negative positive+++{-+{- |+This one does not use vectorized select.+Cf. the outcommented signumInt.+-}+signumInt ::+   (TypeNum.PositiveT n,+    IsPrimitive a, IsArithmetic a, IsConst a, Num a,+    LLVM.CmpRet a, LLVM.CmpResult a ~ b,+    IsPrimitive b, LLVM.IsInteger b) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+signumInt x = do+   let zero = LLVM.value LLVM.zero+   negative <- A.cmp LLVM.CmpLT x zero+   positive <- A.cmp LLVM.CmpGT x zero+   map+      (\(n,p) ->+         LLVM.select n (valueOf (-1))+            =<< LLVM.select p (valueOf 1) (LLVM.value LLVM.zero))+      (negative, positive)++signumWord ::+   (TypeNum.PositiveT n,+    IsPrimitive a, IsArithmetic a, IsConst a, Num a,+    LLVM.CmpRet a, LLVM.CmpResult a ~ b,+    IsPrimitive b, LLVM.IsInteger b) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+signumWord x = do+   positive <- A.cmp LLVM.CmpGT x (LLVM.value LLVM.zero)+   map+      (\p -> LLVM.select p (valueOf 1) (LLVM.value LLVM.zero))+      positive+-}++signumIntGeneric ::+   (TypeNum.PositiveT n,+    {- TypeNum.PositiveT (n :*: LLVM.SizeOf a), -}+    IsPrimitive a, LLVM.IsInteger a,+    LLVM.CmpRet a, LLVM.CmpResult a ~ b,+    IsPrimitive b, LLVM.IsInteger b) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+signumIntGeneric x = do+   let zero = LLVM.value LLVM.zero+   negative <- LLVM.sadapt =<< A.cmp LLVM.CmpLT x zero+   positive <- LLVM.sadapt =<< A.cmp LLVM.CmpGT x zero+   A.sub positive negative++signumWordGeneric ::+   (TypeNum.PositiveT n,+    IsPrimitive a, LLVM.IsInteger a,+    LLVM.CmpRet a, LLVM.CmpResult a ~ b,+    IsPrimitive b, LLVM.IsInteger b) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+signumWordGeneric x =+   LLVM.zadapt =<< A.cmp LLVM.CmpGT x (LLVM.value LLVM.zero)++signumFloatGeneric ::+   (TypeNum.PositiveT n,+    IsPrimitive a, IsArithmetic a, IsFloating a,+    LLVM.CmpRet a, LLVM.CmpResult a ~ b,+    IsPrimitive b, LLVM.IsInteger b) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+signumFloatGeneric x = do+   let zero = LLVM.value LLVM.zero+   negative <- LLVM.sitofp =<< A.cmp LLVM.CmpLT x zero+   positive <- LLVM.sitofp =<< A.cmp LLVM.CmpGT x zero+   A.sub negative positive+++signedFraction ::+   (IsFloating a, IsConst a, Real a, TypeNum.PositiveT n) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+signedFraction x =+   A.sub x =<< truncate x++floorGeneric ::+   (IsFloating a, IsConst a, Real a, TypeNum.PositiveT n) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+floorGeneric = floorLogical A.fcmp++{- |+On LLVM-2.6 and X86 this produces branch-free+but even slower code than 'fractionSelect',+since the comparison to booleans and+back to a floating point number is translated literally+to elementwise comparison, conversion to a 0 or -1 byte+and then to a floating point number.+-}+fractionGeneric ::+   (IsFloating a, IsConst a, Real a, TypeNum.PositiveT n) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+fractionGeneric = fractionLogical A.fcmp+++{-+These should be replaced by A.min, A.max, A.abs+when they work, eventually.+-}+class (LLVM.IsSized a, LLVM.IsSized (Mask a),+       LLVM.SizeOf a ~ LLVM.SizeOf (Mask a),+       LLVM.IsPrimitive a, LLVM.IsPrimitive (Mask a),+       LLVM.IsInteger (Mask a)) =>+         Maskable a where+   type Mask a :: *++instance Maskable Int8   where type Mask Int8   = Int8+instance Maskable Int16  where type Mask Int16  = Int16+instance Maskable Int32  where type Mask Int32  = Int32+instance Maskable Int64  where type Mask Int64  = Int64+instance Maskable Word8  where type Mask Word8  = Int8+instance Maskable Word16 where type Mask Word16 = Int16+instance Maskable Word32 where type Mask Word32 = Int32+instance Maskable Word64 where type Mask Word64 = Int64+instance Maskable Float  where type Mask Float  = Int32+instance Maskable Double where type Mask Double = Int64++makeMask ::+   (Maskable a, TypeNum.PositiveT n) =>+   Value (Vector n a) ->+   Value (Vector n Bool) ->+   CodeGenFunction r (Value (Vector n (Mask a)))+makeMask _ = LLVM.sadapt+++minGeneric, maxGeneric ::+   (IsConst a, Real a, Maskable a, TypeNum.PositiveT n) =>+   Value (Vector n a) ->+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))++minGeneric x y = do+   b <- makeMask x =<< A.cmp LLVM.CmpLT x y+   selectLogical b x y++maxGeneric x y = do+   b <- makeMask x =<< A.cmp LLVM.CmpGT x y+   selectLogical b x y++absGeneric ::+   (IsConst a, Real a, Maskable a, TypeNum.PositiveT n) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+absGeneric x =+   maxGeneric x =<< LLVM.neg x++absAuto ::+   (TypeNum.PositiveT n, TypeNum.PositiveT m, TypeNum.PositiveT k,+    IsConst a, Real a, Maskable a) =>+   Ext.T (Value (Vector m a) -> CodeGenFunction r (Value (Vector m a))) ->+   Ext.T (Value (Vector k a) -> CodeGenFunction r (Value (Vector k a))) ->+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+absAuto byChunk byLargeChunk x =+   absGeneric x+   `Ext.run`+   (Ext.with byChunk $ \f -> mapChunks f x)+   `Ext.run`+   (Ext.with2 byChunk byLargeChunk $+    \ f g -> mapChunks2 f g x)+++{- |+LLVM.select on boolean vectors cannot be translated to X86 code in LLVM-2.6,+thus I code my own version that calls select on all elements.+This is slow but works.+When this issue is fixed, this function will be replaced by LLVM.select.+-}+select ::+   (LLVM.IsFirstClass a, IsPrimitive a, TypeNum.PositiveT n,+    LLVM.CmpRet a, LLVM.CmpResult a ~ Bool) =>+   Value (Vector n Bool) ->+   Value (Vector n a) ->+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+select b x y =+   map (uncurry3 LLVM.select) (b, x, y)++{- |+'floor' implemented using 'select'.+This will need jumps.+-}+_floorSelect ::+   (Num a, IsFloating a, IsConst a, Real a, TypeNum.PositiveT n) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+_floorSelect x =+   do xr <- truncate x+      b <- A.fcmp LLVM.FPOLE xr x+      select b xr =<< A.sub xr =<< replicate (valueOf 1)++{- |+'fraction' implemented using 'select'.+This will need jumps.+-}+_fractionSelect ::+   (Num a, IsFloating a, IsConst a, Real a, TypeNum.PositiveT n) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+_fractionSelect x =+   do xf <- signedFraction x+      b <- A.fcmp LLVM.FPOGE xf (value LLVM.zero)+      select b xf =<< A.add xf =<< replicate (valueOf 1)+++{- |+Another implementation of 'select',+this time in terms of binary logical operations.+The selecting integers must be+(-1) for selecting an element from the first operand+and 0 for selecting an element from the second operand.+This leads to optimal code.++On SSE41 this could be done with blendvps or blendvpd.+-}+selectLogical ::+   (LLVM.IsFirstClass a, IsPrimitive a,+    LLVM.IsInteger i, IsPrimitive i,+    LLVM.IsSized a, LLVM.IsSized i,+    LLVM.SizeOf a ~ LLVM.SizeOf i,+    TypeNum.PositiveT n) =>+   Value (Vector n i) ->+   Value (Vector n a) ->+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+selectLogical b x y = do+--   bneg <- A.xor b+   bneg <- LLVM.inv b+   xm <- A.and b    =<< LLVM.bitcastElements x+   ym <- A.and bneg =<< LLVM.bitcastElements y+   LLVM.bitcastElements =<< A.or xm ym+++floorLogical ::+   (IsFloating a, IsConst a, Real a,+    IsPrimitive i, LLVM.IsInteger i, TypeNum.PositiveT n) =>+   (LLVM.FPPredicate ->+    Value (Vector n a) ->+    Value (Vector n a) ->+    CodeGenFunction r (Value (Vector n i))) ->+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+floorLogical cmp x =+   do xr <- truncate x+      b <- cmp LLVM.FPOGT xr x+      A.add xr =<< LLVM.sitofp b++fractionLogical ::+   (IsFloating a, IsConst a, Real a,+    IsPrimitive i, LLVM.IsInteger i, TypeNum.PositiveT n) =>+   (LLVM.FPPredicate ->+    Value (Vector n a) ->+    Value (Vector n a) ->+    CodeGenFunction r (Value (Vector n i))) ->+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+fractionLogical cmp x =+   do xf <- signedFraction x+      b <- cmp LLVM.FPOLT xf (value LLVM.zero)+      A.sub xf =<< LLVM.sitofp b+++order ::+   (TypeNum.PositiveT n, TypeNum.PositiveT m, TypeNum.PositiveT k,+    LLVM.IsFirstClass a, IsPrimitive a) =>+   (Value (Vector n a) -> Value (Vector n a) -> CodeGenFunction r (Value (Vector n a))) ->+   Ext.T (Value (Vector m a) -> Value (Vector m a) -> CodeGenFunction r (Value (Vector m a))) ->+   Ext.T (Value (Vector k a) -> Value (Vector k a) -> CodeGenFunction r (Value (Vector k a))) ->+   (Value (Vector n a) -> Value (Vector n a) -> CodeGenFunction r (Value (Vector n a)))+order f byChunk byLargeChunk x y =+   f x y+   `Ext.run`+   (Ext.with byChunk $ \psel -> zipChunksWith psel x y)+   `Ext.run`+   (Ext.with2 byChunk byLargeChunk $+    \ psel plsel -> zipChunks2With psel plsel x y)+++-- * target independent functions with target dependent optimizations++{- |+The order of addition is chosen for maximum efficiency.+We do not try to prevent cancelations.+-}+class (IsArithmetic a, IsPrimitive a) => Arithmetic a where+   sum ::+      (TypeNum.PositiveT n) =>+      Value (Vector n a) ->+      CodeGenFunction r (Value a)+   sum = sumGeneric++   {- |+   The first result value is the sum of all vector elements from 0 to @div n 2 + 1@+   and the second result value is the sum of vector elements from @div n 2@ to @n-1@.+   n must be at least D2.+   -}+   sumToPair ::+      (TypeNum.PositiveT n) =>+      Value (Vector n a) ->+      CodeGenFunction r (Value a, Value a)+   sumToPair = sumToPairGeneric++   {- |+   Treat the vector as concatenation of pairs and all these pairs are added.+   Useful for stereo signal processing.+   n must be at least D2.+   -}+   sumInterleavedToPair ::+      (TypeNum.PositiveT n) =>+      Value (Vector n a) ->+      CodeGenFunction r (Value a, Value a)+   sumInterleavedToPair v =+      getLowestPair =<< reduceSumInterleaved 2 v++   cumulate ::+      (TypeNum.PositiveT n) =>+      Value a -> Value (Vector n a) ->+      CodeGenFunction r (Value a, Value (Vector n a))+   cumulate = cumulateGeneric++   dotProduct ::+      (TypeNum.PositiveT n) =>+      Value (Vector n a) ->+      Value (Vector n a) ->+      CodeGenFunction r (Value a)+   dotProduct x y =+      dotProductPartial (size x) x y++   mul ::+      (TypeNum.PositiveT n) =>+      Value (Vector n a) ->+      Value (Vector n a) ->+      CodeGenFunction r (Value (Vector n a))+   mul = A.mul++instance Arithmetic Float where+   sum x =+      Ext.runWhen (size x >= 4) (sumGeneric x) $+      Ext.with X86A.haddps $ \haddp ->+          {-+          We can make use of the following facts:+          SSE3 has Float vectors of size 4,+          there is an instruction for horizontal add.+          -}+          do chunkSum <-+                foldl1 (M.liftR2 A.add) $ chop x+             y <- haddp chunkSum (value undef)+             z <- haddp y        (value undef)+{-+             y <- haddp chunkSum chunkSum+             z <- haddp y y+-}+             extractelement z (valueOf 0)++   sumToPair x =+      Ext.runWhen (size x >= 4) (getLowestPair x) $+      Ext.with X86A.haddps $ \haddp ->+          let {-+              reduce ::+                 [CodeGenFunction r (Value (Vector D4 Float))] ->+                 [CodeGenFunction r (Value (Vector D4 Float))]+              -}+              reduce [] = []+              reduce [_] = error "vector must have size power of two"+              reduce (x0:x1:xs) =+                 M.liftR2 haddp x0 x1 : reduce xs+              go []  = error "vector must not be empty"+              go [c] =+                 getLowestPair+                    =<< flip haddp (value undef)+                    =<< c+              go cs  = go (reduce cs)+          in  go $ chop x++{-+The haddps based implementation cumulate is slower than the generic one.+However, one day the x86 processors may implement a cumulative sum+which we could employ with this frame.++   cumulate a x =+      Ext.runWhen (size x >= 4) (cumulateGeneric a x) $+      Ext.with X86.cumulate1s $ \cumulate1s -> do+         (b,ys) <-+            foldr+               (\chunk0 cont a0 -> do+                  (a1,chunk1) <- cumulateFrom1 cumulate1s a0 =<< chunk0+                  fmap (mapSnd (chunk1:)) (cont a1))+               (\a0 -> return (a0,[]))+               (chop x)+               a+         y <- concat ys+         return (b,y)+-}++   dotProduct x y =+      Ext.run (sum =<< A.mul x y) $+      Ext.with X86A.dpps $ \dpp ->+         foldl1 (M.liftR2 A.add) $+         List.zipWith+            (\mx my -> do+               cx <- mx+               cy <- my+               flip extractelement (valueOf 0)+                =<< dpp cx cy (valueOf 0xF1))+            (chop x)+            (chop y)++instance Arithmetic Double where++instance Arithmetic Int8   where+instance Arithmetic Int16  where+instance Arithmetic Int32  where+instance Arithmetic Int64  where+instance Arithmetic Word8  where+instance Arithmetic Word16 where+instance Arithmetic Word64 where++instance Arithmetic Word32 where+   mul x y =+      A.mul x y+      `Ext.run`+      (Ext.with X86A.pmuludq128 $ \pmul ->+         zipChunksWith+            (\cx cy -> do+               evenX <- shuffleMatchPlain1 cx+                  (constVector [constOf 0, undef, constOf 2, undef])+               evenY <- shuffleMatchPlain1 cy+                  (constVector [constOf 0, undef, constOf 2, undef])+               evenZ64 <- pmul evenX evenY+               evenZ <- LLVM.bitcast evenZ64+               oddX <- shuffleMatchPlain1 cx+                  (constVector [constOf 1, undef, constOf 3, undef])+               oddY <- shuffleMatchPlain1 cy+                  (constVector [constOf 1, undef, constOf 3, undef])+               oddZ64 <- pmul oddX oddY+               oddZ <- LLVM.bitcast oddZ64+               shuffleMatchPlain2 evenZ oddZ+                  (constVector [constOf 0, constOf 4, constOf 2, constOf 6]))+            x y)+      `Ext.run`+      Ext.wrap X86C.sse41 (A.mul x y)+++umul32to64 ::+   (TypeNum.PositiveT n) =>+   Value (Vector n Word32) ->+   Value (Vector n Word32) ->+   CodeGenFunction r (Value (Vector n Word64))+umul32to64 x y =+   (do x64 <- map LLVM.zext x+       y64 <- map LLVM.zext y+       A.mul x64 y64)+   `Ext.run`+   (Ext.with X86A.pmuludq128 $ \pmul ->+      zipChunksWith+         -- save an initial shuffle+         (\cx cy -> do+            evenX <- shuffleMatchPlain1 cx+               (constVector [constOf 0, undef, constOf 2, undef])+            evenY <- shuffleMatchPlain1 cy+               (constVector [constOf 0, undef, constOf 2, undef])+            evenZ <- pmul evenX evenY+            oddX <- shuffleMatchPlain1 cx+               (constVector [constOf 1, undef, constOf 3, undef])+            oddY <- shuffleMatchPlain1 cy+               (constVector [constOf 1, undef, constOf 3, undef])+            oddZ <- pmul oddX oddY+{-+            shuffleMatchPlain2 evenZ oddZ+               (constVector [constOf 0, constOf 2, constOf 1, constOf 3])+-}+            assemble =<< (sequence $+               extract (valueOf 0) evenZ :+               extract (valueOf 0) oddZ :+               extract (valueOf 1) evenZ :+               extract (valueOf 1) oddZ :+               []) :: CodeGenFunction r (Value (Vector D4 Word64)))+{-+         -- save the final shuffle+         (\cx cy -> do+            lowerX <- shuffleMatchPlain1 cx+               (constVector [constOf 0, undef, constOf 1, undef])+            lowerY <- shuffleMatchPlain1 cy+               (constVector [constOf 0, undef, constOf 1, undef])+            lowerZ <- pmul lowerX lowerY+            upperX <- shuffleMatchPlain1 cx+               (constVector [constOf 2, undef, constOf 3, undef])+            upperY <- shuffleMatchPlain1 cy+               (constVector [constOf 2, undef, constOf 3, undef])+            upperZ <- pmul upperX upperY+{-+            shuffleMatchPlain2 lowerZ upperZ+               (constVector [constOf 0, constOf 1, constOf 2, constOf 3])+-}+            concat [lowerZ, upperZ])+-}+         x y)+++{- |+Attention:+The rounding and fraction functions only work+for floating point values with maximum magnitude of @maxBound :: Int32@.+This way we safe expensive handling of possibly seldom cases.+-}+class (Arithmetic a, LLVM.CmpRet a, LLVM.CmpResult a ~ Bool, IsConst a) =>+         Real a where+   min, max ::+      (TypeNum.PositiveT n) =>+      Value (Vector n a) ->+      Value (Vector n a) ->+      CodeGenFunction r (Value (Vector n a))++   abs ::+      (TypeNum.PositiveT n) =>+      Value (Vector n a) ->+      CodeGenFunction r (Value (Vector n a))++   signum ::+      (TypeNum.PositiveT n) =>+      Value (Vector n a) ->+      CodeGenFunction r (Value (Vector n a))++   truncate, floor, fraction ::+      (TypeNum.PositiveT n) =>+      Value (Vector n a) ->+      CodeGenFunction r (Value (Vector n a))++instance Real Float where+   min = order minGeneric X86A.minps X86A.minps256+   max = order maxGeneric X86A.maxps X86A.maxps256+   abs x = Ext.run (absGeneric x) (Ext.with X86.absps ($x))+   signum x =+      signumFloatGeneric x+      `Ext.run`+      (Ext.with X86.cmpps $ \cmp ->+          inttofp =<< mapChunks (signumLogical (cmp LLVM.FPOGT)) x)+{- crashes LLVM-3.1 in JIT mode+Stack dump:+0.      Running pass 'X86 DAG->DAG Instruction Selection' on function '@_fun1'+segmentation fault++      `Ext.run`+      (Ext.with X86.cmpps256 $ \cmp ->+          mapChunks (signumLogical+             (\a b -> LLVM.sitofp =<< cmp LLVM.FPOGT a b)) x)+-}+{- crashes LLVM-3.1 in JIT mode+   only efficient in AVX2, where large integer vector subtraction is available+      `Ext.run`+      (Ext.with X86.cmpps256 $ \cmp ->+          inttofp =<< mapChunks (signumLogical (cmp LLVM.FPOGT)) x)+-}+   {-+   An IEEE specific implementation could do some bit manipulation:+   s eeeeeeee mmmmmmmmmmmmmmmmmmmmmmm+   Generate a pure power of two by clearing mantissa:+   s eeeeeeee 00000000000000000000000+   Now subtract 1 in order to get the required bit mask for the mantissa+   s eeeeeeee 11111111110000000000000+   multiply with 2 in order to correct exponent+   and then do bitwise AND of the mask with the original number.+   This method only works for numbers from 1 to 2^23-1,+   that is the range is even more smaller+   than that for the rounding via Int32.+   -}+   truncate x =+      withRound+         ((LLVM.inttofp .+           (id :: Value (Vector n Int32) -> Value (Vector n Int32))+           <=< LLVM.fptoint) x)+         X86A.roundps X86A.roundps256 return 3 x+   floor x =+      withRound+         (floorGeneric x+          `Ext.run`+          (Ext.with X86.cmpps $ \cmp ->+              mapChunks (floorLogical cmp) x)+{- LLVM-2.6 rearranges the MXCSR manipulations in an invalid way+          `Ext.run`+          (Ext.with2 (X86.withMXCSR (Bit.shiftL 1 13)) X86.cvtps2dq $+              \ with cvtps2dq -> with $+                 LLVM.inttofp =<< mapChunks cvtps2dq x)+-}+          )+         X86A.roundps X86A.roundps256 return 1 x+   fraction x =+      withRound+         (fractionGeneric x+          `Ext.run`+          (Ext.with X86.cmpps $ \cmp ->+              mapChunks (fractionLogical cmp) x)+{-+          `Ext.run`+          (Ext.with2 (X86.withMXCSR (Bit.shiftL 1 13)) X86.cvtps2dq $+              \ with cvtps2dq -> with $+                 A.sub x =<< LLVM.inttofp =<< mapChunks cvtps2dq x)+-}+          )+         X86A.roundps X86A.roundps256 (A.sub x) 1 x++instance Real Double where+   min = order minGeneric X86A.minpd X86A.minpd256+   max = order maxGeneric X86A.maxpd X86A.maxpd256+   abs x = Ext.run (absGeneric x) (Ext.with X86.abspd ($x))+   signum x =+      signumFloatGeneric x+      `Ext.run`+      (Ext.with2 X86.cmppd X86A.cvtdq2pd $ \cmp tofp ->+          mapChunks (signumLogical+             (\a b -> do+                c <- LLVM.bitcast =<< cmp LLVM.FPOGT a b+                c0 <- extract (valueOf 0) (c :: Value (Vector D4 Int32))+                c1 <- extract (valueOf 2) c+                tofp =<< assemble [c0,c1])) x)+{- crashes LLVM-3.1 in JIT mode+      `Ext.run`+      -- we could still optimize using mapChunks2+      (Ext.with2 X86.cmppd256 X86A.cvtdq2pd256 $ \cmp tofp ->+          mapChunks (signumLogical+             (\a b -> do+                c <- LLVM.bitcast =<< cmp LLVM.FPOGT a b+                c0 <- extract (valueOf 0) (c :: Value (Vector D8 Int32))+                c1 <- extract (valueOf 2) c+                c2 <- extract (valueOf 4) c+                c3 <- extract (valueOf 6) c+                tofp =<< assemble [c0,c1,c2,c3])) x)+-}+   truncate x =+      withRound+         ((LLVM.inttofp .+           (id :: Value (Vector n Int64) -> Value (Vector n Int64))+           <=< LLVM.fptoint) x)+         X86A.roundpd X86A.roundpd256 return 3 x+   floor x =+      withRound+         (floorGeneric x+          `Ext.run`+          (Ext.with X86.cmppd $ \cmp ->+              mapChunks (floorLogical cmp) x))+         X86A.roundpd X86A.roundpd256 return 1 x+   fraction x =+      withRound+         (fractionGeneric x+          `Ext.run`+          (Ext.with X86.cmppd $ \cmp ->+              mapChunks (fractionLogical cmp) x))+         X86A.roundpd X86A.roundpd256 (A.sub x) 1 x++instance Real Int8 where+   min = order minGeneric X86A.pminsb128 X86A.pminsb256+   max = order maxGeneric X86A.pmaxsb128 X86A.pmaxsb256+   abs = absAuto X86A.pabsb128 X86A.pabsb256+   signum = signumIntGeneric+   truncate = return+   floor = return+   fraction = const $ return (value LLVM.zero)++instance Real Int16 where+   min = order minGeneric X86A.pminsw128 X86A.pminsw256+   max = order maxGeneric X86A.pmaxsw128 X86A.pmaxsw256+   abs = absAuto X86A.pabsw128 X86A.pabsw256+   signum = signumIntGeneric+   truncate = return+   floor = return+   fraction = const $ return (value LLVM.zero)++instance Real Int32 where+   min = order minGeneric X86A.pminsd128 X86A.pminsd256+   max = order maxGeneric X86A.pmaxsd128 X86A.pmaxsd256+   abs = absAuto X86A.pabsd128 X86A.pabsd256+   signum = signumIntGeneric+   truncate = return+   floor = return+   fraction = const $ return (value LLVM.zero)++instance Real Int64 where+   min = minGeneric+   max = maxGeneric+   abs = absGeneric+   signum = signumIntGeneric+   truncate = return+   floor = return+   fraction = const $ return (value LLVM.zero)++instance Real Word8 where+   min = order minGeneric X86A.pminub128 X86A.pminub256+   max = order maxGeneric X86A.pmaxub128 X86A.pmaxub256+   abs = return+   signum = signumWordGeneric+   truncate = return+   floor = return+   fraction = const $ return (value LLVM.zero)++instance Real Word16 where+   min = order minGeneric X86A.pminuw128 X86A.pminuw256+   max = order maxGeneric X86A.pmaxuw128 X86A.pmaxuw256+   abs = return+   signum = signumWordGeneric+   truncate = return+   floor = return+   fraction = const $ return (value LLVM.zero)++instance Real Word32 where+   min = order minGeneric X86A.pminud128 X86A.pminud256+   max = order maxGeneric X86A.pmaxud128 X86A.pmaxud256+   abs = return+   signum = signumWordGeneric+   truncate = return+   floor = return+   fraction = const $ return (value LLVM.zero)++instance Real Word64 where+   min = minGeneric+   max = maxGeneric+   abs = return+   signum = signumWordGeneric    truncate = return    floor = return    fraction = const $ return (value LLVM.zero)
+ src/PrepareIntrinsics.hs view
@@ -0,0 +1,326 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{- |+Parse an Intrinsics file and generate a Haskell interface to every intrinsic.+This is currently only tested and used for IntrinsicsX86.td+and relies on the flat structure of IntrinsicsX86.td.+In contrast to that, IntrinsicsPowerPC.td uses custom classes+and thus cannot be processed by this program.++A safer way would be to invoke the llvm-tblgen utility in some way.++1. We could write some Haskell or C++ code,+   that queries the intrinsics from the include/llvm/Intrinsics.h interface.++2. We could write a custom variant of llvm-tblgen+   with a back-end that creates the Haskell interface for intrinsics.+   This can be written in C++ or+   we have to call the TableGen library functions from Haskell somehow.++3. We could ask llvm-tblgen for a list of all records and parse its output.+   This requires no C++ coding,+   but we rely on the output format of @-print-records@.++   > llvm-tblgen -I /usr/local/llvm-3.1/include /usr/local/llvm-3.1/include/llvm/Intrinsics.td -print-records+-}+module Main where++import qualified Text.ParserCombinators.Parsec.Token as T+import qualified Text.ParserCombinators.Parsec.Language as L+import qualified Text.ParserCombinators.Parsec as Parsec+import Text.ParserCombinators.Parsec (CharParser, (<|>), )++import qualified Control.Monad.Trans.Writer as MW+import qualified Data.Map as M+import qualified Data.Set as S++import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold+import qualified Data.List.HT as ListHT+import qualified Data.List as List+import qualified Data.Char as Char+import Control.Monad (mzero, )+import Control.Functor.HT (void, )+import Data.Maybe (fromMaybe, )++import qualified System.IO as IO+++data Intrinsic typ = Intrinsic Name Name (FunctionType typ)+   deriving (Show, Functor, Fold.Foldable, Trav.Traversable)++data FunctionType typ = FunctionType [typ] [typ]+   deriving (Show, Functor, Fold.Foldable, Trav.Traversable)++type Name = String++data QualName = QualName String String String++newtype LLVMType = LLVMType String+   deriving (Show)++newtype HaskellType = HaskellType {haskellTypeDecons :: String}+   deriving (Show, Eq, Ord)+++gccBuiltinPrefix :: String+gccBuiltinPrefix = "__builtin_ia32_"++unsignedFunctions :: S.Set String+unsignedFunctions = S.fromList $ map (gccBuiltinPrefix++) $+   "packusdw128" :+   "packusdw256" :+   "packuswb128" :+   "packuswb256" :+   "paddusb128" :+   "paddusb256" :+   "paddusw128" :+   "paddusw256" :+   "phminposuw128" :+   "pmaddubsw128" :+   "pmaddubsw256" :+   "pmaxub128" :+   "pmaxub256" :+   "pmaxud128" :+   "pmaxud256" :+   "pmaxuw128" :+   "pmaxuw256" :+   "pminub128" :+   "pminub256" :+   "pminud128" :+   "pminud256" :+   "pminuw128" :+   "pminuw256" :+   "pmulhuw128" :+   "pmulhuw256" :+   "pmuludq128" :+   "pmuludq256" :+   "psubusb128" :+   "psubusb256" :+   "psubusw128" :+   "psubusw256" :+   "vphaddubd" :+   "vphaddubq" :+   "vphaddubw" :+   "vphaddudq" :+   "vphadduwd" :+   "vphadduwq" :+   -- it's only the flag set that is unsigned+   -- the floating point operands are always signed+   "roundps" :+   "roundpd" :+   "roundps256" :+   "roundpd256" :+   "roundss" :+   "roundsd" :+   "cmpps" :+   "cmppd" :+   "cmpps256" :+   "cmppd256" :+   "cmpss" :+   "cmpsd" :+   []++translateType ::+   Bool -> LLVMType ->+   MW.Writer (M.Map HaskellType HaskellType) HaskellType+translateType signed (LLVMType llvmTypeStr) =+   let formatQType (mqual, typ) =+          maybe "" (++".") mqual ++ typ+       returnType shortType longType = do+          MW.tell (M.singleton shortType longType)+          return shortType+       composedType = do+          vec <- Parsec.optionMaybe $ do+             void $ Parsec.char 'v'+             Parsec.many1 Parsec.digit+          prim <- Parsec.choice $+             (do void $ Parsec.char 'i'+                 fmap+                    (\n ->+                       if signed+                         then (Just "I", "Int"++n)+                         else (Just "W", "Word"++n)) $+                    Parsec.many1 Parsec.digit) :+             (do void $ Parsec.char 'f'+                 n <- Parsec.many1 Parsec.digit+                 case n of+                    "32" -> return (Nothing, "Float")+                    "64" -> return (Nothing, "Double")+                    _ -> return $ (Just "LLVM", "FP" ++ n)) :+             []+          return $+             case vec of+                Nothing -> return $ HaskellType $ "LLVM.Value " ++ formatQType prim+                Just d ->+                   returnType+                      (HaskellType $ "V" ++ d ++ snd prim)+                      (HaskellType $+                          "LLVM.Value (LLVM.Vector TypeNum.D" +++                          d ++ " " ++ formatQType prim ++ ")")+       p = do+          void $ Parsec.string "llvm_"+          haskType <- Parsec.choice $+             (Parsec.string "x86mmx" >>+              return (returnType (HaskellType "MMX") (HaskellType "LLVM.Value (LLVM.Vector TypeNum.D8 W.Word8)"))) :+             (Parsec.string "ptr" >>+              return (return (HaskellType "LLVM.Value (Ptr ())"))) :+             composedType :+             []+          void $ Parsec.string "_ty"+          return haskType+   in  case Parsec.parse p "" llvmTypeStr of+          Left _msg ->+             let typeSyn = HaskellType $+                    case llvmTypeStr of+                       c:cs -> Char.toUpper c : cs+                       _ -> ""+             in do+                 MW.tell (M.singleton typeSyn (HaskellType "LLVM.Value ()"))+                 return typeSyn+          Right act -> act++splitName :: Name -> QualName+splitName name =+   let p = do+          void $ Parsec.string "int_"+          arch <- Parsec.many1 Parsec.alphaNum+          void $ Parsec.char '_'+          feature <- Parsec.many1 Parsec.alphaNum+          void $ Parsec.char '_'+          stem <- Parsec.many1 Parsec.anyChar+          return $ QualName arch feature stem+   in  case Parsec.parse p "" name of+          Left _msg -> QualName "" "" name+          Right qname -> qname++featureMap :: M.Map String String+featureMap = M.fromList $+   ("sse", "sse1") :+   ("aesni", "aes") :+   ("3dnow", "amd3dnow") :+   ("3dnowa", "amd3dnowa") :+   []++formatIntrinsicInHaskell :: Intrinsic HaskellType -> String+formatIntrinsicInHaskell+      (Intrinsic name gccblt (FunctionType parameters results)) =+   let (QualName _arch feature stem) = splitName name+       dotStem = map (\c -> case c of '_' -> '.'; _ -> c) stem+       haskName =+          fromMaybe gccblt $+          ListHT.maybePrefixOf gccBuiltinPrefix gccblt+       resultStr =+          if null results+            then "LLVM.Value ()"+            else List.intercalate ", " $ map haskellTypeDecons results+   in  unlines $+          (haskName ++ " :: Ext.T (" +++           concatMap (\(HaskellType typ) -> typ ++ " -> ") parameters +++           "LLVM.CodeGenFunction r (" ++ resultStr ++ "))") :+          (haskName ++ " = Ext.intrinsic ExtX86." +++           M.findWithDefault feature feature featureMap +++           " " ++ show dotStem) :+          []++convertIntrinsics :: [Intrinsic LLVMType] -> String+convertIntrinsics intrinsics =+   unlines $+   "{- Do not edit! This file was created with the PrepareIntrinsics tool. -}" :+   "module LLVM.Extra.Extension.X86Auto where" :+   "" :+   "import qualified LLVM.Extra.Extension as Ext" :+   "import qualified LLVM.Extra.ExtensionCheck.X86 as ExtX86" :+   "import qualified LLVM.Core as LLVM" :+   "import qualified Types.Data.Num as TypeNum" :+   "import qualified Data.Int as I" :+   "import qualified Data.Word as W" :+   "import Foreign.Ptr (Ptr, )" :+   "" :+   case MW.runWriter $+        mapM (\intr@(Intrinsic _ gccblt _) ->+                 Trav.traverse (translateType (not $ S.member gccblt unsignedFunctions)) intr) $+        filter (\(Intrinsic _ gccblt _) -> not $ null gccblt) intrinsics of+      (funcs, types) ->+         (map (\(HaskellType short, HaskellType long) ->+                  "type " ++ short ++ " = " ++ long) $+          M.toList types) +++         "" :+         (map formatIntrinsicInHaskell funcs)++lexer :: T.TokenParser st+lexer =+   T.makeTokenParser $ L.emptyDef {+      L.commentStart = "/*",+      L.commentEnd = "*/",+      L.commentLine = "//",+      L.nestedComments = False,+      L.identStart = identifierStart,+      L.identLetter = identifierLetter,+      L.opStart = mzero,+      L.opLetter = mzero,+      L.caseSensitive = True,+      L.reservedNames = [ "let", "def", "in" ],+      L.reservedOpNames = [ "=", ":", "," ]+      }++identifierStart, identifierLetter :: CharParser st Char+identifierStart = Parsec.letter <|> Parsec.char '_'++identifierLetter =+   Parsec.alphaNum <|> Parsec.char '_' <|> Parsec.char '.'+++gccBuiltin :: CharParser st String+gccBuiltin = do+   T.reserved lexer "GCCBuiltin"+   T.angles lexer $ T.stringLiteral lexer++llvmType :: CharParser st LLVMType+llvmType = fmap LLVMType $ T.identifier lexer++intrinsic :: CharParser st (FunctionType LLVMType)+intrinsic =+   Parsec.between (T.reserved lexer "Intrinsic") (T.semi lexer) $+         T.angles lexer $ do+      results <- T.brackets lexer $ T.commaSep lexer llvmType+      void $ T.comma lexer+      parameters <- T.brackets lexer $ T.commaSep lexer llvmType+      Parsec.optional $ do+         void $ T.comma lexer+         _attributes <- T.brackets lexer $ T.commaSep lexer $ T.identifier lexer+         return ()+      return $ FunctionType parameters results++letBlock :: CharParser st [Intrinsic LLVMType]+letBlock = do+   T.reserved lexer "let"+   T.reserved lexer "TargetPrefix"+   void $ T.symbol lexer "="+   _prefix <- T.stringLiteral lexer+   T.reserved lexer "in"+   T.braces lexer $ Parsec.many $ do+      T.reserved lexer "def"+      name <- T.identifier lexer+      void $ T.colon lexer+      gccblt <- Parsec.option "" $ do+         gccblt <- gccBuiltin+         void $ T.comma lexer+         return gccblt+      intr <- intrinsic+      return $ Intrinsic name gccblt intr++parser :: CharParser st [Intrinsic LLVMType]+parser =+   fmap concat $ Parsec.many1 letBlock++main :: IO ()+main = do+   parsed <-+      Parsec.parseFromFile (T.whiteSpace lexer >> parser)+         "/usr/local/llvm-3.1/include/llvm/IntrinsicsX86.td"+   case parsed of+      Left msg -> IO.hPutStrLn IO.stderr $ show msg+      Right intrinsics ->+         writeFile "src/LLVM/Extra/Extension/X86Auto.hs" $ convertIntrinsics intrinsics
x86/cpuid/LLVM/Extra/ExtensionCheck/X86.hs view
@@ -1,14 +1,15 @@ module LLVM.Extra.ExtensionCheck.X86 (-   sse1, sse2, sse3, ssse3, sse41, sse42,+   sse1, sse2, sse3, ssse3, sse41, sse42, avx, avx2,+   fma3, fma4, amd3dnow, amd3dnowa, aes,    ) where  import qualified LLVM.Extra.Extension as Ext import qualified System.Cpuid as CPUID-import System.IO.Unsafe (unsafePerformIO, )+import qualified System.Unsafe as Unsafe  {- I expect that the cpuid does not suddenly change-and thus calling unsafePerformIO is safe.+and thus calling Unsafe.performIO is safe. -} subtarget ::    String ->@@ -16,7 +17,7 @@    Ext.Subtarget subtarget name q =    Ext.Subtarget "x86" name-      (return $ unsafePerformIO $ check q)+      (return $ Unsafe.performIO $ check q)  check ::    (CPUID.FlagSet CPUID.Feature1C -> CPUID.FlagSet CPUID.Feature1D -> Bool) ->@@ -44,3 +45,24 @@  sse42 :: Ext.Subtarget sse42 = subtarget "sse42" (\ecx _edx -> CPUID.testFlag CPUID.sse4_2 ecx)++avx :: Ext.Subtarget+avx = subtarget "avx" (\ecx _edx -> CPUID.testFlag CPUID.avx ecx)++avx2 :: Ext.Subtarget+avx2 = subtarget "avx2" (\ _ecx _edx -> False)++fma3 :: Ext.Subtarget+fma3 = subtarget "fma3" (\ ecx _edx -> CPUID.testFlag CPUID.fma ecx)++fma4 :: Ext.Subtarget+fma4 = subtarget "fma4" (\ _ecx _edx -> False)++amd3dnow :: Ext.Subtarget+amd3dnow = subtarget "3dnow" (\ _ecx _edx -> False)++amd3dnowa :: Ext.Subtarget+amd3dnowa = subtarget "3dnowa" (\ _ecx _edx -> False)++aes :: Ext.Subtarget+aes = subtarget "aesni" (\ _ecx _edx -> False)
x86/none/LLVM/Extra/ExtensionCheck/X86.hs view
@@ -1,5 +1,6 @@ module LLVM.Extra.ExtensionCheck.X86 (-   sse1, sse2, sse3, ssse3, sse41, sse42,+   sse1, sse2, sse3, ssse3, sse41, sse42, avx, avx2,+   fma3, fma4, amd3dnow, amd3dnowa, aes,    ) where  import qualified LLVM.Extra.Extension as Ext@@ -28,3 +29,24 @@  sse42 :: Ext.Subtarget sse42 = subtarget "sse42" False++avx :: Ext.Subtarget+avx = subtarget "avx" False++avx2 :: Ext.Subtarget+avx2 = subtarget "avx2" False++fma3 :: Ext.Subtarget+fma3 = subtarget "fma3" False++fma4 :: Ext.Subtarget+fma4 = subtarget "fma4" False++amd3dnow :: Ext.Subtarget+amd3dnow = subtarget "3dnow" False++amd3dnowa :: Ext.Subtarget+amd3dnowa = subtarget "3dnowa" False++aes :: Ext.Subtarget+aes = subtarget "aesni" False