diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -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 diff --git a/llvm-extra.cabal b/llvm-extra.cabal --- a/llvm-extra.cabal +++ b/llvm-extra.cabal @@ -1,5 +1,5 @@ Name: llvm-extra -Version: 0.3.0.1 +Version: 0.4.1 License: BSD3 License-File: LICENSE Author: Henning Thielemann @@ -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 diff --git a/src/Array.hs b/src/Array.hs --- a/src/Array.hs +++ b/src/Array.hs @@ -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 diff --git a/src/LLVM/Extra/Arithmetic.hs b/src/LLVM/Extra/Arithmetic.hs --- a/src/LLVM/Extra/Arithmetic.hs +++ b/src/LLVM/Extra/Arithmetic.hs @@ -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" diff --git a/src/LLVM/Extra/ArithmeticPrivate.hs b/src/LLVM/Extra/ArithmeticPrivate.hs --- a/src/LLVM/Extra/ArithmeticPrivate.hs +++ b/src/LLVM/Extra/ArithmeticPrivate.hs @@ -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 diff --git a/src/LLVM/Extra/Array.hs b/src/LLVM/Extra/Array.hs --- a/src/LLVM/Extra/Array.hs +++ b/src/LLVM/Extra/Array.hs @@ -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 = diff --git a/src/LLVM/Extra/Class.hs b/src/LLVM/Extra/Class.hs --- a/src/LLVM/Extra/Class.hs +++ b/src/LLVM/Extra/Class.hs @@ -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) - - diff --git a/src/LLVM/Extra/Control.hs b/src/LLVM/Extra/Control.hs --- a/src/LLVM/Extra/Control.hs +++ b/src/LLVM/Extra/Control.hs @@ -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 diff --git a/src/LLVM/Extra/Extension.hs b/src/LLVM/Extra/Extension.hs --- a/src/LLVM/Extra/Extension.hs +++ b/src/LLVM/Extra/Extension.hs @@ -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 -> diff --git a/src/LLVM/Extra/Extension/X86.hs b/src/LLVM/Extra/Extension/X86.hs --- a/src/LLVM/Extra/Extension/X86.hs +++ b/src/LLVM/Extra/Extension/X86.hs @@ -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] diff --git a/src/LLVM/Extra/Extension/X86Auto.hs b/src/LLVM/Extra/Extension/X86Auto.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/Extra/Extension/X86Auto.hs @@ -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" + diff --git a/src/LLVM/Extra/ForeignPtr.hs b/src/LLVM/Extra/ForeignPtr.hs --- a/src/LLVM/Extra/ForeignPtr.hs +++ b/src/LLVM/Extra/ForeignPtr.hs @@ -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) diff --git a/src/LLVM/Extra/MaybeContinuation.hs b/src/LLVM/Extra/MaybeContinuation.hs --- a/src/LLVM/Extra/MaybeContinuation.hs +++ b/src/LLVM/Extra/MaybeContinuation.hs @@ -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) diff --git a/src/LLVM/Extra/Memory.hs b/src/LLVM/Extra/Memory.hs --- a/src/LLVM/Extra/Memory.hs +++ b/src/LLVM/Extra/Memory.hs @@ -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) diff --git a/src/LLVM/Extra/ScalarOrVector.hs b/src/LLVM/Extra/ScalarOrVector.hs --- a/src/LLVM/Extra/ScalarOrVector.hs +++ b/src/LLVM/Extra/ScalarOrVector.hs @@ -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] diff --git a/src/LLVM/Extra/Vector.hs b/src/LLVM/Extra/Vector.hs --- a/src/LLVM/Extra/Vector.hs +++ b/src/LLVM/Extra/Vector.hs @@ -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 ( - 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 ( + 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) diff --git a/src/PrepareIntrinsics.hs b/src/PrepareIntrinsics.hs new file mode 100644 --- /dev/null +++ b/src/PrepareIntrinsics.hs @@ -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 diff --git a/x86/cpuid/LLVM/Extra/ExtensionCheck/X86.hs b/x86/cpuid/LLVM/Extra/ExtensionCheck/X86.hs --- a/x86/cpuid/LLVM/Extra/ExtensionCheck/X86.hs +++ b/x86/cpuid/LLVM/Extra/ExtensionCheck/X86.hs @@ -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) diff --git a/x86/none/LLVM/Extra/ExtensionCheck/X86.hs b/x86/none/LLVM/Extra/ExtensionCheck/X86.hs --- a/x86/none/LLVM/Extra/ExtensionCheck/X86.hs +++ b/x86/none/LLVM/Extra/ExtensionCheck/X86.hs @@ -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