packages feed

llvm-extra 0.7.3 → 0.13.0.1

raw patch · 63 files changed

Files

+ Changes.md view
@@ -0,0 +1,48 @@+# Change log for the `llvm-extra` package++## 0.12.1++* `Multi.Value` -> `Nice.Value`++  The `Multi.Value` name was misleading.+  `Multi.Value` retained for compatibility for now.++## 0.11++* `Memory`: turn methods `load` and `store` into top-level functions+  based on `decompose` and `compose`.+  Deriving `decompose` and `compose` from `load` and `store`, respectively,+  requires `alloca` which will blast your stack when used in a loop.++## 0.10++* `Storable`: We do not support storing tuple types directly anymore.+  This would require the `storable-tuple` package.+  That package ships orphan `Storable` instances+  with a memory layout that does not match your system's ABI.+  Instead, we support the `Tuple` wrapper from `storable-record`.++* `Memory`: Attention!+  Memory layout is no longer compatible with `Foreign.Storable`.+  E.g. `Bool` now takes 1 byte space like LLVM does,+  but no longer 4 byte like `Foreign.Storable`.+  A `Foreign.Storable`-compliant layout+  is provided by `LLVM.Extra.Storable` now.++* `Marshal`: Now based on `Memory.load` and `Memory.store`.+  Does not need `Proxy` anymore.++* `Class` -> `Tuple`,+  `Tuple.Vector` class added.+  Pro: `valueOf vector` is no longer restricted to `IsPrimitive` elements.+  Cons: type inference works less well than before++## 0.9++* `Extension`: Move to new package `llvm-extension`.+  We now implement advanced instructions using generic LLVM intrinsics.++## 0.8.1++* `FastMath`: support for simplified arithmetic primitives+  under the assumption of the absence of corner cases.
Makefile view
@@ -1,18 +1,10 @@ .PHONY:	sharedobj -ghci:-	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 configure --user -fbuildExamples --enable-tests 	runhaskell Setup.lhs build+#	runhaskell Setup.lhs haddock+	./dist/build/llvm-extra-test/llvm-extra-test  llvmversion = 2.6
− Problems.txt 
@@ -1,91 +0,0 @@-LLVM-2.5 running GHCi--First I can load, say, Array.hs in ghci.-When running 'main' I get the error that LLVMSystem.so cannot be found.-No LLVM*.so file on my machine, cannot be found in a Suse package.-Building .so file manually using gcc as in ./make-so.sh.--Then I get a problem with pthread.so not being a shared object file-but a script.-However, we do not need pthread anyway,-thus removing it from ~/.ghc/i386-linux-6.10.4/package.conf solves that problem.-This is a known issue:-   http://hackage.haskell.org/trac/ghc/ticket/2615#comment:16--In GHC-6.12.3 you must also run-   ghc-pkg recache --user-  after removing pthread from ~/.ghc/i386-linux-6.12.3/package.conf.d/llvm-*.conf--Now when running 'main' I get the error,-that something about CurrentEngine cannot be found.-It means, we must also include /usr/lib/llvm/LLVM*.o files.-But in what order?-Seems there is no working order,-but the one given by-   llvm-config --libs-is close to what we need.-Problem: GHCi cannot cope with weak symbol _ZTIN4llvm12X86SubtargetE ("V" in nm)--This is a known issue due to-  http://hackage.haskell.org/trac/ghc/ticket/3333#comment:3--I have used gcc to build a monolithic libLLVM.so-containing all libLLVM*.a and libLLVM*.o files of /usr/lib/llvm/.-Then I reduced the occurrences of LLVM in package.conf-in the extraLibraries field to "LLVM"-and the ldOptions to -lLLVM.---Now I can call LLVM in GHCi - but only until I do :reload.-After reload the next attempt to play something will let GHCi quit with:--ghci: JITEmitter.cpp:110: <unnamed>::JITResolver::JITResolver(llvm::JIT&): Assertion `TheJITResolver == 0 && "Multiple JIT resolvers?"' failed.--Maybe this can be handled in LLVM-2.6-where the JIT must be initialized explicitly.---LLVM-2.6:--If I do as described above,-then when linking the Array example-I get errors for undefined symbols like-/usr/local/lib/libLLVM.so: undefined reference to `AutoGeneratedSwitch_emit_dash_llvm'-/usr/local/lib/libLLVM.so: undefined reference to `AutoGeneratedList_Wl_comma_'-...--These can be avoided by excluding libplugin_llvmc_Base.a-and libplugin_llvmc_Clang.a from the libLLVM.so conglomerate.-Then the example can be compiled but it aborts with PassRegistrar error as below.--I GHCi I get «unknown symbol `LLVMGetBitcodeModuleProviderInContext'»-when running 'main' in GHCi.-Additionally to -lLLVM for our custom libLLVM.so-I have to add -lLTO to ldOptions.-Then all symbols can be found.-However, when running LLVM.initializeNativeTarget-GHCi quits with-ghci: Pass.cpp:152: void<unnamed>::PassRegistrar::RegisterPass(const llvm::PassInfo&): Assertion `Inserted && "Pass registered multiple times!"' failed.-Also running LLVM.Target.X86.initializeTarget or Array.renderRamp-leads to this error.---LLVM-2.8--If I remove 'pthread' from Extra-Libraries and add 'LLVM-2.8rc' to Extra-GHCi-Libraries in-  $HOME/.ghc/i386-linux-6.12.3/package.conf.d/llvm-0.9.*-*.conf- and run-  ghc-pkg recache --user- I am even able to run 'llvm' example programs from within GHCi!--Sometimes it happends that llvm.buildinfo contains-ld-options: /usr/local/lib/libLLVM-2.8rc.so-and then llvm-0.9.*-*.conf contains this as well.-This leads to a failure of a LLVM runtime assertion:--llvm/examples$ DotProd.exe-Two passes with the same argument (-preverify) attempted to be registered!-UNREACHABLE executed!-Aborted--ld-options field must be empty!
llvm-extra.cabal view
@@ -1,6 +1,7 @@+Cabal-Version:  2.2 Name:           llvm-extra-Version:        0.7.3-License:        BSD3+Version:        0.13.0.1+License:        BSD-3-Clause License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de> Maintainer:     Henning Thielemann <haskell@henning-thielemann.de>@@ -20,9 +21,15 @@   * a type class for loading and storing sets of values with one command (macro)     in "LLVM.Extra.Memory",   .-  * support instance declarations of LLVM classes-    in "LLVM.Extra.Class",+  * storing and reading Haskell values in an LLVM compatible format+    in "LLVM.Extra.Marshal",   .+  * LLVM functions for loading and storing values in Haskell's @Storable@ format+    in "LLVM.Extra.Storable",+  .+  * support value tuples and instance declarations of LLVM classes+    in "LLVM.Extra.Tuple",+  .   * handling of termination by a custom monad on top of @CodeGenFunction@     in "LLVM.Extra.MaybeContinuation"   .@@ -31,14 +38,7 @@   .   * more functional loop construction using "LLVM.Extra.Iterator"   .-  * complex Haskell values mapped to LLVM values in "LLVM.Extra.Multi.Value"-  .-  * automatic adaption to target specific extensions,-    currently used for access of vector operations-    that are specific to an SSE level on x86 processors-    in "LLVM.Extra.Extension"-    (On x86 architectures we depend on the cpuid package-     that is needed for automatic detection of available features.)+  * complex Haskell values mapped to LLVM values in "LLVM.Extra.Nice.Value"   .   * advanced vector operations     such as sum of all vector elements, cumulative sum,@@ -48,34 +48,22 @@   * type classes for handling scalar and vector operations     in a uniform way     in "LLVM.Extra.ScalarOrVector"-  .-  * 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-Tested-With:    GHC==7.0.4, GHC==7.4.1, GHC==7.6.3-Cabal-Version:  >=1.14+Tested-With:    GHC==7.0.4, GHC==7.4.2, GHC==7.8.4+Tested-With:    GHC==8.4.4, GHC==8.6.5, GHC==8.8.1 Build-Type:     Simple Extra-Source-Files:   Makefile-  Problems.txt-  x86/cpuid/LLVM/Extra/ExtensionCheck/X86.hs-  x86/none/LLVM/Extra/ExtensionCheck/X86.hs +Extra-Doc-Files:+  Changes.md+ Flag buildExamples   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.7.3+  Tag:         0.13.0.1   Type:        darcs   Location:    http://code.haskell.org/~thielema/llvm-extra/ @@ -85,30 +73,22 @@  Library   Build-Depends:-    -- llvm must be imported with restrictive version bounds,-    -- because we import implicitly and unqualified-    llvm-tf >=3.0.3 && <3.2,+    private,+    llvm-tf >=12.1 && <21.1,     tfp >=1.0 && <1.1,     non-empty >=0.2.1 && <0.4,-    containers >=0.1 && <0.6,-    bifunctors >=5.4 && <6,-    transformers >=0.1.1 && <0.6,-    utility-ht >=0.0.1 && <0.1--  Build-Depends:-    base >=3 && <5--  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-    -- we may ask LLVM's Subtarget detection.-    -- This would also enable cross compilation.-    -- However in LLVM-2.6 this is only available in the C++ interface.-    Hs-Source-Dirs: x86/none+    fixed-length >=0.2.1 && <0.3,+    containers >=0.1 && <0.9,+    enumset >=0.0.5 && <0.2,+    storable-record >=0.0.5 && <0.1,+    storable-enum >=0.0 && <0.1,+    bool8 >=0.0 && <0.1,+    transformers >=0.1.1 && <0.7,+    tagged >=0.7 && <0.9,+    utility-ht >=0.0.15 && <0.1,+    prelude-compat >=0.0 && <0.0.1,+    base-orphans >= 0.5 && <1,+    base >=4.8 && <5    Default-Language: Haskell98   GHC-Options: -Wall@@ -117,32 +97,62 @@     LLVM.Extra.Arithmetic     LLVM.Extra.Monad     LLVM.Extra.Memory+    LLVM.Extra.Marshal+    LLVM.Extra.Storable     LLVM.Extra.Maybe     LLVM.Extra.MaybeContinuation     LLVM.Extra.Either-    LLVM.Extra.Class+    LLVM.Extra.Tuple+    LLVM.Extra.Struct     LLVM.Extra.Control-    LLVM.Extra.Extension-    LLVM.Extra.Extension.X86-    LLVM.Extra.ExtensionCheck.X86+    LLVM.Extra.Function     LLVM.Extra.Array     LLVM.Extra.Scalar     LLVM.Extra.Vector     LLVM.Extra.ScalarOrVector+    LLVM.Extra.FastMath     LLVM.Extra.Iterator+    LLVM.Extra.Nice.Iterator+    LLVM.Extra.Nice.Value+    LLVM.Extra.Nice.Value.Vector+    LLVM.Extra.Nice.Value.Marshal+    LLVM.Extra.Nice.Value.Storable+    LLVM.Extra.Nice.Vector+    LLVM.Extra.Nice.Vector.Instance+    LLVM.Extra.Nice.Class+    -- retained for compatibility     LLVM.Extra.Multi.Iterator     LLVM.Extra.Multi.Value-    LLVM.Extra.Multi.Value.Memory+    LLVM.Extra.Multi.Value.Vector+    LLVM.Extra.Multi.Value.Marshal+    LLVM.Extra.Multi.Value.Storable     LLVM.Extra.Multi.Vector-    LLVM.Extra.Multi.Vector.Memory+    LLVM.Extra.Multi.Vector.Instance     LLVM.Extra.Multi.Class   Other-Modules:-    LLVM.Extra.ArithmeticPrivate+    LLVM.Extra.Storable.Array+    LLVM.Extra.Storable.Private+    LLVM.Extra.TuplePrivate     LLVM.Extra.MaybePrivate     LLVM.Extra.EitherPrivate-    LLVM.Extra.MemoryPrivate-    LLVM.Extra.Extension.X86Auto+    LLVM.Extra.Nice.Value.Private+    LLVM.Extra.Nice.Value.Array +Library private+  Build-Depends:+    llvm-tf,+    tfp,+    non-empty,+    utility-ht,+    base >=3 && <5++  Default-Language: Haskell98+  GHC-Options: -Wall+  Hs-source-dirs: private+  Exposed-Modules:+    LLVM.Extra.ScalarOrVectorPrivate+    LLVM.Extra.ArithmeticPrivate+ Executable tone-llvm   If flag(buildExamples)     Build-Depends:@@ -150,7 +160,7 @@       llvm-tf,       tfp,       non-empty,-      containers >=0.1 && <0.6,+      containers >=0.1 && <0.9,       transformers,       utility-ht >=0.0.1 && <0.1,       base >=3 && <5@@ -160,16 +170,24 @@   GHC-Options: -Wall   Main-Is: src/Array.hs -Executable prepare-intrinsics-  If flag(buildTools)-    Build-Depends:-      parsec >=2.1 && <3.2,-      containers >=0.1 && <0.6,-      transformers,-      utility-ht >=0.0.1 && <0.1,-      base >=3 && <5-  Else-    Buildable: False+Test-Suite llvm-extra-test+  Type: exitcode-stdio-1.0+  Build-Depends:+    doctest-exitcode-stdio >=0.0 && <0.1,+    QuickCheck >=2.11 && <3,+    private,+    llvm-extra,+    llvm-tf,+    tfp,+    storable-record,+    utility-ht >=0.0.1 && <0.1,+    transformers,+    base >=3 && <5   Default-Language: Haskell98   GHC-Options: -Wall-  Main-Is: src/PrepareIntrinsics.hs+  Hs-Source-Dirs: test+  Main-Is: Main.hs+  Other-Modules:+    Test.Storable+    Test.Vector+    LLVM.Extra.VectorAlt
+ private/LLVM/Extra/ArithmeticPrivate.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module LLVM.Extra.ArithmeticPrivate where++import qualified LLVM.Util.Intrinsic as Intrinsic++import qualified LLVM.Core as LLVM+import LLVM.Core+   (CodeGenFunction, valueOf, Value,+    CmpPredicate(CmpLE, CmpGE), FPPredicate, CmpRet, CmpResult,+    IsConst, IsPrimitive, IsArithmetic, IsInteger, IsFloating,+    getElementPtr, )++import Data.Word (Word32, )+import Data.Int (Int32, )++import Prelude hiding (and, or, sqrt, sin, cos, exp, log, abs, min, max, )+++add ::+   (IsArithmetic a) =>+   Value a -> Value a -> CodeGenFunction r (Value a)+add = LLVM.add++sub ::+   (IsArithmetic a) =>+   Value a -> Value a -> CodeGenFunction r (Value a)+sub = LLVM.sub+++inc ::+   (IsArithmetic a, IsConst a, Num a) =>+   Value a -> CodeGenFunction r (Value a)+inc x = add x (valueOf 1)++dec ::+   (IsArithmetic a, IsConst a, Num a) =>+   Value a -> CodeGenFunction r (Value a)+dec x = sub x (valueOf 1)++advanceArrayElementPtr ::+   (LLVM.IsType a) =>+   Value (LLVM.Ptr a) ->+   CodeGenFunction r (Value (LLVM.Ptr a))+advanceArrayElementPtr p =+   getElementPtr p (valueOf 1 :: Value Word32, ())++decreaseArrayElementPtr ::+   (LLVM.IsType a) =>+   Value (LLVM.Ptr a) ->+   CodeGenFunction r (Value (LLVM.Ptr a))+decreaseArrayElementPtr p =+   getElementPtr p (valueOf (-1) :: Value Int32, ())++++mul ::+   (IsArithmetic a) =>+   Value a -> Value a -> CodeGenFunction r (Value a)+mul = LLVM.mul+++{- |+This would also work for vectors,+but LLVM-3.1 crashes when actually doing this.+-}+min :: (CmpRet a) => Value a -> Value a -> CodeGenFunction r (Value a)+min = cmpSelect (cmp CmpLE)++max :: (CmpRet a) => Value a -> Value a -> CodeGenFunction r (Value a)+max = cmpSelect (cmp CmpGE)++abs :: (IsArithmetic a, CmpRet a) =>+   Value a -> CodeGenFunction r (Value a)+abs x = do+   b <- cmp LLVM.CmpGE x (LLVM.value LLVM.zero)+   LLVM.select b x =<< LLVM.neg x+++signumGen ::+   (CmpRet a, IsPrimitive a) =>+   Value a -> 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, CmpRet a, IsConst a, IsPrimitive a) =>+   Value a -> CodeGenFunction r (Value a)+signum = signumGen (LLVM.valueOf (-1)) (LLVM.valueOf 1)+++cmpSelect ::+   (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, CmpResult a ~ b) =>+   FPPredicate -> Value a -> Value a -> CodeGenFunction r (Value b)+fcmp = LLVM.fcmp++cmp ::+   (CmpRet a, CmpResult a ~ b) =>+   CmpPredicate -> Value a -> Value a -> CodeGenFunction r (Value b)+cmp = LLVM.cmp++++and ::+   (IsInteger a) =>+   Value a -> Value a -> CodeGenFunction r (Value a)+and = LLVM.and++or ::+   (IsInteger a) =>+   Value a -> Value a -> CodeGenFunction r (Value a)+or = LLVM.or+++fraction :: (IsFloating a) => Value a -> CodeGenFunction r (Value a)+fraction x = sub x =<< Intrinsic.floor x
+ private/LLVM/Extra/ScalarOrVectorPrivate.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module LLVM.Extra.ScalarOrVectorPrivate where++import qualified LLVM.Extra.ArithmeticPrivate as A++import qualified Type.Data.Num.Decimal as TypeNum+import Type.Data.Num.Decimal (D1)++import qualified LLVM.Core as LLVM+import LLVM.Core+   (Value, ConstValue, valueOf,+    CmpRet, ShapeOf,+    Vector, WordN, IntN, FP128,+    IsConst, IsInteger, CodeGenFunction)++import qualified Data.NonEmpty as NonEmpty+import Data.Word (Word8, Word16, Word32, Word64, Word)+import Data.Int  (Int8,  Int16,  Int32,  Int64)++import Prelude hiding (replicate)+++type family Scalar vector++type instance Scalar Float  = Float+type instance Scalar Double = Double+type instance Scalar FP128  = FP128+type instance Scalar Bool   = Bool+type instance Scalar Int    = Int+type instance Scalar Int8   = Int8+type instance Scalar Int16  = Int16+type instance Scalar Int32  = Int32+type instance Scalar Int64  = Int64+type instance Scalar Word   = Word+type instance Scalar Word8  = Word8+type instance Scalar Word16 = Word16+type instance Scalar Word32 = Word32+type instance Scalar Word64 = Word64+type instance Scalar (IntN  d) = IntN  d+type instance Scalar (WordN d) = WordN d+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 Int    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 Word   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 Replicate (IntN  d) where replicate = return; replicateConst = id;+instance Replicate (WordN d) where replicate = return; replicateConst = id;+instance+   (TypeNum.Positive n, LLVM.IsPrimitive a) =>+      Replicate (Vector n a) where+   replicate x = do+      v <- singleton x+      LLVM.shufflevector v (LLVM.value LLVM.undef) LLVM.zero+   replicateConst x = LLVM.constCyclicVector $ NonEmpty.Cons x []++singleton ::+   (LLVM.IsPrimitive a) =>+   Value a -> CodeGenFunction r (Value (Vector D1 a))+singleton x =+   LLVM.insertelement (LLVM.value LLVM.undef) x (valueOf 0)+++uaddSat, usubSat ::+   (IsInteger v, CmpRet v, Replicate v, Scalar v ~ a, IsConst a, Bounded a) =>+   Value v -> Value v -> CodeGenFunction r (Value v)+uaddSat x y = do+   z <- A.add x y+   wrong <- A.cmp LLVM.CmpLT z x+   maxBnd <- replicate $ valueOf maxBound+   LLVM.select wrong maxBnd z+usubSat x y = do+   z <- A.sub x y+   wrong <- A.cmp LLVM.CmpGT z x+   LLVM.select wrong (LLVM.value LLVM.zero) z++saddSat, ssubSat ::+   (IsInteger v, CmpRet v, Replicate v, ShapeOf v ~ shape,+    LLVM.ShapedType shape Bool ~ bv, ShapeOf bv ~ shape, CmpRet bv,+    Scalar v ~ a, IsConst a, Bounded a) =>+   Value v -> Value v -> CodeGenFunction r (Value v)++saddSat x y = do+   z <- A.add x y+   nonNegX <- A.cmp LLVM.CmpGE x $ LLVM.value LLVM.zero+   nonNegY <- A.cmp LLVM.CmpGE y $ LLVM.value LLVM.zero+   distinctSign <- A.cmp LLVM.CmpNE nonNegX nonNegY+   overflow <- A.cmp LLVM.CmpLT z x+   underflow <- A.cmp LLVM.CmpGT z x+   maxBnd <- replicate $ valueOf maxBound+   minBnd <- replicate $ valueOf minBound+   maxSat <- LLVM.select overflow maxBnd z+   minSat <- LLVM.select underflow minBnd z+   saturated <- LLVM.select nonNegX maxSat minSat+   LLVM.select distinctSign z saturated++ssubSat x y = do+   z <- A.sub x y+   nonNegX <- A.cmp LLVM.CmpGE x $ LLVM.value LLVM.zero+   nonNegY <- A.cmp LLVM.CmpGE y $ LLVM.value LLVM.zero+   sameSign <- A.cmp LLVM.CmpEQ nonNegX nonNegY+   overflow <- A.cmp LLVM.CmpLT z x+   underflow <- A.cmp LLVM.CmpGT z x+   maxBnd <- replicate $ valueOf maxBound+   minBnd <- replicate $ valueOf minBound+   maxSat <- LLVM.select overflow maxBnd z+   minSat <- LLVM.select underflow minBnd z+   saturated <- LLVM.select nonNegX maxSat minSat+   LLVM.select sameSign z saturated++saddSatLogical ::+   (IsInteger v, CmpRet v, Replicate v, ShapeOf v ~ shape,+    LLVM.ShapedType shape Bool ~ bv, ShapeOf bv ~ shape, CmpRet bv,+    IsInteger bv,+    Scalar v ~ a, IsConst a, Bounded a) =>+   Value v -> Value v -> CodeGenFunction r (Value v)+saddSatLogical x y = do+   z <- A.add x y+   nonNegX <- A.cmp LLVM.CmpGE x $ LLVM.value LLVM.zero+   nonNegY <- A.cmp LLVM.CmpGE y $ LLVM.value LLVM.zero+   distinctSign <- A.cmp LLVM.CmpNE nonNegX nonNegY+   minBnd <- replicate $ valueOf minBound+   maxBnd <- replicate $ valueOf maxBound+   bounds <- LLVM.select nonNegX maxBnd minBnd+   overflow <- A.cmp LLVM.CmpLT z y+   underflow <- A.cmp LLVM.CmpGT z y+   xflow <- LLVM.select nonNegX overflow underflow+   correctSum <- A.or distinctSign xflow+   LLVM.select correctSum z bounds
src/Array.hs view
@@ -3,23 +3,22 @@ {-# LANGUAGE ForeignFunctionInterface #-} module Main where -import LLVM.Extra.Control (arrayLoop, ) import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Vector as Vector -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.Iterator as Iter+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Arithmetic as A+import LLVM.Extra.Storable (arrayLoop, store)+import LLVM.Extra.Control (ret)  import qualified LLVM.ExecutionEngine as EE import qualified LLVM.Core as LLVM import LLVM.ExecutionEngine (simpleFunction, ) import LLVM.Core          (Value, valueOf, value, constOf, undef, zero, add, sub, mul, frem,-          createFunction, Function, Linkage(ExternalLinkage), ret,-          CodeGenModule, CodeGenFunction, store,+          createFunction, Function, Linkage(ExternalLinkage),+          CodeGenModule, CodeGenFunction,           Vector, extractelement, insertelement, shufflevector, ) import qualified System.IO as IO @@ -32,8 +31,10 @@ import qualified Data.Empty as Empty import Data.NonEmpty ((!:), ) -import Control.Monad.Trans.State (StateT(StateT), runStateT, )-import Control.Monad (liftM2, )+import Control.Monad.Trans.State (StateT(StateT), runStateT)+import Control.Monad.HT ((<=<))+import Control.Monad (liftM2)+import Control.Applicative (liftA2)   @@ -42,7 +43,7 @@ constVec ::    Float -> CodeGenFunction r (Value (Vector D4 Float)) constVec x =-   return $ valueOf $ LLVM.toVector (x,x,x,x)+   return $ valueOf $ LLVM.consVector x x x x  constVecInsert ::    Float -> CodeGenFunction r (Value (Vector D4 Float))@@ -59,9 +60,7 @@ because 'frem' is only available in the FPU. -} fractionVector0 ::-   (LLVM.IsFloating c, LLVM.ABinOp a (Value (Vector D4 Float)),-    LLVM.ABinOpResult a (Value (Vector D4 Float)) ~ (v c)) =>-   a -> CodeGenFunction r (v c)+   Value (Vector D4 Float) -> CodeGenFunction r (Value (Vector D4 Float)) fractionVector0 x =    frem x =<< constVec 1 @@ -70,7 +69,7 @@ This call      fill (fromIntegral len) ptr-       (LLVM.toVector (0.01003, 0.01001, 0.00999, 0.00997)) >>+       (LLVM.consVector 0.01003 0.01001 0.00999 0.00997) >>  would not work, because Vector is not of type Generic. -}@@ -111,6 +110,16 @@     A.mul (valueOf 0.25) =<< add s0 s1 -} +mixScalar :: Value (Vector D4 Float) -> CodeGenFunction r (Value Float)+mixScalar y = do+    y0 <- extractelement y (valueOf 0)+    y1 <- extractelement y (valueOf 1)+    y2 <- extractelement y (valueOf 2)+    y3 <- extractelement y (valueOf 3)+    s0 <- A.add y0 y1+    s1 <- A.add y2 y3+    A.mul (valueOf 0.25) =<< A.add s0 s1+ {- Here we do use consistently Vectors of size 4. Since we declare the upper floats as undefined@@ -128,24 +137,6 @@     A.mul (valueOf 0.25) =<< A.add s0 s1  -{--Needs the horizontal add instruction from the SSSE3 extension in ix86 CPUs.--}-mixHorizontal :: Value (Vector D4 Float) -> CodeGenFunction r (Value Float)-mixHorizontal y = do-    z <- Ext.runUnsafe X86.haddps (value undef) y-    s <- Ext.runUnsafe X86.haddps (value undef) z-    A.mul (valueOf 0.25) =<< extractelement s (valueOf 0)--{--Needs the dot product instruction from the SSE4 extension in ix86 CPUs.--}-mixDotProduct :: Value (Vector D4 Float) -> CodeGenFunction r (Value Float)-mixDotProduct y = do-    x <- SoV.replicate (valueOf 0.25)-    z <- Ext.runUnsafe X86.dpps x y (valueOf 0xF1)-    extractelement z (valueOf 0)- mChorusVector ::   CodeGenModule     (Function@@ -156,17 +147,36 @@     const1 <- constVec 1     const2 <- constVec (-2)     s <- arrayLoop size ptr (value (zero :: Vec)) $ \ ptri phase -> do-      flip store ptri =<< mixHorizontal =<< add const1 =<< mul const2 phase+      flip store ptri =<< mixGeneric =<< add const1 =<< mul const2 phase       Vector.fraction =<< A.add phase freq     ss <- extractelement s (valueOf 0)     ret ss +mChorusVectorIterator ::+  CodeGenModule+    (Function+      (Word32 -> Ptr Float -> Float -> Float -> Float -> Float -> IO Float))+mChorusVectorIterator =+  createFunction ExternalLinkage $ \ size ptr f0 f1 f2 f3 -> do+    freq <- Vector.assemble [f0,f1,f2,f3]+    const1 <- constVec 1+    const2 <- constVec (-2)+    Iter.mapM_ id $ Iter.take size $+      liftA2+        (\ptri phase ->+          flip store ptri =<< mixGeneric =<< add const1 =<< mul const2 phase)+        (Iter.storableArrayPtrs ptr)+        (Iter.iterate (Vector.fraction <=< A.add freq) (value (zero :: Vec)))+    ret (value zero :: Value Float)++ waveSaw :: Value Float -> CodeGenFunction r (Value Float) waveSaw t =   A.sub (valueOf 1) =<<   A.mul (valueOf 2) t -osciSaw :: Value Float -> Value Float -> CodeGenFunction r (Value Float, Value Float)+osciSaw ::+  Value Float -> Value Float -> CodeGenFunction r (Value Float, Value Float) osciSaw freq phase =   liftM2 (,) (waveSaw phase) (SoV.incPhase freq phase) @@ -176,7 +186,7 @@       (Word32 -> Ptr Float -> Float -> Float -> Float -> Float -> IO Float)) mChorus =   createFunction ExternalLinkage $ \ size ptr f0 f1 f2 f3 -> do-    s <- arrayLoop size ptr Class.zeroTuple $+    s <- arrayLoop size ptr Tuple.zero $          \ ptri ((phase0, phase1), (phase2, phase3)) -> do       (y0, phase0') <- osciSaw f0 phase0       (y1, phase1') <- osciSaw f1 phase1@@ -222,7 +232,7 @@       (Word32 -> Ptr Float -> Float -> Float -> Float -> Float -> IO Float)) mChorusMonadic =   createFunction ExternalLinkage $ \ size ptr f0 f1 f2 f3 -> do-    s <- arrayLoop size ptr Class.zeroTuple $+    s <- arrayLoop size ptr Tuple.zero $          \ ptri phases -> do       (y, phases') <-          flip runStateT phases $@@ -253,7 +263,7 @@  renderChorus :: IO () renderChorus = do-  fill <- generateFunction derefChorusPtr mChorusVector+  fill <- generateFunction derefChorusPtr mChorusVectorIterator   IO.withFile "speedtest.f32" IO.WriteMode $ \h ->     let len = 10000000     in  allocaArray len $ \ ptr ->
src/LLVM/Extra/Arithmetic.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleContexts #-} module LLVM.Extra.Arithmetic (    -- * arithmetic: generalized and improved type inference@@ -22,18 +23,19 @@    -- * transcendental functions    Algebraic (sqrt),    Transcendental (pi, sin, cos, exp, log, pow),+   exp2, log2, log10,    ) where +import qualified LLVM.Util.Intrinsic as Intrinsic import LLVM.Extra.ArithmeticPrivate    (inc, dec, advanceArrayElementPtr, decreaseArrayElementPtr, ) -import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.ScalarOrVector as SoV-import qualified LLVM.Util.Proxy as LP import qualified LLVM.Core as LLVM import LLVM.Core    (CodeGenFunction, value, Value, ConstValue,-    IsType, IsInteger, IsFloating, IsArithmetic, IsFirstClass, )+    IsInteger, IsFloating, IsArithmetic)  import Control.Monad (liftM2, liftM3, ) @@ -57,7 +59,7 @@ Disadvantage: You cannot use constant values directly, but you have to convert them all to 'Value'. -}-class (Class.Zero a) => Additive a where+class (Tuple.Zero a) => Additive a where    zero :: a    add :: a -> a -> CodeGenFunction r a    sub :: a -> a -> CodeGenFunction r a@@ -69,11 +71,11 @@    sub = LLVM.sub    neg = LLVM.neg -instance (IsArithmetic a) => Additive (ConstValue a) where+instance (IsInteger a) => Additive (ConstValue a) where    zero = LLVM.zero-   add = LLVM.add-   sub = LLVM.sub-   neg = sub LLVM.zero+   add = LLVM.iadd+   sub = LLVM.isub+   neg = LLVM.isub LLVM.zero  instance (Additive a, Additive b) => Additive (a,b) where    zero = (zero, zero)@@ -100,11 +102,8 @@ instance (IsArithmetic v) => PseudoRing (Value v) where    mul = LLVM.mul -instance (IsArithmetic v) => PseudoRing (ConstValue v) where-   mul = LLVM.mul --type family Scalar vector :: *+type family Scalar vector type instance Scalar (Value a) = Value (SoV.Scalar a) type instance Scalar (ConstValue a) = ConstValue (SoV.Scalar a) @@ -114,10 +113,7 @@ instance (SoV.PseudoModule v) => PseudoModule (Value v) where    scale = SoV.scale -instance (SoV.PseudoModule v) => PseudoModule (ConstValue v) where-   scale = SoV.scaleConst - class IntegerConstant a where    fromInteger' :: Integer -> a @@ -159,10 +155,7 @@ instance (LLVM.IsFloating v) => Field (Value v) where    fdiv = LLVM.fdiv -instance (LLVM.IsFloating v) => Field (ConstValue v) where-   fdiv = LLVM.fdiv - class (IntegerConstant a) => RationalConstant a where    fromRational' :: Rational -> a @@ -233,29 +226,22 @@   class Comparison a where-   type CmpResult a :: *+   type CmpResult a    cmp :: LLVM.CmpPredicate -> a -> a -> CodeGenFunction r (CmpResult a)  instance (LLVM.CmpRet a) => Comparison (Value a) where    type CmpResult (Value a) = Value (LLVM.CmpResult a)    cmp = LLVM.cmp -instance (LLVM.CmpRet a) => Comparison (ConstValue a) where-   type CmpResult (ConstValue a) = ConstValue (LLVM.CmpResult a)-   cmp = LLVM.cmp - class (Comparison a) => FloatingComparison a where    fcmp :: LLVM.FPPredicate -> a -> a -> CodeGenFunction r (CmpResult a)  instance (IsFloating a, LLVM.CmpRet a) => FloatingComparison (Value a) where    fcmp = LLVM.fcmp -instance (IsFloating a, LLVM.CmpRet a) => FloatingComparison (ConstValue a) where-   fcmp = LLVM.fcmp  - class Logic a where    and :: a -> a -> CodeGenFunction r a    or :: a -> a -> CodeGenFunction r a@@ -268,62 +254,13 @@    xor = LLVM.xor    inv = LLVM.inv -instance (LLVM.IsInteger a) => Logic (ConstValue a) where-   and = LLVM.and-   or = LLVM.or-   xor = LLVM.xor-   inv = LLVM.inv  -valueTypeName ::-   (IsType a) =>-   Value a -> String-valueTypeName =-   LLVM.intrinsicTypeName . ((\_ -> LP.Proxy) :: Value a -> LP.Proxy a)---callIntrinsic1 ::-   (IsFirstClass a) =>-   String -> Value a -> CodeGenFunction r (Value a)-callIntrinsic1 fn x = do-   op <- LLVM.externFunction ("llvm." ++ fn ++ "." ++ valueTypeName x)-   LLVM.call op x >>= addReadNone--callIntrinsic2 ::-   (IsFirstClass a) =>-   String -> Value a -> Value a -> CodeGenFunction r (Value a)-callIntrinsic2 fn x y = do-   op <- LLVM.externFunction ("llvm." ++ fn ++ "." ++ valueTypeName x)-   LLVM.call op x y >>= addReadNone---{--If we add the attribute, then LLVM-2.8 complains:--$ ./dist/build/synthi-llvm-test/synthi-llvm-test-Attribute readnone only applies to the function!-  %97 = call readnone float @llvm.sin.f32(float %96)-Attribute readnone only applies to the function!-  %99 = call readnone float @llvm.exp.f32(float %98)-Attribute readnone only applies to the function!-  %102 = call readnone float @llvm.cos.f32(float %101)-Broken module found, compilation aborted!-Stack dump:-0.      Running pass 'Function Pass Manager' on module '_module'.-1.      Running pass 'Module Verifier' on function '@fillsignal'-make: *** [test] Abgebrochen--}-addReadNone :: Value a -> CodeGenFunction r (Value a)-addReadNone x = do---   LLVM.addAttributes x 0 [LLVM.ReadNoneAttribute]-   return x-- class Field a => Algebraic a where    sqrt :: a -> CodeGenFunction r a  instance (IsFloating a) => Algebraic (Value a) where-   sqrt = callIntrinsic1 "sqrt"+   sqrt = Intrinsic.call1 "sqrt"   class Algebraic a => Transcendental a where@@ -333,8 +270,18 @@  instance (IsFloating a, SoV.TranscendentalConstant a) => Transcendental (Value a) where    pi = return $ value SoV.constPi-   sin = callIntrinsic1 "sin"-   cos = callIntrinsic1 "cos"-   exp = callIntrinsic1 "exp"-   log = callIntrinsic1 "log"-   pow = callIntrinsic2 "pow"+   sin = Intrinsic.call1 "sin"+   cos = Intrinsic.call1 "cos"+   exp = Intrinsic.call1 "exp"+   log = Intrinsic.call1 "log"+   pow = Intrinsic.call2 "pow"+++exp2 :: (IsFloating a) => Value a -> CodeGenFunction r (Value a)+exp2 = Intrinsic.call1 "exp2"++log2 :: (IsFloating a) => Value a -> CodeGenFunction r (Value a)+log2 = Intrinsic.call1 "log2"++log10 :: (IsFloating a) => Value a -> CodeGenFunction r (Value a)+log10 = Intrinsic.call1 "log10"
− src/LLVM/Extra/ArithmeticPrivate.hs 
@@ -1,124 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-module LLVM.Extra.ArithmeticPrivate where--import qualified LLVM.Core as LLVM-import LLVM.Core-   (CodeGenFunction, valueOf, Value,-    CmpPredicate(CmpLE, CmpGE), FPPredicate, CmpRet, CmpResult,-    IsConst, IsFirstClass, IsArithmetic, IsInteger, IsFloating,-    getElementPtr, )--import Foreign.Ptr (Ptr, )-import Data.Word (Word32, )-import Data.Int (Int32, )--import Prelude hiding (and, or, sqrt, sin, cos, exp, log, abs, min, max, )---add ::-   (IsArithmetic a) =>-   Value a -> Value a -> CodeGenFunction r (Value a)-add = LLVM.add--sub ::-   (IsArithmetic a) =>-   Value a -> Value a -> CodeGenFunction r (Value a)-sub = LLVM.sub---inc ::-   (IsArithmetic a, IsConst a, Num a) =>-   Value a -> CodeGenFunction r (Value a)-inc x = add x (valueOf 1)--dec ::-   (IsArithmetic a, IsConst a, Num a) =>-   Value a -> CodeGenFunction r (Value a)-dec x = sub x (valueOf 1)--advanceArrayElementPtr ::-   Value (Ptr a) ->-   CodeGenFunction r (Value (Ptr a))-advanceArrayElementPtr p =-   getElementPtr p (valueOf 1 :: Value Word32, ())--decreaseArrayElementPtr ::-   Value (Ptr a) ->-   CodeGenFunction r (Value (Ptr a))-decreaseArrayElementPtr p =-   getElementPtr p (valueOf (-1) :: Value Int32, ())----mul ::-   (IsArithmetic a) =>-   Value a -> Value a -> CodeGenFunction r (Value a)-mul = LLVM.mul---{- |-This would also work for vectors,-but LLVM-3.1 crashes when actually doing this.--}-min :: (IsFirstClass a, CmpRet a) =>-   Value a -> Value a -> CodeGenFunction r (Value a)-min = cmpSelect (cmp CmpLE)--max :: (IsFirstClass a, CmpRet a) =>-   Value a -> Value a -> CodeGenFunction r (Value a)-max = cmpSelect (cmp CmpGE)--abs :: (IsArithmetic a, CmpRet a) =>-   Value a -> CodeGenFunction r (Value a)-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) =>-   (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, CmpResult a ~ b) =>-   FPPredicate -> Value a -> Value a -> CodeGenFunction r (Value b)-fcmp = LLVM.fcmp--cmp ::-   (CmpRet a, CmpResult a ~ b) =>-   CmpPredicate -> Value a -> Value a -> CodeGenFunction r (Value b)-cmp = LLVM.cmp----and ::-   (IsInteger a) =>-   Value a -> Value a -> CodeGenFunction r (Value a)-and = LLVM.and--or ::-   (IsInteger a) =>-   Value a -> Value a -> CodeGenFunction r (Value a)-or = LLVM.or
src/LLVM/Extra/Array.hs view
@@ -5,7 +5,7 @@    map,    ) where -import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple  import qualified LLVM.Core as LLVM import LLVM.Core (Value, Array, CodeGenFunction, )@@ -41,10 +41,10 @@ This can be considered the inverse of 'extractAll'. -} assemble ::-   (TypeNum.Natural n, LLVM.IsFirstClass a, LLVM.IsSized a) =>+   (TypeNum.Natural n, LLVM.IsSized a) =>    [Value a] -> CodeGenFunction r (Value (Array n a)) assemble =-   foldM (\v (k,x) -> LLVM.insertvalue v x (k::Word32)) Class.undefTuple .+   foldM (\v (k,x) -> LLVM.insertvalue v x (k::Word32)) Tuple.undef .    List.zip [0..]  {- |@@ -53,7 +53,7 @@ This can be considered the inverse of 'assemble'. -} extractAll ::-   (TypeNum.Natural n, LLVM.IsFirstClass a, LLVM.IsSized a) =>+   (TypeNum.Natural n, LLVM.IsSized a) =>    Value (Array n a) -> LLVM.CodeGenFunction r [Value a] extractAll x =    mapM@@ -65,9 +65,7 @@ since 'LLVM.insertvalue' and 'LLVM.extractvalue' expect constant indices. -} map ::-   (TypeNum.Natural n,-    LLVM.IsFirstClass a, LLVM.IsSized a,-    LLVM.IsFirstClass b, LLVM.IsSized b) =>+   (TypeNum.Natural n, LLVM.IsSized a, LLVM.IsSized b) =>    (Value a -> CodeGenFunction r (Value b)) ->    (Value (Array n a) -> CodeGenFunction r (Value (Array n b))) map f =
− src/LLVM/Extra/Class.hs 
@@ -1,218 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-module LLVM.Extra.Class where--import qualified LLVM.Extra.EitherPrivate as Either-import qualified LLVM.Extra.MaybePrivate as Maybe-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 Type.Data.Num.Decimal as TypeNum--import Control.Applicative (pure, liftA2, )-import qualified Control.Applicative as App-import qualified Data.Foldable as Fold-import qualified Data.Traversable as Trav--import Foreign.StablePtr (StablePtr, )-import Foreign.Ptr (FunPtr, Ptr, )--import Data.Word (Word8, Word16, Word32, Word64, )-import Data.Int  (Int8,  Int16,  Int32,  Int64, )--import Prelude hiding (and, iterate, map, zipWith, writeFile, )----- * class for tuples of undefined values--class Undefined a where-   undefTuple :: a--instance Undefined () where-   undefTuple = ()--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)--instance (Undefined a, Undefined b, Undefined c) => Undefined (a, b, c) where-   undefTuple = (undefTuple, undefTuple, undefTuple)--instance (Undefined a) => Undefined (Maybe.T a) where-   undefTuple = Maybe.Cons undefTuple undefTuple--instance (Undefined a, Undefined b) => Undefined (Either.T a b) where-   undefTuple = Either.Cons undefTuple undefTuple undefTuple----- * class for tuples of zero values--class Zero a where-   zeroTuple :: a--instance Zero () where-   zeroTuple = ()--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)--instance (Zero a, Zero b, Zero c) => Zero (a, b, c) where-   zeroTuple = (zeroTuple, zeroTuple, zeroTuple)--zeroTuplePointed ::-   (Zero a, App.Applicative f) =>-   f a-zeroTuplePointed =-   pure zeroTuple----- * class for creating tuples of constant values--class (Undefined (ValueTuple haskellValue)) =>-      MakeValueTuple haskellValue where-   type ValueTuple haskellValue :: *-   valueTupleOf :: haskellValue -> ValueTuple haskellValue--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, 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 a) => MakeValueTuple (Maybe a) where-   type ValueTuple (Maybe a) = Maybe.T (ValueTuple a)-   valueTupleOf = maybe (Maybe.nothing undefTuple) (Maybe.just . valueTupleOf)--instance-   (MakeValueTuple a, MakeValueTuple b) =>-      MakeValueTuple (Either a b) where-   type ValueTuple (Either a b) = Either.T (ValueTuple a) (ValueTuple b)-   valueTupleOf =-      either-         (Either.left undefTuple . valueTupleOf)-         (Either.right undefTuple . valueTupleOf)--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) where-   type ValueTuple (Ptr a) = Value (Ptr a)-   valueTupleOf = valueOf--instance LLVM.IsFunction a => MakeValueTuple (FunPtr a) where-   type ValueTuple (FunPtr a) = Value (FunPtr 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) where-   type ValueTuple (IntN n) = (Value (IntN n))-instance (Pos n) => MakeValueTuple (WordN n) where-   type ValueTuple (WordN n) = (Value (WordN n))--}-instance (TypeNum.Positive 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--{--buildTupleTraversable ::-   (Undefined a, Trav.Traversable f, App.Applicative f) =>-   FunctionRef -> State Int (f a)-buildTupleTraversable f =-   Trav.sequence (pure (buildTuple f))--}-{--buildTupleTraversable ::-   (Trav.Traversable f, App.Applicative f) =>-   State Int a ->-   State Int (f a)-buildTupleTraversable build =-   Trav.sequence (pure build)--}-{- this is the version I used-buildTupleTraversable ::-   (Monad m, Trav.Traversable f, App.Applicative f) =>-   m a ->-   m (f a)-buildTupleTraversable build =-   Trav.sequence (pure build)--}--undefTuplePointed ::-   (Undefined a, App.Applicative f) =>-   f a-undefTuplePointed =-   pure undefTuple--valueTupleOfFunctor ::-   (MakeValueTuple h, Functor f) =>-   f h -> f (ValueTuple h)-valueTupleOfFunctor =-   fmap valueTupleOf--{--tupleDescFoldable ::-   (IsTuple a, Fold.Foldable f) =>-   f a -> [TypeDesc]-tupleDescFoldable =-   Fold.foldMap tupleDesc--}--phisTraversable ::-   (Phi a, Trav.Traversable f) =>-   BasicBlock -> f a -> CodeGenFunction r (f a)-phisTraversable bb x =-   Trav.mapM (phis bb) x--addPhisFoldable ::-   (Phi a, Fold.Foldable f, App.Applicative f) =>-   BasicBlock -> f a -> f a -> CodeGenFunction r ()-addPhisFoldable bb x y =-   Fold.sequence_ (liftA2 (addPhis bb) x y)
src/LLVM/Extra/Control.hs view
@@ -16,25 +16,25 @@    Select(select),    selectTraversable,    ifThenSelect,+   ret,+   retVoid,    ) where -import LLVM.Extra.ArithmeticPrivate-   (cmp, sub, dec, advanceArrayElementPtr, ) import qualified LLVM.Extra.ArithmeticPrivate as A+import qualified LLVM.Extra.TuplePrivate as Tuple+import LLVM.Extra.ArithmeticPrivate (cmp, sub, dec, advanceArrayElementPtr)+ import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, phis, addPhis, ) import LLVM.Core    (getCurrentBasicBlock, newBasicBlock, defineBasicBlock,     br, condBr,     Value, value, valueOf,     phi, addPhiInputs,-    CmpPredicate(CmpGT), CmpRet, CmpResult,-    IsInteger, IsType, IsConst, IsFirstClass,+    CmpPredicate(CmpGT), CmpRet,+    IsInteger, IsType, IsConst, IsPrimitive,     CodeGenFunction,     CodeGenModule, newModule, defineModule, writeBitcodeToFile, ) -import Foreign.Ptr (Ptr, )- import qualified Control.Applicative as App import qualified Data.Traversable as Trav import Control.Monad (liftM3, liftM2, )@@ -46,14 +46,14 @@ -- * control structures  {--I had to export Phi's methods in llvm-0.6.8+I had to export Tuple.Phi's methods in llvm-0.6.8 in order to be able to implement this function. -} arrayLoop ::-   (Phi a, IsType b,-    Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>-   Value i -> Value (Ptr b) -> a ->-   (Value (Ptr b) -> a -> CodeGenFunction r a) ->+   (Tuple.Phi a, IsType b,+    Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>+   Value i -> Value (LLVM.Ptr b) -> a ->+   (Value (LLVM.Ptr b) -> a -> CodeGenFunction r a) ->    CodeGenFunction r a arrayLoop len ptr start loopBody =    fmap snd $@@ -63,10 +63,10 @@          (loopBody p s)  arrayLoop2 ::-   (Phi s, IsType a, IsType b,-    Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>-   Value i -> Value (Ptr a) -> Value (Ptr b) -> s ->-   (Value (Ptr a) -> Value (Ptr b) -> s -> CodeGenFunction r s) ->+   (Tuple.Phi s, IsType a, IsType b,+    Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>+   Value i -> Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> s ->+   (Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> s -> CodeGenFunction r s) ->    CodeGenFunction r s arrayLoop2 len ptrA ptrB start loopBody =    fmap snd $@@ -78,10 +78,10 @@   arrayLoopWithExit ::-   (Phi s, IsType a,-    Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>-   Value i -> Value (Ptr a) -> s ->-   (Value (Ptr a) -> s -> CodeGenFunction r (Value Bool, s)) ->+   (Tuple.Phi s, IsType a,+    Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>+   Value i -> Value (LLVM.Ptr a) -> s ->+   (Value (LLVM.Ptr a) -> s -> CodeGenFunction r (Value Bool, s)) ->    CodeGenFunction r (Value i, s) arrayLoopWithExit len ptr start loopBody = do    ((_, vars), (i,_)) <-@@ -106,10 +106,10 @@ than manual decrement, zero test and conditional branch. -} _arrayLoopWithExitDecLoop ::-   (Phi a, IsType b,-    Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>-   Value i -> Value (Ptr b) -> a ->-   (Value (Ptr b) -> a -> CodeGenFunction r (Value Bool, a)) ->+   (Tuple.Phi a, IsType b,+    Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>+   Value i -> Value (LLVM.Ptr b) -> a ->+   (Value (LLVM.Ptr b) -> a -> CodeGenFunction r (Value Bool, a)) ->    CodeGenFunction r (Value i, a) _arrayLoopWithExitDecLoop len ptr start loopBody = do    top <- getCurrentBasicBlock@@ -126,14 +126,14 @@    defineBasicBlock checkEnd    i <- phi [(len, top)]    p <- phi [(ptr, top)]-   vars <- phis top start+   vars <- Tuple.phi top start    t <- phi [(t0, top)]    condBr t loop exit     defineBasicBlock loop     (cont, vars') <- loopBody p vars-   addPhis next vars vars'+   Tuple.addPhi next vars vars'    condBr cont next exit     defineBasicBlock next@@ -152,10 +152,10 @@   arrayLoop2WithExit ::-   (Phi s, IsType a, IsType b,-    Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>-   Value i -> Value (Ptr a) -> Value (Ptr b) -> s ->-   (Value (Ptr a) -> Value (Ptr b) -> s -> CodeGenFunction r (Value Bool, s)) ->+   (Tuple.Phi s, IsType a, IsType b,+    Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>+   Value i -> Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> s ->+   (Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> s -> CodeGenFunction r (Value Bool, s)) ->    CodeGenFunction r (Value i, s) arrayLoop2WithExit len ptrA ptrB start loopBody =    fmap (mapSnd snd) $@@ -167,8 +167,8 @@   fixedLengthLoop ::-   (Phi s,-    Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>+   (Tuple.Phi s,+    Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>    Value i -> s ->    (s -> CodeGenFunction r s) ->    CodeGenFunction r s@@ -180,7 +180,7 @@   whileLoop, _whileLoop ::-   Phi a =>+   Tuple.Phi a =>    a ->    (a -> CodeGenFunction r (Value Bool)) ->    (a -> CodeGenFunction r a) ->@@ -198,13 +198,13 @@    br loop     defineBasicBlock loop-   state <- phis top start+   state <- Tuple.phi top start    b <- check state    condBr b cont exit    defineBasicBlock cont    res <- body state    cont' <- getCurrentBasicBlock-   addPhis cont' state res+   Tuple.addPhi cont' state res    br loop     defineBasicBlock exit@@ -216,7 +216,7 @@ The @Bool@ value indicates whether the loop shall be continued. -} loopWithExit ::-   Phi a =>+   Tuple.Phi a =>    a ->    (a -> CodeGenFunction r (Value Bool, b)) ->    (b -> CodeGenFunction r a) ->@@ -229,13 +229,13 @@    br loop     defineBasicBlock loop-   state <- phis top start+   state <- Tuple.phi top start    (contB,b) <- check state    condBr contB cont exit    defineBasicBlock cont    a <- body b    cont' <- getCurrentBasicBlock-   addPhis cont' state a+   Tuple.addPhi cont' state a    br loop     defineBasicBlock exit@@ -248,7 +248,7 @@ for both loop condition and loop body. -} whileLoopShared ::-   Phi a =>+   Tuple.Phi a =>    a ->    (a ->       (CodeGenFunction r (Value Bool),@@ -264,7 +264,7 @@ so be prepared when continueing after an 'ifThenElse'. -} ifThenElse ::-   Phi a =>+   Tuple.Phi a =>    Value Bool ->    CodeGenFunction r a ->    CodeGenFunction r a ->@@ -286,13 +286,13 @@    br mergeBlock     defineBasicBlock mergeBlock-   a2 <- phis thenBlock' a0-   addPhis elseBlock' a2 a1+   a2 <- Tuple.phi thenBlock' a0+   Tuple.addPhi elseBlock' a2 a1    return a2   ifThen ::-   Phi a =>+   Tuple.Phi a =>    Value Bool ->    a ->    CodeGenFunction r a ->@@ -309,15 +309,15 @@    br mergeBlock     defineBasicBlock mergeBlock-   a1 <- phis defltBlock deflt-   addPhis thenBlock' a1 a0+   a1 <- Tuple.phi defltBlock deflt+   Tuple.addPhi thenBlock' a1 a0    return a1  -class Phi a => Select a where+class Tuple.Phi a => Select a where    select :: Value Bool -> a -> a -> CodeGenFunction r a -instance (IsFirstClass a, CmpRet a, CmpResult a ~ Bool) => Select (Value a) where+instance (CmpRet a, IsPrimitive a) => Select (Value a) where    select = LLVM.select  instance Select () where@@ -359,6 +359,20 @@ ifThenSelect cond deflt thenCode = do    thenResult <- thenCode    select cond thenResult deflt+++-- * return with better type inference++{- |+'ret' terminates a basic block which interferes badly+with other control structures in this module.+If you use the control structures then better use "LLVM.Extra.Function".+-}+ret :: Value a -> CodeGenFunction a ()+ret = LLVM.ret++retVoid :: CodeGenFunction () ()+retVoid = LLVM.ret ()   -- * debugging
src/LLVM/Extra/Either.hs view
@@ -13,11 +13,11 @@    ) where  import qualified LLVM.Extra.EitherPrivate as Either-import LLVM.Extra.Class (Undefined, undefTuple, )+import qualified LLVM.Extra.Tuple as Tuple  -left :: (Undefined b) => a -> Either.T a b-left = Either.left undefTuple+left :: (Tuple.Undefined b) => a -> Either.T a b+left = Either.left Tuple.undef -right :: (Undefined a) => b -> Either.T a b-right = Either.right undefTuple+right :: (Tuple.Undefined a) => b -> Either.T a b+right = Either.right Tuple.undef
src/LLVM/Extra/EitherPrivate.hs view
@@ -1,11 +1,11 @@ {-# LANGUAGE TypeFamilies #-} module LLVM.Extra.EitherPrivate where +import qualified LLVM.Extra.TuplePrivate as Tuple import LLVM.Extra.Control (ifThenElse, )  import qualified LLVM.Core as LLVM import LLVM.Core (Value, valueOf, CodeGenFunction, )-import LLVM.Util.Loop (Phi, phis, addPhis, )  import Control.Monad (liftM3, ) @@ -19,17 +19,23 @@ data T a b = Cons {isRight :: Value Bool, fromLeft :: a, fromRight :: b}  -instance (Phi a, Phi b) => Phi (T a b) where-   phis bb (Cons r a b) = liftM3 Cons (phis bb r) (phis bb a) (phis bb b)-   addPhis bb (Cons r0 a0 b0) (Cons r1 a1 b1) =-      addPhis bb r0 r1 >> addPhis bb a0 a1 >> addPhis bb b0 b1+instance+   (Tuple.Undefined a, Tuple.Undefined b) =>+      Tuple.Undefined (T a b) where+   undef = Cons Tuple.undef Tuple.undef Tuple.undef +instance (Tuple.Phi a, Tuple.Phi b) => Tuple.Phi (T a b) where+   phi bb (Cons r a b) =+      liftM3 Cons (Tuple.phi bb r) (Tuple.phi bb a) (Tuple.phi bb b)+   addPhi bb (Cons r0 a0 b0) (Cons r1 a1 b1) =+      Tuple.addPhi bb r0 r1 >> Tuple.addPhi bb a0 a1 >> Tuple.addPhi bb b0 b1 + {- | counterpart to 'either' -} run ::-   (Phi c) =>+   (Tuple.Phi c) =>    T a b ->    (a -> CodeGenFunction r c) ->    (b -> CodeGenFunction r c) ->
− src/LLVM/Extra/Extension.hs 
@@ -1,177 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE Rank2Types #-}-module LLVM.Extra.Extension (-   T, Result, CallArgs,-   Subtarget(Subtarget), wrap,-   intrinsic, intrinsicAttr,-   run, runWhen, runUnsafe,-   with, with2, with3,-   ) where--import qualified LLVM.Core as LLVM-import LLVM.Core-   (Value, CodeGenFunction, externFunction, call,-    addAttributes, Attribute {- (ReadNoneAttribute) -}, )--import Data.Map (Map, )-import qualified Data.Map as Map--import Control.Monad.Trans.Writer (Writer, writer, runWriter, )-import Control.Monad (join, )-import Control.Applicative (Applicative, pure, (<*>), )--import Prelude hiding (replicate, sum, map, zipWith, )---data Subtarget =-   Subtarget {-      targetName, name :: String,-      check :: forall r. CodeGenFunction r Bool-   }---{- |-This is an Applicative functor that registers,-what extensions are needed in order to run the contained instructions.-You can escape from the functor by calling 'run'-and providing a generic implementation.--We use an applicative functor-since with a monadic interface-we had to create the specialised code in every case,-in order to see which extensions where used-in the course of creating the instructions.--We use only one (unparameterized) type for all extensions,-since this is the most simple solution.-Alternatively we could use a type parameter-where class constraints show what extensions are needed.-This would be just like exceptions that are explicit in the type signature-as in the control-monad-exception package.-However we would still need to lift all basic LLVM instructions to the new monad.--}-newtype T a =-   Cons (Writer (Map String Subtarget) a)-   deriving (Functor, Applicative)--{- |-Declare that a certain plain LLVM instruction-depends on a particular extension.-This can be useful if you rely on the data layout-of a certain architecture when doing a bitcast,-or if you know that LLVM translates a certain generic operation-to something especially optimal for the declared extension.--}-wrap :: Subtarget -> a -> T a-wrap tar cgf =-   Cons $-   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 where-   buildIntrinsic :: [Attribute] -> CodeGenFunction (Result g) g -> g--instance (CallArgs g) =>-      CallArgs (Value a -> g) where-   buildIntrinsic attrs g x =-      buildIntrinsic attrs (fmap ($x) g)--instance CallArgs (CodeGenFunction r (Value a)) where-   buildIntrinsic attrs g = do-      z <- join g-      addAttributes z 0 attrs-      return z--{- |-Create an intrinsic and register the needed extension.-We cannot immediately check whether the signature matches-or whether the right extension is given.-However, when resolving intrinsics-LLVM will not find the intrinsic if the extension is wrong,-and it also checks the signature.--}-intrinsic ::-   (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 (Result g), CallArgs g) =>-   [Attribute] -> Subtarget -> String -> T g-intrinsicAttr attrs tar intr =-   wrap tar $-   buildIntrinsic attrs $-   fmap call $-   externFunction $-      "llvm." ++ targetName tar ++ "." ++ name tar ++ "." ++ intr---infixl 1 `run`--{- |-@run generic specific@ generates the @specific@ code-if the required extensions are available on the host processor-and @generic@ otherwise.--}-run ::-   CodeGenFunction r a ->-   T (CodeGenFunction r a) ->-   CodeGenFunction r a-run alt (Cons m) = do-   let (a,s) = runWriter m-   b <- mapM check (Map.elems s)-   if and b-     then a-     else alt--{- |-Convenient variant of 'run':-Only run the code with extended instructions-if an additional condition is satisfied.--}-runWhen ::-   Bool ->-   CodeGenFunction r a ->-   T (CodeGenFunction r a) ->-   CodeGenFunction r a-runWhen c alt (Cons m) = do-   let (a,s) = runWriter m-   b <- mapM check (Map.elems s)-   if c && and b-     then a-     else alt--{- |-Only for debugging purposes.--}-runUnsafe ::-   T a -> a-runUnsafe (Cons m) =-   fst $ runWriter m---with :: (Functor f) => f a -> (a -> b) -> f b-with = flip fmap--with2 :: (Applicative f) => f a -> f b -> (a -> b -> c) -> f c-with2 a b f =-   pure f <*> a <*> b--with3 :: (Applicative f) => f a -> f b -> f c -> (a -> b -> c -> d) -> f d-with3 a b c f =-   pure f <*> a <*> b <*> c
− src/LLVM/Extra/Extension/X86.hs 
@@ -1,359 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-{- |-Some special operations on X86 processors.-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'-and this driver function then selects the most advanced of both implementations.-Functions that are written this way can be found in "LLVM.Extra.Vector".-Availability of extensions is checked with the @CPUID@ instruction.-However this does only work if you compile code for the host machine,-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.--}-module LLVM.Extra.Extension.X86 (-   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,-   pmaxsb, pmaxsw, pmaxsd,-   pminub, pminuw, pminud,-   pmaxub, pmaxuw, pmaxud,-   pabsb, pabsw, pabsd,-   pmuludq, pmuldq,-   pmulld,-   cvtps2dq, cvtpd2dq,-   cvtdq2ps, cvtdq2pd,-   ldmxcsr, stmxcsr, withMXCSR,-   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, sse41, sse42, )--import qualified LLVM.Extra.Monad as M-import qualified LLVM.Extra.ArithmeticPrivate as A-import qualified LLVM.Core as LLVM-import LLVM.Core-   (Value, Vector, valueOf, constOf, vector,-    CodeGenFunction, FPPredicate, )--import qualified Type.Data.Num.Decimal as TypeNum--import qualified Data.NonEmpty.Class as NonEmptyC-import qualified Data.Empty as Empty-import Data.NonEmpty ((!:), )--import Data.Bits (clearBit, complement, )-import Data.Word (Word8, Word32, Word64, )--import Control.Monad.HT ((<=<), )-import Control.Applicative (pure, )--import Foreign.Ptr (Ptr, )---switchFPPred ::-   (Num i, LLVM.IsConst i, LLVM.IsInteger i, LLVM.IsPrimitive i,-    LLVM.IsFirstClass v,-    TypeNum.Positive 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.bitcast =<< g x0 y0 (valueOf i)-   in  case p of-          LLVM.FPFalse -> return (LLVM.value LLVM.zero)-          LLVM.FPOEQ   -> f 0 x y-          LLVM.FPOGT   -> f 1 y x-          LLVM.FPOGE   -> f 2 y x-          LLVM.FPOLT   -> f 1 x y-          LLVM.FPOLE   -> f 2 x y-          LLVM.FPONE   -> M.liftR2 A.and (f 7 x y) (f 4 x y)-          LLVM.FPORD   -> f 7 x y-          LLVM.FPUNO   -> f 3 x y-          LLVM.FPUEQ   -> M.liftR2 A.or (f 3 x y) (f 0 x y)-          LLVM.FPUGT   -> f 6 x y-          LLVM.FPUGE   -> f 5 x y-          LLVM.FPULT   -> f 6 y x-          LLVM.FPULE   -> f 5 y x-          LLVM.FPUNE   -> f 4 x y-          LLVM.FPT     -> return (valueOf $ pure (-1))--cmpss :: Ext.T (FPPredicate -> V4Float -> V4Float -> CodeGenFunction r V4Int32)-cmpss = fmap switchFPPred X86.cmpss--cmpps :: Ext.T (FPPredicate -> V4Float -> V4Float -> CodeGenFunction r V4Int32)-cmpps = fmap switchFPPred X86.cmpps--cmpsd :: Ext.T (FPPredicate -> V2Double -> V2Double -> CodeGenFunction r V2Int64)-cmpsd = fmap switchFPPred X86.cmpsd--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--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 (V8Int16 -> V8Int16 -> CodeGenFunction r V8Int16)-pcmpgtw = Ext.intrinsic sse2 "pcmpgt.w"--pcmpgtd :: Ext.T (V4Int32 -> V4Int32 -> CodeGenFunction r V4Int32)-pcmpgtd = Ext.intrinsic sse2 "pcmpgt.d"--pcmpgtq :: Ext.T (V2Int64 -> V2Int64 -> CodeGenFunction r V2Int64)-pcmpgtq = Ext.intrinsic sse42 "pcmpgtq"---pcmpuFromPcmp ::-   (TypeNum.Positive n,-    LLVM.IsPrimitive s,-    LLVM.IsPrimitive u, LLVM.IsArithmetic u, LLVM.IsConst u,-    Bounded u, Integral u,-    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 = valueOf $ pure (1 + div maxBound 2)-      xa <- LLVM.bitcast =<< A.sub x offset-      ya <- LLVM.bitcast =<< A.sub y offset-      LLVM.bitcast =<< cmp xa ya--pcmpugtb :: Ext.T (V16Word8 -> V16Word8 -> CodeGenFunction r V16Word8)-pcmpugtb = pcmpuFromPcmp pcmpgtb--pcmpugtw :: Ext.T (V8Word16 -> V8Word16 -> CodeGenFunction r V8Word16)-pcmpugtw = pcmpuFromPcmp pcmpgtw--pcmpugtd :: Ext.T (V4Word32 -> V4Word32 -> CodeGenFunction r V4Word32)-pcmpugtd = pcmpuFromPcmp pcmpgtd--pcmpugtq :: Ext.T (V2Word64 -> V2Word64 -> CodeGenFunction r V2Word64)-pcmpugtq = pcmpuFromPcmp pcmpgtq---pminsb, pmaxsb :: Ext.T (V16Int8 -> V16Int8 -> CodeGenFunction r V16Int8)-pminsb = X86.pminsb128-pmaxsb = X86.pmaxsb128--pminsw, pmaxsw :: Ext.T (V8Int16 -> V8Int16 -> CodeGenFunction r V8Int16)-pminsw = X86.pminsw128-pmaxsw = X86.pmaxsw128--pminsd, pmaxsd :: Ext.T (V4Int32 -> V4Int32 -> CodeGenFunction r V4Int32)-pminsd = X86.pminsd128-pmaxsd = X86.pmaxsd128---pminub, pmaxub :: Ext.T (V16Word8 -> V16Word8 -> CodeGenFunction r V16Word8)-pminub = X86.pminub128-pmaxub = X86.pmaxub128--pminuw, pmaxuw :: Ext.T (V8Word16 -> V8Word16 -> CodeGenFunction r V8Word16)-pminuw = X86.pminuw128-pmaxuw = X86.pmaxuw128--pminud, pmaxud :: Ext.T (V4Word32 -> V4Word32 -> CodeGenFunction r V4Word32)-pminud = X86.pminud128-pmaxud = X86.pmaxud128---pabsb :: Ext.T (V16Int8 -> CodeGenFunction r V16Int8)-pabsb = X86.pabsb128--pabsw :: Ext.T (V8Int16 -> CodeGenFunction r V8Int16)-pabsw = X86.pabsw128--pabsd :: Ext.T (V4Int32 -> CodeGenFunction r V4Int32)-pabsd = X86.pabsd128---pmuludq :: Ext.T (V4Word32 -> V4Word32 -> CodeGenFunction r V2Word64)-pmuludq = X86.pmuludq128--pmuldq :: Ext.T (V4Int32 -> V4Int32 -> CodeGenFunction r V2Int64)-pmuldq = X86.pmuldq128--pmulld :: Ext.T (V4Word32 -> V4Word32 -> CodeGenFunction r V4Word32)-pmulld = Ext.wrap sse41 LLVM.mul--- pmulld = Ext.intrinsic sse41 "pmulld"---cvtps2dq :: Ext.T (V4Float -> CodeGenFunction r V4Int32)-cvtps2dq = X86.cvtps2dq---- | 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---cvtdq2ps :: Ext.T (V4Int32 -> CodeGenFunction r V4Float)-cvtdq2ps = X86.cvtdq2ps---- | 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 () -> ()-valueUnit _ = ()--{- |-MXCSR is not really supported by LLVM-2.6.-LLVM does not know about the dependency of all floating point operations-on this status register.--}-ldmxcsr :: Ext.T (Value (Ptr Word32) -> CodeGenFunction r ())-ldmxcsr =-   fmap (fmap valueUnit .) $ Ext.intrinsicAttr [] sse1 "ldmxcsr"--stmxcsr :: Ext.T (Value (Ptr Word32) -> CodeGenFunction r ())-stmxcsr =-   fmap (fmap valueUnit .) $ Ext.intrinsicAttr [] sse1 "stmxcsr"--withMXCSR :: Word32 -> Ext.T (CodeGenFunction r a -> CodeGenFunction r a)-withMXCSR mxcsr =-   Ext.with2 ldmxcsr stmxcsr $ \ ld st f -> do-      mxcsrOld <- LLVM.alloca-      st mxcsrOld-      mxcsrFloor <- LLVM.alloca-      LLVM.store (valueOf $ mxcsr) mxcsrFloor-{- unfortunately, createGlobal is a function CodeGenModule monad-      mxcsrFloor <--         LLVM.createGlobal True LLVM.InternalLinkage mxcsr--}-      ld mxcsrFloor-      r <- f-      ld mxcsrOld-      return r--{--[maxsd, minsd, maxpd, minpd] =-   map (Ext.intrinsic sse2)-     ["max.ss", "min.ss", "max.ps", "min.ps"]--}--roundss :: Ext.T (V4Float -> Value Word32 -> CodeGenFunction r V4Float)-roundss =-   fmap (\f -> f (LLVM.value LLVM.undef)) X86.roundss--roundsd :: Ext.T (V2Double -> Value Word32 -> CodeGenFunction r V2Double)-roundsd =-   fmap (\f -> f (LLVM.value LLVM.undef)) X86.roundsd----{--Not an LLVM intrinsic but implementation specific:-We expect that floating point values are in IEEE format-and thus the most significant bit is the sign.-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 (V4Float -> CodeGenFunction r V4Float)-absss =-   Ext.wrap sse1 $-   LLVM.bitcast-     <=< A.and (LLVM.valueOf $ vector $-           (flip clearBit 31 $ complement 0) !: NonEmptyC.repeat (complement 0)-            :: V4Word32)-     <=< LLVM.bitcast--{--This function works on a single Float,-but I like to do the masking in an XMM register-because usually the value is there anyway.--absss =-   flip LLVM.extractelement (valueOf 0)-     . 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.bitcast-     <=< A.and (valueOf 0x7FFFFFFF :: Value Word32)-     <=< LLVM.bitcast--}--abssd :: Ext.T (V2Double -> CodeGenFunction r V2Double)-abssd =-   Ext.wrap sse2 $-   LLVM.bitcast-     <=< A.and (LLVM.valueOf $ vector $-            (flip clearBit 63 $ complement 0) !: complement 0 !: Empty.Cons-            :: V2Word64)-     <=< LLVM.bitcast---mask ::-   (TypeNum.Positive 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.valueOf $ pure x)--absps ::-   (TypeNum.Positive n) =>-   Ext.T (Value (Vector n Float) -> CodeGenFunction r (Value (Vector n Float)))-absps =-   Ext.wrap sse1 $-   LLVM.bitcastElements-     <=< mask (flip clearBit 31 $ complement 0 :: Word32)-     <=< LLVM.bitcastElements--abspd ::-   (TypeNum.Positive n) =>-   Ext.T (Value (Vector n Double) -> CodeGenFunction r (Value (Vector n Double)))-abspd =-   Ext.wrap sse2 $-   LLVM.bitcastElements-     <=< mask (flip clearBit 63 $ complement 0 :: Word64)-     <=< LLVM.bitcastElements--{- |-cumulative sum:-@(a,b,c,d) -> (a,a+b,a+b+c,a+b+c+d)@--I try to cleverly use horizontal add,-but the generic version in the Vector module is better.--}-_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 $-      constOf $ vector $ 0!:4!:2!:5!:Empty.Cons-   offset <- LLVM.shufflevector y (LLVM.value LLVM.zero) $-      constOf $ vector $ 4!:5!:0!:0!:Empty.Cons-   A.add z offset
− src/LLVM/Extra/Extension/X86Auto.hs 
@@ -1,2699 +0,0 @@-{- 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 Type.Data.Num.Decimal 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 V16Float = LLVM.Value (LLVM.Vector TypeNum.D16 Float)-type V16Int16 = LLVM.Value (LLVM.Vector TypeNum.D16 I.Int16)-type V16Int32 = LLVM.Value (LLVM.Vector TypeNum.D16 I.Int32)-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 V32Int16 = LLVM.Value (LLVM.Vector TypeNum.D32 I.Int16)-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 V64Int8 = LLVM.Value (LLVM.Vector TypeNum.D64 I.Int8)-type V8Double = LLVM.Value (LLVM.Vector TypeNum.D8 Double)-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 V8Int64 = LLVM.Value (LLVM.Vector TypeNum.D8 I.Int64)-type V8Word16 = LLVM.Value (LLVM.Vector TypeNum.D8 W.Word16)-type V8Word32 = LLVM.Value (LLVM.Vector TypeNum.D8 W.Word32)--{--readeflags_u32 :: Ext.T (LLVM.CodeGenFunction r (LLVM.Value I.Int32))-readeflags_u32 = Ext.intrinsic ExtX86.flags "read.u32"--readeflags_u64 :: Ext.T (LLVM.CodeGenFunction r (LLVM.Value I.Int64))-readeflags_u64 = Ext.intrinsic ExtX86.flags "read.u64"--writeeflags_u32 :: Ext.T (LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (LLVM.Value ()))-writeeflags_u32 = Ext.intrinsic ExtX86.flags "write.u32"--writeeflags_u64 :: Ext.T (LLVM.Value I.Int64 -> LLVM.CodeGenFunction r (LLVM.Value ()))-writeeflags_u64 = Ext.intrinsic ExtX86.flags "write.u64"--rdtsc :: Ext.T (LLVM.CodeGenFunction r (LLVM.Value I.Int64))-rdtsc = Ext.intrinsic ExtX86. "int.x86.rdtsc"--rdtscp :: Ext.T (LLVM.Value (Ptr ()) -> LLVM.CodeGenFunction r (LLVM.Value I.Int64))-rdtscp = Ext.intrinsic ExtX86. "int.x86.rdtscp"--rdpmc :: Ext.T (LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (LLVM.Value I.Int64))-rdpmc = Ext.intrinsic ExtX86. "int.x86.rdpmc"--}--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"--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"--pause :: Ext.T (LLVM.CodeGenFunction r (LLVM.Value ()))-pause = Ext.intrinsic ExtX86.sse2 "pause"--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"--pshufd :: Ext.T (V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-pshufd = Ext.intrinsic ExtX86.sse2 "pshuf.d"--pshuflw :: Ext.T (V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-pshuflw = Ext.intrinsic ExtX86.sse2 "pshufl.w"--pshufhw :: Ext.T (V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-pshufhw = Ext.intrinsic ExtX86.sse2 "pshufh.w"--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"--{--pclmulqdq128 :: Ext.T (V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-pclmulqdq128 = Ext.intrinsic ExtX86. "int.x86.pclmulqdq"--}--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.Int8 -> 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"--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.Int8 -> LLVM.CodeGenFunction r (V2Double))-dppd = Ext.intrinsic ExtX86.sse41 "dppd"--dpps :: Ext.T (V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-dpps = Ext.intrinsic ExtX86.sse41 "dpps"--mpsadbw128 :: Ext.T (V16Int8 -> V16Int8 -> LLVM.Value I.Int8 -> 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"--extrqi :: Ext.T (V2Int64 -> LLVM.Value I.Int8 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-extrqi = Ext.intrinsic ExtX86.sse4a "extrqi"--extrq :: Ext.T (V2Int64 -> V16Int8 -> LLVM.CodeGenFunction r (V2Int64))-extrq = Ext.intrinsic ExtX86.sse4a "extrq"--insertqi :: Ext.T (V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-insertqi = Ext.intrinsic ExtX86.sse4a "insertqi"--insertq :: Ext.T (V2Int64 -> V2Int64 -> LLVM.CodeGenFunction r (V2Int64))-insertq = Ext.intrinsic ExtX86.sse4a "insertq"--movntss :: Ext.T (LLVM.Value (Ptr ()) -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value ()))-movntss = Ext.intrinsic ExtX86.sse4a "movnt.ss"--movntsd :: Ext.T (LLVM.Value (Ptr ()) -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value ()))-movntsd = Ext.intrinsic ExtX86.sse4a "movnt.sd"--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"--vpermi2vard128_mask :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-vpermi2vard128_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.d.128"--vpermi2vard256_mask :: Ext.T (V8Int32 -> V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-vpermi2vard256_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.d.256"--vpermi2vard512_mask :: Ext.T (V16Int32 -> V16Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-vpermi2vard512_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.d.512"--vpermi2varhi128_mask :: Ext.T (V8Int16 -> V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-vpermi2varhi128_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.hi.128"--vpermi2varhi256_mask :: Ext.T (V16Int16 -> V16Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-vpermi2varhi256_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.hi.256"--vpermi2varhi512_mask :: Ext.T (V32Int16 -> V32Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-vpermi2varhi512_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.hi.512"--vpermi2varpd128_mask :: Ext.T (V2Double -> V2Int64 -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vpermi2varpd128_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.pd.128"--vpermi2varpd256_mask :: Ext.T (V4Double -> V4Int64 -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vpermi2varpd256_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.pd.256"--vpermi2varpd512_mask :: Ext.T (V8Double -> V8Int64 -> V8Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Double))-vpermi2varpd512_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.pd.512"--vpermi2varps128_mask :: Ext.T (V4Float -> V4Int32 -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vpermi2varps128_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.ps.128"--vpermi2varps256_mask :: Ext.T (V8Float -> V8Int32 -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vpermi2varps256_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.ps.256"--vpermi2varps512_mask :: Ext.T (V16Float -> V16Int32 -> V16Float -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Float))-vpermi2varps512_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.ps.512"--vpermi2varq128_mask :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-vpermi2varq128_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.q.128"--vpermi2varq256_mask :: Ext.T (V4Int64 -> V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-vpermi2varq256_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.q.256"--vpermi2varq512_mask :: Ext.T (V8Int64 -> V8Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-vpermi2varq512_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermi2var.q.512"--vpermt2vard512_mask :: Ext.T (V16Int32 -> V16Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-vpermt2vard512_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.d.512"--vpermt2varq512_mask :: Ext.T (V8Int64 -> V8Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-vpermt2varq512_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.q.512"--vpermt2varps512_mask :: Ext.T (V16Int32 -> V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Float))-vpermt2varps512_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.ps.512"--vpermt2varpd512_mask :: Ext.T (V8Int64 -> V8Double -> V8Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Double))-vpermt2varpd512_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.pd.512"--vpermt2vard128_mask :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-vpermt2vard128_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.d.128"--vpermt2vard128_maskz :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-vpermt2vard128_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.d.128"--vpermt2vard256_mask :: Ext.T (V8Int32 -> V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-vpermt2vard256_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.d.256"--vpermt2vard256_maskz :: Ext.T (V8Int32 -> V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-vpermt2vard256_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.d.256"--vpermt2vard512_maskz :: Ext.T (V16Int32 -> V16Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-vpermt2vard512_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.d.512"--vpermt2varhi128_mask :: Ext.T (V8Int16 -> V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-vpermt2varhi128_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.hi.128"--vpermt2varhi128_maskz :: Ext.T (V8Int16 -> V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-vpermt2varhi128_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.hi.128"--vpermt2varhi256_mask :: Ext.T (V16Int16 -> V16Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-vpermt2varhi256_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.hi.256"--vpermt2varhi256_maskz :: Ext.T (V16Int16 -> V16Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-vpermt2varhi256_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.hi.256"--vpermt2varhi512_mask :: Ext.T (V32Int16 -> V32Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-vpermt2varhi512_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.hi.512"--vpermt2varhi512_maskz :: Ext.T (V32Int16 -> V32Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-vpermt2varhi512_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.hi.512"--vpermt2varpd128_mask :: Ext.T (V2Int64 -> V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vpermt2varpd128_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.pd.128"--vpermt2varpd128_maskz :: Ext.T (V2Int64 -> V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vpermt2varpd128_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.pd.128"--vpermt2varpd256_mask :: Ext.T (V4Int64 -> V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vpermt2varpd256_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.pd.256"--vpermt2varpd256_maskz :: Ext.T (V4Int64 -> V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vpermt2varpd256_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.pd.256"--vpermt2varpd512_maskz :: Ext.T (V8Int64 -> V8Double -> V8Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Double))-vpermt2varpd512_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.pd.512"--vpermt2varps128_mask :: Ext.T (V4Int32 -> V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vpermt2varps128_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.ps.128"--vpermt2varps128_maskz :: Ext.T (V4Int32 -> V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vpermt2varps128_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.ps.128"--vpermt2varps256_mask :: Ext.T (V8Int32 -> V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vpermt2varps256_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.ps.256"--vpermt2varps256_maskz :: Ext.T (V8Int32 -> V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vpermt2varps256_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.ps.256"--vpermt2varps512_maskz :: Ext.T (V16Int32 -> V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Float))-vpermt2varps512_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.ps.512"--vpermt2varq128_mask :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-vpermt2varq128_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.q.128"--vpermt2varq128_maskz :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-vpermt2varq128_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.q.128"--vpermt2varq256_mask :: Ext.T (V4Int64 -> V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-vpermt2varq256_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermt2var.q.256"--vpermt2varq256_maskz :: Ext.T (V4Int64 -> V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-vpermt2varq256_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.q.256"--vpermt2varq512_maskz :: Ext.T (V8Int64 -> V8Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-vpermt2varq512_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vpermt2var.q.512"--vpermilpd_mask :: Ext.T (V2Double -> LLVM.Value I.Int32 -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vpermilpd_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermil.pd.128"--vpermilpd256_mask :: Ext.T (V4Double -> LLVM.Value I.Int32 -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vpermilpd256_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermil.pd.256"--vpermilpd512_mask :: Ext.T (V8Double -> LLVM.Value I.Int32 -> V8Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Double))-vpermilpd512_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermil.pd.512"--vpermilps_mask :: Ext.T (V4Float -> LLVM.Value I.Int32 -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vpermilps_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermil.ps.128"--vpermilps256_mask :: Ext.T (V8Float -> LLVM.Value I.Int32 -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vpermilps256_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermil.ps.256"--vpermilps512_mask :: Ext.T (V16Float -> LLVM.Value I.Int32 -> V16Float -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Float))-vpermilps512_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermil.ps.512"--vpermilvarpd256_mask :: Ext.T (V4Double -> V4Int64 -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vpermilvarpd256_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermilvar.pd.256"--vpermilvarpd512_mask :: Ext.T (V8Double -> V8Int64 -> V8Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Double))-vpermilvarpd512_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermilvar.pd.512"--vpermilvarpd_mask :: Ext.T (V2Double -> V2Int64 -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vpermilvarpd_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermilvar.pd.128"--vpermilvarps256_mask :: Ext.T (V8Float -> V8Int32 -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vpermilvarps256_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermilvar.ps.256"--vpermilvarps512_mask :: Ext.T (V16Float -> V16Int32 -> V16Float -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Float))-vpermilvarps512_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermilvar.ps.512"--vpermilvarps_mask :: Ext.T (V4Float -> V4Int32 -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vpermilvarps_mask = Ext.intrinsic ExtX86.avx512 "mask.vpermilvar.ps.128"--pshufb128_mask :: Ext.T (V16Int8 -> V16Int8 -> V16Int8 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int8))-pshufb128_mask = Ext.intrinsic ExtX86.avx512 "mask.pshuf.b.128"--pshufb256_mask :: Ext.T (V32Int8 -> V32Int8 -> V32Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int8))-pshufb256_mask = Ext.intrinsic ExtX86.avx512 "mask.pshuf.b.256"--pshufb512_mask :: Ext.T (V64Int8 -> V64Int8 -> V64Int8 -> LLVM.Value I.Int64 -> LLVM.CodeGenFunction r (V64Int8))-pshufb512_mask = Ext.intrinsic ExtX86.avx512 "mask.pshuf.b.512"--pshufd128_mask :: Ext.T (V4Int32 -> LLVM.Value I.Int16 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-pshufd128_mask = Ext.intrinsic ExtX86.avx512 "mask.pshuf.d.128"--pshufd256_mask :: Ext.T (V8Int32 -> LLVM.Value I.Int16 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-pshufd256_mask = Ext.intrinsic ExtX86.avx512 "mask.pshuf.d.256"--pshufd512_mask :: Ext.T (V16Int32 -> LLVM.Value I.Int16 -> V16Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V16Int32))-pshufd512_mask = Ext.intrinsic ExtX86.avx512 "mask.pshuf.d.512"--pshufhw128_mask :: Ext.T (V8Int16 -> LLVM.Value I.Int8 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-pshufhw128_mask = Ext.intrinsic ExtX86.avx512 "mask.pshufh.w.128"--pshufhw256_mask :: Ext.T (V16Int16 -> LLVM.Value I.Int8 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-pshufhw256_mask = Ext.intrinsic ExtX86.avx512 "mask.pshufh.w.256"--pshufhw512_mask :: Ext.T (V32Int16 -> LLVM.Value I.Int8 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-pshufhw512_mask = Ext.intrinsic ExtX86.avx512 "mask.pshufh.w.512"--pshuflw128_mask :: Ext.T (V8Int16 -> LLVM.Value I.Int8 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-pshuflw128_mask = Ext.intrinsic ExtX86.avx512 "mask.pshufl.w.128"--pshuflw256_mask :: Ext.T (V16Int16 -> LLVM.Value I.Int8 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-pshuflw256_mask = Ext.intrinsic ExtX86.avx512 "mask.pshufl.w.256"--pshuflw512_mask :: Ext.T (V32Int16 -> LLVM.Value I.Int8 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-pshuflw512_mask = Ext.intrinsic ExtX86.avx512 "mask.pshufl.w.512"--shuf_f32x4_256_mask :: Ext.T (V8Float -> V8Float -> LLVM.Value I.Int32 -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-shuf_f32x4_256_mask = Ext.intrinsic ExtX86.avx512 "mask.shuf.f32x4.256"--shuf_f32x4_mask :: Ext.T (V16Float -> V16Float -> LLVM.Value I.Int32 -> V16Float -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Float))-shuf_f32x4_mask = Ext.intrinsic ExtX86.avx512 "mask.shuf.f32x4"--shuf_f64x2_256_mask :: Ext.T (V4Double -> V4Double -> LLVM.Value I.Int32 -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-shuf_f64x2_256_mask = Ext.intrinsic ExtX86.avx512 "mask.shuf.f64x2.256"--shuf_f64x2_mask :: Ext.T (V8Double -> V8Double -> LLVM.Value I.Int32 -> V8Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Double))-shuf_f64x2_mask = Ext.intrinsic ExtX86.avx512 "mask.shuf.f64x2"--shuf_i32x4_256_mask :: Ext.T (V8Int32 -> V8Int32 -> LLVM.Value I.Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-shuf_i32x4_256_mask = Ext.intrinsic ExtX86.avx512 "mask.shuf.i32x4.256"--shuf_i32x4_mask :: Ext.T (V16Int32 -> V16Int32 -> LLVM.Value I.Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-shuf_i32x4_mask = Ext.intrinsic ExtX86.avx512 "mask.shuf.i32x4"--shuf_i64x2_256_mask :: Ext.T (V4Int64 -> V4Int64 -> LLVM.Value I.Int32 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-shuf_i64x2_256_mask = Ext.intrinsic ExtX86.avx512 "mask.shuf.i64x2.256"--shuf_i64x2_mask :: Ext.T (V8Int64 -> V8Int64 -> LLVM.Value I.Int32 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-shuf_i64x2_mask = Ext.intrinsic ExtX86.avx512 "mask.shuf.i64x2"--shufpd128_mask :: Ext.T (V2Double -> V2Double -> LLVM.Value I.Int32 -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-shufpd128_mask = Ext.intrinsic ExtX86.avx512 "mask.shuf.pd.128"--shufpd256_mask :: Ext.T (V4Double -> V4Double -> LLVM.Value I.Int32 -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-shufpd256_mask = Ext.intrinsic ExtX86.avx512 "mask.shuf.pd.256"--shufpd512_mask :: Ext.T (V8Double -> V8Double -> LLVM.Value I.Int32 -> V8Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Double))-shufpd512_mask = Ext.intrinsic ExtX86.avx512 "mask.shuf.pd.512"--shufps128_mask :: Ext.T (V4Float -> V4Float -> LLVM.Value I.Int32 -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-shufps128_mask = Ext.intrinsic ExtX86.avx512 "mask.shuf.ps.128"--shufps256_mask :: Ext.T (V8Float -> V8Float -> LLVM.Value I.Int32 -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-shufps256_mask = Ext.intrinsic ExtX86.avx512 "mask.shuf.ps.256"--shufps512_mask :: Ext.T (V16Float -> V16Float -> LLVM.Value I.Int32 -> V16Float -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Float))-shufps512_mask = Ext.intrinsic ExtX86.avx512 "mask.shuf.ps.512"--movshdup128_mask :: Ext.T (V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-movshdup128_mask = Ext.intrinsic ExtX86.avx512 "mask.movshdup.128"--movshdup256_mask :: Ext.T (V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-movshdup256_mask = Ext.intrinsic ExtX86.avx512 "mask.movshdup.256"--movshdup512_mask :: Ext.T (V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Float))-movshdup512_mask = Ext.intrinsic ExtX86.avx512 "mask.movshdup.512"--movsldup128_mask :: Ext.T (V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-movsldup128_mask = Ext.intrinsic ExtX86.avx512 "mask.movsldup.128"--movsldup256_mask :: Ext.T (V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-movsldup256_mask = Ext.intrinsic ExtX86.avx512 "mask.movsldup.256"--movsldup512_mask :: Ext.T (V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Float))-movsldup512_mask = Ext.intrinsic ExtX86.avx512 "mask.movsldup.512"--movddup128_mask :: Ext.T (V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-movddup128_mask = Ext.intrinsic ExtX86.avx512 "mask.movddup.128"--movddup256_mask :: Ext.T (V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-movddup256_mask = Ext.intrinsic ExtX86.avx512 "mask.movddup.256"--movddup512_mask :: Ext.T (V8Double -> V8Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Double))-movddup512_mask = Ext.intrinsic ExtX86.avx512 "mask.movddup.512"--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.Int8 -> 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"--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"--ptestmd512 :: Ext.T (V16Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (LLVM.Value I.Int16))-ptestmd512 = Ext.intrinsic ExtX86.avx512 "mask.ptestm.d.512"--ptestmq512 :: Ext.T (V8Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int8))-ptestmq512 = Ext.intrinsic ExtX86.avx512 "mask.ptestm.q.512"--fpclasspd128_mask :: Ext.T (V2Double -> LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int8))-fpclasspd128_mask = Ext.intrinsic ExtX86.avx512 "mask.fpclass.pd.128"--fpclasspd256_mask :: Ext.T (V4Double -> LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int8))-fpclasspd256_mask = Ext.intrinsic ExtX86.avx512 "mask.fpclass.pd.256"--fpclasspd512_mask :: Ext.T (V8Double -> LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int8))-fpclasspd512_mask = Ext.intrinsic ExtX86.avx512 "mask.fpclass.pd.512"--fpclassps128_mask :: Ext.T (V4Float -> LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int8))-fpclassps128_mask = Ext.intrinsic ExtX86.avx512 "mask.fpclass.ps.128"--fpclassps256_mask :: Ext.T (V8Float -> LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int8))-fpclassps256_mask = Ext.intrinsic ExtX86.avx512 "mask.fpclass.ps.256"--fpclassps512_mask :: Ext.T (V16Float -> LLVM.Value I.Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (LLVM.Value I.Int16))-fpclassps512_mask = Ext.intrinsic ExtX86.avx512 "mask.fpclass.ps.512"--fpclasssd :: Ext.T (V2Double -> LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int8))-fpclasssd = Ext.intrinsic ExtX86.avx512 "mask.fpclass.sd"--fpclassss :: Ext.T (V4Float -> LLVM.Value I.Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value I.Int8))-fpclassss = Ext.intrinsic ExtX86.avx512 "mask.fpclass.ss"--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"--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"--maskloadpd :: Ext.T (LLVM.Value (Ptr ()) -> V2Int64 -> LLVM.CodeGenFunction r (V2Double))-maskloadpd = Ext.intrinsic ExtX86.avx "maskload.pd"--maskloadps :: Ext.T (LLVM.Value (Ptr ()) -> V4Int32 -> LLVM.CodeGenFunction r (V4Float))-maskloadps = Ext.intrinsic ExtX86.avx "maskload.ps"--maskloadpd256 :: Ext.T (LLVM.Value (Ptr ()) -> V4Int64 -> LLVM.CodeGenFunction r (V4Double))-maskloadpd256 = Ext.intrinsic ExtX86.avx "maskload.pd.256"--maskloadps256 :: Ext.T (LLVM.Value (Ptr ()) -> V8Int32 -> LLVM.CodeGenFunction r (V8Float))-maskloadps256 = Ext.intrinsic ExtX86.avx "maskload.ps.256"--loadups128_mask :: Ext.T (LLVM.Value (Ptr ()) -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-loadups128_mask = Ext.intrinsic ExtX86.avx512 "mask.loadu.ps.128"--loadups256_mask :: Ext.T (LLVM.Value (Ptr ()) -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-loadups256_mask = Ext.intrinsic ExtX86.avx512 "mask.loadu.ps.256"--loadups512_mask :: Ext.T (LLVM.Value (Ptr ()) -> V16Float -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Float))-loadups512_mask = Ext.intrinsic ExtX86.avx512 "mask.loadu.ps.512"--loadupd128_mask :: Ext.T (LLVM.Value (Ptr ()) -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-loadupd128_mask = Ext.intrinsic ExtX86.avx512 "mask.loadu.pd.128"--loadupd256_mask :: Ext.T (LLVM.Value (Ptr ()) -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-loadupd256_mask = Ext.intrinsic ExtX86.avx512 "mask.loadu.pd.256"--loadupd512_mask :: Ext.T (LLVM.Value (Ptr ()) -> V8Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Double))-loadupd512_mask = Ext.intrinsic ExtX86.avx512 "mask.loadu.pd.512"--loadaps128_mask :: Ext.T (LLVM.Value (Ptr ()) -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-loadaps128_mask = Ext.intrinsic ExtX86.avx512 "mask.load.ps.128"--loadaps256_mask :: Ext.T (LLVM.Value (Ptr ()) -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-loadaps256_mask = Ext.intrinsic ExtX86.avx512 "mask.load.ps.256"--loadaps512_mask :: Ext.T (LLVM.Value (Ptr ()) -> V16Float -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Float))-loadaps512_mask = Ext.intrinsic ExtX86.avx512 "mask.load.ps.512"--loadapd128_mask :: Ext.T (LLVM.Value (Ptr ()) -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-loadapd128_mask = Ext.intrinsic ExtX86.avx512 "mask.load.pd.128"--loadapd256_mask :: Ext.T (LLVM.Value (Ptr ()) -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-loadapd256_mask = Ext.intrinsic ExtX86.avx512 "mask.load.pd.256"--loadapd512_mask :: Ext.T (LLVM.Value (Ptr ()) -> V8Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Double))-loadapd512_mask = Ext.intrinsic ExtX86.avx512 "mask.load.pd.512"--movss_mask :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-movss_mask = Ext.intrinsic ExtX86.avx512 "mask.move.ss"--movsd_mask :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-movsd_mask = Ext.intrinsic ExtX86.avx512 "mask.move.sd"--maskstorepd :: Ext.T (LLVM.Value (Ptr ()) -> V2Int64 -> V2Double -> LLVM.CodeGenFunction r (LLVM.Value ()))-maskstorepd = Ext.intrinsic ExtX86.avx "maskstore.pd"--maskstoreps :: Ext.T (LLVM.Value (Ptr ()) -> V4Int32 -> V4Float -> LLVM.CodeGenFunction r (LLVM.Value ()))-maskstoreps = Ext.intrinsic ExtX86.avx "maskstore.ps"--maskstorepd256 :: Ext.T (LLVM.Value (Ptr ()) -> V4Int64 -> V4Double -> LLVM.CodeGenFunction r (LLVM.Value ()))-maskstorepd256 = Ext.intrinsic ExtX86.avx "maskstore.pd.256"--maskstoreps256 :: Ext.T (LLVM.Value (Ptr ()) -> V8Int32 -> V8Float -> LLVM.CodeGenFunction r (LLVM.Value ()))-maskstoreps256 = Ext.intrinsic ExtX86.avx "maskstore.ps.256"--storeups512_mask :: Ext.T (LLVM.Value (Ptr ()) -> V16Float -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (LLVM.Value ()))-storeups512_mask = Ext.intrinsic ExtX86.avx512 "mask.storeu.ps.512"--storeupd512_mask :: Ext.T (LLVM.Value (Ptr ()) -> V8Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value ()))-storeupd512_mask = Ext.intrinsic ExtX86.avx512 "mask.storeu.pd.512"--storeaps512_mask :: Ext.T (LLVM.Value (Ptr ()) -> V16Float -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (LLVM.Value ()))-storeaps512_mask = Ext.intrinsic ExtX86.avx512 "mask.store.ps.512"--storeapd512_mask :: Ext.T (LLVM.Value (Ptr ()) -> V8Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value ()))-storeapd512_mask = Ext.intrinsic ExtX86.avx512 "mask.store.pd.512"--storess_mask :: Ext.T (LLVM.Value (Ptr ()) -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value ()))-storess_mask = Ext.intrinsic ExtX86.avx512 "mask.store.ss"--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"--pmaxsb128_mask :: Ext.T (V16Int8 -> V16Int8 -> V16Int8 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int8))-pmaxsb128_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxs.b.128"--pmaxsb256_mask :: Ext.T (V32Int8 -> V32Int8 -> V32Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int8))-pmaxsb256_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxs.b.256"--pmaxsb512_mask :: Ext.T (V64Int8 -> V64Int8 -> V64Int8 -> LLVM.Value I.Int64 -> LLVM.CodeGenFunction r (V64Int8))-pmaxsb512_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxs.b.512"--pmaxub128_mask :: Ext.T (V16Int8 -> V16Int8 -> V16Int8 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int8))-pmaxub128_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxu.b.128"--pmaxub256_mask :: Ext.T (V32Int8 -> V32Int8 -> V32Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int8))-pmaxub256_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxu.b.256"--pmaxub512_mask :: Ext.T (V64Int8 -> V64Int8 -> V64Int8 -> LLVM.Value I.Int64 -> LLVM.CodeGenFunction r (V64Int8))-pmaxub512_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxu.b.512"--pmaxsw128_mask :: Ext.T (V8Int16 -> V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-pmaxsw128_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxs.w.128"--pmaxsw256_mask :: Ext.T (V16Int16 -> V16Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-pmaxsw256_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxs.w.256"--pmaxsw512_mask :: Ext.T (V32Int16 -> V32Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-pmaxsw512_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxs.w.512"--pmaxuw128_mask :: Ext.T (V8Int16 -> V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-pmaxuw128_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxu.w.128"--pmaxuw256_mask :: Ext.T (V16Int16 -> V16Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-pmaxuw256_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxu.w.256"--pmaxuw512_mask :: Ext.T (V32Int16 -> V32Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-pmaxuw512_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxu.w.512"--pminsb128_mask :: Ext.T (V16Int8 -> V16Int8 -> V16Int8 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int8))-pminsb128_mask = Ext.intrinsic ExtX86.avx512 "mask.pmins.b.128"--pminsb256_mask :: Ext.T (V32Int8 -> V32Int8 -> V32Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int8))-pminsb256_mask = Ext.intrinsic ExtX86.avx512 "mask.pmins.b.256"--pminsb512_mask :: Ext.T (V64Int8 -> V64Int8 -> V64Int8 -> LLVM.Value I.Int64 -> LLVM.CodeGenFunction r (V64Int8))-pminsb512_mask = Ext.intrinsic ExtX86.avx512 "mask.pmins.b.512"--pminub128_mask :: Ext.T (V16Int8 -> V16Int8 -> V16Int8 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int8))-pminub128_mask = Ext.intrinsic ExtX86.avx512 "mask.pminu.b.128"--pminub256_mask :: Ext.T (V32Int8 -> V32Int8 -> V32Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int8))-pminub256_mask = Ext.intrinsic ExtX86.avx512 "mask.pminu.b.256"--pminub512_mask :: Ext.T (V64Int8 -> V64Int8 -> V64Int8 -> LLVM.Value I.Int64 -> LLVM.CodeGenFunction r (V64Int8))-pminub512_mask = Ext.intrinsic ExtX86.avx512 "mask.pminu.b.512"--pminsw128_mask :: Ext.T (V8Int16 -> V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-pminsw128_mask = Ext.intrinsic ExtX86.avx512 "mask.pmins.w.128"--pminsw256_mask :: Ext.T (V16Int16 -> V16Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-pminsw256_mask = Ext.intrinsic ExtX86.avx512 "mask.pmins.w.256"--pminsw512_mask :: Ext.T (V32Int16 -> V32Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-pminsw512_mask = Ext.intrinsic ExtX86.avx512 "mask.pmins.w.512"--pminuw128_mask :: Ext.T (V8Int16 -> V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-pminuw128_mask = Ext.intrinsic ExtX86.avx512 "mask.pminu.w.128"--pminuw256_mask :: Ext.T (V16Int16 -> V16Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-pminuw256_mask = Ext.intrinsic ExtX86.avx512 "mask.pminu.w.256"--pminuw512_mask :: Ext.T (V32Int16 -> V32Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-pminuw512_mask = Ext.intrinsic ExtX86.avx512 "mask.pminu.w.512"--pmaxud512_mask :: Ext.T (V16Int32 -> V16Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-pmaxud512_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxu.d.512"--pmaxud256_mask :: Ext.T (V8Int32 -> V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-pmaxud256_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxu.d.256"--pmaxud128_mask :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-pmaxud128_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxu.d.128"--pmaxsd512_mask :: Ext.T (V16Int32 -> V16Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-pmaxsd512_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxs.d.512"--pmaxsd256_mask :: Ext.T (V8Int32 -> V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-pmaxsd256_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxs.d.256"--pmaxsd128_mask :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-pmaxsd128_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxs.d.128"--pmaxuq512_mask :: Ext.T (V8Int64 -> V8Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-pmaxuq512_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxu.q.512"--pmaxuq256_mask :: Ext.T (V4Int64 -> V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-pmaxuq256_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxu.q.256"--pmaxuq128_mask :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-pmaxuq128_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxu.q.128"--pmaxsq512_mask :: Ext.T (V8Int64 -> V8Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-pmaxsq512_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxs.q.512"--pmaxsq256_mask :: Ext.T (V4Int64 -> V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-pmaxsq256_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxs.q.256"--pmaxsq128_mask :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-pmaxsq128_mask = Ext.intrinsic ExtX86.avx512 "mask.pmaxs.q.128"--pminud512_mask :: Ext.T (V16Int32 -> V16Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-pminud512_mask = Ext.intrinsic ExtX86.avx512 "mask.pminu.d.512"--pminud256_mask :: Ext.T (V8Int32 -> V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-pminud256_mask = Ext.intrinsic ExtX86.avx512 "mask.pminu.d.256"--pminud128_mask :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-pminud128_mask = Ext.intrinsic ExtX86.avx512 "mask.pminu.d.128"--pminsd512_mask :: Ext.T (V16Int32 -> V16Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-pminsd512_mask = Ext.intrinsic ExtX86.avx512 "mask.pmins.d.512"--pminsd256_mask :: Ext.T (V8Int32 -> V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-pminsd256_mask = Ext.intrinsic ExtX86.avx512 "mask.pmins.d.256"--pminsd128_mask :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-pminsd128_mask = Ext.intrinsic ExtX86.avx512 "mask.pmins.d.128"--pminuq512_mask :: Ext.T (V8Int64 -> V8Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-pminuq512_mask = Ext.intrinsic ExtX86.avx512 "mask.pminu.q.512"--pminuq256_mask :: Ext.T (V4Int64 -> V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-pminuq256_mask = Ext.intrinsic ExtX86.avx512 "mask.pminu.q.256"--pminuq128_mask :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-pminuq128_mask = Ext.intrinsic ExtX86.avx512 "mask.pminu.q.128"--pminsq512_mask :: Ext.T (V8Int64 -> V8Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-pminsq512_mask = Ext.intrinsic ExtX86.avx512 "mask.pmins.q.512"--pminsq256_mask :: Ext.T (V4Int64 -> V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-pminsq256_mask = Ext.intrinsic ExtX86.avx512 "mask.pmins.q.256"--pminsq128_mask :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-pminsq128_mask = Ext.intrinsic ExtX86.avx512 "mask.pmins.q.128"--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"--pslldi512 :: Ext.T (V16Int32 -> LLVM.Value I.Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-pslldi512 = Ext.intrinsic ExtX86.avx512 "mask.pslli.d"--psllqi512 :: Ext.T (V8Int64 -> LLVM.Value I.Int32 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-psllqi512 = Ext.intrinsic ExtX86.avx512 "mask.pslli.q"--psrldi512 :: Ext.T (V16Int32 -> LLVM.Value I.Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-psrldi512 = Ext.intrinsic ExtX86.avx512 "mask.psrli.d"--psrlqi512 :: Ext.T (V8Int64 -> LLVM.Value I.Int32 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-psrlqi512 = Ext.intrinsic ExtX86.avx512 "mask.psrli.q"--psradi512 :: Ext.T (V16Int32 -> LLVM.Value I.Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-psradi512 = Ext.intrinsic ExtX86.avx512 "mask.psrai.d"--psraqi512 :: Ext.T (V8Int64 -> LLVM.Value I.Int32 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-psraqi512 = Ext.intrinsic ExtX86.avx512 "mask.psrai.q"--psrlw128_mask :: Ext.T (V8Int16 -> V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-psrlw128_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.w.128"--psrlw256_mask :: Ext.T (V16Int16 -> V8Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-psrlw256_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.w.256"--psrlw512_mask :: Ext.T (V32Int16 -> V8Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-psrlw512_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.w.512"--psrlwi128_mask :: Ext.T (V8Int16 -> LLVM.Value I.Int8 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-psrlwi128_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.wi.128"--psrlwi256_mask :: Ext.T (V16Int16 -> LLVM.Value I.Int8 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-psrlwi256_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.wi.256"--psrlwi512_mask :: Ext.T (V32Int16 -> LLVM.Value I.Int8 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-psrlwi512_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.wi.512"--psraw128_mask :: Ext.T (V8Int16 -> V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-psraw128_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.w.128"--psraw256_mask :: Ext.T (V16Int16 -> V8Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-psraw256_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.w.256"--psraw512_mask :: Ext.T (V32Int16 -> V8Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-psraw512_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.w.512"--psrawi128_mask :: Ext.T (V8Int16 -> LLVM.Value I.Int8 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-psrawi128_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.wi.128"--psrawi256_mask :: Ext.T (V16Int16 -> LLVM.Value I.Int8 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-psrawi256_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.wi.256"--psrawi512_mask :: Ext.T (V32Int16 -> LLVM.Value I.Int8 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-psrawi512_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.wi.512"--pslld512_mask :: Ext.T (V16Int32 -> V4Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-pslld512_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.d"--psllq512_mask :: Ext.T (V8Int64 -> V2Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-psllq512_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.q"--psrld512_mask :: Ext.T (V16Int32 -> V4Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-psrld512_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.d"--psrlq512_mask :: Ext.T (V8Int64 -> V2Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-psrlq512_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.q"--psrad512_mask :: Ext.T (V16Int32 -> V4Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-psrad512_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.d"--psraq512_mask :: Ext.T (V8Int64 -> V2Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-psraq512_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.q"--psllw128_mask :: Ext.T (V8Int16 -> V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-psllw128_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.w.128"--psllw256_mask :: Ext.T (V16Int16 -> V8Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-psllw256_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.w.256"--psllw512_mask :: Ext.T (V32Int16 -> V8Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-psllw512_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.w.512"--psllwi128_mask :: Ext.T (V8Int16 -> LLVM.Value I.Int8 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-psllwi128_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.wi.128"--psllwi256_mask :: Ext.T (V16Int16 -> LLVM.Value I.Int8 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-psllwi256_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.wi.256"--psllwi512_mask :: Ext.T (V32Int16 -> LLVM.Value I.Int8 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-psllwi512_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.wi.512"--psllv16hi_mask :: Ext.T (V16Int16 -> V16Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-psllv16hi_mask = Ext.intrinsic ExtX86.avx512 "mask.psllv16.hi"--psllv2di_mask :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-psllv2di_mask = Ext.intrinsic ExtX86.avx512 "mask.psllv2.di"--psllv32hi_mask :: Ext.T (V32Int16 -> V32Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-psllv32hi_mask = Ext.intrinsic ExtX86.avx512 "mask.psllv32hi"--psllv4di_mask :: Ext.T (V4Int64 -> V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-psllv4di_mask = Ext.intrinsic ExtX86.avx512 "mask.psllv4.di"--psllv4si_mask :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-psllv4si_mask = Ext.intrinsic ExtX86.avx512 "mask.psllv4.si"--psllv8hi_mask :: Ext.T (V8Int16 -> V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-psllv8hi_mask = Ext.intrinsic ExtX86.avx512 "mask.psllv8.hi"--psllv8si_mask :: Ext.T (V8Int32 -> V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-psllv8si_mask = Ext.intrinsic ExtX86.avx512 "mask.psllv8.si"--psrad128_mask :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-psrad128_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.d.128"--psrad256_mask :: Ext.T (V8Int32 -> V4Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-psrad256_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.d.256"--psradi128_mask :: Ext.T (V4Int32 -> LLVM.Value I.Int8 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-psradi128_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.di.128"--psradi256_mask :: Ext.T (V8Int32 -> LLVM.Value I.Int8 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-psradi256_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.di.256"--psradi512_mask :: Ext.T (V16Int32 -> LLVM.Value I.Int8 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-psradi512_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.di.512"--psraq128_mask :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-psraq128_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.q.128"--psraq256_mask :: Ext.T (V4Int64 -> V2Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-psraq256_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.q.256"--psraqi128_mask :: Ext.T (V2Int64 -> LLVM.Value I.Int8 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-psraqi128_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.qi.128"--psraqi256_mask :: Ext.T (V4Int64 -> LLVM.Value I.Int8 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-psraqi256_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.qi.256"--psraqi512_mask :: Ext.T (V8Int64 -> LLVM.Value I.Int8 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-psraqi512_mask = Ext.intrinsic ExtX86.avx512 "mask.psra.qi.512"--psrld128_mask :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-psrld128_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.d.128"--psrld256_mask :: Ext.T (V8Int32 -> V4Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-psrld256_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.d.256"--psrldi128_mask :: Ext.T (V4Int32 -> LLVM.Value I.Int8 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-psrldi128_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.di.128"--psrldi256_mask :: Ext.T (V8Int32 -> LLVM.Value I.Int8 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-psrldi256_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.di.256"--psrldi512_mask :: Ext.T (V16Int32 -> LLVM.Value I.Int8 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-psrldi512_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.di.512"--psrlq128_mask :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-psrlq128_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.q.128"--psrlq256_mask :: Ext.T (V4Int64 -> V2Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-psrlq256_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.q.256"--psrlqi128_mask :: Ext.T (V2Int64 -> LLVM.Value I.Int8 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-psrlqi128_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.qi.128"--psrlqi256_mask :: Ext.T (V4Int64 -> LLVM.Value I.Int8 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-psrlqi256_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.qi.256"--psrlqi512_mask :: Ext.T (V8Int64 -> LLVM.Value I.Int8 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-psrlqi512_mask = Ext.intrinsic ExtX86.avx512 "mask.psrl.qi.512"--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"--pabsb128_mask :: Ext.T (V16Int8 -> V16Int8 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int8))-pabsb128_mask = Ext.intrinsic ExtX86.avx512 "mask.pabs.b.128"--pabsb256_mask :: Ext.T (V32Int8 -> V32Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int8))-pabsb256_mask = Ext.intrinsic ExtX86.avx512 "mask.pabs.b.256"--pabsb512_mask :: Ext.T (V64Int8 -> V64Int8 -> LLVM.Value I.Int64 -> LLVM.CodeGenFunction r (V64Int8))-pabsb512_mask = Ext.intrinsic ExtX86.avx512 "mask.pabs.b.512"--pabsd128_mask :: Ext.T (V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-pabsd128_mask = Ext.intrinsic ExtX86.avx512 "mask.pabs.d.128"--pabsd256_mask :: Ext.T (V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-pabsd256_mask = Ext.intrinsic ExtX86.avx512 "mask.pabs.d.256"--pabsd512_mask :: Ext.T (V16Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-pabsd512_mask = Ext.intrinsic ExtX86.avx512 "mask.pabs.d.512"--pabsq128_mask :: Ext.T (V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-pabsq128_mask = Ext.intrinsic ExtX86.avx512 "mask.pabs.q.128"--pabsq256_mask :: Ext.T (V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-pabsq256_mask = Ext.intrinsic ExtX86.avx512 "mask.pabs.q.256"--pabsq512_mask :: Ext.T (V8Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-pabsq512_mask = Ext.intrinsic ExtX86.avx512 "mask.pabs.q.512"--pabsw128_mask :: Ext.T (V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-pabsw128_mask = Ext.intrinsic ExtX86.avx512 "mask.pabs.w.128"--pabsw256_mask :: Ext.T (V16Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-pabsw256_mask = Ext.intrinsic ExtX86.avx512 "mask.pabs.w.256"--pabsw512_mask :: Ext.T (V32Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-pabsw512_mask = Ext.intrinsic ExtX86.avx512 "mask.pabs.w.512"--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"--pmulhrsw128_mask :: Ext.T (V8Int16 -> V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-pmulhrsw128_mask = Ext.intrinsic ExtX86.avx512 "mask.pmul.hr.sw.128"--pmulhrsw256_mask :: Ext.T (V16Int16 -> V16Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-pmulhrsw256_mask = Ext.intrinsic ExtX86.avx512 "mask.pmul.hr.sw.256"--pmulhrsw512_mask :: Ext.T (V32Int16 -> V32Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-pmulhrsw512_mask = Ext.intrinsic ExtX86.avx512 "mask.pmul.hr.sw.512"--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"--pbroadcastd512_gpr_mask :: Ext.T (LLVM.Value I.Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-pbroadcastd512_gpr_mask = Ext.intrinsic ExtX86.avx512 "mask.pbroadcast.d.gpr.512"--pbroadcastq512_gpr_mask :: Ext.T (LLVM.Value I.Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-pbroadcastq512_gpr_mask = Ext.intrinsic ExtX86.avx512 "mask.pbroadcast.q.gpr.512"--pbroadcastq512_mem_mask :: Ext.T (LLVM.Value I.Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-pbroadcastq512_mem_mask = Ext.intrinsic ExtX86.avx512 "mask.pbroadcast.q.mem.512"--permvarsi256 :: Ext.T (V8Int32 -> V8Int32 -> LLVM.CodeGenFunction r (V8Int32))-permvarsi256 = Ext.intrinsic ExtX86.avx2 "permd"--permvarsf256 :: Ext.T (V8Float -> V8Int32 -> 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"--extractf32x4_mask :: Ext.T (V16Float -> LLVM.Value I.Int32 -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-extractf32x4_mask = Ext.intrinsic ExtX86.avx512 "mask.vextractf32x4.512"--extracti32x4_mask :: Ext.T (V16Int32 -> LLVM.Value I.Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-extracti32x4_mask = Ext.intrinsic ExtX86.avx512 "mask.vextracti32x4.512"--extractf32x4_256_mask :: Ext.T (V8Float -> LLVM.Value I.Int32 -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-extractf32x4_256_mask = Ext.intrinsic ExtX86.avx512 "mask.vextractf32x4.256"--extracti32x4_256_mask :: Ext.T (V8Int32 -> LLVM.Value I.Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-extracti32x4_256_mask = Ext.intrinsic ExtX86.avx512 "mask.vextracti32x4.256"--extractf64x2_256_mask :: Ext.T (V4Double -> LLVM.Value I.Int32 -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-extractf64x2_256_mask = Ext.intrinsic ExtX86.avx512 "mask.vextractf64x2.256"--extracti64x2_256_mask :: Ext.T (V4Int64 -> LLVM.Value I.Int32 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-extracti64x2_256_mask = Ext.intrinsic ExtX86.avx512 "mask.vextracti64x2.256"--extractf64x2_512_mask :: Ext.T (V8Double -> LLVM.Value I.Int32 -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-extractf64x2_512_mask = Ext.intrinsic ExtX86.avx512 "mask.vextractf64x2.512"--extracti64x2_512_mask :: Ext.T (V8Int64 -> LLVM.Value I.Int32 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-extracti64x2_512_mask = Ext.intrinsic ExtX86.avx512 "mask.vextracti64x2.512"--extractf32x8_mask :: Ext.T (V16Float -> LLVM.Value I.Int32 -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-extractf32x8_mask = Ext.intrinsic ExtX86.avx512 "mask.vextractf32x8.512"--extracti32x8_mask :: Ext.T (V16Int32 -> LLVM.Value I.Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-extracti32x8_mask = Ext.intrinsic ExtX86.avx512 "mask.vextracti32x8.512"--extractf64x4_mask :: Ext.T (V8Double -> LLVM.Value I.Int32 -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-extractf64x4_mask = Ext.intrinsic ExtX86.avx512 "mask.vextractf64x4.512"--extracti64x4_mask :: Ext.T (V8Int64 -> LLVM.Value I.Int32 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-extracti64x4_mask = Ext.intrinsic ExtX86.avx512 "mask.vextracti64x4.512"--insertf32x4_256_mask :: Ext.T (V8Float -> V4Float -> LLVM.Value I.Int32 -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-insertf32x4_256_mask = Ext.intrinsic ExtX86.avx512 "mask.insertf32x4.256"--insertf32x4_512_mask :: Ext.T (V16Float -> V4Float -> LLVM.Value I.Int32 -> V16Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V16Float))-insertf32x4_512_mask = Ext.intrinsic ExtX86.avx512 "mask.insertf32x4.512"--insertf32x8_mask :: Ext.T (V16Float -> V8Float -> LLVM.Value I.Int32 -> V16Float -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Float))-insertf32x8_mask = Ext.intrinsic ExtX86.avx512 "mask.insertf32x8.512"--insertf64x2_256_mask :: Ext.T (V4Double -> V2Double -> LLVM.Value I.Int32 -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-insertf64x2_256_mask = Ext.intrinsic ExtX86.avx512 "mask.insertf64x2.256"--insertf64x2_512_mask :: Ext.T (V8Double -> V2Double -> LLVM.Value I.Int32 -> V8Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Double))-insertf64x2_512_mask = Ext.intrinsic ExtX86.avx512 "mask.insertf64x2.512"--insertf64x4_mask :: Ext.T (V8Double -> V4Double -> LLVM.Value I.Int32 -> V8Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Double))-insertf64x4_mask = Ext.intrinsic ExtX86.avx512 "mask.insertf64x4.512"--inserti32x4_256_mask :: Ext.T (V8Int32 -> V4Int32 -> LLVM.Value I.Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-inserti32x4_256_mask = Ext.intrinsic ExtX86.avx512 "mask.inserti32x4.256"--inserti32x4_512_mask :: Ext.T (V16Int32 -> V4Int32 -> LLVM.Value I.Int32 -> V16Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V16Int32))-inserti32x4_512_mask = Ext.intrinsic ExtX86.avx512 "mask.inserti32x4.512"--inserti32x8_mask :: Ext.T (V16Int32 -> V8Int32 -> LLVM.Value I.Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-inserti32x8_mask = Ext.intrinsic ExtX86.avx512 "mask.inserti32x8.512"--inserti64x2_256_mask :: Ext.T (V4Int64 -> V2Int64 -> LLVM.Value I.Int32 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-inserti64x2_256_mask = Ext.intrinsic ExtX86.avx512 "mask.inserti64x2.256"--inserti64x2_512_mask :: Ext.T (V8Int64 -> V2Int64 -> LLVM.Value I.Int32 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-inserti64x2_512_mask = Ext.intrinsic ExtX86.avx512 "mask.inserti64x2.512"--inserti64x4_mask :: Ext.T (V8Int64 -> V4Int64 -> LLVM.Value I.Int32 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-inserti64x4_mask = Ext.intrinsic ExtX86.avx512 "mask.inserti64x4.512"--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"--loaddqusi512_mask :: Ext.T (LLVM.Value (Ptr ()) -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-loaddqusi512_mask = Ext.intrinsic ExtX86.avx512 "mask.loadu.d.512"--loaddqudi512_mask :: Ext.T (LLVM.Value (Ptr ()) -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-loaddqudi512_mask = Ext.intrinsic ExtX86.avx512 "mask.loadu.q.512"--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"--storedqusi512_mask :: Ext.T (LLVM.Value (Ptr ()) -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (LLVM.Value ()))-storedqusi512_mask = Ext.intrinsic ExtX86.avx512 "mask.storeu.d.512"--storedqudi512_mask :: Ext.T (LLVM.Value (Ptr ()) -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (LLVM.Value ()))-storedqudi512_mask = Ext.intrinsic ExtX86.avx512 "mask.storeu.q.512"--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"--psllv16si_mask :: Ext.T (V16Int32 -> V16Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-psllv16si_mask = Ext.intrinsic ExtX86.avx512 "mask.psllv.d"--psllv8di_mask :: Ext.T (V8Int64 -> V8Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-psllv8di_mask = Ext.intrinsic ExtX86.avx512 "mask.psllv.q"--psrav16si_mask :: Ext.T (V16Int32 -> V16Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-psrav16si_mask = Ext.intrinsic ExtX86.avx512 "mask.psrav.d"--psrav8di_mask :: Ext.T (V8Int64 -> V8Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-psrav8di_mask = Ext.intrinsic ExtX86.avx512 "mask.psrav.q"--psrlv16si_mask :: Ext.T (V16Int32 -> V16Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-psrlv16si_mask = Ext.intrinsic ExtX86.avx512 "mask.psrlv.d"--psrlv8di_mask :: Ext.T (V8Int64 -> V8Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-psrlv8di_mask = Ext.intrinsic ExtX86.avx512 "mask.psrlv.q"--pslldq512 :: Ext.T (V8Int64 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Int64))-pslldq512 = Ext.intrinsic ExtX86.avx512 "psll.dq.512"--psrldq512 :: Ext.T (V8Int64 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Int64))-psrldq512 = Ext.intrinsic ExtX86.avx512 "psrl.dq.512"--pslld128_mask :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-pslld128_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.d.128"--pslld256_mask :: Ext.T (V8Int32 -> V4Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-pslld256_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.d.256"--pslldi128_mask :: Ext.T (V4Int32 -> LLVM.Value I.Int8 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-pslldi128_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.di.128"--pslldi256_mask :: Ext.T (V8Int32 -> LLVM.Value I.Int8 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-pslldi256_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.di.256"--pslldi512_mask :: Ext.T (V16Int32 -> LLVM.Value I.Int8 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-pslldi512_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.di.512"--psllq128_mask :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-psllq128_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.q.128"--psllq256_mask :: Ext.T (V4Int64 -> V2Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-psllq256_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.q.256"--psllqi128_mask :: Ext.T (V2Int64 -> LLVM.Value I.Int8 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-psllqi128_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.qi.128"--psllqi256_mask :: Ext.T (V4Int64 -> LLVM.Value I.Int8 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-psllqi256_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.qi.256"--psllqi512_mask :: Ext.T (V8Int64 -> LLVM.Value I.Int8 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-psllqi512_mask = Ext.intrinsic ExtX86.avx512 "mask.psll.qi.512"--psrav16hi_mask :: Ext.T (V16Int16 -> V16Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-psrav16hi_mask = Ext.intrinsic ExtX86.avx512 "mask.psrav16.hi"--psrav32hi_mask :: Ext.T (V32Int16 -> V32Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-psrav32hi_mask = Ext.intrinsic ExtX86.avx512 "mask.psrav32.hi"--psrav4si_mask :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-psrav4si_mask = Ext.intrinsic ExtX86.avx512 "mask.psrav4.si"--psrav8hi_mask :: Ext.T (V8Int16 -> V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-psrav8hi_mask = Ext.intrinsic ExtX86.avx512 "mask.psrav8.hi"--psrav8si_mask :: Ext.T (V8Int32 -> V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-psrav8si_mask = Ext.intrinsic ExtX86.avx512 "mask.psrav8.si"--psravq128_mask :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-psravq128_mask = Ext.intrinsic ExtX86.avx512 "mask.psrav.q.128"--psravq256_mask :: Ext.T (V4Int64 -> V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-psravq256_mask = Ext.intrinsic ExtX86.avx512 "mask.psrav.q.256"--psrlv16hi_mask :: Ext.T (V16Int16 -> V16Int16 -> V16Int16 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int16))-psrlv16hi_mask = Ext.intrinsic ExtX86.avx512 "mask.psrlv16.hi"--psrlv2di_mask :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-psrlv2di_mask = Ext.intrinsic ExtX86.avx512 "mask.psrlv2.di"--psrlv32hi_mask :: Ext.T (V32Int16 -> V32Int16 -> V32Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V32Int16))-psrlv32hi_mask = Ext.intrinsic ExtX86.avx512 "mask.psrlv32hi"--psrlv4di_mask :: Ext.T (V4Int64 -> V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-psrlv4di_mask = Ext.intrinsic ExtX86.avx512 "mask.psrlv4.di"--psrlv4si_mask :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-psrlv4si_mask = Ext.intrinsic ExtX86.avx512 "mask.psrlv4.si"--psrlv8hi_mask :: Ext.T (V8Int16 -> V8Int16 -> V8Int16 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int16))-psrlv8hi_mask = Ext.intrinsic ExtX86.avx512 "mask.psrlv8.hi"--psrlv8si_mask :: Ext.T (V8Int32 -> V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-psrlv8si_mask = Ext.intrinsic ExtX86.avx512 "mask.psrlv8.si"--prorvd128_mask :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-prorvd128_mask = Ext.intrinsic ExtX86.avx512 "mask.prorv.d.128"--prorvd256_mask :: Ext.T (V8Int32 -> V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-prorvd256_mask = Ext.intrinsic ExtX86.avx512 "mask.prorv.d.256"--prorvd512_mask :: Ext.T (V16Int32 -> V16Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-prorvd512_mask = Ext.intrinsic ExtX86.avx512 "mask.prorv.d.512"--prorvq128_mask :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-prorvq128_mask = Ext.intrinsic ExtX86.avx512 "mask.prorv.q.128"--prorvq256_mask :: Ext.T (V4Int64 -> V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-prorvq256_mask = Ext.intrinsic ExtX86.avx512 "mask.prorv.q.256"--prorvq512_mask :: Ext.T (V8Int64 -> V8Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-prorvq512_mask = Ext.intrinsic ExtX86.avx512 "mask.prorv.q.512"--prold128_mask :: Ext.T (V4Int32 -> LLVM.Value I.Int8 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-prold128_mask = Ext.intrinsic ExtX86.avx512 "mask.prol.d.128"--prold256_mask :: Ext.T (V8Int32 -> LLVM.Value I.Int8 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-prold256_mask = Ext.intrinsic ExtX86.avx512 "mask.prol.d.256"--prold512_mask :: Ext.T (V16Int32 -> LLVM.Value I.Int8 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-prold512_mask = Ext.intrinsic ExtX86.avx512 "mask.prol.d.512"--prolq128_mask :: Ext.T (V2Int64 -> LLVM.Value I.Int8 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-prolq128_mask = Ext.intrinsic ExtX86.avx512 "mask.prol.q.128"--prolq256_mask :: Ext.T (V4Int64 -> LLVM.Value I.Int8 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-prolq256_mask = Ext.intrinsic ExtX86.avx512 "mask.prol.q.256"--prolq512_mask :: Ext.T (V8Int64 -> LLVM.Value I.Int8 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-prolq512_mask = Ext.intrinsic ExtX86.avx512 "mask.prol.q.512"--prolvd128_mask :: Ext.T (V4Int32 -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-prolvd128_mask = Ext.intrinsic ExtX86.avx512 "mask.prolv.d.128"--prolvd256_mask :: Ext.T (V8Int32 -> V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-prolvd256_mask = Ext.intrinsic ExtX86.avx512 "mask.prolv.d.256"--prolvd512_mask :: Ext.T (V16Int32 -> V16Int32 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-prolvd512_mask = Ext.intrinsic ExtX86.avx512 "mask.prolv.d.512"--prolvq128_mask :: Ext.T (V2Int64 -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-prolvq128_mask = Ext.intrinsic ExtX86.avx512 "mask.prolv.q.128"--prolvq256_mask :: Ext.T (V4Int64 -> V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-prolvq256_mask = Ext.intrinsic ExtX86.avx512 "mask.prolv.q.256"--prolvq512_mask :: Ext.T (V8Int64 -> V8Int64 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-prolvq512_mask = Ext.intrinsic ExtX86.avx512 "mask.prolv.q.512"--prord128_mask :: Ext.T (V4Int32 -> LLVM.Value I.Int8 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-prord128_mask = Ext.intrinsic ExtX86.avx512 "mask.pror.d.128"--prord256_mask :: Ext.T (V8Int32 -> LLVM.Value I.Int8 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-prord256_mask = Ext.intrinsic ExtX86.avx512 "mask.pror.d.256"--prord512_mask :: Ext.T (V16Int32 -> LLVM.Value I.Int8 -> V16Int32 -> LLVM.Value I.Int16 -> LLVM.CodeGenFunction r (V16Int32))-prord512_mask = Ext.intrinsic ExtX86.avx512 "mask.pror.d.512"--prorq128_mask :: Ext.T (V2Int64 -> LLVM.Value I.Int8 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-prorq128_mask = Ext.intrinsic ExtX86.avx512 "mask.pror.q.128"--prorq256_mask :: Ext.T (V4Int64 -> LLVM.Value I.Int8 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-prorq256_mask = Ext.intrinsic ExtX86.avx512 "mask.pror.q.256"--prorq512_mask :: Ext.T (V8Int64 -> LLVM.Value I.Int8 -> V8Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int64))-prorq512_mask = Ext.intrinsic ExtX86.avx512 "mask.pror.q.512"--gatherd_pd :: Ext.T (V2Double -> LLVM.Value (Ptr ()) -> V4Int32 -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-gatherd_pd = Ext.intrinsic ExtX86.avx2 "gather.d.pd"--gatherd_pd256 :: Ext.T (V4Double -> LLVM.Value (Ptr ()) -> V4Int32 -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-gatherd_pd256 = Ext.intrinsic ExtX86.avx2 "gather.d.pd.256"--gatherq_pd :: Ext.T (V2Double -> LLVM.Value (Ptr ()) -> V2Int64 -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-gatherq_pd = Ext.intrinsic ExtX86.avx2 "gather.q.pd"--gatherq_pd256 :: Ext.T (V4Double -> LLVM.Value (Ptr ()) -> V4Int64 -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-gatherq_pd256 = Ext.intrinsic ExtX86.avx2 "gather.q.pd.256"--gatherd_ps :: Ext.T (V4Float -> LLVM.Value (Ptr ()) -> V4Int32 -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-gatherd_ps = Ext.intrinsic ExtX86.avx2 "gather.d.ps"--gatherd_ps256 :: Ext.T (V8Float -> LLVM.Value (Ptr ()) -> V8Int32 -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-gatherd_ps256 = Ext.intrinsic ExtX86.avx2 "gather.d.ps.256"--gatherq_ps :: Ext.T (V4Float -> LLVM.Value (Ptr ()) -> V2Int64 -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-gatherq_ps = Ext.intrinsic ExtX86.avx2 "gather.q.ps"--gatherq_ps256 :: Ext.T (V4Float -> LLVM.Value (Ptr ()) -> V4Int64 -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-gatherq_ps256 = Ext.intrinsic ExtX86.avx2 "gather.q.ps.256"--gatherd_q :: Ext.T (V2Int64 -> LLVM.Value (Ptr ()) -> V4Int32 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-gatherd_q = Ext.intrinsic ExtX86.avx2 "gather.d.q"--gatherd_q256 :: Ext.T (V4Int64 -> LLVM.Value (Ptr ()) -> V4Int32 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-gatherd_q256 = Ext.intrinsic ExtX86.avx2 "gather.d.q.256"--gatherq_q :: Ext.T (V2Int64 -> LLVM.Value (Ptr ()) -> V2Int64 -> V2Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Int64))-gatherq_q = Ext.intrinsic ExtX86.avx2 "gather.q.q"--gatherq_q256 :: Ext.T (V4Int64 -> LLVM.Value (Ptr ()) -> V4Int64 -> V4Int64 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int64))-gatherq_q256 = Ext.intrinsic ExtX86.avx2 "gather.q.q.256"--gatherd_d :: Ext.T (V4Int32 -> LLVM.Value (Ptr ()) -> V4Int32 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-gatherd_d = Ext.intrinsic ExtX86.avx2 "gather.d.d"--gatherd_d256 :: Ext.T (V8Int32 -> LLVM.Value (Ptr ()) -> V8Int32 -> V8Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Int32))-gatherd_d256 = Ext.intrinsic ExtX86.avx2 "gather.d.d.256"--gatherq_d :: Ext.T (V4Int32 -> LLVM.Value (Ptr ()) -> V2Int64 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-gatherq_d = Ext.intrinsic ExtX86.avx2 "gather.q.d"--gatherq_d256 :: Ext.T (V4Int32 -> LLVM.Value (Ptr ()) -> V4Int64 -> V4Int32 -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Int32))-gatherq_d256 = Ext.intrinsic ExtX86.avx2 "gather.q.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.Int8 -> 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.fma "vfmadd.ss"--vfmaddsd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))-vfmaddsd = Ext.intrinsic ExtX86.fma "vfmadd.sd"--vfmaddps :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))-vfmaddps = Ext.intrinsic ExtX86.fma "vfmadd.ps"--vfmaddpd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))-vfmaddpd = Ext.intrinsic ExtX86.fma "vfmadd.pd"--vfmaddps256 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))-vfmaddps256 = Ext.intrinsic ExtX86.fma "vfmadd.ps.256"--vfmaddpd256 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))-vfmaddpd256 = Ext.intrinsic ExtX86.fma "vfmadd.pd.256"--vfmsubss :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))-vfmsubss = Ext.intrinsic ExtX86.fma "vfmsub.ss"--vfmsubsd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))-vfmsubsd = Ext.intrinsic ExtX86.fma "vfmsub.sd"--vfmsubps :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))-vfmsubps = Ext.intrinsic ExtX86.fma "vfmsub.ps"--vfmsubpd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))-vfmsubpd = Ext.intrinsic ExtX86.fma "vfmsub.pd"--vfmsubps256 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))-vfmsubps256 = Ext.intrinsic ExtX86.fma "vfmsub.ps.256"--vfmsubpd256 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))-vfmsubpd256 = Ext.intrinsic ExtX86.fma "vfmsub.pd.256"--vfnmaddss :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))-vfnmaddss = Ext.intrinsic ExtX86.fma "vfnmadd.ss"--vfnmaddsd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))-vfnmaddsd = Ext.intrinsic ExtX86.fma "vfnmadd.sd"--vfnmaddps :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))-vfnmaddps = Ext.intrinsic ExtX86.fma "vfnmadd.ps"--vfnmaddpd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))-vfnmaddpd = Ext.intrinsic ExtX86.fma "vfnmadd.pd"--vfnmaddps256 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))-vfnmaddps256 = Ext.intrinsic ExtX86.fma "vfnmadd.ps.256"--vfnmaddpd256 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))-vfnmaddpd256 = Ext.intrinsic ExtX86.fma "vfnmadd.pd.256"--vfnmsubss :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))-vfnmsubss = Ext.intrinsic ExtX86.fma "vfnmsub.ss"--vfnmsubsd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))-vfnmsubsd = Ext.intrinsic ExtX86.fma "vfnmsub.sd"--vfnmsubps :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))-vfnmsubps = Ext.intrinsic ExtX86.fma "vfnmsub.ps"--vfnmsubpd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))-vfnmsubpd = Ext.intrinsic ExtX86.fma "vfnmsub.pd"--vfnmsubps256 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))-vfnmsubps256 = Ext.intrinsic ExtX86.fma "vfnmsub.ps.256"--vfnmsubpd256 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))-vfnmsubpd256 = Ext.intrinsic ExtX86.fma "vfnmsub.pd.256"--vfmaddsubps :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))-vfmaddsubps = Ext.intrinsic ExtX86.fma "vfmaddsub.ps"--vfmaddsubpd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))-vfmaddsubpd = Ext.intrinsic ExtX86.fma "vfmaddsub.pd"--vfmaddsubps256 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))-vfmaddsubps256 = Ext.intrinsic ExtX86.fma "vfmaddsub.ps.256"--vfmaddsubpd256 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))-vfmaddsubpd256 = Ext.intrinsic ExtX86.fma "vfmaddsub.pd.256"--vfmsubaddps :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.CodeGenFunction r (V4Float))-vfmsubaddps = Ext.intrinsic ExtX86.fma "vfmsubadd.ps"--vfmsubaddpd :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.CodeGenFunction r (V2Double))-vfmsubaddpd = Ext.intrinsic ExtX86.fma "vfmsubadd.pd"--vfmsubaddps256 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.CodeGenFunction r (V8Float))-vfmsubaddps256 = Ext.intrinsic ExtX86.fma "vfmsubadd.ps.256"--vfmsubaddpd256 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.CodeGenFunction r (V4Double))-vfmsubaddpd256 = Ext.intrinsic ExtX86.fma "vfmsubadd.pd.256"--vfmaddpd128_mask :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vfmaddpd128_mask = Ext.intrinsic ExtX86.avx512 "mask.vfmadd.pd.128"--vfmaddpd128_mask3 :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vfmaddpd128_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmadd.pd.128"--vfmaddpd128_maskz :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vfmaddpd128_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vfmadd.pd.128"--vfmaddpd256_mask :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vfmaddpd256_mask = Ext.intrinsic ExtX86.avx512 "mask.vfmadd.pd.256"--vfmaddpd256_mask3 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vfmaddpd256_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmadd.pd.256"--vfmaddpd256_maskz :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vfmaddpd256_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vfmadd.pd.256"--vfmaddpd512_mask :: Ext.T (V8Double -> V8Double -> V8Double -> LLVM.Value I.Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Double))-vfmaddpd512_mask = Ext.intrinsic ExtX86.avx512 "mask.vfmadd.pd.512"--vfmaddpd512_mask3 :: Ext.T (V8Double -> V8Double -> V8Double -> LLVM.Value I.Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Double))-vfmaddpd512_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmadd.pd.512"--vfmaddpd512_maskz :: Ext.T (V8Double -> V8Double -> V8Double -> LLVM.Value I.Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Double))-vfmaddpd512_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vfmadd.pd.512"--vfmaddps128_mask :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vfmaddps128_mask = Ext.intrinsic ExtX86.avx512 "mask.vfmadd.ps.128"--vfmaddps128_mask3 :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vfmaddps128_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmadd.ps.128"--vfmaddps128_maskz :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vfmaddps128_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vfmadd.ps.128"--vfmaddps256_mask :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vfmaddps256_mask = Ext.intrinsic ExtX86.avx512 "mask.vfmadd.ps.256"--vfmaddps256_mask3 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vfmaddps256_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmadd.ps.256"--vfmaddps256_maskz :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vfmaddps256_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vfmadd.ps.256"--vfmaddps512_mask :: Ext.T (V16Float -> V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Float))-vfmaddps512_mask = Ext.intrinsic ExtX86.avx512 "mask.vfmadd.ps.512"--vfmaddps512_mask3 :: Ext.T (V16Float -> V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Float))-vfmaddps512_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmadd.ps.512"--vfmaddps512_maskz :: Ext.T (V16Float -> V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Float))-vfmaddps512_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vfmadd.ps.512"--vfmaddsubpd128_mask :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vfmaddsubpd128_mask = Ext.intrinsic ExtX86.avx512 "mask.vfmaddsub.pd.128"--vfmaddsubpd128_mask3 :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vfmaddsubpd128_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmaddsub.pd.128"--vfmaddsubpd128_maskz :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vfmaddsubpd128_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vfmaddsub.pd.128"--vfmaddsubpd256_mask :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vfmaddsubpd256_mask = Ext.intrinsic ExtX86.avx512 "mask.vfmaddsub.pd.256"--vfmaddsubpd256_mask3 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vfmaddsubpd256_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmaddsub.pd.256"--vfmaddsubpd256_maskz :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vfmaddsubpd256_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vfmaddsub.pd.256"--vfmaddsubpd512_mask :: Ext.T (V8Double -> V8Double -> V8Double -> LLVM.Value I.Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Double))-vfmaddsubpd512_mask = Ext.intrinsic ExtX86.avx512 "mask.vfmaddsub.pd.512"--vfmaddsubpd512_mask3 :: Ext.T (V8Double -> V8Double -> V8Double -> LLVM.Value I.Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Double))-vfmaddsubpd512_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmaddsub.pd.512"--vfmaddsubpd512_maskz :: Ext.T (V8Double -> V8Double -> V8Double -> LLVM.Value I.Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Double))-vfmaddsubpd512_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vfmaddsub.pd.512"--vfmaddsubps128_mask :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vfmaddsubps128_mask = Ext.intrinsic ExtX86.avx512 "mask.vfmaddsub.ps.128"--vfmaddsubps128_mask3 :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vfmaddsubps128_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmaddsub.ps.128"--vfmaddsubps128_maskz :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vfmaddsubps128_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vfmaddsub.ps.128"--vfmaddsubps256_mask :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vfmaddsubps256_mask = Ext.intrinsic ExtX86.avx512 "mask.vfmaddsub.ps.256"--vfmaddsubps256_mask3 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vfmaddsubps256_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmaddsub.ps.256"--vfmaddsubps256_maskz :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vfmaddsubps256_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vfmaddsub.ps.256"--vfmaddsubps512_mask :: Ext.T (V16Float -> V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Float))-vfmaddsubps512_mask = Ext.intrinsic ExtX86.avx512 "mask.vfmaddsub.ps.512"--vfmaddsubps512_mask3 :: Ext.T (V16Float -> V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Float))-vfmaddsubps512_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmaddsub.ps.512"--vfmaddsubps512_maskz :: Ext.T (V16Float -> V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Float))-vfmaddsubps512_maskz = Ext.intrinsic ExtX86.avx512 "maskz.vfmaddsub.ps.512"--vfmsubpd128_mask3 :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vfmsubpd128_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmsub.pd.128"--vfmsubpd256_mask3 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vfmsubpd256_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmsub.pd.256"--vfmsubpd512_mask3 :: Ext.T (V8Double -> V8Double -> V8Double -> LLVM.Value I.Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Double))-vfmsubpd512_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmsub.pd.512"--vfmsubps128_mask3 :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vfmsubps128_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmsub.ps.128"--vfmsubps256_mask3 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vfmsubps256_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmsub.ps.256"--vfmsubps512_mask3 :: Ext.T (V16Float -> V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Float))-vfmsubps512_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmsub.ps.512"--vfmsubaddpd128_mask3 :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vfmsubaddpd128_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmsubadd.pd.128"--vfmsubaddpd256_mask3 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vfmsubaddpd256_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmsubadd.pd.256"--vfmsubaddpd512_mask3 :: Ext.T (V8Double -> V8Double -> V8Double -> LLVM.Value I.Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Double))-vfmsubaddpd512_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmsubadd.pd.512"--vfmsubaddps128_mask3 :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vfmsubaddps128_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmsubadd.ps.128"--vfmsubaddps256_mask3 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vfmsubaddps256_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmsubadd.ps.256"--vfmsubaddps512_mask3 :: Ext.T (V16Float -> V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Float))-vfmsubaddps512_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfmsubadd.ps.512"--vfnmaddpd128_mask :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vfnmaddpd128_mask = Ext.intrinsic ExtX86.avx512 "mask.vfnmadd.pd.128"--vfnmaddpd256_mask :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vfnmaddpd256_mask = Ext.intrinsic ExtX86.avx512 "mask.vfnmadd.pd.256"--vfnmaddpd512_mask :: Ext.T (V8Double -> V8Double -> V8Double -> LLVM.Value I.Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Double))-vfnmaddpd512_mask = Ext.intrinsic ExtX86.avx512 "mask.vfnmadd.pd.512"--vfnmaddps128_mask :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vfnmaddps128_mask = Ext.intrinsic ExtX86.avx512 "mask.vfnmadd.ps.128"--vfnmaddps256_mask :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vfnmaddps256_mask = Ext.intrinsic ExtX86.avx512 "mask.vfnmadd.ps.256"--vfnmaddps512_mask :: Ext.T (V16Float -> V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Float))-vfnmaddps512_mask = Ext.intrinsic ExtX86.avx512 "mask.vfnmadd.ps.512"--vfnmsubpd128_mask :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vfnmsubpd128_mask = Ext.intrinsic ExtX86.avx512 "mask.vfnmsub.pd.128"--vfnmsubpd128_mask3 :: Ext.T (V2Double -> V2Double -> V2Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V2Double))-vfnmsubpd128_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfnmsub.pd.128"--vfnmsubpd256_mask :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vfnmsubpd256_mask = Ext.intrinsic ExtX86.avx512 "mask.vfnmsub.pd.256"--vfnmsubpd256_mask3 :: Ext.T (V4Double -> V4Double -> V4Double -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Double))-vfnmsubpd256_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfnmsub.pd.256"--vfnmsubpd512_mask :: Ext.T (V8Double -> V8Double -> V8Double -> LLVM.Value I.Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Double))-vfnmsubpd512_mask = Ext.intrinsic ExtX86.avx512 "mask.vfnmsub.pd.512"--vfnmsubpd512_mask3 :: Ext.T (V8Double -> V8Double -> V8Double -> LLVM.Value I.Int8 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V8Double))-vfnmsubpd512_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfnmsub.pd.512"--vfnmsubps128_mask :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vfnmsubps128_mask = Ext.intrinsic ExtX86.avx512 "mask.vfnmsub.ps.128"--vfnmsubps128_mask3 :: Ext.T (V4Float -> V4Float -> V4Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V4Float))-vfnmsubps128_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfnmsub.ps.128"--vfnmsubps256_mask :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vfnmsubps256_mask = Ext.intrinsic ExtX86.avx512 "mask.vfnmsub.ps.256"--vfnmsubps256_mask3 :: Ext.T (V8Float -> V8Float -> V8Float -> LLVM.Value I.Int8 -> LLVM.CodeGenFunction r (V8Float))-vfnmsubps256_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfnmsub.ps.256"--vfnmsubps512_mask :: Ext.T (V16Float -> V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Float))-vfnmsubps512_mask = Ext.intrinsic ExtX86.avx512 "mask.vfnmsub.ps.512"--vfnmsubps512_mask3 :: Ext.T (V16Float -> V16Float -> V16Float -> LLVM.Value I.Int16 -> LLVM.Value I.Int32 -> LLVM.CodeGenFunction r (V16Float))-vfnmsubps512_mask3 = Ext.intrinsic ExtX86.avx512 "mask3.vfnmsub.ps.512"--
+ src/LLVM/Extra/FastMath.hs view
@@ -0,0 +1,533 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module LLVM.Extra.FastMath ( +   NoNaNs(NoNaNs),+   NoInfs(NoInfs),+   NoSignedZeros(NoSignedZeros),+   AllowReciprocal(AllowReciprocal),+   Fast(Fast),+   Flags(setFlags),++   Number(Number, deconsNumber),+   getNumber,+   nvNumber,+   nvDenumber,+   mvNumber,+   mvDenumber,++   NiceValue(setMultiValueFlags, setNiceValueFlags),+   attachNiceValueFlags,+   attachMultiValueFlags,+   liftNumberM,+   liftNumberM2,+   nvecNumber,+   nvecDenumber,+   mvecNumber,+   mvecDenumber,++   NiceVector(setMultiVectorFlags, setNiceVectorFlags),+   attachNiceVectorFlags,+   liftNiceVectorM,+   liftNiceVectorM2,+   attachMultiVectorFlags,+   liftMultiVectorM,+   liftMultiVectorM2,++   Tuple(setTupleFlags),+   Context(Context),+   attachTupleFlags,+   liftContext,+   liftContext2,+   ) where++import qualified LLVM.Extra.Nice.Vector as NiceVector+import qualified LLVM.Extra.Nice.Value.Private as Nice+import qualified LLVM.Extra.Arithmetic as A+import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.Core as LLVM+import LLVM.Util.Proxy (Proxy(Proxy))++import Foreign.Storable (Storable)++import qualified Control.Monad.HT as Monad+import Control.Applicative ((<$>))+++data NoNaNs          = NoNaNs          deriving (Show, Eq)+data NoInfs          = NoInfs          deriving (Show, Eq)+data NoSignedZeros   = NoSignedZeros   deriving (Show, Eq)+data AllowReciprocal = AllowReciprocal deriving (Show, Eq)+data Fast            = Fast            deriving (Show, Eq)+++class Flags flags where+   setFlags ::+      (LLVM.IsFloating a) =>+      Proxy flags -> Bool -> LLVM.Value a -> LLVM.CodeGenFunction r ()++instance Flags NoNaNs          where setFlags Proxy = LLVM.setHasNoNaNs+instance Flags NoInfs          where setFlags Proxy = LLVM.setHasNoInfs+instance Flags NoSignedZeros   where setFlags Proxy = LLVM.setHasNoSignedZeros+instance Flags AllowReciprocal where setFlags Proxy = LLVM.setHasAllowReciprocal+instance Flags Fast            where setFlags Proxy = LLVM.setFastMath++instance (Flags f0, Flags f1) => Flags (f0,f1) where+   setFlags p b v = setFlags (fst<$>p) b v >> setFlags (snd<$>p) b v++instance (Flags f0, Flags f1, Flags f2) => Flags (f0,f1,f2) where+   setFlags = setSplitFlags $ \(f0,f1,f2) -> (f0,(f1,f2))++instance (Flags f0, Flags f1, Flags f2, Flags f3) => Flags (f0,f1,f2,f3) where+   setFlags = setSplitFlags $ \(f0,f1,f2,f3) -> (f0,(f1,f2,f3))++instance+   (Flags f0, Flags f1, Flags f2, Flags f3, Flags f4) =>+      Flags (f0,f1,f2,f3,f4) where+   setFlags = setSplitFlags $ \(f0,f1,f2,f3,f4) -> (f0,(f1,f2,f3,f4))++setSplitFlags ::+   (Flags split, LLVM.IsFloating a) =>+   (flags -> split) ->+   Proxy flags -> Bool -> LLVM.Value a -> LLVM.CodeGenFunction r ()+setSplitFlags split p = setFlags (fmap split p)+++newtype Number flags a = Number {deconsNumber :: a}+   deriving (Eq, Ord, Show, Num, Fractional, Floating, Storable)++getNumber :: flags -> Number flags a -> a+getNumber _ (Number a) = a++instance NiceValue a => Nice.C (Number flags a) where+   type Repr (Number flags a) = Nice.Repr a+   cons = nvNumber . Nice.cons . deconsNumber+   undef = nvNumber Nice.undef+   zero = nvNumber Nice.zero+   phi bb = fmap nvNumber . Nice.phi bb . nvDenumber+   addPhi bb a b = Nice.addPhi bb (nvDenumber a) (nvDenumber b)++nvNumber :: Nice.T a -> Nice.T (Number flags a)+nvNumber (Nice.Cons a) = Nice.Cons a++nvDenumber :: Nice.T (Number flags a) -> Nice.T a+nvDenumber (Nice.Cons a) = Nice.Cons a++{-# DEPRECATED mvNumber "Use nvNumber instead" #-}+mvNumber :: Nice.T a -> Nice.T (Number flags a)+mvNumber (Nice.Cons a) = Nice.Cons a++{-# DEPRECATED mvDenumber "Use nvDenumber instead" #-}+mvDenumber :: Nice.T (Number flags a) -> Nice.T a+mvDenumber (Nice.Cons a) = Nice.Cons a+++{-# DEPRECATED setMultiValueFlags "use setNiceValueFlags instead" #-}+class Nice.C a => NiceValue a where+   {-# MINIMAL setNiceValueFlags | setMultiValueFlags #-}+   setNiceValueFlags, setMultiValueFlags ::+      (Flags flags) =>+      Proxy flags -> Bool -> Nice.T (Number flags a) ->+      LLVM.CodeGenFunction r ()+   setNiceValueFlags = setMultiValueFlags+   setMultiValueFlags = setNiceValueFlags++instance NiceValue Float where+   setNiceValueFlags p b (Nice.Cons a) = setFlags p b a++instance NiceValue Double where+   setNiceValueFlags p b (Nice.Cons a) = setFlags p b a+++type Id a = a -> a++{-# DEPRECATED attachMultiValueFlags "Use attachNiceValueFlags instead." #-}+attachMultiValueFlags, attachNiceValueFlags ::+   (Flags flags, NiceValue a) =>+   Id (LLVM.CodeGenFunction r (Nice.T (Number flags a)))+attachMultiValueFlags = attachNiceValueFlags+attachNiceValueFlags act = do+   mv <- act+   setMultiValueFlags Proxy True mv+   return mv++liftNumberM ::+   (m ~ LLVM.CodeGenFunction r, Flags flags, NiceValue b) =>+   (Nice.T a -> m (Nice.T b)) ->+   Nice.T (Number flags a) -> m (Nice.T (Number flags b))+liftNumberM f =+   attachMultiValueFlags . Monad.lift nvNumber . f . nvDenumber++liftNumberM2 ::+   (m ~ LLVM.CodeGenFunction r, Flags flags, NiceValue c) =>+   (Nice.T a -> Nice.T b -> m (Nice.T c)) ->+   Nice.T (Number flags a) -> Nice.T (Number flags b) ->+   m (Nice.T (Number flags c))+liftNumberM2 f a b =+   attachMultiValueFlags $ Monad.lift nvNumber $ f (nvDenumber a) (nvDenumber b)+++instance (Flags flags, Nice.Compose a) => Nice.Compose (Number flags a) where+   type Composed (Number flags a) = Number flags (Nice.Composed a)+   compose = nvNumber . Nice.compose . deconsNumber++instance+      (Flags flags, Nice.Decompose pa) => Nice.Decompose (Number flags pa) where+   decompose (Number p) = Number . Nice.decompose p . nvDenumber++type instance+   Nice.Decomposed f (Number flags pa) = Number flags (Nice.Decomposed f pa)+type instance+   Nice.PatternTuple (Number flags pa) = Number flags (Nice.PatternTuple pa)+++instance+   (Flags flags, NiceValue a, Nice.IntegerConstant a) =>+      Nice.IntegerConstant (Number flags a) where+   fromInteger' = nvNumber . Nice.fromInteger'++instance+   (Flags flags, NiceValue a, Nice.RationalConstant a) =>+      Nice.RationalConstant (Number flags a) where+   fromRational' = nvNumber . Nice.fromRational'++instance+   (Flags flags, NiceValue a, Nice.Additive a) =>+      Nice.Additive (Number flags a) where+   add = liftNumberM2 Nice.add+   sub = liftNumberM2 Nice.sub+   neg = liftNumberM Nice.neg++instance+   (Flags flags, NiceValue a, Nice.PseudoRing a) =>+      Nice.PseudoRing (Number flags a) where+   mul = liftNumberM2 Nice.mul++instance+   (Flags flags, NiceValue a, Nice.Field a) =>+      Nice.Field (Number flags a) where+   fdiv = liftNumberM2 Nice.fdiv++type instance Nice.Scalar (Number flags a) = Number flags (Nice.Scalar a)++instance+   (Flags flags, NiceValue a, a ~ Nice.Scalar v,+    NiceValue v, Nice.PseudoModule v) =>+      Nice.PseudoModule (Number flags v) where+   scale = liftNumberM2 Nice.scale++instance+   (Flags flags, NiceValue a, Nice.Real a) =>+      Nice.Real (Number flags a) where+   min = liftNumberM2 Nice.min+   max = liftNumberM2 Nice.max+   abs = liftNumberM Nice.abs+   signum = liftNumberM Nice.signum++instance+   (Flags flags, NiceValue a, Nice.Fraction a) =>+      Nice.Fraction (Number flags a) where+   truncate = liftNumberM Nice.truncate+   fraction = liftNumberM Nice.fraction++instance+   (Flags flags, NiceValue a, Nice.Algebraic a) =>+      Nice.Algebraic (Number flags a) where+   sqrt = liftNumberM Nice.sqrt++instance+   (Flags flags, NiceValue a, Nice.Transcendental a) =>+      Nice.Transcendental (Number flags a) where+   pi = fmap nvNumber Nice.pi+   sin = liftNumberM Nice.sin+   cos = liftNumberM Nice.cos+   exp = liftNumberM Nice.exp+   log = liftNumberM Nice.log+   pow = liftNumberM2 Nice.pow++instance+   (Flags flags, NiceValue a, Nice.Select a) =>+      Nice.Select (Number flags a) where+   select = liftNumberM2 . Nice.select++instance+   (Flags flags, NiceValue a, Nice.Comparison a) =>+      Nice.Comparison (Number flags a) where+   cmp p a b = Nice.cmp p (nvDenumber a) (nvDenumber b)++instance+   (Flags flags, NiceValue a, Nice.FloatingComparison a) =>+      Nice.FloatingComparison (Number flags a) where+   fcmp p a b = Nice.fcmp p (nvDenumber a) (nvDenumber b)++++nvecNumber :: NiceVector.T n a -> NiceVector.T n (Number flags a)+nvecNumber (NiceVector.Cons v) = NiceVector.Cons v++nvecDenumber :: NiceVector.T n (Number flags a) -> NiceVector.T n a+nvecDenumber (NiceVector.Cons v) = NiceVector.Cons v++{-# DEPRECATED mvecNumber "Use nvecNumber instead" #-}+mvecNumber :: NiceVector.T n a -> NiceVector.T n (Number flags a)+mvecNumber (NiceVector.Cons v) = NiceVector.Cons v++{-# DEPRECATED mvecDenumber "Use nvecDenumber instead" #-}+mvecDenumber :: NiceVector.T n (Number flags a) -> NiceVector.T n a+mvecDenumber (NiceVector.Cons v) = NiceVector.Cons v++{-# DEPRECATED setMultiVectorFlags "use setNiceVectorFlags instead" #-}+class (NiceValue a, NiceVector.C a) => NiceVector a where+   {-# MINIMAL setNiceVectorFlags | setMultiVectorFlags #-}+   setNiceVectorFlags, setMultiVectorFlags ::+      (Flags flags, LLVM.Positive n) =>+      Proxy flags -> Bool ->+      NiceVector.T n (Number flags a) -> LLVM.CodeGenFunction r ()+   setNiceVectorFlags = setMultiVectorFlags+   setMultiVectorFlags = setNiceVectorFlags++instance NiceVector Float where+   setMultiVectorFlags p b =+      setFlags p b . NiceVector.deconsPrim . nvecDenumber++instance NiceVector Double where+   setMultiVectorFlags p b =+      setFlags p b . NiceVector.deconsPrim . nvecDenumber++{-# DEPRECATED attachMultiVectorFlags "Use attachNiceVectorFlags instead." #-}+attachNiceVectorFlags, attachMultiVectorFlags ::+   (LLVM.Positive n, Flags flags, NiceVector a) =>+   Id (LLVM.CodeGenFunction r (NiceVector.T n (Number flags a)))+attachMultiVectorFlags = attachNiceVectorFlags+attachNiceVectorFlags act = do+   mv <- act+   setMultiVectorFlags Proxy True mv+   return mv++{-# DEPRECATED liftMultiVectorM "Use liftNiceVectorM instead." #-}+liftNiceVectorM, liftMultiVectorM ::+   (m ~ LLVM.CodeGenFunction r, LLVM.Positive n, Flags flags, NiceVector b) =>+   (NiceVector.T n a -> m (NiceVector.T n b)) ->+   NiceVector.T n (Number flags a) -> m (NiceVector.T n (Number flags b))+liftMultiVectorM = liftNiceVectorM+liftNiceVectorM f =+   attachMultiVectorFlags . Monad.lift nvecNumber . f . nvecDenumber++{-# DEPRECATED liftMultiVectorM2 "Use liftNiceVectorM2 instead." #-}+liftNiceVectorM2, liftMultiVectorM2 ::+   (m ~ LLVM.CodeGenFunction r, LLVM.Positive n, Flags flags, NiceVector c) =>+   (NiceVector.T n a -> NiceVector.T n b -> m (NiceVector.T n c)) ->+   NiceVector.T n (Number flags a) -> NiceVector.T n (Number flags b) ->+   m (NiceVector.T n (Number flags c))+liftMultiVectorM2 = liftNiceVectorM2+liftNiceVectorM2 f a b =+   attachMultiVectorFlags $+      Monad.lift nvecNumber $ f (nvecDenumber a) (nvecDenumber b)++instance (Flags flags, NiceVector a) => NiceVector.C (Number flags a) where+   type Repr n (Number flags a) = NiceVector.Repr n a+   cons = nvecNumber . NiceVector.cons . fmap deconsNumber+   undef = nvecNumber NiceVector.undef+   zero = nvecNumber NiceVector.zero+   phi bb = fmap nvecNumber . NiceVector.phi bb . nvecDenumber+   addPhi bb a b = NiceVector.addPhi bb (nvecDenumber a) (nvecDenumber b)+   shuffle ks a b =+      fmap nvecNumber $ NiceVector.shuffle ks (nvecDenumber a) (nvecDenumber b)+   extract k = fmap nvNumber . NiceVector.extract k . nvecDenumber+   insert k x =+      fmap nvecNumber . NiceVector.insert k (nvDenumber x) . nvecDenumber++instance+   (Flags flags, NiceVector a, NiceVector.IntegerConstant a) =>+      NiceVector.IntegerConstant (Number flags a) where+   fromInteger' = nvecNumber . NiceVector.fromInteger'++instance+   (Flags flags, NiceVector a, NiceVector.RationalConstant a) =>+      NiceVector.RationalConstant (Number flags a) where+   fromRational' = nvecNumber . NiceVector.fromRational'++instance+   (Flags flags, NiceVector a, NiceVector.Additive a) =>+      NiceVector.Additive (Number flags a) where+   add = liftNiceVectorM2 NiceVector.add+   sub = liftNiceVectorM2 NiceVector.sub+   neg = liftNiceVectorM NiceVector.neg++instance+   (Flags flags, NiceVector a, NiceVector.PseudoRing a) =>+      NiceVector.PseudoRing (Number flags a) where+   mul = liftNiceVectorM2 NiceVector.mul++instance+   (Flags flags, NiceVector a, NiceVector.Field a) =>+      NiceVector.Field (Number flags a) where+   fdiv = liftNiceVectorM2 NiceVector.fdiv+++{-+type instance NiceValue.Scalar (Number flags a) =+      Number flags (NiceValue.Scalar a)+instance+   (Flags flags, NiceVector a, NiceVector.PseudoModule a) =>+      NiceVector.PseudoModule (Number flags a) where+   scale = liftNiceVectorM2 NiceVector.mul+-}++instance+   (Flags flags, NiceVector a, NiceVector.Real a) =>+      NiceVector.Real (Number flags a) where+   min = liftNiceVectorM2 NiceVector.min+   max = liftNiceVectorM2 NiceVector.max+   abs = liftNiceVectorM NiceVector.abs+   signum = liftNiceVectorM NiceVector.signum++instance+   (Flags flags, NiceVector a, NiceVector.Fraction a) =>+      NiceVector.Fraction (Number flags a) where+   truncate = liftNiceVectorM NiceVector.truncate+   fraction = liftNiceVectorM NiceVector.fraction++instance+   (Flags flags, NiceVector a, NiceVector.Algebraic a) =>+      NiceVector.Algebraic (Number flags a) where+   sqrt = liftNiceVectorM NiceVector.sqrt++instance+   (Flags flags, NiceVector a, NiceVector.Transcendental a) =>+      NiceVector.Transcendental (Number flags a) where+   pi = fmap nvecNumber NiceVector.pi+   sin = liftNiceVectorM NiceVector.sin+   cos = liftNiceVectorM NiceVector.cos+   exp = liftNiceVectorM NiceVector.exp+   log = liftNiceVectorM NiceVector.log+   pow = liftNiceVectorM2 NiceVector.pow++instance+   (Flags flags, NiceVector a, NiceVector.Select a) =>+      NiceVector.Select (Number flags a) where+   select = liftNiceVectorM2 . NiceVector.select++instance+   (Flags flags, NiceVector a, NiceVector.Comparison a) =>+      NiceVector.Comparison (Number flags a) where+   cmp p a b = NiceVector.cmp p (nvecDenumber a) (nvecDenumber b)++instance+   (Flags flags, NiceVector a, NiceVector.FloatingComparison a) =>+      NiceVector.FloatingComparison (Number flags a) where+   fcmp p a b = NiceVector.fcmp p (nvecDenumber a) (nvecDenumber b)++++class Tuple a where+   setTupleFlags ::+      (Flags flags) => Proxy flags -> Bool -> a -> LLVM.CodeGenFunction r ()++instance (LLVM.IsFloating a) => Tuple (LLVM.Value a) where+   setTupleFlags = setFlags+++newtype Context flags a = Context a++proxyFromContext :: Context flags a -> Proxy flags+proxyFromContext (Context _) = Proxy++instance+   (Flags flags, Tuple.Zero a, Tuple a) =>+      Tuple.Zero (Context flags a) where+   zero = Context Tuple.zero++instance+   (Flags flags, Tuple a, A.Additive a) =>+      A.Additive (Context flags a) where+   zero = Context A.zero+   add = liftContext2 A.add+   sub = liftContext2 A.sub+   neg = liftContext A.neg++instance+   (Flags flags, A.PseudoRing a, Tuple a) =>+      A.PseudoRing (Context flags a) where+   mul = liftContext2 A.mul++type instance A.Scalar (Context flags a) = Context flags (A.Scalar a)++instance+   (Flags flags, A.PseudoModule v, Tuple v, A.Scalar v ~ a, Tuple a) =>+      A.PseudoModule (Context flags v) where+   scale = liftContext2 A.scale++instance+   (Flags flags, Tuple a, A.IntegerConstant a) =>+      A.IntegerConstant (Context flags a) where+   fromInteger' = Context . A.fromInteger'++instance+   (Flags flags, Tuple v, A.Field v) =>+      A.Field (Context flags v) where+   fdiv = liftContext2 A.fdiv++instance+   (Flags flags, Tuple a, A.RationalConstant a) =>+      A.RationalConstant (Context flags a) where+   fromRational' = Context . A.fromRational'++instance (Flags flags, Tuple a, A.Real a) => A.Real (Context flags a) where+   min = liftContext2 A.min+   max = liftContext2 A.max+   abs = liftContext A.abs+   signum = liftContext A.signum++instance+   (Flags flags, Tuple a, A.Fraction a) =>+      A.Fraction (Context flags a) where+   truncate = liftContext A.truncate+   fraction = liftContext A.fraction++instance+   (Flags flags, Tuple a, A.Comparison a) =>+      A.Comparison (Context flags a) where+   type CmpResult (Context flags a) = A.CmpResult a+   cmp p (Context x) (Context y) = A.cmp p x y++instance+   (Flags flags, Tuple a, A.FloatingComparison a) =>+      A.FloatingComparison (Context flags a) where+   fcmp p (Context x) (Context y) = A.fcmp p x y++instance+   (Flags flags, Tuple a, A.Algebraic a) =>+      A.Algebraic (Context flags a) where+   sqrt = liftContext A.sqrt++instance+   (Flags flags, Tuple a, A.Transcendental a) =>+      A.Transcendental (Context flags a) where+   pi = attachTupleFlags A.pi+   sin = liftContext A.sin+   cos = liftContext A.cos+   exp = liftContext A.exp+   log = liftContext A.log+   pow = liftContext2 A.pow+++attachTupleFlags ::+   (Flags flags, Tuple a) =>+   Id (LLVM.CodeGenFunction r (Context flags a))+attachTupleFlags act = do+   c@(Context x) <- act+   setTupleFlags (proxyFromContext c) True x+   return c++liftContext :: (Flags flags, Tuple b) =>+   (a -> LLVM.CodeGenFunction r b) ->+   Context flags a -> LLVM.CodeGenFunction r (Context flags b)+liftContext f (Context x) = attachTupleFlags (Context <$> f x)++liftContext2 :: (Flags flags, Tuple c) =>+   (a -> b -> LLVM.CodeGenFunction r c) ->+   Context flags a -> Context flags b ->+   LLVM.CodeGenFunction r (Context flags c)+liftContext2 f (Context x) = liftContext $ f x
+ src/LLVM/Extra/Function.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE TypeFamilies #-}+{- |+Alternative to 'LLVM.Core.defineFunction'+that creates the final 'LLVM.Core.ret' instruction for you.+-}+module LLVM.Extra.Function (+   C,+   CodeGen,+   define,+   create,+   createNamed,+   Return, Result, ret,+   ) where++import qualified LLVM.Util.Proxy as LP+import qualified LLVM.Core as LLVM++import Foreign.StablePtr (StablePtr)+import Foreign.Ptr (Ptr, FunPtr)++import Control.Applicative ((<*>))++import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word8, Word16, Word32, Word64, Word)+++define ::+   (C f) => LLVM.Function f -> CodeGen f -> LLVM.CodeGenModule ()+define fn body =+   LLVM.defineFunction fn (addRet (proxyFromElement2 fn) body)++proxyFromElement2 :: f (g a) -> LP.Proxy a+proxyFromElement2 _ = LP.Proxy+++create ::+   (C f) =>+   LLVM.Linkage -> CodeGen f -> LLVM.CodeGenModule (LLVM.Function f)+create linkage body = do+   f <- LLVM.newFunction linkage+   define f body+   return f++createNamed ::+   (C f) =>+   LLVM.Linkage -> String -> CodeGen f -> LLVM.CodeGenModule (LLVM.Function f)+createNamed linkage name body = do+   f <- LLVM.newNamedFunction linkage name+   define f body+   return f+++{- |+> CodeGen (a->b->...-> IO z) =+>    Value a -> Value b -> ... CodeGenFunction r (Value z)@.+-}+class LLVM.FunctionArgs f => C f where+   type CodeGen f+   addRet :: LP.Proxy f -> CodeGen f -> LLVM.FunctionCodeGen f++instance (C b, LLVM.IsFirstClass a) => C (a -> b) where+   type CodeGen (a -> b) = LLVM.Value a -> CodeGen b+   addRet proxy f a = addRet (proxy<*>LP.Proxy) (f a)++instance Return a => C (IO a) where+   type CodeGen (IO a) = LLVM.CodeGenFunction a (Result a)+   addRet LP.Proxy code = code >>= ret+++class (LLVM.IsFirstClass a) => Return a where+   type Result a+   ret :: Result a -> LLVM.CodeGenFunction a ()+instance Return () where+   type Result () = ()+   ret = LLVM.ret++instance Return Bool where+   type Result Bool = LLVM.Value Bool; ret = LLVM.ret+instance Return Int where+   type Result Int = LLVM.Value Int; ret = LLVM.ret+instance Return Int8 where+   type Result Int8 = LLVM.Value Int8; ret = LLVM.ret+instance Return Int16 where+   type Result Int16 = LLVM.Value Int16; ret = LLVM.ret+instance Return Int32 where+   type Result Int32 = LLVM.Value Int32; ret = LLVM.ret+instance Return Int64 where+   type Result Int64 = LLVM.Value Int64; ret = LLVM.ret+instance Return Word where+   type Result Word = LLVM.Value Word; ret = LLVM.ret+instance Return Word8 where+   type Result Word8 = LLVM.Value Word8; ret = LLVM.ret+instance Return Word16 where+   type Result Word16 = LLVM.Value Word16; ret = LLVM.ret+instance Return Word32 where+   type Result Word32 = LLVM.Value Word32; ret = LLVM.ret+instance Return Word64 where+   type Result Word64 = LLVM.Value Word64; ret = LLVM.ret++instance Return Float where+   type Result Float = LLVM.Value Float; ret = LLVM.ret+instance Return Double where+   type Result Double = LLVM.Value Double; ret = LLVM.ret++instance Return (Ptr a) where+   type Result (Ptr a) = LLVM.Value (Ptr a); ret = LLVM.ret+instance (LLVM.IsType a) => Return (LLVM.Ptr a) where+   type Result (LLVM.Ptr a) = LLVM.Value (LLVM.Ptr a); ret = LLVM.ret+instance (LLVM.IsFunction a) => Return (FunPtr a) where+   type Result (FunPtr a) = LLVM.Value (FunPtr a); ret = LLVM.ret+instance Return (StablePtr a) where+   type Result (StablePtr a) = LLVM.Value (StablePtr a); ret = LLVM.ret
src/LLVM/Extra/Iterator.hs view
@@ -1,19 +1,47 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-}-module LLVM.Extra.Iterator where+module LLVM.Extra.Iterator (+   T,+   -- * consumers+   mapM_,+   mapState_,+   mapStateM_,+   mapWhileState_,+   -- * producers+   empty,+   singleton,+   cons,+   iterate,+   countDown,+   arrayPtrs,+   storableArrayPtrs,+   -- * modifiers+   mapM,+   mapMaybe,+   catMaybes,+   takeWhileJust,+   takeWhile,+   cartesian,+   take,+   -- * application examples+   fixedLengthLoop,+   arrayLoop,+   arrayLoopWithExit,+   arrayLoop2,+   ) where  import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Maybe as Maybe +import qualified LLVM.Extra.Storable as Storable import qualified LLVM.Extra.ArithmeticPrivate as A-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Control as C import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, ) import LLVM.Core    (CodeGenFunction, Value, value, valueOf,-    CmpRet, CmpResult, IsInteger, IsType, IsConst, )+    CmpRet, IsInteger, IsType, IsConst, IsPrimitive)  import Foreign.Ptr (Ptr, ) @@ -25,15 +53,16 @@  import Data.Tuple.HT (mapFst, mapSnd, ) -import Prelude hiding (iterate, takeWhile, take, mapM)+import Prelude2010 hiding (iterate, takeWhile, take, mapM, mapM_)+import Prelude ()   {- | Simulates a non-strict list. -} data T r a =-   forall s. (Phi s) =>-   Cons s (forall z. (Phi z) => s -> MaybeCont.T r z (a,s))+   forall s. (Tuple.Phi s, Tuple.Undefined s) =>+   Cons s (forall z. (Tuple.Phi z) => s -> MaybeCont.T r z (a,s))  mapM_ :: (a -> CodeGenFunction r ()) -> T r a -> CodeGenFunction r () mapM_ f (Cons s next) =@@ -46,7 +75,7 @@       return  mapState_ ::-   (Phi t) =>+   (Tuple.Phi t) =>    (a -> t -> CodeGenFunction r t) ->    T r a -> t -> CodeGenFunction r t mapState_ f (Cons s next) t =@@ -59,7 +88,7 @@       return  mapStateM_ ::-   (Phi t) =>+   (Tuple.Phi t) =>    (a -> MS.StateT t (CodeGenFunction r) ()) ->    T r a -> MS.StateT t (CodeGenFunction r) () mapStateM_ f xs =@@ -68,7 +97,7 @@   mapWhileState_ ::-   (Phi t) =>+   (Tuple.Phi t) =>    (a -> t -> CodeGenFunction r (Value Bool, t)) ->    T r a -> t -> CodeGenFunction r t mapWhileState_ f (Cons s next) t =@@ -90,7 +119,16 @@       (valueOf True)       (\running -> MaybeCont.guard running >> return (a, valueOf False)) +cons :: (Tuple.Phi a, Tuple.Undefined a) => a -> T r a -> T r a+cons a0 (Cons s next) =+   Cons Maybe.nothing+      (fmap (mapSnd Maybe.just) .+       MaybeCont.fromMaybe .+       (\ms -> Maybe.run ms+         (return $ Maybe.just (a0,s))+         (MaybeCont.toMaybe . next))) + instance Functor (T r) where    fmap f (Cons s next) = Cons s (\s0 -> mapFst f <$> next s0) @@ -117,11 +155,11 @@ mapM f (Cons s next) = Cons s (MaybeCont.lift . FuncHT.mapFst f <=< next)  mapMaybe ::-   (Phi b, Class.Undefined b) =>+   (Tuple.Phi b, Tuple.Undefined b) =>    (a -> CodeGenFunction r (Maybe.T b)) -> T r a -> T r b mapMaybe f = catMaybes . mapM f -catMaybes :: (Phi a, Class.Undefined a) => T r (Maybe.T a) -> T r a+catMaybes :: (Tuple.Phi a, Tuple.Undefined a) => T r (Maybe.T a) -> T r a catMaybes (Cons s next) =    Cons s       (\s0 ->@@ -137,13 +175,12 @@                         (\a -> return (valueOf False, (Maybe.just a, s2)))))             (return . snd)) +takeWhileJust :: T r (Maybe.T a) -> T r a+takeWhileJust (Cons s next) =+   Cons s (FuncHT.mapFst MaybeCont.fromPlainMaybe <=< next)+ takeWhile :: (a -> CodeGenFunction r (Value Bool)) -> T r a -> T r a-takeWhile p (Cons s next) =-   Cons s-      (\s0 -> do-         (a,s1) <- next s0-         MaybeCont.guard =<< MaybeCont.lift (p a)-         return (a,s1))+takeWhile p = takeWhileJust . mapM (\a -> flip Maybe.fromBool a <$> p a)  {- | Attention:@@ -151,65 +188,54 @@ I.e. if 'f' reads from or writes to memory make sure that accessing one more pointer is legal. -}-iterate :: (Phi a) => (a -> CodeGenFunction r a) -> a -> T r a+iterate ::+   (Tuple.Phi a, Tuple.Undefined a) => (a -> CodeGenFunction r a) -> a -> T r a iterate f a = Cons a (\a0 -> MaybeCont.lift $ fmap ((,) a0) $ f a0) -{- |-This is MaybeCont.toMaybe' where @('Undefined' a)@ constraint-is replaced by a custom value.-This way, we do not need 'Undefined' constraint in 'T'.-On the other hand, an LLVM-undefined value would enable more LLVM optimizations.--}-maybeFromCont ::-   a -> MaybeCont.T r (Maybe.T a) a -> CodeGenFunction r (Maybe.T a)-maybeFromCont undef (MaybeCont.Cons m) =-   m (return $ Maybe.Cons (valueOf False) undef) (return . Maybe.just)  cartesianAux ::-   (Phi a, Phi b, Class.Undefined a, Class.Undefined b) =>+   (Tuple.Phi a, Tuple.Phi b, Tuple.Undefined a, Tuple.Undefined b) =>    T r a -> T r b -> T r (Maybe.T (a,b)) cartesianAux (Cons sa nextA) (Cons sb nextB) =    Cons (Maybe.nothing,sa,sb)       (\(ma0,sa0,sb0) -> do          (a1,sa1) <--            MaybeCont.fromMaybe $-            Maybe.run ma0-               (maybeFromCont (Class.undefTuple,sa0) $ nextA sa0)-               (\a0 -> return (Maybe.just (a0,sa0)))+            MaybeCont.alternative+               (MaybeCont.fromMaybe $ return $ fmap (flip (,) sa0) ma0)+               (nextA sa0)          MaybeCont.lift $             MaybeCont.resolve (nextB sb0)                (return (Maybe.nothing,(Maybe.nothing,sa1,sb)))                (\(b1,sb1) ->                   return (Maybe.just (a1,b1), (Maybe.just a1, sa1, sb1)))) ---- * helper functions- cartesian ::-   (Phi a, Phi b, Class.Undefined a, Class.Undefined b) =>+   (Tuple.Phi a, Tuple.Phi b, Tuple.Undefined a, Tuple.Undefined b) =>    T r a -> T r b -> T r (a,b) cartesian as bs = catMaybes $ cartesianAux as bs  countDown ::-   (Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>+   (Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>    Value i -> T r (Value i) countDown len =    takeWhile (A.cmp LLVM.CmpLT (value LLVM.zero)) $ iterate A.dec len  take ::-   (Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>+   (Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>    Value i -> T r a -> T r a take len xs = liftA2 const xs (countDown len) -arrayPtrs :: (IsType a) => Value (Ptr a) -> T r (Value (Ptr a))+arrayPtrs :: (IsType a) => Value (LLVM.Ptr a) -> T r (Value (LLVM.Ptr a)) arrayPtrs = iterate A.advanceArrayElementPtr +storableArrayPtrs :: (Storable.C a) => Value (Ptr a) -> T r (Value (Ptr a))+storableArrayPtrs = iterate Storable.incrementPtr + -- * examples  fixedLengthLoop ::-   (Phi s,-    Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>+   (Tuple.Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>    Value i -> s ->    (s -> CodeGenFunction r s) ->    CodeGenFunction r s@@ -217,19 +243,17 @@    mapState_ (const loopBody) (countDown len) start  arrayLoop ::-   (Phi a, IsType b,-    Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>-   Value i -> Value (Ptr b) -> a ->-   (Value (Ptr b) -> a -> CodeGenFunction r a) ->+   (Tuple.Phi a, IsType b, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>+   Value i -> Value (LLVM.Ptr b) -> a ->+   (Value (LLVM.Ptr b) -> a -> CodeGenFunction r a) ->    CodeGenFunction r a arrayLoop len ptr start loopBody =    mapState_ loopBody (take len $ arrayPtrs ptr) start  arrayLoopWithExit ::-   (Phi s, IsType a,-    Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>-   Value i -> Value (Ptr a) -> s ->-   (Value (Ptr a) -> s -> CodeGenFunction r (Value Bool, s)) ->+   (Tuple.Phi s, IsType a, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>+   Value i -> Value (LLVM.Ptr a) -> s ->+   (Value (LLVM.Ptr a) -> s -> CodeGenFunction r (Value Bool, s)) ->    CodeGenFunction r (Value i, s) arrayLoopWithExit len ptr0 start loopBody = do    (i, end) <-@@ -241,10 +265,9 @@    return (pos, end)  arrayLoop2 ::-   (Phi s, IsType a, IsType b,-    Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>-   Value i -> Value (Ptr a) -> Value (Ptr b) -> s ->-   (Value (Ptr a) -> Value (Ptr b) -> s -> CodeGenFunction r s) ->+   (Tuple.Phi s, IsType a, IsType b, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>+   Value i -> Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> s ->+   (Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> s -> CodeGenFunction r s) ->    CodeGenFunction r s arrayLoop2 len ptrA ptrB start loopBody =    mapState_ (uncurry loopBody)
+ src/LLVM/Extra/Marshal.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{- |+Transfer values between Haskell and JIT generated code+in an LLVM-compatible format.+E.g. 'Bool' is stored as 'i1' and occupies a byte,+@'Vector' n 'Bool'@ is stored as a bit vector,+@'Vector' n 'Word8'@ is stored in an order depending on machine endianess,+and Haskell tuples are stored as LLVM structs.+-}+module LLVM.Extra.Marshal (+   C(..),+   Struct,+   peek,+   poke,++   VectorStruct,+   Vector(..),++   with,+   EE.alloca,+   ) where++import qualified LLVM.Extra.Memory as Memory+import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.ExecutionEngine as EE+import qualified LLVM.Core as LLVM++import qualified Type.Data.Num.Decimal as TypeNum++import qualified Control.Functor.HT as FuncHT+import Control.Applicative (liftA2, liftA3, (<$>))++import Foreign.Storable (Storable)+import Foreign.StablePtr (StablePtr)+import Foreign.Ptr (FunPtr, Ptr)++import Data.Word (Word8, Word16, Word32, Word64, Word)+import Data.Int  (Int8,  Int16,  Int32,  Int64)++++peek ::+   (C a, Struct a ~ struct, EE.Marshal struct) => LLVM.Ptr struct -> IO a+peek ptr = unpack <$> EE.peek ptr++poke ::+   (C a, Struct a ~ struct, EE.Marshal struct) => LLVM.Ptr struct -> a -> IO ()+poke ptr = EE.poke ptr . pack+++type Struct a = Memory.Struct (Tuple.ValueOf a)++class+   (Tuple.Value a, Memory.C (Tuple.ValueOf a),+    EE.Marshal (Struct a), LLVM.IsSized (Struct a)) =>+      C a where+   pack :: a -> Struct a+   unpack :: Struct a -> a++instance C Bool   where pack = id; unpack = id+instance C Float  where pack = id; unpack = id+instance C Double where pack = id; unpack = id+instance C Word   where pack = id; unpack = id+instance C Word8  where pack = id; unpack = id+instance C Word16 where pack = id; unpack = id+instance C Word32 where pack = id; unpack = id+instance C Word64 where pack = id; unpack = id+instance C Int    where pack = id; unpack = id+instance C Int8   where pack = id; unpack = id+instance C Int16  where pack = id; unpack = id+instance C Int32  where pack = id; unpack = id+instance C Int64  where pack = id; unpack = id++instance (Storable a)        => C (Ptr a)       where pack = id; unpack = id+instance (LLVM.IsType a)     => C (LLVM.Ptr a)  where pack = id; unpack = id+instance (LLVM.IsFunction a) => C (FunPtr a)    where pack = id; unpack = id+instance                        C (StablePtr a) where pack = id; unpack = id++instance C () where+   pack = LLVM.Struct+   unpack (LLVM.Struct unit) = unit++instance+   (LLVM.IsSized (Struct a), LLVM.IsSized (Struct b), C a, C b) =>+      C (a,b) where+   pack (a,b) = LLVM.consStruct (pack a) (pack b)+   unpack = LLVM.uncurryStruct $ \a b -> (unpack a, unpack b)++instance+   (LLVM.IsSized (Struct a), LLVM.IsSized (Struct b), LLVM.IsSized (Struct c),+    C a, C b, C c) =>+      C (a,b,c) where+   pack (a,b,c) = LLVM.consStruct (pack a) (pack b) (pack c)+   unpack = LLVM.uncurryStruct $ \a b c -> (unpack a, unpack b, unpack c)++instance+   (LLVM.IsSized (Struct a), LLVM.IsSized (Struct b),+    LLVM.IsSized (Struct c), LLVM.IsSized (Struct d),+    C a, C b, C c, C d) =>+      C (a,b,c,d) where+   pack (a,b,c,d) = LLVM.consStruct (pack a) (pack b) (pack c) (pack d)+   unpack =+      LLVM.uncurryStruct $ \a b c d -> (unpack a, unpack b, unpack c, unpack d)++++type VectorStruct n a = Memory.Struct (Tuple.VectorValueOf n a)++class+   (TypeNum.Positive n,+    Tuple.VectorValue n a, Memory.C (Tuple.VectorValueOf n a),+    EE.Marshal (VectorStruct n a), LLVM.IsSized (VectorStruct n a)) =>+      Vector n a where+   packVector :: LLVM.Vector n a -> VectorStruct n a+   unpackVector :: VectorStruct n a -> LLVM.Vector n a++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: LLVM.SizeOf a),+    Vector n a) =>+      C (LLVM.Vector n a) where+   pack = packVector; unpack = unpackVector+++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D1)) =>+      Vector n Bool where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D32)) =>+      Vector n Float where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D64)) =>+      Vector n Double where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: LLVM.IntSize)) =>+      Vector n Word where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D8)) =>+      Vector n Word8 where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D16)) =>+      Vector n Word16 where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D32)) =>+      Vector n Word32 where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D64)) =>+      Vector n Word64 where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: LLVM.IntSize)) =>+      Vector n Int where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D8)) =>+      Vector n Int8 where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D16)) =>+      Vector n Int16 where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D32)) =>+      Vector n Int32 where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D64)) =>+      Vector n Int64 where+   packVector = id+   unpackVector = id++instance (Vector n a, Vector n b) => Vector n (a,b) where+   packVector x =+      case FuncHT.unzip x of+         (a,b) -> LLVM.consStruct (packVector a) (packVector b)+   unpackVector = LLVM.uncurryStruct $ \a b ->+      liftA2 (,) (unpackVector a) (unpackVector b)++instance (Vector n a, Vector n b, Vector n c) => Vector n (a,b,c) where+   packVector x =+      case FuncHT.unzip3 x of+         (a,b,c) -> LLVM.consStruct (packVector a) (packVector b) (packVector c)+   unpackVector = LLVM.uncurryStruct $ \a b c ->+      liftA3 (,,) (unpackVector a) (unpackVector b) (unpackVector c)+++with :: (C a) => a -> (LLVM.Ptr (Struct a) -> IO b) -> IO b+with a act = EE.alloca $ \ptr -> poke ptr a >> act ptr
src/LLVM/Extra/Maybe.hs view
@@ -21,20 +21,19 @@    loopWithExit,    ) where +import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.MaybePrivate as Maybe import qualified LLVM.Extra.Control as C-import LLVM.Extra.Class (Undefined, undefTuple, ) -import LLVM.Util.Loop (Phi, ) import LLVM.Core (CodeGenFunction, )  -nothing :: (Undefined a) => Maybe.T a-nothing = Maybe.nothing undefTuple+nothing :: (Tuple.Undefined a) => Maybe.T a+nothing = Maybe.nothing Tuple.undef   loopWithExit ::-   Phi a =>+   Tuple.Phi a =>    a ->    (a -> CodeGenFunction r (Maybe.T c, b)) ->    ((c,b) -> CodeGenFunction r a) ->
src/LLVM/Extra/MaybeContinuation.hs view
@@ -5,25 +5,21 @@ module LLVM.Extra.MaybeContinuation where  import qualified LLVM.Extra.Maybe as Maybe+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Control as C import LLVM.Extra.Control (ifThenElse, )-import LLVM.Extra.Class (Undefined, undefTuple, )  import qualified LLVM.Core as LLVM import LLVM.Core-   (Value, value, valueOf,-    CodeGenFunction,-    IsConst, IsType, IsFirstClass, IsInteger,-    CmpRet, CmpResult, )-import LLVM.Util.Loop (Phi, ) -- (phis, addPhis, )+   (CodeGenFunction, Value, value, valueOf,+    IsConst, IsType, IsPrimitive, IsInteger, CmpRet)  import qualified Control.Monad as M import qualified Control.Applicative as App import Control.Monad.IO.Class (MonadIO(liftIO), ) import Control.Monad.HT ((<=<), ) -import Foreign.Ptr (Ptr, ) import Data.Tuple.HT (mapSnd, )  import Prelude hiding (map, )@@ -50,11 +46,10 @@    fmap f (Cons m) = Cons $ \n j -> m n (j . f)  instance App.Applicative (T r z) where-   pure = return+   pure a = lift (pure a)    (<*>) = M.ap  instance Monad (T r z) where-   return a = lift (return a)    (>>=) = bind  instance MonadIO (T r z) where@@ -64,7 +59,7 @@ counterpart to Data.Maybe.HT.toMaybe -} withBool ::-   (Phi z) =>+   (Tuple.Phi z) =>    Value Bool -> CodeGenFunction r a -> T r z a withBool b a =    guard b >> lift a@@ -74,7 +69,7 @@ -}  fromBool ::-   (Phi z) =>+   (Tuple.Phi z) =>    CodeGenFunction r (Value Bool, a) ->    T r z a fromBool m = do@@ -83,22 +78,20 @@    return a  toBool ::-   (Undefined a) =>+   (Tuple.Undefined a) =>    T r (Value Bool, a) a -> CodeGenFunction r (Value Bool, a) toBool (Cons m) =-   m (return (valueOf False, undefTuple)) (return . (,) (valueOf True))+   m (return (valueOf False, Tuple.undef)) (return . (,) (valueOf True))  -fromMaybe ::-   (Phi z) =>-   CodeGenFunction r (Maybe.T a) -> T r z a-fromMaybe m = do-   Maybe.Cons b a <- lift m-   guard b-   return a+fromPlainMaybe :: (Tuple.Phi z) => Maybe.T a -> T r z a+fromPlainMaybe (Maybe.Cons b a) = guard b >> return a +fromMaybe :: (Tuple.Phi z) => CodeGenFunction r (Maybe.T a) -> T r z a+fromMaybe m = lift m >>= fromPlainMaybe+ toMaybe ::-   (Undefined a) =>+   (Tuple.Undefined a) =>    T r (Maybe.T a) a -> CodeGenFunction r (Maybe.T a) toMaybe (Cons m) =    m (return Maybe.nothing) (return . Maybe.just)@@ -113,7 +106,7 @@ lift a = Cons $ \ _n j -> j =<< a  guard ::-   (Phi z) =>+   (Tuple.Phi z) =>    Value Bool -> T r z () guard b = Cons $ \n j ->    ifThenElse b (j ()) n@@ -144,15 +137,15 @@ If both actions fail, then the composed action fails, too. -} alternative ::-   (Phi z, Undefined a) =>+   (Tuple.Phi z, Tuple.Undefined a) =>    T r (Maybe.T a) a -> T r (Maybe.T a) a -> T r z a alternative x y =    fromMaybe $ resolve x (toMaybe y) (return . Maybe.just)   fixedLengthLoop ::-   (Phi s, Undefined s,-    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i, CmpResult i ~ Bool) =>+   (Tuple.Phi s, Tuple.Undefined s,+    Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>    Value i -> s ->    (s -> T r (Maybe.T s) s) ->    CodeGenFunction r (Value i, Maybe.T s)@@ -176,11 +169,11 @@ then returned final state is 'Maybe.nothing'. -} arrayLoop ::-   (Phi s, Undefined s, IsType a,-    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i, CmpResult i ~ Bool) =>+   (Tuple.Phi s, Tuple.Undefined s, IsType a,+    Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>    Value i ->-   Value (Ptr a) -> s ->-   (Value (Ptr a) -> s -> T r (Maybe.T (Value (Ptr a), s)) s) ->+   Value (LLVM.Ptr a) -> s ->+   (Value (LLVM.Ptr a) -> s -> T r (Maybe.T (Value (LLVM.Ptr a), s)) s) ->    CodeGenFunction r (Value i, Maybe.T s) arrayLoop len ptr start loopBody =    fmap (mapSnd (fmap snd)) $@@ -191,12 +184,12 @@   arrayLoop2 ::-   (Phi s, Undefined s, IsType a, IsType b,-    Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i, CmpResult i ~ Bool) =>+   (Tuple.Phi s, Tuple.Undefined s, IsType a, IsType b,+    Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>    Value i ->-   Value (Ptr a) -> Value (Ptr b) -> s ->-   (Value (Ptr a) -> Value (Ptr b) -> s ->-      T r (Maybe.T (Value (Ptr a), (Value (Ptr b), s))) s) ->+   Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> s ->+   (Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> s ->+      T r (Maybe.T (Value (LLVM.Ptr a), (Value (LLVM.Ptr b), s))) s) ->    CodeGenFunction r (Value i, Maybe.T s) arrayLoop2 len ptrA ptrB start loopBody =    fmap (mapSnd (fmap snd)) $@@ -212,7 +205,7 @@ and we could just propagate a Nothing.  whileLoop ::-   Phi a =>+   Tuple.Phi a =>    a ->    (a -> T r z a) ->    CodeGenFunction r a@@ -224,13 +217,13 @@    br loop     defineBasicBlock loop-   state <- phis top start+   state <- phi top start    b <- check state    condBr b cont exit    defineBasicBlock cont    res <- body state    cont' <- getCurrentBasicBlock-   addPhis cont' state res+   addPhi cont' state res    br loop     defineBasicBlock exit
src/LLVM/Extra/MaybePrivate.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE TypeFamilies #-} module LLVM.Extra.MaybePrivate where +import qualified LLVM.Extra.TuplePrivate as Tuple import qualified LLVM.Extra.Control as C import LLVM.Extra.Control (ifThenElse, )  import qualified LLVM.Core as LLVM import LLVM.Core (Value, valueOf, CodeGenFunction, )-import LLVM.Util.Loop (Phi, phis, addPhis, )  import qualified Control.Monad as Monad @@ -22,17 +22,20 @@ instance Functor T where    fmap f (Cons b a) = Cons b (f a) -instance (Phi a) => Phi (T a) where-   phis bb (Cons b a) = Monad.liftM2 Cons (phis bb b) (phis bb a)-   addPhis bb (Cons b0 a0) (Cons b1 a1) =-      addPhis bb b0 b1 >> addPhis bb a0 a1+instance (Tuple.Undefined a) => Tuple.Undefined (T a) where+   undef = Cons Tuple.undef Tuple.undef +instance (Tuple.Phi a) => Tuple.Phi (T a) where+   phi bb (Cons b a) = Monad.liftM2 Cons (Tuple.phi bb b) (Tuple.phi bb a)+   addPhi bb (Cons b0 a0) (Cons b1 a1) =+      Tuple.addPhi bb b0 b1 >> Tuple.addPhi bb a0 a1 + {- | counterpart to 'maybe' -} run ::-   (Phi b) =>+   (Tuple.Phi b) =>    T a ->    CodeGenFunction r b ->    (a -> CodeGenFunction r b) ->@@ -90,8 +93,7 @@ lift2 f (Cons b0 a0) (Cons b1 a1) =    Monad.liftM (flip Cons (f a0 a1)) (LLVM.and b0 b1) -sequence ::-   T (CodeGenFunction r a) -> CodeGenFunction r (T a)+sequence :: T (CodeGenFunction r a) -> CodeGenFunction r (T a) sequence (Cons b0 a0) =    Monad.liftM (Cons b0) a0 @@ -104,3 +106,11 @@    (a -> b -> CodeGenFunction r c) ->    T a -> T b -> CodeGenFunction r (T c) liftM2 f ma mb = Monad.join $ fmap sequence $ lift2 f ma mb+++maybeArg ::+   (Tuple.Phi b) =>+   b ->+   (a -> CodeGenFunction r (T b)) ->+   T a -> CodeGenFunction r (T b)+maybeArg undef f m = run m (return $ nothing undef) f
src/LLVM/Extra/Memory.hs view
@@ -1,87 +1,88 @@ {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} module LLVM.Extra.Memory (-   C(load, store, decompose, compose), modify, castStorablePtr,+   C(load, store, decompose, compose), modify,    Struct,    Record, Element, element,    loadRecord, storeRecord, decomposeRecord, composeRecord,    loadNewtype, storeNewtype, decomposeNewtype, composeNewtype,-   FirstClass, Stored,    ) where -import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, )-import LLVM.Extra.MemoryPrivate (decomposeFromLoad, composeFromStore, )--import qualified LLVM.Extra.Multi.Vector.Memory as MultiVectorMemory-import qualified LLVM.Extra.Multi.Value.Memory as MultiValueMemory-import qualified LLVM.Extra.Multi.Vector as MultiVector-import qualified LLVM.Extra.Multi.Value as MultiValue-import qualified LLVM.Extra.ArithmeticPrivate as A-import qualified LLVM.Extra.Vector as Vector+import qualified LLVM.Extra.Nice.Vector as NiceVector+import qualified LLVM.Extra.Nice.Value.Private as NiceValue import qualified LLVM.Extra.Scalar as Scalar-import qualified LLVM.Extra.Array as Array+import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.Extra.Struct as Struct import qualified LLVM.Extra.Either as Either import qualified LLVM.Extra.Maybe as Maybe -import qualified LLVM.Util.Proxy as LP import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, ) import LLVM.Core-   (getElementPtr0,-    extractvalue, insertvalue,-    Value, -- valueOf, Vector,-    IsType, IsSized,-    CodeGenFunction, )+   (CodeGenFunction, Value, IsType, IsSized,+    getElementPtr0, extractvalue, insertvalue)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal (d0, d1, d2, )-import Type.Base.Proxy (Proxy(Proxy), )--import Foreign.StablePtr (StablePtr, )-import Foreign.Ptr (FunPtr, Ptr, castPtr, )--import Data.Word (Word8, Word16, Word32, Word64, )-import Data.Int  (Int8,  Int16,  Int32,  Int64, )--import qualified Control.Applicative as App-import Control.Monad (ap, )-import Control.Applicative (pure, liftA2, liftA3, )+import qualified Type.Data.Num.Unary as Unary+import Type.Data.Num.Decimal (d0, d1, d2, d3)+import Type.Base.Proxy (Proxy(Proxy)) +import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold+import qualified Data.FixedLength as FixedLength+import qualified Data.Complex as Complex+import Data.Complex (Complex((:+))) import Data.Tuple.HT (fst3, snd3, thd3, )+import Data.Word (Word) -import Prelude hiding (maybe, either, )+import qualified Control.Applicative.HT as App+import Control.Monad (ap, (<=<))+import Control.Applicative (Applicative, pure, liftA2, liftA3, (<*>)) +import Prelude2010 hiding (maybe, either, )+import Prelude () -{- |-An implementation of both 'MakeValueTuple' and 'Memory.C'-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@. -We use a functional dependency in order to let type inference work nicely.--}-class (Phi llvmValue, Undefined llvmValue, IsType (Struct llvmValue), IsSized (Struct llvmValue)) =>+class+   (Tuple.Phi llvmValue, Tuple.Undefined llvmValue,+    IsType (Struct llvmValue), IsSized (Struct llvmValue)) =>       C llvmValue where-   {-# MINIMAL (load|decompose), (store|compose) #-}-   type Struct llvmValue :: *-   load :: Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue+   type Struct llvmValue+   load :: Value (LLVM.Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue    load ptr  =  decompose =<< LLVM.load ptr-   store :: llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()+   store ::+      llvmValue -> Value (LLVM.Ptr (Struct llvmValue)) -> CodeGenFunction r ()    store r ptr  =  flip LLVM.store ptr =<< compose r+   {- |+   In principle it holds:++   > decompose struct = do+   >   ptr <- LLVM.alloca+   >   LLVM.store struct ptr+   >   Memory.load ptr++   but 'LLVM.alloca' will blast your stack when used in a loop.+   -}    decompose :: Value (Struct llvmValue) -> CodeGenFunction r llvmValue-   decompose = decomposeFromLoad load+   {- |+   In principle it holds:++   > compose struct = do+   >   ptr <- LLVM.alloca+   >   Memory.store struct ptr+   >   LLVM.load ptr++   but 'LLVM.alloca' will blast your stack when used in a loop.+   -}    compose :: llvmValue -> CodeGenFunction r (Value (Struct llvmValue))-   compose = composeFromStore store  modify ::    (C llvmValue) =>    (llvmValue -> CodeGenFunction r llvmValue) ->-   Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()+   Value (LLVM.Ptr (Struct llvmValue)) -> CodeGenFunction r () modify f ptr =    flip store ptr =<< f =<< load ptr @@ -98,15 +99,15 @@  data Element r o v x =    Element {-      loadElement :: Value (Ptr o) -> CodeGenFunction r x,-      storeElement :: Value (Ptr o) -> v -> CodeGenFunction r (),+      loadElement :: Value (LLVM.Ptr o) -> CodeGenFunction r x,+      storeElement :: Value (LLVM.Ptr o) -> v -> CodeGenFunction r (),       extractElement :: Value o -> CodeGenFunction r x,       insertElement :: v -> Value o -> CodeGenFunction r (Value o)          -- State.Monoid    }  element ::-   (C x,+   (C x, IsType o,     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@@ -127,7 +128,7 @@          insertElement = insertElement m       } -instance App.Applicative (Element r o v) where+instance Applicative (Element r o v) where    pure x =       Element {          loadElement = \ _ptr -> return x,@@ -146,12 +147,12 @@  loadRecord ::    Record r o llvmValue ->-   Value (Ptr o) -> CodeGenFunction r llvmValue+   Value (LLVM.Ptr o) -> CodeGenFunction r llvmValue loadRecord = loadElement  storeRecord ::    Record r o llvmValue ->-   llvmValue -> Value (Ptr o) -> CodeGenFunction r ()+   llvmValue -> Value (LLVM.Ptr o) -> CodeGenFunction r () storeRecord m y ptr = storeElement m ptr y  decomposeRecord ::@@ -203,16 +204,74 @@    compose = composeRecord triple  +quadruple ::+   (C a, C b, C c, C d) =>+   Record r+      (LLVM.Struct (Struct a, (Struct b, (Struct c, (Struct d, ())))))+      (a, b, c, d)+quadruple =+   App.lift4 (,,,)+      (element (\(x,_,_,_) -> x) d0)+      (element (\(_,x,_,_) -> x) d1)+      (element (\(_,_,x,_) -> x) d2)+      (element (\(_,_,_,x) -> x) d3)++instance (C a, C b, C c, C d) => C (a, b, c, d) where+   type Struct (a, b, c, d) =+           LLVM.Struct (Struct a, (Struct b, (Struct c, (Struct d, ()))))+   load = loadRecord quadruple+   store = storeRecord quadruple+   decompose = decomposeRecord quadruple+   compose = composeRecord quadruple+++complex ::+   (C a) =>+   Record r (LLVM.Struct (Struct a, (Struct a, ()))) (Complex a)+complex =+   liftA2 (:+)+      (element Complex.realPart d0)+      (element Complex.imagPart d1)++instance (C a) => C (Complex a) where+   type Struct (Complex a) = LLVM.Struct (Struct a, (Struct a, ()))+   load = loadRecord complex+   store = storeRecord complex+   decompose = decomposeRecord complex+   compose = composeRecord complex+++instance+   (Unary.Natural n, C a,+    TypeNum.Natural (TypeNum.FromUnary n),+    TypeNum.Natural (TypeNum.FromUnary n TypeNum.:*: LLVM.SizeOf (Struct a)),+    LLVM.IsFirstClass (Struct a)) =>+      C (FixedLength.T n a) where+   type Struct (FixedLength.T n a) =+            LLVM.Array (TypeNum.FromUnary n) (Struct a)+   compose xs =+      Fold.foldlM+         (\arr (x,i) -> compose x >>= \xc -> LLVM.insertvalue arr xc i)+         (LLVM.value LLVM.undef) $+      FixedLength.zipWith (,) xs $ iterateTrav (1+) (0::Word)+   decompose arr =+      Trav.mapM (decompose <=< LLVM.extractvalue arr) $+      iterateTrav (1+) (0::Word)++iterateTrav :: (Applicative t, Trav.Traversable t) => (a -> a) -> a -> t a+iterateTrav f a0 = snd $ Trav.mapAccumL (\a () -> (f a, a)) a0 $ pure ()++ maybe ::    (C a) =>-   Record r (LLVM.Struct (Word32, (Struct a, ()))) (Maybe.T a)+   Record r (LLVM.Struct (Bool, (Struct a, ()))) (Maybe.T a) maybe =    liftA2 Maybe.Cons       (element Maybe.isJust d0)       (element Maybe.fromJust d1)  instance (C a) => C (Maybe.T a) where-   type Struct (Maybe.T a) = LLVM.Struct (Word32, (Struct a, ()))+   type Struct (Maybe.T a) = LLVM.Struct (Bool, (Struct a, ()))    load = loadRecord maybe    store = storeRecord maybe    decompose = decomposeRecord maybe@@ -221,7 +280,7 @@  either ::    (C a, C b) =>-   Record r (LLVM.Struct (Word32, (Struct a, (Struct b, ())))) (Either.T a b)+   Record r (LLVM.Struct (Bool, (Struct a, (Struct b, ())))) (Either.T a b) either =    liftA3 Either.Cons       (element Either.isRight d0)@@ -229,7 +288,7 @@       (element Either.fromRight d2)  instance (C a, C b) => C (Either.T a b) where-   type Struct (Either.T a b) = LLVM.Struct (Word32, (Struct a, (Struct b, ())))+   type Struct (Either.T a b) = LLVM.Struct (Bool, (Struct a, (Struct b, ())))    load = loadRecord either    store = storeRecord either    decompose = decomposeRecord either@@ -245,167 +304,91 @@    compose = composeNewtype Scalar.decons  -{--This would not work for Booleans,-since on x86 LLVM's @i1@ type uses one byte in memory,-whereas Storable uses 4 byte and 4 byte alignment.--instance (LLVM.IsFirstClass a) => C (Value a) a where+instance (IsSized a) => C (Value a) where+   type Struct (Value a) = a    load = LLVM.load    store = LLVM.store    decompose = return    compose = return--}  -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  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-   (TypeNum.Positive 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-   (TypeNum.Natural 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) where-   type Stored (Ptr a) = Ptr a-   fromStorable = return; toStorable = return-instance (LLVM.IsFunction a) => FirstClass (FunPtr a) where-   type Stored (FunPtr a) = FunPtr a-   fromStorable = return; toStorable = return-instance FirstClass (StablePtr a) where-   type Stored (StablePtr a) = StablePtr a-   fromStorable = return; toStorable = return-+type family StructStruct s+type instance StructStruct (a,as) = (Struct a, StructStruct as)+type instance StructStruct () = ()  instance-   (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 LP.Proxy of-         sfields -> do-            s <- decomposeField sfields d0 sm-            let _ = asTypeOf (fields s) sfields-            return s-   toStorable s =-      composeField (fields s) d0 s--fields :: Value (LLVM.Struct s) -> LP.Proxy s-fields _ = LP.Proxy---type family StoredStruct s :: *-type instance StoredStruct () = ()-type instance StoredStruct (s,rem) = (Stored s, StoredStruct rem)+   (Struct.Phi s, Struct.Undefined s,+    LLVM.StructFields (StructStruct s),+    ConvertStruct (StructStruct s) TypeNum.D0 s) =>+      C (Struct.T s) where+   type Struct (Struct.T s) = LLVM.Struct (StructStruct s)+   decompose = fmap Struct.Cons . decomposeFields TypeNum.d0+   compose (Struct.Cons s) = composeFields TypeNum.d0 s  class ConvertStruct s i rem where-   decomposeField ::-      LP.Proxy rem -> Proxy i -> Value (LLVM.Struct (StoredStruct s)) ->-      CodeGenFunction r (Value (LLVM.Struct s))-   composeField ::-      LP.Proxy rem -> Proxy i -> Value (LLVM.Struct s) ->-      CodeGenFunction r (Value (LLVM.Struct (StoredStruct s)))+   decomposeFields ::+      Proxy i -> Value (LLVM.Struct s) -> CodeGenFunction r rem+   composeFields ::+      Proxy i -> rem -> CodeGenFunction r (Value (LLVM.Struct s))  instance-   (sm ~ StoredStruct s,-    FirstClass a, am ~ Stored a,-    LLVM.GetValue (LLVM.Struct s) (Proxy i),-    LLVM.GetValue (LLVM.Struct sm) (Proxy i),-    LLVM.ValueType (LLVM.Struct s) (Proxy i) ~ a,-    LLVM.ValueType (LLVM.Struct sm) (Proxy i) ~ am,+   (TypeNum.Natural i, LLVM.GetField s i, LLVM.FieldType s i ~ Struct a, C a,     ConvertStruct s (TypeNum.Succ i) rem) =>       ConvertStruct s i (a,rem) where-   decomposeField flds i sm = do-      s <- decomposeField (fmap snd flds) (decSucc i) sm-      a <- fromStorable =<< LLVM.extractvalue sm i-      LLVM.insertvalue s a i-   composeField flds i s = do-      sm <- composeField (fmap snd flds) (decSucc i) s-      am <- toStorable =<< LLVM.extractvalue s i+   decomposeFields i sm =+      liftA2 (,)+         (decompose =<< LLVM.extractvalue sm i)+         (decomposeFields (decSucc i) sm)+   composeFields i (a,as) = do+      sm <- composeFields (decSucc i) as+      am <- compose a       LLVM.insertvalue sm am i  decSucc :: Proxy n -> Proxy (TypeNum.Succ n) decSucc Proxy = Proxy -instance-   (sm ~ StoredStruct s,-    IsType (LLVM.Struct s),-    IsType (LLVM.Struct sm)) =>-      ConvertStruct s i () where-   decomposeField _ _ _ =-      return (LLVM.value LLVM.undef)-   composeField _ _ _ =-      return (LLVM.value LLVM.undef)+instance (LLVM.StructFields s) => ConvertStruct s i () where+   decomposeFields _ _ = return ()+   composeFields _ _ = return (LLVM.value LLVM.undef)  -instance (FirstClass a, IsSized (Stored a)) => C (Value a) where-   type Struct (Value a) = Stored a-   decompose = fromStorable-   compose = toStorable --instance (MultiValueMemory.C a) => C (MultiValue.T a) where-   type Struct (MultiValue.T a) = MultiValueMemory.Struct a-   load      = MultiValueMemory.load-   store     = MultiValueMemory.store-   decompose = MultiValueMemory.decompose-   compose   = MultiValueMemory.compose---instance (MultiVectorMemory.C n a) => C (MultiVector.T n a) where-   type Struct (MultiVector.T n a) = MultiVectorMemory.Struct n a-   load      = MultiVectorMemory.load-   store     = MultiVectorMemory.store-   decompose = MultiVectorMemory.decompose-   compose   = MultiVectorMemory.compose-+-- redundant IsType and IsSized constraints required for loopy instance+instance+   (IsType (Struct (NiceValue.Repr a)),+    IsSized (Struct (NiceValue.Repr a)),+    NiceValue.C a, C (NiceValue.Repr a)) =>+      C (NiceValue.T a) where+   type Struct (NiceValue.T a) = Struct (NiceValue.Repr a)+   load = fmap NiceValue.Cons . load+   store (NiceValue.Cons a) = store a+   decompose = fmap NiceValue.Cons . decompose+   compose (NiceValue.Cons a) = compose a -castStorablePtr ::-   (MakeValueTuple haskellValue, C (ValueTuple haskellValue)) =>-   Ptr haskellValue -> Ptr (Struct (ValueTuple haskellValue))-castStorablePtr = castPtr+instance+   (IsType (Struct (NiceVector.Repr n a)),+    IsSized (Struct (NiceVector.Repr n a)),+    TypeNum.Positive n, NiceVector.C a, C (NiceVector.Repr n a)) =>+      C (NiceVector.T n a) where+   type Struct (NiceVector.T n a) = Struct (NiceVector.Repr n a)+   load = fmap NiceVector.Cons . load+   store (NiceVector.Cons a) = store a+   decompose = fmap NiceVector.Cons . decompose+   compose (NiceVector.Cons a) = compose a    loadNewtype ::    (C a) =>    (a -> llvmValue) ->-   Value (Ptr (Struct a)) -> CodeGenFunction r llvmValue+   Value (LLVM.Ptr (Struct a)) -> CodeGenFunction r llvmValue loadNewtype wrap ptr =    fmap wrap $ load ptr  storeNewtype ::    (C a) =>    (llvmValue -> a) ->-   llvmValue -> Value (Ptr (Struct a)) -> CodeGenFunction r ()+   llvmValue -> Value (LLVM.Ptr (Struct a)) -> CodeGenFunction r () storeNewtype unwrap y ptr =    store (unwrap y) ptr
− src/LLVM/Extra/MemoryPrivate.hs 
@@ -1,25 +0,0 @@-module LLVM.Extra.MemoryPrivate where--import qualified LLVM.Core as LLVM-import LLVM.Core (CodeGenFunction, Value, )--import Foreign.Ptr (Ptr, )---decomposeFromLoad ::-   LLVM.IsSized struct =>-   (Value (Ptr struct) -> CodeGenFunction r a) ->-   Value struct -> CodeGenFunction r a-decomposeFromLoad loadStruct struct = do-   ptr <- LLVM.alloca-   LLVM.store struct ptr-   loadStruct ptr--composeFromStore ::-   LLVM.IsSized struct =>-   (a -> Value (Ptr struct) -> CodeGenFunction r ()) ->-   a -> CodeGenFunction r (Value struct)-composeFromStore storeStruct x = do-   ptr <- LLVM.alloca-   storeStruct x ptr-   LLVM.load ptr
src/LLVM/Extra/Monad.hs view
@@ -1,20 +1,24 @@ {- | These functions work in arbitrary monads-but are especially helpful when working with the CodeGenFunction monad.+but are especially helpful when working with the @CodeGenFunction@ monad. -}-module LLVM.Extra.Monad where+module LLVM.Extra.Monad+   {-# DEPRECATED "use utility-ht:Control.Monad.HT" #-} where  import Control.Monad (liftM2, liftM3, join, (<=<), )  +{-# DEPRECATED chain "use utility-ht:Control.Monad.HT.chain" #-} chain :: (Monad m) => [a -> m a] -> (a -> m a) chain =    foldr (flip (<=<)) return +{-# DEPRECATED liftR2 "use utility-ht:Control.Monad.HT.liftJoin2" #-} liftR2 :: (Monad m) => (a -> b -> m c) -> m a -> m b -> m c liftR2 f ma mb =    join (liftM2 f ma mb) +{-# DEPRECATED liftR3 "use utility-ht:Control.Monad.HT.liftJoin3" #-} liftR3 :: (Monad m) => (a -> b -> c -> m d) -> m a -> m b -> m c -> m d liftR3 f ma mb mc =    join (liftM3 f ma mb mc)
src/LLVM/Extra/Multi/Class.hs view
@@ -1,169 +1,5 @@-{-# LANGUAGE TypeFamilies #-}-module LLVM.Extra.Multi.Class where--import qualified LLVM.Extra.Multi.Value as MultiValue-import qualified LLVM.Extra.Multi.Vector as MultiVector-import qualified LLVM.Extra.Arithmetic as A--import qualified LLVM.Core as LLVM--import qualified Type.Data.Num.Decimal as TypeNum---class C value where-   type Size value :: *-   switch ::-      f MultiValue.T ->-      f (MultiVector.T (Size value)) ->-      f value--instance C MultiValue.T where-   type Size MultiValue.T = TypeNum.D1-   switch x _ = x--instance (TypeNum.Positive n) => C (MultiVector.T n) where-   type Size (MultiVector.T n) = n-   switch _ x = x---newtype Const a value = Const {getConst :: value a}--undef ::-   (C value, Size value ~ n, TypeNum.Positive n, MultiVector.C a) =>-   value a-undef =-   getConst $-   switch-      (Const MultiValue.undef)-      (Const MultiVector.undef)--zero ::-   (C value, Size value ~ n, TypeNum.Positive n, MultiVector.C a) =>-   value a-zero =-   getConst $-   switch-      (Const MultiValue.zero)-      (Const MultiVector.zero)---newtype-   Op0 r a value =-      Op0 {runOp0 :: LLVM.CodeGenFunction r (value a)}--newtype-   Op1 r a b value =-      Op1 {runOp1 :: value a -> LLVM.CodeGenFunction r (value b)}--newtype-   Op2 r a b c value =-      Op2 {runOp2 :: value a -> value b -> LLVM.CodeGenFunction r (value c)}--add, sub ::-   (TypeNum.Positive n, MultiVector.Additive a,-    n ~ Size value, C value) =>-   value a -> value a -> LLVM.CodeGenFunction r (value a)-add = runOp2 $ switch (Op2 A.add) (Op2 A.add)-sub = runOp2 $ switch (Op2 A.sub) (Op2 A.sub)--neg ::-   (TypeNum.Positive n, MultiVector.Additive a,-    n ~ Size value, C value) =>-   value a -> LLVM.CodeGenFunction r (value a)-neg = runOp1 $ switch (Op1 A.neg) (Op1 A.neg)---mul ::-   (TypeNum.Positive n, MultiVector.PseudoRing a,-    n ~ Size value, C value) =>-   value a -> value a -> LLVM.CodeGenFunction r (value a)-mul = runOp2 $ switch (Op2 A.mul) (Op2 A.mul)-fdiv ::-   (TypeNum.Positive n, MultiVector.Field a,-    n ~ Size value, C value) =>-   value a -> value a -> LLVM.CodeGenFunction r (value a)-fdiv = runOp2 $ switch (Op2 A.fdiv) (Op2 A.fdiv)--scale ::-   (TypeNum.Positive n, MultiVector.PseudoModule v,-    n ~ Size value, C value) =>-   value (MultiValue.Scalar v) -> value v -> LLVM.CodeGenFunction r (value v)-scale = runOp2 $ switch (Op2 A.scale) (Op2 A.scale)--min, max ::-   (TypeNum.Positive n, MultiVector.Real a,-    n ~ Size value, C value) =>-   value a -> value a -> LLVM.CodeGenFunction r (value a)-min = runOp2 $ switch (Op2 A.min) (Op2 A.min)-max = runOp2 $ switch (Op2 A.max) (Op2 A.max)--abs, signum ::-   (TypeNum.Positive n, MultiVector.Real a,-    n ~ Size value, C value) =>-   value a -> LLVM.CodeGenFunction r (value a)-abs = runOp1 $ switch (Op1 A.abs) (Op1 A.abs)-signum = runOp1 $ switch (Op1 A.signum) (Op1 A.signum)--truncate, fraction ::-   (TypeNum.Positive n, MultiVector.Fraction a,-    n ~ Size value, C value) =>-   value a -> LLVM.CodeGenFunction r (value a)-truncate = runOp1 $ switch (Op1 A.truncate) (Op1 A.truncate)-fraction = runOp1 $ switch (Op1 A.fraction) (Op1 A.fraction)--sqrt ::-   (TypeNum.Positive n, MultiVector.Algebraic a,-    n ~ Size value, C value) =>-   value a -> LLVM.CodeGenFunction r (value a)-sqrt = runOp1 $ switch (Op1 A.sqrt) (Op1 A.sqrt)--pi ::-   (TypeNum.Positive n, MultiVector.Transcendental a,-    n ~ Size value, C value) =>-   LLVM.CodeGenFunction r (value a)-pi = runOp0 $ switch (Op0 A.pi) (Op0 A.pi)--sin, cos, exp, log ::-   (TypeNum.Positive n, MultiVector.Transcendental a,-    n ~ Size value, C value) =>-   value a -> LLVM.CodeGenFunction r (value a)-sin = runOp1 $ switch (Op1 A.sin) (Op1 A.sin)-cos = runOp1 $ switch (Op1 A.cos) (Op1 A.cos)-exp = runOp1 $ switch (Op1 A.exp) (Op1 A.exp)-log = runOp1 $ switch (Op1 A.log) (Op1 A.log)--pow ::-   (TypeNum.Positive n, MultiVector.Transcendental a,-    n ~ Size value, C value) =>-   value a -> value a -> LLVM.CodeGenFunction r (value a)-pow = runOp2 $ switch (Op2 A.pow) (Op2 A.pow)---cmp ::-   (TypeNum.Positive n, MultiVector.Comparison a,-    n ~ Size value, C value) =>-   LLVM.CmpPredicate ->-   value a -> value a -> LLVM.CodeGenFunction r (value Bool)-cmp p = runOp2 $ switch (Op2 $ A.cmp p) (Op2 $ A.cmp p)--fcmp ::-   (TypeNum.Positive n, MultiVector.FloatingComparison a,-    n ~ Size value, C value) =>-   LLVM.FPPredicate ->-   value a -> value a -> LLVM.CodeGenFunction r (value Bool)-fcmp p = runOp2 $ switch (Op2 $ A.fcmp p) (Op2 $ A.fcmp p)---and, or, xor ::-   (TypeNum.Positive n, MultiVector.Logic a,-    n ~ Size value, C value) =>-   value a -> value a -> LLVM.CodeGenFunction r (value a)-and = runOp2 $ switch (Op2 A.and) (Op2 A.and)-or = runOp2 $ switch (Op2 A.or) (Op2 A.or)-xor = runOp2 $ switch (Op2 A.xor) (Op2 A.xor)+module LLVM.Extra.Multi.Class+   {-# DEPRECATED "Use LLVM.Extra.Nice.Class instead." #-}+   (module LLVM.Extra.Nice.Class) where -inv ::-   (TypeNum.Positive n, MultiVector.Logic a,-    n ~ Size value, C value) =>-   value a -> LLVM.CodeGenFunction r (value a)-inv = runOp1 $ switch (Op1 A.inv) (Op1 A.inv)+import LLVM.Extra.Nice.Class
src/LLVM/Extra/Multi/Iterator.hs view
@@ -1,39 +1,5 @@-module LLVM.Extra.Multi.Iterator (-   takeWhile,-   countDown,-   take,-   ) where--import qualified LLVM.Extra.Multi.Value as MultiValue-import qualified LLVM.Extra.Iterator as Iter--import qualified LLVM.Core as LLVM-import LLVM.Core (CodeGenFunction)--import Control.Applicative (liftA2)--import Prelude hiding (take, takeWhile)----takeWhile ::-   (a -> CodeGenFunction r (MultiValue.T Bool)) ->-   Iter.T r a -> Iter.T r a-takeWhile p = Iter.takeWhile (fmap unpackBool . p)--unpackBool :: MultiValue.T Bool -> LLVM.Value Bool-unpackBool (MultiValue.Cons b) = b--countDown ::-   (MultiValue.Additive i, MultiValue.Comparison i,-    MultiValue.IntegerConstant i) =>-   MultiValue.T i -> Iter.T r (MultiValue.T i)-countDown len =-   takeWhile (MultiValue.cmp LLVM.CmpLT MultiValue.zero) $-   Iter.iterate MultiValue.dec len+module LLVM.Extra.Multi.Iterator+   {-# DEPRECATED "Use LLVM.Extra.Nice.Iterator instead." #-}+   (module LLVM.Extra.Nice.Iterator) where -take ::-   (MultiValue.Additive i, MultiValue.Comparison i,-    MultiValue.IntegerConstant i) =>-   MultiValue.T i -> Iter.T r a -> Iter.T r a-take len xs = liftA2 const xs (countDown len)+import LLVM.Extra.Nice.Iterator
src/LLVM/Extra/Multi/Value.hs view
@@ -1,1057 +1,5 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-}-module LLVM.Extra.Multi.Value where--import qualified LLVM.Extra.ScalarOrVector as SoV-import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Control as C-import qualified LLVM.Extra.Class as Class--import qualified LLVM.Core as LLVM-import qualified LLVM.Util.Loop as Loop-import LLVM.Util.Loop (Phi, )--import Type.Data.Num.Decimal (D1)--import Foreign.StablePtr (StablePtr, )-import Foreign.Ptr (Ptr, FunPtr, )--import qualified Control.Monad.HT as Monad-import Control.Monad (Monad, return, fmap, (>>), )-import Data.Functor (Functor, )--import qualified Data.Tuple.HT as TupleHT-import qualified Data.Tuple as Tuple-import Data.Complex (Complex((:+)))-import Data.Function (id, (.), ($), )-import Data.Tuple.HT (uncurry3, )-import Data.Maybe (Maybe(Nothing,Just), )-import Data.Bool (Bool(False,True), )-import Data.Word (Word8, Word16, Word32, Word64, )-import Data.Int (Int8, Int16, Int32, Int64, )--import Prelude (Float, Double, Integer, Rational, )---newtype T a = Cons (Repr LLVM.Value a)---class C a where-   type Repr (f :: * -> *) a :: *-   cons :: a -> T a-   undef :: T a-   zero :: T a-   phis :: LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)-   addPhis :: LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()--instance C Bool where-   type Repr f Bool = f Bool-   cons = consPrimitive-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive--instance C Float where-   type Repr f Float = f Float-   cons = consPrimitive-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive--instance C Double where-   type Repr f Double = f Double-   cons = consPrimitive-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive--instance C Word8 where-   type Repr f Word8 = f Word8-   cons = consPrimitive-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive--instance C Word16 where-   type Repr f Word16 = f Word16-   cons = consPrimitive-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive--instance C Word32 where-   type Repr f Word32 = f Word32-   cons = consPrimitive-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive--instance C Word64 where-   type Repr f Word64 = f Word64-   cons = consPrimitive-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive--instance C Int8 where-   type Repr f Int8 = f Int8-   cons = consPrimitive-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive--instance C Int16 where-   type Repr f Int16 = f Int16-   cons = consPrimitive-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive--instance C Int32 where-   type Repr f Int32 = f Int32-   cons = consPrimitive-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive--instance C Int64 where-   type Repr f Int64 = f Int64-   cons = consPrimitive-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive--instance (LLVM.IsType a) => C (Ptr a) where-   -- Do we also have to convert the pointer target type?-   type Repr f (Ptr a) = f (Ptr a)-   cons = consPrimitive-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive--instance (LLVM.IsFunction a) => C (FunPtr a) where-   type Repr f (FunPtr a) = f (FunPtr a)-   cons = consPrimitive-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive--instance C (StablePtr a) where-   type Repr f (StablePtr a) = f (StablePtr a)-   cons = consPrimitive-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive---consPrimitive ::-   (LLVM.IsConst al, LLVM.Value al ~ Repr LLVM.Value a) =>-   al -> T a-consPrimitive = Cons . LLVM.valueOf--undefPrimitive, zeroPrimitive ::-   (LLVM.IsType al, LLVM.Value al ~ Repr LLVM.Value a) =>-   T a-undefPrimitive = Cons $ LLVM.value LLVM.undef-zeroPrimitive = Cons $ LLVM.value LLVM.zero--phisPrimitive ::-   (LLVM.IsFirstClass al, LLVM.Value al ~ Repr LLVM.Value a) =>-   LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)-phisPrimitive bb (Cons a) = fmap Cons $ Loop.phis bb a--addPhisPrimitive ::-   (LLVM.IsFirstClass al, LLVM.Value al ~ Repr LLVM.Value a) =>-   LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()-addPhisPrimitive bb (Cons a) (Cons b) = Loop.addPhis bb a b---instance C () where-   type Repr f () = ()-   cons = consUnit-   undef = undefUnit-   zero = zeroUnit-   phis = phisUnit-   addPhis = addPhisUnit--consUnit :: (Repr LLVM.Value a ~ ()) => a -> T a-consUnit _ = Cons ()--undefUnit :: (Repr LLVM.Value a ~ ()) => T a-undefUnit = Cons ()--zeroUnit :: (Repr LLVM.Value a ~ ()) => T a-zeroUnit = Cons ()--phisUnit ::-   (Repr LLVM.Value a ~ ()) =>-   LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)-phisUnit _bb (Cons ()) = return $ Cons ()--addPhisUnit ::-   (Repr LLVM.Value a ~ ()) =>-   LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()-addPhisUnit _bb (Cons ()) (Cons ()) = return ()---instance (C a) => C (Maybe a) where-   type Repr f (Maybe a) = (f Bool, Repr f a)-   cons Nothing = nothing-   cons (Just a) = just $ cons a-   undef = toMaybe undef undef-   zero = toMaybe (cons False) zero-   phis bb ma =-      case splitMaybe ma of-         (b,a) -> Monad.lift2 toMaybe (phis bb b) (phis bb a)-   addPhis bb x y =-      case (splitMaybe x, splitMaybe y) of-         ((xb,xa), (yb,ya)) ->-            addPhis bb xb yb >>-            addPhis bb xa ya--splitMaybe :: T (Maybe a) -> (T Bool, T a)-splitMaybe (Cons (b,a)) = (Cons b, Cons a)--toMaybe :: T Bool -> T a -> T (Maybe a)-toMaybe (Cons b) (Cons a) = Cons (b,a)--nothing :: (C a) => T (Maybe a)-nothing = toMaybe (cons False) undef--just :: T a -> T (Maybe a)-just = toMaybe (cons True)---instance (C a, C b) => C (a,b) where-   type Repr f (a, b) = (Repr f a, Repr f b)-   cons (a,b) = zip (cons a) (cons b)-   undef = zip undef undef-   zero = zip zero zero-   phis bb a =-      case unzip a of-         (a0,a1) ->-            Monad.lift2 zip (phis bb a0) (phis bb a1)-   addPhis bb a b =-      case (unzip a, unzip b) of-         ((a0,a1), (b0,b1)) ->-            addPhis bb a0 b0 >>-            addPhis bb a1 b1--instance (C a, C b, C c) => C (a,b,c) where-   type Repr f (a, b, c) = (Repr f a, Repr f b, Repr f c)-   cons (a,b,c) = zip3 (cons a) (cons b) (cons c)-   undef = zip3 undef undef undef-   zero = zip3 zero zero zero-   phis bb a =-      case unzip3 a of-         (a0,a1,a2) ->-            Monad.lift3 zip3 (phis bb a0) (phis bb a1) (phis bb a2)-   addPhis bb a b =-      case (unzip3 a, unzip3 b) of-         ((a0,a1,a2), (b0,b1,b2)) ->-            addPhis bb a0 b0 >>-            addPhis bb a1 b1 >>-            addPhis bb a2 b2--instance (C a, C b, C c, C d) => C (a,b,c,d) where-   type Repr f (a, b, c, d) = (Repr f a, Repr f b, Repr f c, Repr f d)-   cons (a,b,c,d) = zip4 (cons a) (cons b) (cons c) (cons d)-   undef = zip4 undef undef undef undef-   zero = zip4 zero zero zero zero-   phis bb a =-      case unzip4 a of-         (a0,a1,a2,a3) ->-            Monad.lift4 zip4 (phis bb a0) (phis bb a1) (phis bb a2) (phis bb a3)-   addPhis bb a b =-      case (unzip4 a, unzip4 b) of-         ((a0,a1,a2,a3), (b0,b1,b2,b3)) ->-            addPhis bb a0 b0 >>-            addPhis bb a1 b1 >>-            addPhis bb a2 b2 >>-            addPhis bb a3 b3---fst :: T (a,b) -> T a-fst (Cons (a,_b)) = Cons a--snd :: T (a,b) -> T b-snd (Cons (_a,b)) = Cons b--curry :: (T (a,b) -> c) -> (T a -> T b -> c)-curry f a b = f $ zip a b--uncurry :: (T a -> T b -> c) -> (T (a,b) -> c)-uncurry f = Tuple.uncurry f . unzip---mapFst :: (T a0 -> T a1) -> T (a0,b) -> T (a1,b)-mapFst f = Tuple.uncurry zip . TupleHT.mapFst f . unzip--mapSnd :: (T b0 -> T b1) -> T (a,b0) -> T (a,b1)-mapSnd f = Tuple.uncurry zip . TupleHT.mapSnd f . unzip--swap :: T (a,b) -> T (b,a)-swap = Tuple.uncurry zip . TupleHT.swap . unzip---fst3 :: T (a,b,c) -> T a-fst3 (Cons (a,_b,_c)) = Cons a--snd3 :: T (a,b,c) -> T b-snd3 (Cons (_a,b,_c)) = Cons b--thd3 :: T (a,b,c) -> T c-thd3 (Cons (_a,_b,c)) = Cons c---mapFst3 :: (T a0 -> T a1) -> T (a0,b,c) -> T (a1,b,c)-mapFst3 f = uncurry3 zip3 . TupleHT.mapFst3 f . unzip3--mapSnd3 :: (T b0 -> T b1) -> T (a,b0,c) -> T (a,b1,c)-mapSnd3 f = uncurry3 zip3 . TupleHT.mapSnd3 f . unzip3--mapThd3 :: (T c0 -> T c1) -> T (a,b,c0) -> T (a,b,c1)-mapThd3 f = uncurry3 zip3 . TupleHT.mapThd3 f . unzip3---zip :: T a -> T b -> T (a,b)-zip (Cons a) (Cons b) = Cons (a,b)--zip3 :: T a -> T b -> T c -> T (a,b,c)-zip3 (Cons a) (Cons b) (Cons c) = Cons (a,b,c)--zip4 :: T a -> T b -> T c -> T d -> T (a,b,c,d)-zip4 (Cons a) (Cons b) (Cons c) (Cons d) = Cons (a,b,c,d)--unzip :: T (a,b) -> (T a, T b)-unzip (Cons (a,b)) = (Cons a, Cons b)--unzip3 :: T (a,b,c) -> (T a, T b, T c)-unzip3 (Cons (a,b,c)) = (Cons a, Cons b, Cons c)--unzip4 :: T (a,b,c,d) -> (T a, T b, T c, T d)-unzip4 (Cons (a,b,c,d)) = (Cons a, Cons b, Cons c, Cons d)---instance (C a) => C (Complex a) where-   type Repr f (Complex a) = Complex (Repr f a)-   cons (a:+b) = consComplex (cons a) (cons b)-   undef = consComplex undef undef-   zero = consComplex zero zero-   phis bb a =-      case deconsComplex a of-         (a0,a1) ->-            Monad.lift2 consComplex (phis bb a0) (phis bb a1)-   addPhis bb a b =-      case (deconsComplex a, deconsComplex b) of-         ((a0,a1), (b0,b1)) ->-            addPhis bb a0 b0 >>-            addPhis bb a1 b1--consComplex :: T a -> T a -> T (Complex a)-consComplex (Cons a) (Cons b) = Cons (a:+b)--deconsComplex :: T (Complex a) -> (T a, T a)-deconsComplex (Cons (a:+b)) = (Cons a, Cons b)----class Compose multituple where-   type Composed multituple-   {- |-   A nested 'zip'.-   -}-   compose :: multituple -> T (Composed multituple)--class-   (Composed (Decomposed T pattern) ~ PatternTuple pattern) =>-      Decompose pattern where-   {- |-   A nested 'unzip'.-   Since it is not obvious how deep to decompose nested tuples,-   you must provide a pattern of the decomposed tuple.-   E.g.--   > f :: MultiValue ((a,b),(c,d)) ->-   >      ((MultiValue a, MultiValue b), MultiValue (c,d))-   > f = decompose ((atom,atom),atom)-   -}-   decompose :: pattern -> T (PatternTuple pattern) -> Decomposed T pattern--type family Decomposed (f :: * -> *) pattern-type family PatternTuple pattern---{- |-A combination of 'compose' and 'decompose'-that let you operate on tuple multivalues as Haskell tuples.--}-modify ::-   (Compose a, Decompose pattern) =>-   pattern ->-   (Decomposed T pattern -> a) ->-   T (PatternTuple pattern) -> T (Composed a)-modify p f = compose . f . decompose p--modify2 ::-   (Compose a, Decompose patternA, Decompose patternB) =>-   patternA ->-   patternB ->-   (Decomposed T patternA -> Decomposed T patternB -> a) ->-   T (PatternTuple patternA) -> T (PatternTuple patternB) -> T (Composed a)-modify2 pa pb f a b = compose $ f (decompose pa a) (decompose pb b)--modifyF ::-   (Compose a, Decompose pattern, Functor f) =>-   pattern ->-   (Decomposed T pattern -> f a) ->-   T (PatternTuple pattern) -> f (T (Composed a))-modifyF p f = fmap compose . f . decompose p--modifyF2 ::-   (Compose a, Decompose patternA, Decompose patternB,-    Functor f) =>-   patternA ->-   patternB ->-   (Decomposed T patternA -> Decomposed T patternB -> f a) ->-   T (PatternTuple patternA) -> T (PatternTuple patternB) -> f (T (Composed a))-modifyF2 pa pb f a b = fmap compose $ f (decompose pa a) (decompose pb b)----instance Compose (T a) where-   type Composed (T a) = a-   compose = id--instance Decompose (Atom a) where-   decompose _ = id--type instance Decomposed f (Atom a) = f a-type instance PatternTuple (Atom a) = a--data Atom a = Atom--atom :: Atom a-atom = Atom---instance Compose () where-   type Composed () = ()-   compose = cons--instance () => Decompose () where-   decompose () _ = ()--type instance Decomposed f () = ()-type instance PatternTuple () = ()---instance (Compose a, Compose b) => Compose (a,b) where-   type Composed (a,b) = (Composed a, Composed b)-   compose = Tuple.uncurry zip . TupleHT.mapPair (compose, compose)--instance (Decompose pa, Decompose pb) => Decompose (pa,pb) where-   decompose (pa,pb) =-      TupleHT.mapPair (decompose pa, decompose pb) . unzip--type instance Decomposed f (pa,pb) = (Decomposed f pa, Decomposed f pb)-type instance PatternTuple (pa,pb) = (PatternTuple pa, PatternTuple pb)---instance (Compose a, Compose b, Compose c) => Compose (a,b,c) where-   type Composed (a,b,c) = (Composed a, Composed b, Composed c)-   compose = uncurry3 zip3 . TupleHT.mapTriple (compose, compose, compose)--instance-   (Decompose pa, Decompose pb, Decompose pc) =>-      Decompose (pa,pb,pc) where-   decompose (pa,pb,pc) =-      TupleHT.mapTriple (decompose pa, decompose pb, decompose pc) . unzip3--type instance Decomposed f (pa,pb,pc) =-        (Decomposed f pa, Decomposed f pb, Decomposed f pc)-type instance PatternTuple (pa,pb,pc) =-        (PatternTuple pa, PatternTuple pb, PatternTuple pc)---instance (Compose a, Compose b, Compose c, Compose d) => Compose (a,b,c,d) where-   type Composed (a,b,c,d) = (Composed a, Composed b, Composed c, Composed d)-   compose (a,b,c,d) = zip4 (compose a) (compose b) (compose c) (compose d)--instance-   (Decompose pa, Decompose pb, Decompose pc, Decompose pd) =>-      Decompose (pa,pb,pc,pd) where-   decompose (pa,pb,pc,pd) x =-      case unzip4 x of-         (a,b,c,d) ->-            (decompose pa a, decompose pb b, decompose pc c, decompose pd d)-type instance Decomposed f (pa,pb,pc,pd) =-        (Decomposed f pa, Decomposed f pb, Decomposed f pc, Decomposed f pd)-type instance PatternTuple (pa,pb,pc,pd) =-        (PatternTuple pa, PatternTuple pb, PatternTuple pc, PatternTuple pd)---instance (Compose a) => Compose (Complex a) where-   type Composed (Complex a) = Complex (Composed a)-   compose (a:+b) = consComplex (compose a) (compose b)--instance (Decompose pa) => Decompose (Complex pa) where-   decompose (pa:+pb) =-      Tuple.uncurry (:+) .-      TupleHT.mapPair (decompose pa, decompose pb) . deconsComplex--type instance Decomposed f (Complex pa) = Complex (Decomposed f pa)-type instance PatternTuple (Complex pa) = Complex (PatternTuple pa)--realPart, imagPart :: T (Complex a) -> T a-realPart (Cons (a:+_)) = Cons a-imagPart (Cons (_:+b)) = Cons b----lift1 :: (Repr LLVM.Value a -> Repr LLVM.Value b) -> T a -> T b-lift1 f (Cons a) = Cons $ f a--liftM0 ::-   (Monad m) =>-   m (Repr LLVM.Value a) ->-   m (T a)-liftM0 f = Monad.lift Cons f--liftM ::-   (Monad m) =>-   (Repr LLVM.Value a -> m (Repr LLVM.Value b)) ->-   T a -> m (T b)-liftM f (Cons a) = Monad.lift Cons $ f a--liftM2 ::-   (Monad m) =>-   (Repr LLVM.Value a -> Repr LLVM.Value b -> m (Repr LLVM.Value c)) ->-   T a -> T b -> m (T c)-liftM2 f (Cons a) (Cons b) = Monad.lift Cons $ f a b--liftM3 ::-   (Monad m) =>-   (Repr LLVM.Value a -> Repr LLVM.Value b -> Repr LLVM.Value c ->-    m (Repr LLVM.Value d)) ->-   T a -> T b -> T c -> m (T d)-liftM3 f (Cons a) (Cons b) (Cons c) = Monad.lift Cons $ f a b c---instance (C a) => Class.Zero (T a) where-   zeroTuple = zero--instance (C a) => Class.Undefined (T a) where-   undefTuple = undef--instance (C a) => Phi (T a) where-   phis = phis-   addPhis = addPhis---class (C a) => IntegerConstant a where-   fromInteger' :: Integer -> T a--class (IntegerConstant a) => RationalConstant a where-   fromRational' :: Rational -> T a--instance IntegerConstant Float  where fromInteger' = Cons . LLVM.value . SoV.constFromInteger-instance IntegerConstant Double where fromInteger' = Cons . LLVM.value . SoV.constFromInteger--instance IntegerConstant Word8 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger-instance IntegerConstant Word16 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger-instance IntegerConstant Word32 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger-instance IntegerConstant Word64 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger--instance IntegerConstant Int8 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger-instance IntegerConstant Int16 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger-instance IntegerConstant Int32 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger-instance IntegerConstant Int64 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger--instance RationalConstant Float  where fromRational' = Cons . LLVM.value . SoV.constFromRational-instance RationalConstant Double where fromRational' = Cons . LLVM.value . SoV.constFromRational---instance (IntegerConstant a) => A.IntegerConstant (T a) where-   fromInteger' = fromInteger'--instance (RationalConstant a) => A.RationalConstant (T a) where-   fromRational' = fromRational'---class (C a) => Additive a where-   add :: T a -> T a -> LLVM.CodeGenFunction r (T a)-   sub :: T a -> T a -> LLVM.CodeGenFunction r (T a)-   neg :: T a -> LLVM.CodeGenFunction r (T a)--instance Additive Float where-   add = liftM2 LLVM.add-   sub = liftM2 LLVM.sub-   neg = liftM LLVM.neg--instance Additive Double where-   add = liftM2 LLVM.add-   sub = liftM2 LLVM.sub-   neg = liftM LLVM.neg--instance Additive Word8 where-   add = liftM2 LLVM.add-   sub = liftM2 LLVM.sub-   neg = liftM LLVM.neg--instance Additive Word16 where-   add = liftM2 LLVM.add-   sub = liftM2 LLVM.sub-   neg = liftM LLVM.neg--instance Additive Word32 where-   add = liftM2 LLVM.add-   sub = liftM2 LLVM.sub-   neg = liftM LLVM.neg--instance Additive Word64 where-   add = liftM2 LLVM.add-   sub = liftM2 LLVM.sub-   neg = liftM LLVM.neg--instance Additive Int8 where-   add = liftM2 LLVM.add-   sub = liftM2 LLVM.sub-   neg = liftM LLVM.neg--instance Additive Int16 where-   add = liftM2 LLVM.add-   sub = liftM2 LLVM.sub-   neg = liftM LLVM.neg--instance Additive Int32 where-   add = liftM2 LLVM.add-   sub = liftM2 LLVM.sub-   neg = liftM LLVM.neg--instance Additive Int64 where-   add = liftM2 LLVM.add-   sub = liftM2 LLVM.sub-   neg = liftM LLVM.neg--instance (Additive a) => A.Additive (T a) where-   zero = zero-   add = add-   sub = sub-   neg = neg--inc, dec ::-   (Additive i, IntegerConstant i) => T i -> LLVM.CodeGenFunction r (T i)-inc = add (fromInteger' 1)-dec = sub (fromInteger' 1)---class (Additive a) => PseudoRing a where-   mul :: T a -> T a -> LLVM.CodeGenFunction r (T a)--instance PseudoRing Float where mul = liftM2 LLVM.mul-instance PseudoRing Double where mul = liftM2 LLVM.mul-instance PseudoRing Word8 where mul = liftM2 LLVM.mul-instance PseudoRing Word16 where mul = liftM2 LLVM.mul-instance PseudoRing Word32 where mul = liftM2 LLVM.mul-instance PseudoRing Word64 where mul = liftM2 LLVM.mul-instance PseudoRing Int8 where mul = liftM2 LLVM.mul-instance PseudoRing Int16 where mul = liftM2 LLVM.mul-instance PseudoRing Int32 where mul = liftM2 LLVM.mul-instance PseudoRing Int64 where mul = liftM2 LLVM.mul--instance (PseudoRing a) => A.PseudoRing (T a) where-   mul = mul---class (PseudoRing a) => Field a where-   fdiv :: T a -> T a -> LLVM.CodeGenFunction r (T a)--instance Field Float where-   fdiv = liftM2 LLVM.fdiv--instance Field Double where-   fdiv = liftM2 LLVM.fdiv--instance (Field a) => A.Field (T a) where-   fdiv = fdiv---type family Scalar vector :: *-type instance Scalar Float = Float-type instance Scalar Double = Double-type instance A.Scalar (T a) = T (Scalar a)--class (PseudoRing (Scalar v), Additive v) => PseudoModule v where-   scale :: T (Scalar v) -> T v -> LLVM.CodeGenFunction r (T v)--instance PseudoModule Float where-   scale = liftM2 A.mul--instance PseudoModule Double where-   scale = liftM2 A.mul--instance (PseudoModule a) => A.PseudoModule (T a) where-   scale = scale---class (Additive a) => Real a where-   min :: T a -> T a -> LLVM.CodeGenFunction r (T a)-   max :: T a -> T a -> LLVM.CodeGenFunction r (T a)-   abs :: T a -> LLVM.CodeGenFunction r (T a)-   signum :: T a -> LLVM.CodeGenFunction r (T a)--instance Real Float where-   min = liftM2 A.min-   max = liftM2 A.max-   abs = liftM A.abs-   signum = liftM A.signum--instance Real Double where-   min = liftM2 A.min-   max = liftM2 A.max-   abs = liftM A.abs-   signum = liftM A.signum--instance Real Word8 where-   min = liftM2 A.min-   max = liftM2 A.max-   abs = liftM A.abs-   signum = liftM A.signum--instance Real Word16 where-   min = liftM2 A.min-   max = liftM2 A.max-   abs = liftM A.abs-   signum = liftM A.signum--instance Real Word32 where-   min = liftM2 A.min-   max = liftM2 A.max-   abs = liftM A.abs-   signum = liftM A.signum--instance Real Word64 where-   min = liftM2 A.min-   max = liftM2 A.max-   abs = liftM A.abs-   signum = liftM A.signum--instance Real Int8 where-   min = liftM2 A.min-   max = liftM2 A.max-   abs = liftM A.abs-   signum = liftM A.signum--instance Real Int16 where-   min = liftM2 A.min-   max = liftM2 A.max-   abs = liftM A.abs-   signum = liftM A.signum--instance Real Int32 where-   min = liftM2 A.min-   max = liftM2 A.max-   abs = liftM A.abs-   signum = liftM A.signum--instance Real Int64 where-   min = liftM2 A.min-   max = liftM2 A.max-   abs = liftM A.abs-   signum = liftM A.signum--instance (Real a) => A.Real (T a) where-   min = min-   max = max-   abs = abs-   signum = signum---class (Real a) => Fraction a where-   truncate :: T a -> LLVM.CodeGenFunction r (T a)-   fraction :: T a -> LLVM.CodeGenFunction r (T a)--instance Fraction Float where-   truncate = liftM A.truncate-   fraction = liftM A.fraction--instance Fraction Double where-   truncate = liftM A.truncate-   fraction = liftM A.fraction--instance (Fraction a) => A.Fraction (T a) where-   truncate = truncate-   fraction = fraction---class-   (Repr LLVM.Value i ~ LLVM.Value ir,-    LLVM.IsInteger ir, SoV.IntegerConstant ir, LLVM.CmpRet ir,-    LLVM.NumberOfElements ir ~ D1, LLVM.CmpResult ir ~ Bool) =>-      NativeInteger i ir where--instance NativeInteger Word8  Word8 where-instance NativeInteger Word16 Word16 where-instance NativeInteger Word32 Word32 where-instance NativeInteger Word64 Word64 where--instance NativeInteger Int8  Int8 where-instance NativeInteger Int16 Int16 where-instance NativeInteger Int32 Int32 where-instance NativeInteger Int64 Int64 where---class-   (Repr LLVM.Value a ~ LLVM.Value ar,-    LLVM.IsFloating ar, SoV.RationalConstant ar, LLVM.CmpRet ar,-    LLVM.NumberOfElements ar ~ D1, LLVM.CmpResult ar ~ Bool) =>-      NativeFloating a ar where--instance NativeFloating Float  Float where-instance NativeFloating Double Double where---truncateToInt, floorToInt, ceilingToInt, roundToIntFast ::-   (NativeInteger i ir, NativeFloating a ar) =>-   T a -> LLVM.CodeGenFunction r (T i)-truncateToInt  = liftM SoV.truncateToInt-floorToInt     = liftM SoV.floorToInt-ceilingToInt   = liftM SoV.ceilingToInt-roundToIntFast = liftM SoV.roundToIntFast--splitFractionToInt ::-   (NativeInteger i ir, NativeFloating a ar) =>-   T a -> LLVM.CodeGenFunction r (T (i,a))-splitFractionToInt = liftM SoV.splitFractionToInt---class Field a => Algebraic a where-   sqrt :: T a -> LLVM.CodeGenFunction r (T a)--instance Algebraic Float where-   sqrt = liftM A.sqrt--instance Algebraic Double where-   sqrt = liftM A.sqrt--instance (Algebraic a) => A.Algebraic (T a) where-   sqrt = sqrt---class Algebraic a => Transcendental a where-   pi :: LLVM.CodeGenFunction r (T a)-   sin, cos, exp, log :: T a -> LLVM.CodeGenFunction r (T a)-   pow :: T a -> T a -> LLVM.CodeGenFunction r (T a)--instance Transcendental Float where-   pi = liftM0 A.pi-   sin = liftM A.sin-   cos = liftM A.cos-   exp = liftM A.exp-   log = liftM A.log-   pow = liftM2 A.pow--instance Transcendental Double where-   pi = liftM0 A.pi-   sin = liftM A.sin-   cos = liftM A.cos-   exp = liftM A.exp-   log = liftM A.log-   pow = liftM2 A.pow--instance (Transcendental a) => A.Transcendental (T a) where-   pi = pi-   sin = sin-   cos = cos-   exp = exp-   log = log-   pow = pow----class (C a) => Select a where-   select ::-      T Bool -> T a -> T a ->-      LLVM.CodeGenFunction r (T a)--instance Select Float where select = liftM3 LLVM.select-instance Select Double where select = liftM3 LLVM.select-instance Select Word8 where select = liftM3 LLVM.select-instance Select Word16 where select = liftM3 LLVM.select-instance Select Word32 where select = liftM3 LLVM.select-instance Select Word64 where select = liftM3 LLVM.select-instance Select Int8 where select = liftM3 LLVM.select-instance Select Int16 where select = liftM3 LLVM.select-instance Select Int32 where select = liftM3 LLVM.select-instance Select Int64 where select = liftM3 LLVM.select--instance (Select a, Select b) => Select (a,b) where-   select b =-      modifyF2 (atom,atom) (atom,atom) $-      \(a0,b0) (a1,b1) ->-         Monad.lift2 (,)-            (select b a0 a1)-            (select b b0 b1)--instance (Select a, Select b, Select c) => Select (a,b,c) where-   select b =-      modifyF2 (atom,atom,atom) (atom,atom,atom) $-      \(a0,b0,c0) (a1,b1,c1) ->-         Monad.lift3 (,,)-            (select b a0 a1)-            (select b b0 b1)-            (select b c0 c1)--instance (Select a) => C.Select (T a) where-   select b = select (Cons b)----class (Real a) => Comparison a where-   {- |-   It must hold--   > max x y  ==  do gt <- cmp CmpGT x y; select gt x y-   -}-   cmp ::-      LLVM.CmpPredicate -> T a -> T a ->-      LLVM.CodeGenFunction r (T Bool)--instance Comparison Float where cmp = liftM2 . LLVM.cmp-instance Comparison Double where cmp = liftM2 . LLVM.cmp--instance Comparison Int8 where cmp = liftM2 . LLVM.cmp-instance Comparison Int16 where cmp = liftM2 . LLVM.cmp-instance Comparison Int32 where cmp = liftM2 . LLVM.cmp-instance Comparison Int64 where cmp = liftM2 . LLVM.cmp--instance Comparison Word8 where cmp = liftM2 . LLVM.cmp-instance Comparison Word16 where cmp = liftM2 . LLVM.cmp-instance Comparison Word32 where cmp = liftM2 . LLVM.cmp-instance Comparison Word64 where cmp = liftM2 . LLVM.cmp--instance (Comparison a) => A.Comparison (T a) where-   type CmpResult (T a) = T Bool-   cmp = cmp----class (Comparison a) => FloatingComparison a where-   fcmp ::-      LLVM.FPPredicate -> T a -> T a ->-      LLVM.CodeGenFunction r (T Bool)--instance FloatingComparison Float where-   fcmp = liftM2 . LLVM.fcmp--instance (FloatingComparison a) => A.FloatingComparison (T a) where-   fcmp = fcmp----class Logic a where-   and :: T a -> T a -> LLVM.CodeGenFunction r (T a)-   or :: T a -> T a -> LLVM.CodeGenFunction r (T a)-   xor :: T a -> T a -> LLVM.CodeGenFunction r (T a)-   inv :: T a -> LLVM.CodeGenFunction r (T a)--instance Logic Bool where-   and = liftM2 LLVM.and; or = liftM2 LLVM.or-   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv--instance Logic Word8 where-   and = liftM2 LLVM.and; or = liftM2 LLVM.or-   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv--instance Logic Word16 where-   and = liftM2 LLVM.and; or = liftM2 LLVM.or-   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv--instance Logic Word32 where-   and = liftM2 LLVM.and; or = liftM2 LLVM.or-   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv--instance Logic Word64 where-   and = liftM2 LLVM.and; or = liftM2 LLVM.or-   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv---instance Logic a => A.Logic (T a) where-   and = and-   or = or-   xor = xor-   inv = inv----class BitShift a where-   shl :: T a -> T a -> LLVM.CodeGenFunction r (T a)-   shr :: T a -> T a -> LLVM.CodeGenFunction r (T a)--instance BitShift Word8 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr--instance BitShift Word16 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr--instance BitShift Word32 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr--instance BitShift Word64 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr--instance BitShift Int8 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr--instance BitShift Int16 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr--instance BitShift Int32 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr--instance BitShift Int64 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr----class (PseudoRing a) => Integral a where-   idiv :: T a -> T a -> LLVM.CodeGenFunction r (T a)-   irem :: T a -> T a -> LLVM.CodeGenFunction r (T a)--instance Integral Word32 where-   idiv = liftM2 LLVM.idiv-   irem = liftM2 LLVM.irem--instance Integral Word64 where-   idiv = liftM2 LLVM.idiv-   irem = liftM2 LLVM.irem--instance Integral Int32 where-   idiv = liftM2 LLVM.idiv-   irem = liftM2 LLVM.irem--instance Integral Int64 where-   idiv = liftM2 LLVM.idiv-   irem = liftM2 LLVM.irem---fromIntegral ::-   (NativeInteger i ir, NativeFloating a ar) =>-   T i -> LLVM.CodeGenFunction r (T a)-fromIntegral = liftM LLVM.inttofp+module LLVM.Extra.Multi.Value+   {-# DEPRECATED "Use LLVM.Extra.Nice.Value instead." #-}+   (module LLVM.Extra.Nice.Value) where++import LLVM.Extra.Nice.Value
+ src/LLVM/Extra/Multi/Value/Marshal.hs view
@@ -0,0 +1,5 @@+module LLVM.Extra.Multi.Value.Marshal+   {-# DEPRECATED "Use LLVM.Extra.Nice.Value.Marshal instead." #-}+   (module LLVM.Extra.Nice.Value.Marshal) where++import LLVM.Extra.Nice.Value.Marshal
− src/LLVM/Extra/Multi/Value/Memory.hs 
@@ -1,242 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-module LLVM.Extra.Multi.Value.Memory where--import qualified LLVM.Extra.Multi.Value as MultiValue-import LLVM.Extra.MemoryPrivate (decomposeFromLoad, composeFromStore, )--import qualified LLVM.Core as LLVM-import LLVM.Core (CodeGenFunction, Value, )--import qualified Type.Data.Num.Decimal as TypeNum--import Foreign.StablePtr (StablePtr, )-import Foreign.Ptr (Ptr, FunPtr, castPtr, )--import Data.Complex (Complex, )-import Data.Word (Word8, Word16, Word32, Word64, )-import Data.Int (Int8, Int16, Int32, Int64, )--import Control.Applicative (pure, liftA2, liftA3, (<*>), )---class (MultiValue.C a, LLVM.IsSized (Struct a)) => C a where-   {-# MINIMAL (load|decompose), (store|compose) #-}-   type Struct a :: *-   load :: Value (Ptr (Struct a)) -> CodeGenFunction r (MultiValue.T a)-   load ptr  =  decompose =<< LLVM.load ptr-   store :: MultiValue.T a -> Value (Ptr (Struct a)) -> CodeGenFunction r ()-   store r ptr  =  flip LLVM.store ptr =<< compose r-   decompose :: Value (Struct a) -> CodeGenFunction r (MultiValue.T a)-   decompose = decomposeFromLoad load-   compose :: MultiValue.T a -> CodeGenFunction r (Value (Struct a))-   compose = composeFromStore store--instance C Float where-   type Struct Float = Float-   load = loadPrimitive-   store = storePrimitive-   decompose = decomposePrimitive-   compose = composePrimitive--instance C Double where-   type Struct Double = Double-   load = loadPrimitive-   store = storePrimitive-   decompose = decomposePrimitive-   compose = composePrimitive--instance C Word8 where-   type Struct Word8 = Word8-   load = loadPrimitive-   store = storePrimitive-   decompose = decomposePrimitive-   compose = composePrimitive--instance C Word16 where-   type Struct Word16 = Word16-   load = loadPrimitive-   store = storePrimitive-   decompose = decomposePrimitive-   compose = composePrimitive--instance C Word32 where-   type Struct Word32 = Word32-   load = loadPrimitive-   store = storePrimitive-   decompose = decomposePrimitive-   compose = composePrimitive--instance C Word64 where-   type Struct Word64 = Word64-   load = loadPrimitive-   store = storePrimitive-   decompose = decomposePrimitive-   compose = composePrimitive--instance C Int8 where-   type Struct Int8 = Int8-   load = loadPrimitive-   store = storePrimitive-   decompose = decomposePrimitive-   compose = composePrimitive--instance C Int16 where-   type Struct Int16 = Int16-   load = loadPrimitive-   store = storePrimitive-   decompose = decomposePrimitive-   compose = composePrimitive--instance C Int32 where-   type Struct Int32 = Int32-   load = loadPrimitive-   store = storePrimitive-   decompose = decomposePrimitive-   compose = composePrimitive--instance C Int64 where-   type Struct Int64 = Int64-   load = loadPrimitive-   store = storePrimitive-   decompose = decomposePrimitive-   compose = composePrimitive--instance (LLVM.IsType a) => C (Ptr a) where-   type Struct (Ptr a) = Ptr a-   load = loadPrimitive-   store = storePrimitive-   decompose = decomposePrimitive-   compose = composePrimitive--instance (LLVM.IsFunction a) => C (FunPtr a) where-   type Struct (FunPtr a) = FunPtr a-   load = loadPrimitive-   store = storePrimitive-   decompose = decomposePrimitive-   compose = composePrimitive--instance C (StablePtr a) where-   type Struct (StablePtr a) = StablePtr a-   load = loadPrimitive-   store = storePrimitive-   decompose = decomposePrimitive-   compose = composePrimitive---loadPrimitive ::-   (MultiValue.Repr Value a ~ Value a) =>-   Value (Ptr a) -> CodeGenFunction r (MultiValue.T a)-loadPrimitive = fmap MultiValue.Cons . LLVM.load--storePrimitive ::-   (MultiValue.Repr Value a ~ Value a) =>-   MultiValue.T a -> Value (Ptr a) -> CodeGenFunction r ()-storePrimitive (MultiValue.Cons a) = LLVM.store a--decomposePrimitive ::-   (MultiValue.Repr Value a ~ Value a) =>-   Value a -> CodeGenFunction r (MultiValue.T a)-decomposePrimitive = return . MultiValue.Cons--composePrimitive ::-   (MultiValue.Repr Value a ~ Value a) =>-   MultiValue.T a -> CodeGenFunction r (Value a)-composePrimitive (MultiValue.Cons a) = return a---instance C () where-   type Struct () = LLVM.Struct ()-   load = loadUnit-   store = storeUnit-   decompose = decomposeUnit-   compose = composeUnit--loadUnit ::-   (MultiValue.Repr Value a ~ ()) =>-   Value (Ptr (LLVM.Struct ())) -> CodeGenFunction r (MultiValue.T a)-loadUnit _ = return $ MultiValue.Cons ()--storeUnit ::-   MultiValue.T a -> Value (Ptr (LLVM.Struct ())) -> CodeGenFunction r ()-storeUnit _ _ = return ()--decomposeUnit ::-   (MultiValue.Repr Value a ~ ()) =>-   Value (LLVM.Struct ()) -> CodeGenFunction r (MultiValue.T a)-decomposeUnit _ = return $ MultiValue.Cons ()--composeUnit ::-   MultiValue.T a -> CodeGenFunction r (Value (LLVM.Struct ()))-composeUnit _ = return (LLVM.value $ LLVM.constStruct ())---instance (C a) => C (Complex a) where-   type Struct (Complex a) = LLVM.Struct (Struct a, (Struct a, ()))-   decompose c =-      liftA2 MultiValue.consComplex-         (decompose =<< LLVM.extractvalue c TypeNum.d0)-         (decompose =<< LLVM.extractvalue c TypeNum.d1)-   compose c =-      case MultiValue.deconsComplex c of-         (r,i) -> do-            sr <- compose r-            si <- compose i-            rr <- LLVM.insertvalue (LLVM.value LLVM.undef) sr TypeNum.d0-            LLVM.insertvalue rr si TypeNum.d1---instance (C a, C b) => C (a,b) where-   type Struct (a,b) = LLVM.Struct (Struct a, (Struct b, ()))-   decompose ab =-      liftA2 MultiValue.zip-         (decompose =<< LLVM.extractvalue ab TypeNum.d0)-         (decompose =<< LLVM.extractvalue ab TypeNum.d1)-   compose ab =-      case MultiValue.unzip ab of-         (a,b) -> do-            sa <- compose a-            sb <- compose b-            ra <- LLVM.insertvalue (LLVM.value LLVM.undef) sa TypeNum.d0-            LLVM.insertvalue ra sb TypeNum.d1--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, ())))-   decompose abc =-      liftA3 MultiValue.zip3-         (decompose =<< LLVM.extractvalue abc TypeNum.d0)-         (decompose =<< LLVM.extractvalue abc TypeNum.d1)-         (decompose =<< LLVM.extractvalue abc TypeNum.d2)-   compose abc =-      case MultiValue.unzip3 abc of-         (a,b,c) -> do-            sa <- compose a-            sb <- compose b-            sc <- compose c-            ra <- LLVM.insertvalue (LLVM.value LLVM.undef) sa TypeNum.d0-            rb <- LLVM.insertvalue ra sb TypeNum.d1-            LLVM.insertvalue rb sc TypeNum.d2--instance (C a, C b, C c, C d) => C (a,b,c,d) where-   type Struct (a,b,c,d) = LLVM.Struct (Struct a, (Struct b, (Struct c, (Struct d, ()))))-   decompose abcd =-      pure MultiValue.zip4-         <*> (decompose =<< LLVM.extractvalue abcd TypeNum.d0)-         <*> (decompose =<< LLVM.extractvalue abcd TypeNum.d1)-         <*> (decompose =<< LLVM.extractvalue abcd TypeNum.d2)-         <*> (decompose =<< LLVM.extractvalue abcd TypeNum.d3)-   compose abcd =-      case MultiValue.unzip4 abcd of-         (a,b,c,d) -> do-            sa <- compose a-            sb <- compose b-            sc <- compose c-            sd <- compose d-            ra <- LLVM.insertvalue (LLVM.value LLVM.undef) sa TypeNum.d0-            rb <- LLVM.insertvalue ra sb TypeNum.d1-            rc <- LLVM.insertvalue rb sc TypeNum.d2-            LLVM.insertvalue rc sd TypeNum.d3---castStructPtr :: Ptr a -> Ptr (Struct a)-castStructPtr = castPtr
+ src/LLVM/Extra/Multi/Value/Storable.hs view
@@ -0,0 +1,5 @@+module LLVM.Extra.Multi.Value.Storable+   {-# DEPRECATED "Use LLVM.Extra.Nice.Value.Storable instead." #-}+   (module LLVM.Extra.Nice.Value.Storable) where++import LLVM.Extra.Nice.Value.Storable
+ src/LLVM/Extra/Multi/Value/Vector.hs view
@@ -0,0 +1,5 @@+module LLVM.Extra.Multi.Value.Vector+   {-# DEPRECATED "Use LLVM.Extra.Nice.Value.Vector instead." #-}+   (module LLVM.Extra.Nice.Value.Vector) where++import LLVM.Extra.Nice.Value.Vector
src/LLVM/Extra/Multi/Vector.hs view
@@ -1,801 +1,5 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-module LLVM.Extra.Multi.Vector (-   T(Cons), consPrim, deconsPrim,-   C(..),-   Value(Value),-   map,-   zip, zip3, unzip, unzip3,-   replicate,-   iterate,--   lift1,--   modify,-   assemble,-   dissect,-   dissectList,--   reverse,-   rotateUp,-   rotateDown,-   shiftUp,-   shiftDown,-   shiftUpMultiZero,-   shiftDownMultiZero,--   undefPrimitive,-   shuffleMatchPrimitive,-   extractPrimitive,-   insertPrimitive,--   shuffleMatchTraversable,-   insertTraversable,-   extractTraversable,--   Additive(..),-   PseudoRing(..),-   Field(..),-   PseudoModule(..),-   Real(..),-   Fraction(..),-   Algebraic(..),-   Transcendental(..),-   FloatingComparison(..),-   Comparison(..),-   Logic(..),-   BitShift(..),-   ) where--import qualified LLVM.Extra.Multi.Value as MultiValue-import qualified LLVM.Extra.ScalarOrVector as SoV-import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Class as Class-import LLVM.Extra.Multi.Value (Repr, )--import qualified LLVM.Util.Loop as Loop-import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, )-import LLVM.Core-   (valueOf, value,-    IsPrimitive,-    CodeGenFunction, )--import qualified Type.Data.Num.Decimal as TypeNum--import qualified Data.Traversable as Trav-import qualified Data.NonEmpty as NonEmpty-import qualified Data.List as List-import Data.Traversable (mapM, sequence, )-import Data.NonEmpty ((!:), )-import Data.Function (flip, (.), ($), )-import Data.Tuple (snd, )-import Data.Maybe (maybe, )-import Data.List (take, (++), )-import Data.Word (Word8, Word16, Word32, Word64, )-import Data.Int (Int8, Int16, Int32, Int64, )-import Data.Bool (Bool, )--import qualified Control.Applicative as App-import qualified Control.Monad.HT as Monad-import Control.Monad.HT ((<=<), )-import Control.Monad (Monad, foldM, fmap, (>>), (=<<), )-import Control.Applicative (liftA2, )--import Prelude (Float, Double, Integer, Int, Rational, fromIntegral, (-), error, )---newtype T n a = Cons (Repr (Value n) a)--newtype Value n a = Value (PrimValue n a)---consPrim ::-   (Repr (Value n) a ~ Value n a) =>-   LLVM.Value (LLVM.Vector n a) -> T n a-consPrim = Cons . Value--deconsPrim ::-   (Repr (Value n) a ~ Value n a) =>-   T n a -> LLVM.Value (LLVM.Vector n a)-deconsPrim (Cons (Value a)) = a---instance (TypeNum.Positive n, C a) => Class.Undefined (T n a) where-   undefTuple = undef--instance (TypeNum.Positive n, C a) => Class.Zero (T n a) where-   zeroTuple = zero--instance (TypeNum.Positive n, C a) => Phi (T n a) where-   phis = phis-   addPhis = addPhis---size :: TypeNum.Positive n => T n a -> Int-size =-   let sz :: TypeNum.Positive n => TypeNum.Singleton n -> T n a -> Int-       sz n _ = TypeNum.integralFromSingleton n-   in  sz TypeNum.singleton---zip :: T n a -> T n b -> T n (a,b)-zip (Cons a) (Cons b) = Cons (a,b)--zip3 :: T n a -> T n b -> T n c -> T n (a,b,c)-zip3 (Cons a) (Cons b) (Cons c) = Cons (a,b,c)--unzip :: T n (a,b) -> (T n a, T n b)-unzip (Cons (a,b)) = (Cons a, Cons b)--unzip3 :: T n (a,b,c) -> (T n a, T n b, T n c)-unzip3 (Cons (a,b,c)) = (Cons a, Cons b, Cons c)---class (MultiValue.C a) => C a where-   undef :: (TypeNum.Positive n) => T n a-   zero :: (TypeNum.Positive n) => T n a-   phis ::-      (TypeNum.Positive n) =>-      LLVM.BasicBlock -> T n a -> LLVM.CodeGenFunction r (T n a)-   addPhis ::-      (TypeNum.Positive n) =>-      LLVM.BasicBlock -> T n a -> T n a -> LLVM.CodeGenFunction r ()--   shuffleMatch ::-      (TypeNum.Positive n) =>-      LLVM.ConstValue (LLVM.Vector n Word32) -> T n a -> CodeGenFunction r (T n a)-   extract ::-      (TypeNum.Positive n) =>-      LLVM.Value Word32 -> T n a -> CodeGenFunction r (MultiValue.T a)-   insert ::-      (TypeNum.Positive n) =>-      LLVM.Value Word32 -> MultiValue.T a ->-      T n a -> CodeGenFunction r (T n a)--instance C Bool where-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive-   shuffleMatch = shuffleMatchPrimitive-   extract = extractPrimitive-   insert = insertPrimitive--instance C Float where-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive-   shuffleMatch = shuffleMatchPrimitive-   extract = extractPrimitive-   insert = insertPrimitive--instance C Double where-   undef = undefPrimitive-   zero = zeroPrimitive-   phis = phisPrimitive-   addPhis = addPhisPrimitive-   shuffleMatch = shuffleMatchPrimitive-   extract = extractPrimitive-   insert = insertPrimitive--undefPrimitive ::-   (TypeNum.Positive n, IsPrimitive a,-    Repr (Value n) a ~ Value n a) =>-   T n a-undefPrimitive = Cons $ Value $ LLVM.value LLVM.undef--zeroPrimitive ::-   (TypeNum.Positive n, IsPrimitive a,-    Repr (Value n) a ~ Value n a) =>-   T n a-zeroPrimitive = Cons $ Value $ LLVM.value LLVM.zero--phisPrimitive ::-   (TypeNum.Positive n, IsPrimitive a, Repr (Value n) a ~ Value n a) =>-   LLVM.BasicBlock -> T n a -> LLVM.CodeGenFunction r (T n a)-phisPrimitive bb (Cons (Value a)) = fmap (Cons . Value) $ Loop.phis bb a--addPhisPrimitive ::-   (TypeNum.Positive n, IsPrimitive a, Repr (Value n) a ~ Value n a) =>-   LLVM.BasicBlock -> T n a -> T n a -> LLVM.CodeGenFunction r ()-addPhisPrimitive bb (Cons (Value a)) (Cons (Value b)) = Loop.addPhis bb a b---shuffleMatchPrimitive ::-   (TypeNum.Positive n, IsPrimitive a,-    Repr LLVM.Value a ~ LLVM.Value a,-    Repr (Value n) a ~ Value n a) =>-   LLVM.ConstValue (LLVM.Vector n Word32) -> T n a -> CodeGenFunction r (T n a)-shuffleMatchPrimitive k (Cons (Value v)) =-   fmap (Cons . Value) $ LLVM.shufflevector v (value LLVM.undef) k--extractPrimitive ::-   (TypeNum.Positive n, IsPrimitive a,-    Repr LLVM.Value a ~ LLVM.Value a,-    Repr (Value n) a ~ Value n a) =>-   LLVM.Value Word32 -> T n a -> CodeGenFunction r (MultiValue.T a)-extractPrimitive k (Cons (Value v)) =-   fmap MultiValue.Cons $ LLVM.extractelement v k--insertPrimitive ::-   (TypeNum.Positive n, IsPrimitive a,--- this constraint is accepted, but does not help---    Repr f a ~ f a,-    Repr LLVM.Value a ~ LLVM.Value a,-    Repr (Value n) a ~ Value n a) =>-   LLVM.Value Word32 ->-   MultiValue.T a -> T n a -> CodeGenFunction r (T n a)-insertPrimitive k (MultiValue.Cons a) (Cons (Value v)) =-   fmap (Cons . Value) $ LLVM.insertelement v a k---instance (C a, C b) => C (a,b) where-   undef = zip undef undef-   zero = zip zero zero--   phis bb a =-      case unzip a of-         (a0,a1) ->-            Monad.lift2 zip (phis bb a0) (phis bb a1)-   addPhis bb a b =-      case (unzip a, unzip b) of-         ((a0,a1), (b0,b1)) ->-            addPhis bb a0 b0 >>-            addPhis bb a1 b1--   shuffleMatch is v =-      case unzip v of-         (v0,v1) ->-            Monad.lift2 zip-               (shuffleMatch is v0)-               (shuffleMatch is v1)--   extract k v =-      case unzip v of-         (v0,v1) ->-            Monad.lift2 MultiValue.zip-               (extract k v0)-               (extract k v1)--   insert k a v =-      case (MultiValue.unzip a, unzip v) of-         ((a0,a1), (v0,v1)) ->-            Monad.lift2 zip-               (insert k a0 v0)-               (insert k a1 v1)---instance (C a, C b, C c) => C (a,b,c) where-   undef = zip3 undef undef undef-   zero = zip3 zero zero zero--   phis bb a =-      case unzip3 a of-         (a0,a1,a2) ->-            Monad.lift3 zip3 (phis bb a0) (phis bb a1) (phis bb a2)-   addPhis bb a b =-      case (unzip3 a, unzip3 b) of-         ((a0,a1,a2), (b0,b1,b2)) ->-            addPhis bb a0 b0 >>-            addPhis bb a1 b1 >>-            addPhis bb a2 b2--   shuffleMatch is v =-      case unzip3 v of-         (v0,v1,v2) ->-            Monad.lift3 zip3-               (shuffleMatch is v0)-               (shuffleMatch is v1)-               (shuffleMatch is v2)--   extract k v =-      case unzip3 v of-         (v0,v1,v2) ->-            Monad.lift3 MultiValue.zip3-               (extract k v0)-               (extract k v1)-               (extract k v2)--   insert k a v =-      case (MultiValue.unzip3 a, unzip3 v) of-         ((a0,a1,a2), (v0,v1,v2)) ->-            Monad.lift3 zip3-               (insert k a0 v0)-               (insert k a1 v1)-               (insert k a2 v2)---class (C a) => IntegerConstant a where-   fromInteger' :: (TypeNum.Positive n) => Integer -> T n a--class (IntegerConstant a) => RationalConstant a where-   fromRational' :: (TypeNum.Positive n) => Rational -> T n a--instance IntegerConstant Float  where fromInteger' = Cons . Value . LLVM.value . SoV.constFromInteger-instance IntegerConstant Double where fromInteger' = Cons . Value . LLVM.value . SoV.constFromInteger--instance RationalConstant Float  where fromRational' = Cons . Value . LLVM.value . SoV.constFromRational-instance RationalConstant Double where fromRational' = Cons . Value . LLVM.value . SoV.constFromRational---instance-   (TypeNum.Positive n, IntegerConstant a) =>-      A.IntegerConstant (T n a) where-   fromInteger' = fromInteger'--instance-   (TypeNum.Positive n, RationalConstant a) =>-      A.RationalConstant (T n a) where-   fromRational' = fromRational'---modify ::-   (TypeNum.Positive n, C a) =>-   LLVM.Value Word32 ->-   (MultiValue.T a -> CodeGenFunction r (MultiValue.T a)) ->-   (T n a -> CodeGenFunction r (T n a))-modify k f v =-   flip (insert k) v =<< f =<< extract k v---assemble ::-   (TypeNum.Positive n, C a) =>-   [MultiValue.T a] -> CodeGenFunction r (T n a)-assemble =-   foldM (\v (k,x) -> insert (valueOf k) x v) undef .-   List.zip [0..]--dissect ::-   (TypeNum.Positive n, C a) =>-   T n a -> LLVM.CodeGenFunction r [MultiValue.T a]-dissect = sequence . dissectList--dissectList ::-   (TypeNum.Positive n, C a) =>-   T n a -> [LLVM.CodeGenFunction r (MultiValue.T a)]-dissectList x =-   List.map-      (flip extract x . LLVM.valueOf)-      (take (size x) [0..])---map ::-   (TypeNum.Positive n, C a, C b) =>-   (MultiValue.T a -> CodeGenFunction r (MultiValue.T b)) ->-   (T n a -> CodeGenFunction r (T n b))-map f  =  assemble <=< mapM f <=< dissect---replicate ::-   (TypeNum.Positive n, C a) =>-   MultiValue.T a -> CodeGenFunction r (T n a)-replicate = replicateCore TypeNum.singleton--replicateCore ::-   (TypeNum.Positive n, C a) =>-   TypeNum.Singleton n -> MultiValue.T a -> CodeGenFunction r (T n a)-replicateCore n =-   assemble . List.replicate (TypeNum.integralFromSingleton n)---iterate ::-   (TypeNum.Positive n, C a) =>-   (MultiValue.T a -> CodeGenFunction r (MultiValue.T a)) ->-   MultiValue.T a -> CodeGenFunction r (T n a)-iterate f x =-   fmap snd $-   iterateCore f x Class.undefTuple--iterateCore ::-   (TypeNum.Positive n, C a) =>-   (MultiValue.T a -> CodeGenFunction r (MultiValue.T a)) ->-   MultiValue.T a -> T n a ->-   CodeGenFunction r (MultiValue.T a, T n a)-iterateCore f x0 v0 =-   foldM-      (\(x,v) k ->-         Monad.lift2 (,) (f x)-            (insert (valueOf k) x v))-      (x0,v0)-      (take (size v0) [0..])----- * re-ordering of elements--constCyclicVector ::-   (LLVM.IsConst a, TypeNum.Positive n) =>-   NonEmpty.T [] a -> LLVM.ConstValue (LLVM.Vector n a)-constCyclicVector =-   LLVM.constCyclicVector . fmap LLVM.constOf--{- |-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 ::-   (TypeNum.Positive n, C a) =>-   T n a -> CodeGenFunction r (T n a)-rotateUp x =-   shuffleMatch-      (constCyclicVector $-       (fromIntegral (size x) - 1) !: [0..]) x--rotateDown ::-   (TypeNum.Positive n, C a) =>-   T n a -> CodeGenFunction r (T n a)-rotateDown x =-   shuffleMatch-      (constCyclicVector $-       NonEmpty.snoc (List.take (size x - 1) [1..]) 0) x--reverse ::-   (TypeNum.Positive n, C a) =>-   T n a -> CodeGenFunction r (T n a)-reverse x =-   shuffleMatch-      (constCyclicVector $-       maybe (error "vector size must be positive") NonEmpty.reverse $-       NonEmpty.fetch $-       List.take (size x) [0..])-      x--shiftUp ::-   (TypeNum.Positive n, C a) =>-   MultiValue.T a -> T n a -> CodeGenFunction r (MultiValue.T a, T n a)-shiftUp x0 x = do-   y <--      shuffleMatch-         (LLVM.constCyclicVector $ LLVM.undef !: List.map LLVM.constOf [0..]) x-   Monad.lift2 (,)-      (extract (LLVM.valueOf (fromIntegral (size x) - 1)) x)-      (insert (value LLVM.zero) x0 y)--shiftDown ::-   (TypeNum.Positive n, C a) =>-   MultiValue.T a -> T n a -> CodeGenFunction r (MultiValue.T a, T n a)-shiftDown x0 x = do-   y <--      shuffleMatch-         (LLVM.constCyclicVector $-          NonEmpty.snoc-             (List.map LLVM.constOf $ List.take (size x - 1) [1..])-             LLVM.undef) x-   Monad.lift2 (,)-      (extract (value LLVM.zero) x)-      (insert (LLVM.valueOf (fromIntegral (size x) - 1)) x0 y)--shiftUpMultiZero ::-   (TypeNum.Positive n, C a, Class.ValueTuple a ~ al, Class.Zero al) =>-   Int -> T n a -> LLVM.CodeGenFunction r (T n a)-shiftUpMultiZero n v =-   assemble . take (size v) .-   (List.replicate n MultiValue.zero ++) =<< dissect v--shiftDownMultiZero ::-   (TypeNum.Positive n, C a, Class.ValueTuple a ~ al, Class.Zero al) =>-   Int -> T n a -> LLVM.CodeGenFunction r (T n a)-shiftDownMultiZero n v =-   assemble . take (size v) .-   (++ List.repeat MultiValue.zero) . List.drop n-      =<< dissect v----- * method implementations based on Traversable--shuffleMatchTraversable ::-   (TypeNum.Positive n, C a, Trav.Traversable f) =>-   LLVM.ConstValue (LLVM.Vector n Word32) ->-   f (T n a) -> CodeGenFunction r (f (T n a))-shuffleMatchTraversable is v =-   Trav.mapM (shuffleMatch is) v--insertTraversable ::-   (TypeNum.Positive n, C a, Trav.Traversable f, App.Applicative f) =>-   LLVM.Value Word32 -> f (MultiValue.T a) ->-   f (T n a) -> CodeGenFunction r (f (T n a))-insertTraversable n a v =-   Trav.sequence (liftA2 (insert n) a v)--extractTraversable ::-   (TypeNum.Positive n, C a, Trav.Traversable f) =>-   LLVM.Value Word32 -> f (T n a) ->-   CodeGenFunction r (f (MultiValue.T a))-extractTraversable n v =-   Trav.mapM (extract n) v---type PrimValue n a = LLVM.Value (LLVM.Vector n a)---lift1 :: (Repr (Value n) a -> Repr (Value n) b) -> T n a -> T n b-lift1 f (Cons a) = Cons $ f a--_liftM0 ::-   (Monad m) =>-   m (Repr (Value n) a) ->-   m (T n a)-_liftM0 f = Monad.lift Cons f--liftM0 ::-   (Monad m,-    Repr (Value n) a ~ Value n a) =>-   m (PrimValue n a) ->-   m (T n a)-liftM0 f = Monad.lift consPrim f--liftM ::-   (Monad m,-    Repr (Value n) a ~ Value n a,-    Repr (Value n) b ~ Value n b) =>-   (PrimValue n a -> m (PrimValue n b)) ->-   T n a -> m (T n b)-liftM f a = Monad.lift consPrim $ f (deconsPrim a)--liftM2 ::-   (Monad m,-    Repr (Value n) a ~ Value n a,-    Repr (Value n) b ~ Value n b,-    Repr (Value n) c ~ Value n c) =>-   (PrimValue n a -> PrimValue n b -> m (PrimValue n c)) ->-   T n a -> T n b -> m (T n c)-liftM2 f a b = Monad.lift consPrim $ f (deconsPrim a) (deconsPrim b)----class (MultiValue.Additive a, C a) => Additive a where-   add ::-      (TypeNum.Positive n) =>-      T n a -> T n a -> LLVM.CodeGenFunction r (T n a)-   sub ::-      (TypeNum.Positive n) =>-      T n a -> T n a -> LLVM.CodeGenFunction r (T n a)-   neg ::-      (TypeNum.Positive n) =>-      T n a -> LLVM.CodeGenFunction r (T n a)--instance Additive Float where-   add = liftM2 LLVM.add-   sub = liftM2 LLVM.sub-   neg = liftM LLVM.neg--instance Additive Double where-   add = liftM2 LLVM.add-   sub = liftM2 LLVM.sub-   neg = liftM LLVM.neg--instance (TypeNum.Positive n, Additive a) => A.Additive (T n a) where-   zero = zero-   add = add-   sub = sub-   neg = neg---class (MultiValue.PseudoRing a, Additive a) => PseudoRing a where-   mul ::-      (TypeNum.Positive n) =>-      T n a -> T n a -> LLVM.CodeGenFunction r (T n a)--instance PseudoRing Float where-   mul = liftM2 LLVM.mul--instance PseudoRing Double where-   mul = liftM2 LLVM.mul--instance (TypeNum.Positive n, PseudoRing a) => A.PseudoRing (T n a) where-   mul = mul---class (MultiValue.Field a, PseudoRing a) => Field a where-   fdiv ::-      (TypeNum.Positive n) =>-      T n a -> T n a -> LLVM.CodeGenFunction r (T n a)--instance Field Float where-   fdiv = liftM2 LLVM.fdiv--instance Field Double where-   fdiv = liftM2 LLVM.fdiv--instance (TypeNum.Positive n, Field a) => A.Field (T n a) where-   fdiv = fdiv---type instance A.Scalar (T n a) = T n (MultiValue.Scalar a)--class-   (MultiValue.PseudoModule v, PseudoRing (MultiValue.Scalar v), Additive v) =>-      PseudoModule v where-   scale ::-      (TypeNum.Positive n) =>-      T n (MultiValue.Scalar v) -> T n v -> LLVM.CodeGenFunction r (T n v)--instance PseudoModule Float where-   scale = liftM2 A.mul--instance PseudoModule Double where-   scale = liftM2 A.mul--instance (TypeNum.Positive n, PseudoModule a) => A.PseudoModule (T n a) where-   scale = scale---class (MultiValue.Real a, Additive a) => Real a where-   min :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)-   max :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)-   abs :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)-   signum :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)--instance Real Float where-   min = liftM2 A.min-   max = liftM2 A.max-   abs = liftM A.abs-   signum = liftM A.signum--instance Real Double where-   min = liftM2 A.min-   max = liftM2 A.max-   abs = liftM A.abs-   signum = liftM A.signum--instance (TypeNum.Positive n, Real a) => A.Real (T n a) where-   min = min-   max = max-   abs = abs-   signum = signum---class (MultiValue.Fraction a, Real a) => Fraction a where-   truncate :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)-   fraction :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)--instance Fraction Float where-   truncate = liftM A.truncate-   fraction = liftM A.fraction--instance Fraction Double where-   truncate = liftM A.truncate-   fraction = liftM A.fraction--instance (TypeNum.Positive n, Fraction a) => A.Fraction (T n a) where-   truncate = truncate-   fraction = fraction---class (MultiValue.Algebraic a, Field a) => Algebraic a where-   sqrt :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)--instance Algebraic Float where-   sqrt = liftM A.sqrt--instance Algebraic Double where-   sqrt = liftM A.sqrt--instance (TypeNum.Positive n, Algebraic a) => A.Algebraic (T n a) where-   sqrt = sqrt---class (MultiValue.Transcendental a, Algebraic a) => Transcendental a where-   pi :: (TypeNum.Positive n) => LLVM.CodeGenFunction r (T n a)-   sin, cos, exp, log ::-      (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)-   pow :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)--instance Transcendental Float where-   pi = liftM0 A.pi-   sin = liftM A.sin-   cos = liftM A.cos-   exp = liftM A.exp-   log = liftM A.log-   pow = liftM2 A.pow--instance Transcendental Double where-   pi = liftM0 A.pi-   sin = liftM A.sin-   cos = liftM A.cos-   exp = liftM A.exp-   log = liftM A.log-   pow = liftM2 A.pow--instance (TypeNum.Positive n, Transcendental a) => A.Transcendental (T n a) where-   pi = pi-   sin = sin-   cos = cos-   exp = exp-   log = log-   pow = pow----class (MultiValue.Comparison a, C a) => Comparison a where-   cmp ::-      (TypeNum.Positive n) =>-      LLVM.CmpPredicate -> T n a -> T n a ->-      LLVM.CodeGenFunction r (T n Bool)--instance Comparison Float where-   cmp = liftM2 . LLVM.cmp--instance Comparison Double where-   cmp = liftM2 . LLVM.cmp--instance (TypeNum.Positive n, Comparison a) => A.Comparison (T n a) where-   type CmpResult (T n a) = T n Bool-   cmp = cmp----class-   (MultiValue.FloatingComparison a, Comparison a) =>-      FloatingComparison a where-   fcmp ::-      (TypeNum.Positive n) =>-      LLVM.FPPredicate -> T n a -> T n a ->-      LLVM.CodeGenFunction r (T n Bool)--instance FloatingComparison Float where-   fcmp = liftM2 . LLVM.fcmp--instance-   (TypeNum.Positive n, FloatingComparison a) =>-      A.FloatingComparison (T n a) where-   fcmp = fcmp----class (MultiValue.Logic a, C a) => Logic a where-   and :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)-   or :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)-   xor :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)-   inv :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)--instance Logic Bool where-   and = liftM2 LLVM.and-   or = liftM2 LLVM.or-   xor = liftM2 LLVM.xor-   inv = liftM LLVM.inv---instance (TypeNum.Positive n, Logic a) => A.Logic (T n a) where-   and = and-   or = or-   xor = xor-   inv = inv----class BitShift a where-   shl :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)-   shr :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)--instance BitShift Word8 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr--instance BitShift Word16 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr--instance BitShift Word32 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr--instance BitShift Word64 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr--instance BitShift Int8 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr--instance BitShift Int16 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr--instance BitShift Int32 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr+module LLVM.Extra.Multi.Vector+   {-# DEPRECATED "Use LLVM.Extra.Nice.Vector instead." #-}+   (module LLVM.Extra.Nice.Vector) where -instance BitShift Int64 where-   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr+import LLVM.Extra.Nice.Vector
+ src/LLVM/Extra/Multi/Vector/Instance.hs view
@@ -0,0 +1,36 @@+module LLVM.Extra.Multi.Vector.Instance+   {-# DEPRECATED "Use LLVM.Extra.Nice.Vector.Instance instead." #-}+   where++import qualified LLVM.Extra.Nice.Vector.Instance as Inst+import qualified LLVM.Extra.Nice.Vector as Vector++import Prelude2010+import Prelude ()+++type MVVector n a = Inst.NVVector n a++toMultiValue :: Vector.T n a -> MVVector n a+toMultiValue = Inst.toNiceValue++fromMultiValue :: MVVector n a -> Vector.T n a+fromMultiValue = Inst.fromNiceValue++liftMultiValueM ::+   (Functor f) =>+   (Vector.T n a -> f (Vector.T m b)) ->+   (MVVector n a -> f (MVVector m b))+liftMultiValueM = Inst.liftNiceValueM++liftMultiValueM2 ::+   (Functor f) =>+   (Vector.T n a -> Vector.T m b -> f (Vector.T k c)) ->+   (MVVector n a -> MVVector m b -> f (MVVector k c))+liftMultiValueM2 = Inst.liftNiceValueM2++liftMultiValueM3 ::+   (Functor f) =>+   (Vector.T n a -> Vector.T m b -> Vector.T m c -> f (Vector.T k d)) ->+   (MVVector n a -> MVVector m b -> MVVector m c -> f (MVVector k d))+liftMultiValueM3 = Inst.liftNiceValueM3
− src/LLVM/Extra/Multi/Vector/Memory.hs 
@@ -1,67 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeOperators #-}-module LLVM.Extra.Multi.Vector.Memory where--import qualified LLVM.Extra.Multi.Vector as MultiVector-import LLVM.Extra.MemoryPrivate (decomposeFromLoad, composeFromStore, )--import qualified LLVM.Core as LLVM-import LLVM.Core (CodeGenFunction, Value, )--import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal ((:*:), )--import Foreign.Ptr (Ptr, )--import Control.Applicative (liftA2, )---class-   (TypeNum.Positive n, MultiVector.C a, LLVM.IsSized (Struct n a)) =>-      C n a where-   {-# MINIMAL (load|decompose), (store|compose) #-}-   type Struct n a :: *-   load :: Value (Ptr (Struct n a)) -> CodeGenFunction r (MultiVector.T n a)-   load ptr  =  decompose =<< LLVM.load ptr-   store :: MultiVector.T n a -> Value (Ptr (Struct n a)) -> CodeGenFunction r ()-   store r ptr  =  flip LLVM.store ptr =<< compose r-   decompose :: Value (Struct n a) -> CodeGenFunction r (MultiVector.T n a)-   decompose = decomposeFromLoad load-   compose :: MultiVector.T n a -> CodeGenFunction r (Value (Struct n a))-   compose = composeFromStore store--instance-   (TypeNum.Positive n, TypeNum.Positive (n :*: TypeNum.D32)) =>-      C n Float where-   type Struct n Float = LLVM.Vector n Float-   load = fmap MultiVector.consPrim . LLVM.load-   store = LLVM.store . MultiVector.deconsPrim-   decompose = return . MultiVector.consPrim-   compose = return . MultiVector.deconsPrim--instance-   (TypeNum.Positive n, TypeNum.Positive (n :*: TypeNum.D64)) =>-      C n Double where-   type Struct n Double = LLVM.Vector n Double-   load = fmap MultiVector.consPrim . LLVM.load-   store = LLVM.store . MultiVector.deconsPrim-   decompose = return . MultiVector.consPrim-   compose = return . MultiVector.deconsPrim--instance (C n a, C n b) => C n (a,b) where-   type Struct n (a,b) = (LLVM.Struct (Struct n a, (Struct n b, ())))-   decompose ab =-      liftA2 MultiVector.zip-         (decompose =<< LLVM.extractvalue ab TypeNum.d0)-         (decompose =<< LLVM.extractvalue ab TypeNum.d1)-   compose ab =-      case MultiVector.unzip ab of-         (a,b) -> do-            sa <- compose a-            sb <- compose b-            ra <- LLVM.insertvalue (LLVM.value LLVM.undef) sa TypeNum.d0-            LLVM.insertvalue ra sb TypeNum.d1
+ src/LLVM/Extra/Nice/Class.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module LLVM.Extra.Nice.Class where++import qualified LLVM.Extra.Nice.Value as NiceValue+import qualified LLVM.Extra.Nice.Vector as NiceVector+import qualified LLVM.Extra.Arithmetic as A++import qualified LLVM.Core as LLVM++import qualified Type.Data.Num.Decimal as TypeNum+++class C value where+   type Size value+   switch ::+      f NiceValue.T ->+      f (NiceVector.T (Size value)) ->+      f value++instance C NiceValue.T where+   type Size NiceValue.T = TypeNum.D1+   switch x _ = x++instance (TypeNum.Positive n) => C (NiceVector.T n) where+   type Size (NiceVector.T n) = n+   switch _ x = x+++newtype Const a value = Const {getConst :: value a}++undef ::+   (C value, Size value ~ n, TypeNum.Positive n, NiceVector.C a) =>+   value a+undef =+   getConst $+   switch+      (Const NiceValue.undef)+      (Const NiceVector.undef)++zero ::+   (C value, Size value ~ n, TypeNum.Positive n, NiceVector.C a) =>+   value a+zero =+   getConst $+   switch+      (Const NiceValue.zero)+      (Const NiceVector.zero)+++newtype+   Op0 r a value =+      Op0 {runOp0 :: LLVM.CodeGenFunction r (value a)}++newtype+   Op1 r a b value =+      Op1 {runOp1 :: value a -> LLVM.CodeGenFunction r (value b)}++newtype+   Op2 r a b c value =+      Op2 {runOp2 :: value a -> value b -> LLVM.CodeGenFunction r (value c)}++add, sub ::+   (TypeNum.Positive n, NiceVector.Additive a,+    n ~ Size value, C value) =>+   value a -> value a -> LLVM.CodeGenFunction r (value a)+add = runOp2 $ switch (Op2 A.add) (Op2 A.add)+sub = runOp2 $ switch (Op2 A.sub) (Op2 A.sub)++neg ::+   (TypeNum.Positive n, NiceVector.Additive a,+    n ~ Size value, C value) =>+   value a -> LLVM.CodeGenFunction r (value a)+neg = runOp1 $ switch (Op1 A.neg) (Op1 A.neg)+++mul ::+   (TypeNum.Positive n, NiceVector.PseudoRing a,+    n ~ Size value, C value) =>+   value a -> value a -> LLVM.CodeGenFunction r (value a)+mul = runOp2 $ switch (Op2 A.mul) (Op2 A.mul)+fdiv ::+   (TypeNum.Positive n, NiceVector.Field a,+    n ~ Size value, C value) =>+   value a -> value a -> LLVM.CodeGenFunction r (value a)+fdiv = runOp2 $ switch (Op2 A.fdiv) (Op2 A.fdiv)++scale ::+   (TypeNum.Positive n, NiceVector.PseudoModule v,+    n ~ Size value, C value) =>+   value (NiceValue.Scalar v) -> value v -> LLVM.CodeGenFunction r (value v)+scale = runOp2 $ switch (Op2 A.scale) (Op2 A.scale)++min, max ::+   (TypeNum.Positive n, NiceVector.Real a,+    n ~ Size value, C value) =>+   value a -> value a -> LLVM.CodeGenFunction r (value a)+min = runOp2 $ switch (Op2 A.min) (Op2 A.min)+max = runOp2 $ switch (Op2 A.max) (Op2 A.max)++abs, signum ::+   (TypeNum.Positive n, NiceVector.Real a,+    n ~ Size value, C value) =>+   value a -> LLVM.CodeGenFunction r (value a)+abs = runOp1 $ switch (Op1 A.abs) (Op1 A.abs)+signum = runOp1 $ switch (Op1 A.signum) (Op1 A.signum)++truncate, fraction ::+   (TypeNum.Positive n, NiceVector.Fraction a,+    n ~ Size value, C value) =>+   value a -> LLVM.CodeGenFunction r (value a)+truncate = runOp1 $ switch (Op1 A.truncate) (Op1 A.truncate)+fraction = runOp1 $ switch (Op1 A.fraction) (Op1 A.fraction)++sqrt ::+   (TypeNum.Positive n, NiceVector.Algebraic a,+    n ~ Size value, C value) =>+   value a -> LLVM.CodeGenFunction r (value a)+sqrt = runOp1 $ switch (Op1 A.sqrt) (Op1 A.sqrt)++pi ::+   (TypeNum.Positive n, NiceVector.Transcendental a,+    n ~ Size value, C value) =>+   LLVM.CodeGenFunction r (value a)+pi = runOp0 $ switch (Op0 A.pi) (Op0 A.pi)++sin, cos, exp, log ::+   (TypeNum.Positive n, NiceVector.Transcendental a,+    n ~ Size value, C value) =>+   value a -> LLVM.CodeGenFunction r (value a)+sin = runOp1 $ switch (Op1 A.sin) (Op1 A.sin)+cos = runOp1 $ switch (Op1 A.cos) (Op1 A.cos)+exp = runOp1 $ switch (Op1 A.exp) (Op1 A.exp)+log = runOp1 $ switch (Op1 A.log) (Op1 A.log)++pow ::+   (TypeNum.Positive n, NiceVector.Transcendental a,+    n ~ Size value, C value) =>+   value a -> value a -> LLVM.CodeGenFunction r (value a)+pow = runOp2 $ switch (Op2 A.pow) (Op2 A.pow)+++cmp ::+   (TypeNum.Positive n, NiceVector.Comparison a,+    n ~ Size value, C value) =>+   LLVM.CmpPredicate ->+   value a -> value a -> LLVM.CodeGenFunction r (value Bool)+cmp p = runOp2 $ switch (Op2 $ A.cmp p) (Op2 $ A.cmp p)++fcmp ::+   (TypeNum.Positive n, NiceVector.FloatingComparison a,+    n ~ Size value, C value) =>+   LLVM.FPPredicate ->+   value a -> value a -> LLVM.CodeGenFunction r (value Bool)+fcmp p = runOp2 $ switch (Op2 $ A.fcmp p) (Op2 $ A.fcmp p)+++and, or, xor ::+   (TypeNum.Positive n, NiceVector.Logic a,+    n ~ Size value, C value) =>+   value a -> value a -> LLVM.CodeGenFunction r (value a)+and = runOp2 $ switch (Op2 A.and) (Op2 A.and)+or = runOp2 $ switch (Op2 A.or) (Op2 A.or)+xor = runOp2 $ switch (Op2 A.xor) (Op2 A.xor)++inv ::+   (TypeNum.Positive n, NiceVector.Logic a,+    n ~ Size value, C value) =>+   value a -> LLVM.CodeGenFunction r (value a)+inv = runOp1 $ switch (Op1 A.inv) (Op1 A.inv)
+ src/LLVM/Extra/Nice/Iterator.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE TypeFamilies #-}+module LLVM.Extra.Nice.Iterator (+   takeWhile,+   countDown,+   take,+   Enum(..),+   ) where++import qualified LLVM.Extra.Nice.Value as NiceValue+import qualified LLVM.Extra.Iterator as Iter+import qualified LLVM.Extra.ScalarOrVector as SoV+import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.Extra.MaybePrivate as Maybe+import qualified LLVM.Extra.Arithmetic as A+import qualified LLVM.Extra.Control as C++import qualified LLVM.Core as LLVM+import LLVM.Core (CodeGenFunction)++import Control.Applicative (liftA2)++import qualified Data.Enum.Storable as Enum++import qualified Prelude as P+import Prelude hiding (take, takeWhile, Enum, enumFrom, enumFromTo)++++takeWhile ::+   (a -> CodeGenFunction r (NiceValue.T Bool)) ->+   Iter.T r a -> Iter.T r a+takeWhile p = Iter.takeWhile (fmap unpackBool . p)++unpackBool :: NiceValue.T Bool -> LLVM.Value Bool+unpackBool (NiceValue.Cons b) = b++countDown ::+   (NiceValue.Additive i, NiceValue.Comparison i,+    NiceValue.IntegerConstant i) =>+   NiceValue.T i -> Iter.T r (NiceValue.T i)+countDown len =+   takeWhile (NiceValue.cmp LLVM.CmpLT NiceValue.zero) $+   Iter.iterate NiceValue.dec len++take ::+   (NiceValue.Additive i, NiceValue.Comparison i,+    NiceValue.IntegerConstant i) =>+   NiceValue.T i -> Iter.T r a -> Iter.T r a+take len xs = liftA2 const xs (countDown len)+++class (NiceValue.C a) => Enum a where+   succ, pred :: NiceValue.T a -> LLVM.CodeGenFunction r (NiceValue.T a)+   enumFrom :: NiceValue.T a -> Iter.T r (NiceValue.T a)+   enumFromTo :: NiceValue.T a -> NiceValue.T a -> Iter.T r (NiceValue.T a)++instance+   (LLVM.IsInteger w, SoV.IntegerConstant w, Num w,+    LLVM.CmpRet w, LLVM.IsPrimitive w, P.Enum e) =>+      Enum (Enum.T w e) where+   succ = NiceValue.succ+   pred = NiceValue.pred+   enumFrom = Iter.iterate NiceValue.succ+   {- |+   More complicated than 'enumFromToSimple'+   but works also for e.g. [0 .. (0xFFFF::Word16)].+   -}+   enumFromTo from to =+      Iter.takeWhileJust $+      Iter.iterate (Maybe.maybeArg Tuple.undef (succMax to)) (Maybe.just from)++succMax ::+   (LLVM.IsInteger w, SoV.IntegerConstant w, Num w,+    LLVM.CmpRet w, LLVM.IsPrimitive w, P.Enum e) =>+   NiceValue.T (Enum.T w e) ->+   NiceValue.T (Enum.T w e) ->+   LLVM.CodeGenFunction r (Maybe.T (NiceValue.T (Enum.T w e)))+succMax to e = do+   NiceValue.Cons less <- NiceValue.cmpEnum A.CmpLT e to+   C.ifThen less (Maybe.nothing Tuple.undef) $+      fmap Maybe.just $ NiceValue.succ e++{- |+Warning: For [0 .. (0xFFFF::Word16)]+it would compute an undefined @0xFFFF+1@.+In modulo arithmetic it would enter an infinite loop.+-}+_enumFromToSimple ::+   (LLVM.IsInteger w, SoV.IntegerConstant w, Num w,+    LLVM.CmpRet w, LLVM.IsPrimitive w, P.Enum e) =>+   NiceValue.T (Enum.T w e) ->+   NiceValue.T (Enum.T w e) ->+   Iter.T r (NiceValue.T (Enum.T w e))+_enumFromToSimple from to =+   takeWhile (NiceValue.cmpEnum LLVM.CmpGE to) $ enumFrom from
+ src/LLVM/Extra/Nice/Value.hs view
@@ -0,0 +1,8 @@+module LLVM.Extra.Nice.Value (+   module LLVM.Extra.Nice.Value.Private,+   Array(..), withArraySize, extractArrayValue, insertArrayValue,+   ) where++import LLVM.Extra.Nice.Vector.Instance ()+import LLVM.Extra.Nice.Value.Array+import LLVM.Extra.Nice.Value.Private
+ src/LLVM/Extra/Nice/Value/Array.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+module LLVM.Extra.Nice.Value.Array where++import qualified LLVM.Extra.Memory as Memory+import qualified LLVM.Extra.Nice.Value.Marshal as Marshal+import qualified LLVM.Extra.Nice.Value.Private as NiceValue+import LLVM.Extra.Nice.Value.Private (Repr)++import qualified LLVM.Core as LLVM++import qualified Type.Data.Num.Decimal as TypeNum+import qualified Type.Data.Num.Decimal.Number as Dec+import Type.Base.Proxy (Proxy(Proxy))++import Control.Applicative (Applicative(pure, (<*>)))++import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold+import Data.Functor.Identity (Identity(Identity, runIdentity))+import Data.Functor ((<$>))++import Prelude2010+import Prelude ()++++newtype Array n a = Array [a]+   deriving (Eq, Show)++instance (Dec.Integer n) => Functor (Array n) where+   fmap f (Array xs) = Array (map f xs)++instance (Dec.Integer n) => Applicative (Array n) where+   pure x =+      runIdentity $ withArraySize $+         \n -> Identity $ Array $ replicate (Dec.integralFromProxy n) x+   Array fs <*> Array xs = Array $ zipWith id fs xs++instance (Dec.Integer n) => Fold.Foldable (Array n) where+   foldMap f (Array xs) = Fold.foldMap f xs++instance (Dec.Integer n) => Trav.Traversable (Array n) where+   traverse f (Array xs) = Array <$> Trav.traverse f xs++withArraySize :: (Proxy n -> gen (Array n a)) -> gen (Array n a)+withArraySize f = f Proxy+++instance (TypeNum.Natural n, Marshal.C a) => NiceValue.C (Array n a) where+   type Repr (Array n a) = LLVM.Value (LLVM.Array n (Marshal.Struct a))+   cons (Array xs) = NiceValue.consPrimitive $ LLVM.Array $ map Marshal.pack xs+   undef = NiceValue.undefPrimitive+   zero = NiceValue.zeroPrimitive+   phi = NiceValue.phiPrimitive+   addPhi = NiceValue.addPhiPrimitive++instance+   (TypeNum.Natural n, Marshal.C a,+    Dec.Natural (n Dec.:*: LLVM.SizeOf (Marshal.Struct a))) =>+      Marshal.C (Array n a) where+   pack (Array xs) = LLVM.Array $ map Marshal.pack xs+   unpack (LLVM.Array xs) = Array $ map Marshal.unpack xs++extractArrayValue ::+   (TypeNum.Natural n, LLVM.ArrayIndex n i, Marshal.C a) =>+   i -> NiceValue.T (Array n a) ->+   LLVM.CodeGenFunction r (NiceValue.T a)+extractArrayValue i (NiceValue.Cons arr) =+   NiceValue.Cons <$> (Memory.decompose =<< LLVM.extractvalue arr i)++insertArrayValue ::+   (TypeNum.Natural n, LLVM.ArrayIndex n i, Marshal.C a) =>+   i -> NiceValue.T a -> NiceValue.T (Array n a) ->+   LLVM.CodeGenFunction r (NiceValue.T (Array n a))+insertArrayValue i (NiceValue.Cons a) (NiceValue.Cons arr) =+   NiceValue.Cons <$> (flip (LLVM.insertvalue arr) i =<< Memory.compose a)
+ src/LLVM/Extra/Nice/Value/Marshal.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{- |+Transfer values between Haskell and JIT generated code+in an LLVM-compatible format.+E.g. 'Bool' is stored as 'i1' and occupies a byte,+@'Vector' n 'Bool'@ is stored as a bit vector,+@'Vector' n 'Word8'@ is stored in an order depending on machine endianess,+and Haskell tuples are stored as LLVM structs.+-}+module LLVM.Extra.Nice.Value.Marshal (+   C(..),+   Struct,+   peek,+   poke,++   VectorStruct,+   Vector(..),++   with,+   EE.alloca,+   ) where++import qualified LLVM.Extra.Nice.Vector as NiceVector+import qualified LLVM.Extra.Nice.Value.Private as NiceValue+import qualified LLVM.Extra.Memory as Memory+import LLVM.Extra.Nice.Vector.Instance ()++import qualified LLVM.ExecutionEngine as EE+import qualified LLVM.Core as LLVM++import qualified Type.Data.Num.Decimal as TypeNum++import qualified Control.Functor.HT as FuncHT+import Control.Applicative (liftA2, liftA3, (<$>))++import Foreign.Storable (Storable)+import Foreign.StablePtr (StablePtr)+import Foreign.Ptr (FunPtr, Ptr)++import Data.Complex (Complex((:+)))+import Data.Word (Word8, Word16, Word32, Word64, Word)+import Data.Int  (Int8,  Int16,  Int32,  Int64)++++peek ::+   (C a, Struct a ~ struct, EE.Marshal struct) => LLVM.Ptr struct -> IO a+peek ptr = unpack <$> EE.peek ptr++poke ::+   (C a, Struct a ~ struct, EE.Marshal struct) => LLVM.Ptr struct -> a -> IO ()+poke ptr = EE.poke ptr . pack+++type Struct a = Memory.Struct (NiceValue.Repr a)++class+   (NiceValue.C a, Memory.C (NiceValue.Repr a),+    EE.Marshal (Struct a), LLVM.IsConst (Struct a)) =>+      C a where+   pack :: a -> Struct a+   unpack :: Struct a -> a++instance C Bool   where pack = id; unpack = id+instance C Float  where pack = id; unpack = id+instance C Double where pack = id; unpack = id+instance C Word   where pack = id; unpack = id+instance C Word8  where pack = id; unpack = id+instance C Word16 where pack = id; unpack = id+instance C Word32 where pack = id; unpack = id+instance C Word64 where pack = id; unpack = id+instance C Int    where pack = id; unpack = id+instance C Int8   where pack = id; unpack = id+instance C Int16  where pack = id; unpack = id+instance C Int32  where pack = id; unpack = id+instance C Int64  where pack = id; unpack = id++instance (Storable a)        => C (Ptr a)       where pack = id; unpack = id+instance (LLVM.IsType a)     => C (LLVM.Ptr a)  where pack = id; unpack = id+instance (LLVM.IsFunction a) => C (FunPtr a)    where pack = id; unpack = id+instance                        C (StablePtr a) where pack = id; unpack = id++instance C () where+   pack = LLVM.Struct+   unpack (LLVM.Struct unit) = unit++instance (C a, C b) => C (a,b) where+   pack (a,b) = LLVM.consStruct (pack a) (pack b)+   unpack = LLVM.uncurryStruct $ \a b -> (unpack a, unpack b)++instance (C a, C b, C c) => C (a,b,c) where+   pack (a,b,c) = LLVM.consStruct (pack a) (pack b) (pack c)+   unpack = LLVM.uncurryStruct $ \a b c -> (unpack a, unpack b, unpack c)++instance (C a, C b, C c, C d) => C (a,b,c,d) where+   pack (a,b,c,d) = LLVM.consStruct (pack a) (pack b) (pack c) (pack d)+   unpack =+      LLVM.uncurryStruct $ \a b c d -> (unpack a, unpack b, unpack c, unpack d)+++instance (C a) => C (Complex a) where+   pack (a:+b) = LLVM.consStruct (pack a) (pack b)+   unpack = LLVM.uncurryStruct $ \a b -> unpack a :+ unpack b++++type VectorStruct n a = Memory.Struct (NiceVector.Repr n a)++class+   (TypeNum.Positive n, C a,+    NiceVector.C a, Memory.C (NiceVector.Repr n a),+    EE.Marshal (VectorStruct n a),+    LLVM.IsConst (VectorStruct n a)) =>+      Vector n a where+   packVector :: LLVM.Vector n a -> VectorStruct n a+   unpackVector :: VectorStruct n a -> LLVM.Vector n a++instance (TypeNum.Positive n, Vector n a) => C (LLVM.Vector n a) where+   pack = packVector; unpack = unpackVector+++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D1)) =>+      Vector n Bool where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D32)) =>+      Vector n Float where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D64)) =>+      Vector n Double where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: LLVM.IntSize)) =>+      Vector n Word where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D8)) =>+      Vector n Word8 where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D16)) =>+      Vector n Word16 where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D32)) =>+      Vector n Word32 where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D64)) =>+      Vector n Word64 where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: LLVM.IntSize)) =>+      Vector n Int where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D8)) =>+      Vector n Int8 where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D16)) =>+      Vector n Int16 where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D32)) =>+      Vector n Int32 where+   packVector = id+   unpackVector = id++instance+   (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D64)) =>+      Vector n Int64 where+   packVector = id+   unpackVector = id++instance (Vector n a, Vector n b) => Vector n (a,b) where+   packVector x =+      case FuncHT.unzip x of+         (a,b) -> LLVM.consStruct (packVector a) (packVector b)+   unpackVector = LLVM.uncurryStruct $ \a b ->+      liftA2 (,) (unpackVector a) (unpackVector b)++instance (Vector n a, Vector n b, Vector n c) => Vector n (a,b,c) where+   packVector x =+      case FuncHT.unzip3 x of+         (a,b,c) -> LLVM.consStruct (packVector a) (packVector b) (packVector c)+   unpackVector = LLVM.uncurryStruct $ \a b c ->+      liftA3 (,,) (unpackVector a) (unpackVector b) (unpackVector c)+++with :: (C a) => a -> (LLVM.Ptr (Struct a) -> IO b) -> IO b+with a act = EE.alloca $ \ptr -> poke ptr a >> act ptr
+ src/LLVM/Extra/Nice/Value/Private.hs view
@@ -0,0 +1,1491 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module LLVM.Extra.Nice.Value.Private where++import qualified LLVM.Extra.ScalarOrVector as SoV+import qualified LLVM.Extra.Arithmetic as A+import qualified LLVM.Extra.Control as C+import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.Extra.Struct as Struct++import qualified LLVM.ExecutionEngine as EE+import qualified LLVM.Core as LLVM+import LLVM.Core (WordN, IntN, )++import qualified Type.Data.Num.Decimal.Number as Dec++import qualified Foreign.Storable.Record.Tuple as StoreTuple+import Foreign.StablePtr (StablePtr, )+import Foreign.Ptr (Ptr, FunPtr, )++import qualified Control.Monad.HT as Monad+import qualified Control.Functor.HT as FuncHT+import Control.Monad (Monad, return, fmap, (>>), )+import Data.Functor (Functor, )++import qualified Data.Tuple.HT as TupleHT+import qualified Data.Tuple as Tup+import qualified Data.EnumBitSet as EnumBitSet+import qualified Data.Enum.Storable as Enum+import qualified Data.Bool8 as Bool8+import Data.Complex (Complex((:+)))+import Data.Tagged (Tagged(Tagged, unTagged))+import Data.Function (id, (.), ($), )+import Data.Maybe (Maybe(Nothing,Just), )+import Data.Bool (Bool(False,True), )+import Data.Word (Word8, Word16, Word32, Word64, Word)+import Data.Int (Int8, Int16, Int32, Int64, Int)+import Data.Bool8 (Bool8)++import qualified Prelude as P+import Prelude (Float, Double, Integer, Rational, )+++newtype T a = Cons (Repr a)+++class C a where+   type Repr a+   cons :: a -> T a+   undef :: T a+   zero :: T a+   phi :: LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)+   addPhi :: LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()++instance C Bool where+   type Repr Bool = LLVM.Value Bool+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance C Float where+   type Repr Float = LLVM.Value Float+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance C Double where+   type Repr Double = LLVM.Value Double+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance C Word where+   type Repr Word = LLVM.Value Word+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance C Word8 where+   type Repr Word8 = LLVM.Value Word8+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance C Word16 where+   type Repr Word16 = LLVM.Value Word16+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance C Word32 where+   type Repr Word32 = LLVM.Value Word32+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance C Word64 where+   type Repr Word64 = LLVM.Value Word64+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance (Dec.Positive n) => C (LLVM.WordN n) where+   type Repr (LLVM.WordN n) = LLVM.Value (LLVM.WordN n)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance C Int where+   type Repr Int = LLVM.Value Int+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance C Int8 where+   type Repr Int8 = LLVM.Value Int8+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance C Int16 where+   type Repr Int16 = LLVM.Value Int16+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance C Int32 where+   type Repr Int32 = LLVM.Value Int32+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance C Int64 where+   type Repr Int64 = LLVM.Value Int64+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance (Dec.Positive n) => C (LLVM.IntN n) where+   type Repr (LLVM.IntN n) = LLVM.Value (LLVM.IntN n)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance (LLVM.IsType a) => C (LLVM.Ptr a) where+   type Repr (LLVM.Ptr a) = LLVM.Value (LLVM.Ptr a)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance C (Ptr a) where+   type Repr (Ptr a) = LLVM.Value (Ptr a)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance (LLVM.IsFunction a) => C (FunPtr a) where+   type Repr (FunPtr a) = LLVM.Value (FunPtr a)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++instance C (StablePtr a) where+   type Repr (StablePtr a) = LLVM.Value (StablePtr a)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+++cast :: (Repr a ~ Repr b) => T a -> T b+cast (Cons a) = Cons a+++consPrimitive ::+   (LLVM.IsConst al, LLVM.Value al ~ Repr a) =>+   al -> T a+consPrimitive = Cons . LLVM.valueOf++undefPrimitive, zeroPrimitive ::+   (LLVM.IsType al, LLVM.Value al ~ Repr a) =>+   T a+undefPrimitive = Cons $ LLVM.value LLVM.undef+zeroPrimitive = Cons $ LLVM.value LLVM.zero++phiPrimitive ::+   (LLVM.IsFirstClass al, LLVM.Value al ~ Repr a) =>+   LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)+phiPrimitive bb (Cons a) = fmap Cons $ Tuple.phi bb a++addPhiPrimitive ::+   (LLVM.IsFirstClass al, LLVM.Value al ~ Repr a) =>+   LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()+addPhiPrimitive bb (Cons a) (Cons b) = Tuple.addPhi bb a b+++consTuple :: (Tuple.Value a, Repr a ~ Tuple.ValueOf a) => a -> T a+consTuple = Cons . Tuple.valueOf++undefTuple :: (Repr a ~ al, Tuple.Undefined al) => T a+undefTuple = Cons Tuple.undef++zeroTuple :: (Repr a ~ al, Tuple.Zero al) => T a+zeroTuple = Cons Tuple.zero++phiTuple ::+   (Repr a ~ al, Tuple.Phi al) =>+   LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)+phiTuple bb (Cons a) = fmap Cons $ Tuple.phi bb a++addPhiTuple ::+   (Repr a ~ al, Tuple.Phi al) =>+   LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()+addPhiTuple bb (Cons a) (Cons b) = Tuple.addPhi bb a b+++instance C () where+   type Repr () = ()+   cons = consUnit+   undef = undefUnit+   zero = zeroUnit+   phi = phiUnit+   addPhi = addPhiUnit++consUnit :: (Repr a ~ ()) => a -> T a+consUnit _ = Cons ()++undefUnit :: (Repr a ~ ()) => T a+undefUnit = Cons ()++zeroUnit :: (Repr a ~ ()) => T a+zeroUnit = Cons ()++phiUnit ::+   (Repr a ~ ()) =>+   LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)+phiUnit _bb (Cons ()) = return $ Cons ()++addPhiUnit ::+   (Repr a ~ ()) =>+   LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()+addPhiUnit _bb (Cons ()) (Cons ()) = return ()+++instance C Bool8 where+   type Repr Bool8 = LLVM.Value Bool+   cons = consPrimitive . Bool8.toBool+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++boolPFrom8 :: T Bool8 -> T Bool+boolPFrom8 (Cons b) = Cons b++bool8FromP :: T Bool -> T Bool8+bool8FromP (Cons b) = Cons b++intFromBool8 :: (NativeInteger i ir) => T Bool8 -> LLVM.CodeGenFunction r (T i)+intFromBool8 = liftM LLVM.zadapt++floatFromBool8 ::+   (NativeFloating a ar) => T Bool8 -> LLVM.CodeGenFunction r (T a)+floatFromBool8 = liftM LLVM.uitofp+++instance+   (LLVM.IsInteger w, LLVM.IsConst w, P.Num w, P.Enum e) =>+      C (Enum.T w e) where+   type Repr (Enum.T w e) = LLVM.Value w+   cons = consPrimitive . P.fromIntegral . P.fromEnum . Enum.toPlain+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive++toEnum ::+   (Repr w ~ LLVM.Value w) =>+   T w -> T (Enum.T w e)+toEnum (Cons w) = Cons w++fromEnum ::+   (Repr w ~ LLVM.Value w) =>+   T (Enum.T w e) -> T w+fromEnum (Cons w) = Cons w++succ, pred ::+   (LLVM.IsArithmetic w, SoV.IntegerConstant w) =>+   T (Enum.T w e) -> LLVM.CodeGenFunction r (T (Enum.T w e))+succ = liftM $ \w -> A.add w A.one+pred = liftM $ \w -> A.sub w A.one++-- cannot be an instance of 'Comparison' because there is no 'Real' instance+cmpEnum ::+   (LLVM.CmpRet w, LLVM.IsPrimitive w) =>+   LLVM.CmpPredicate -> T (Enum.T w a) -> T (Enum.T w a) ->+   LLVM.CodeGenFunction r (T Bool)+cmpEnum = liftM2 . LLVM.cmp+++class (C a) => Bounded a where+   minBound, maxBound :: T a++instance+   (LLVM.IsInteger w, LLVM.IsConst w, P.Num w, P.Enum e, P.Bounded e) =>+      Bounded (Enum.T w e) where+   minBound = cons P.minBound+   maxBound = cons P.maxBound+++instance (LLVM.IsInteger w, LLVM.IsConst w) => C (EnumBitSet.T w i) where+   type Repr (EnumBitSet.T w i) = LLVM.Value w+   cons = consPrimitive . EnumBitSet.decons+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+++instance (C a) => C (Maybe a) where+   type Repr (Maybe a) = (LLVM.Value Bool, Repr a)+   cons Nothing = nothing+   cons (Just a) = just $ cons a+   undef = toMaybe undef undef+   zero = toMaybe (cons False) zero+   phi bb ma =+      case splitMaybe ma of+         (b,a) -> Monad.lift2 toMaybe (phi bb b) (phi bb a)+   addPhi bb x y =+      case (splitMaybe x, splitMaybe y) of+         ((xb,xa), (yb,ya)) ->+            addPhi bb xb yb >>+            addPhi bb xa ya++splitMaybe :: T (Maybe a) -> (T Bool, T a)+splitMaybe (Cons (b,a)) = (Cons b, Cons a)++toMaybe :: T Bool -> T a -> T (Maybe a)+toMaybe (Cons b) (Cons a) = Cons (b,a)++nothing :: (C a) => T (Maybe a)+nothing = toMaybe (cons False) undef++just :: T a -> T (Maybe a)+just = toMaybe (cons True)+++instance (C a, C b) => C (a,b) where+   type Repr (a, b) = (Repr a, Repr b)+   cons (a,b) = zip (cons a) (cons b)+   undef = zip undef undef+   zero = zip zero zero+   phi bb a =+      case unzip a of+         (a0,a1) ->+            Monad.lift2 zip (phi bb a0) (phi bb a1)+   addPhi bb a b =+      case (unzip a, unzip b) of+         ((a0,a1), (b0,b1)) ->+            addPhi bb a0 b0 >>+            addPhi bb a1 b1++instance (C a, C b, C c) => C (a,b,c) where+   type Repr (a, b, c) = (Repr a, Repr b, Repr c)+   cons (a,b,c) = zip3 (cons a) (cons b) (cons c)+   undef = zip3 undef undef undef+   zero = zip3 zero zero zero+   phi bb a =+      case unzip3 a of+         (a0,a1,a2) ->+            Monad.lift3 zip3 (phi bb a0) (phi bb a1) (phi bb a2)+   addPhi bb a b =+      case (unzip3 a, unzip3 b) of+         ((a0,a1,a2), (b0,b1,b2)) ->+            addPhi bb a0 b0 >>+            addPhi bb a1 b1 >>+            addPhi bb a2 b2++instance (C a, C b, C c, C d) => C (a,b,c,d) where+   type Repr (a, b, c, d) = (Repr a, Repr b, Repr c, Repr d)+   cons (a,b,c,d) = zip4 (cons a) (cons b) (cons c) (cons d)+   undef = zip4 undef undef undef undef+   zero = zip4 zero zero zero zero+   phi bb a =+      case unzip4 a of+         (a0,a1,a2,a3) ->+            Monad.lift4 zip4 (phi bb a0) (phi bb a1) (phi bb a2) (phi bb a3)+   addPhi bb a b =+      case (unzip4 a, unzip4 b) of+         ((a0,a1,a2,a3), (b0,b1,b2,b3)) ->+            addPhi bb a0 b0 >>+            addPhi bb a1 b1 >>+            addPhi bb a2 b2 >>+            addPhi bb a3 b3+++fst :: T (a,b) -> T a+fst (Cons (a,_b)) = Cons a++snd :: T (a,b) -> T b+snd (Cons (_a,b)) = Cons b++curry :: (T (a,b) -> c) -> (T a -> T b -> c)+curry f a b = f $ zip a b++uncurry :: (T a -> T b -> c) -> (T (a,b) -> c)+uncurry f = Tup.uncurry f . unzip+++mapFst :: (T a0 -> T a1) -> T (a0,b) -> T (a1,b)+mapFst f = Tup.uncurry zip . TupleHT.mapFst f . unzip++mapSnd :: (T b0 -> T b1) -> T (a,b0) -> T (a,b1)+mapSnd f = Tup.uncurry zip . TupleHT.mapSnd f . unzip++mapFstF :: (Functor f) => (T a0 -> f (T a1)) -> T (a0,b) -> f (T (a1,b))+mapFstF f = fmap (Tup.uncurry zip) . FuncHT.mapFst f . unzip++mapSndF :: (Functor f) => (T b0 -> f (T b1)) -> T (a,b0) -> f (T (a,b1))+mapSndF f = fmap (Tup.uncurry zip) . FuncHT.mapSnd f . unzip++swap :: T (a,b) -> T (b,a)+swap = Tup.uncurry zip . TupleHT.swap . unzip+++fst3 :: T (a,b,c) -> T a+fst3 (Cons (a,_b,_c)) = Cons a++snd3 :: T (a,b,c) -> T b+snd3 (Cons (_a,b,_c)) = Cons b++thd3 :: T (a,b,c) -> T c+thd3 (Cons (_a,_b,c)) = Cons c++curry3 :: (T (a,b,c) -> d) -> (T a -> T b -> T c -> d)+curry3 f a b c = f $ zip3 a b c++uncurry3 :: (T a -> T b -> T c -> d) -> (T (a,b,c) -> d)+uncurry3 f = TupleHT.uncurry3 f . unzip3+++mapFst3 :: (T a0 -> T a1) -> T (a0,b,c) -> T (a1,b,c)+mapFst3 f = TupleHT.uncurry3 zip3 . TupleHT.mapFst3 f . unzip3++mapSnd3 :: (T b0 -> T b1) -> T (a,b0,c) -> T (a,b1,c)+mapSnd3 f = TupleHT.uncurry3 zip3 . TupleHT.mapSnd3 f . unzip3++mapThd3 :: (T c0 -> T c1) -> T (a,b,c0) -> T (a,b,c1)+mapThd3 f = TupleHT.uncurry3 zip3 . TupleHT.mapThd3 f . unzip3++mapFst3F :: (Functor f) => (T a0 -> f (T a1)) -> T (a0,b,c) -> f (T (a1,b,c))+mapFst3F f = fmap (TupleHT.uncurry3 zip3) . FuncHT.mapFst3 f . unzip3++mapSnd3F :: (Functor f) => (T b0 -> f (T b1)) -> T (a,b0,c) -> f (T (a,b1,c))+mapSnd3F f = fmap (TupleHT.uncurry3 zip3) . FuncHT.mapSnd3 f . unzip3++mapThd3F :: (Functor f) => (T c0 -> f (T c1)) -> T (a,b,c0) -> f (T (a,b,c1))+mapThd3F f = fmap (TupleHT.uncurry3 zip3) . FuncHT.mapThd3 f . unzip3+++zip :: T a -> T b -> T (a,b)+zip (Cons a) (Cons b) = Cons (a,b)++zip3 :: T a -> T b -> T c -> T (a,b,c)+zip3 (Cons a) (Cons b) (Cons c) = Cons (a,b,c)++zip4 :: T a -> T b -> T c -> T d -> T (a,b,c,d)+zip4 (Cons a) (Cons b) (Cons c) (Cons d) = Cons (a,b,c,d)++unzip :: T (a,b) -> (T a, T b)+unzip (Cons (a,b)) = (Cons a, Cons b)++unzip3 :: T (a,b,c) -> (T a, T b, T c)+unzip3 (Cons (a,b,c)) = (Cons a, Cons b, Cons c)++unzip4 :: T (a,b,c,d) -> (T a, T b, T c, T d)+unzip4 (Cons (a,b,c,d)) = (Cons a, Cons b, Cons c, Cons d)+++instance (C tuple) => C (StoreTuple.Tuple tuple) where+   type Repr (StoreTuple.Tuple tuple) = Repr tuple+   cons = tuple . cons . StoreTuple.getTuple+   undef = tuple undef+   zero = tuple zero+   phi bb = fmap tuple . phi bb . untuple+   addPhi bb a b = addPhi bb (untuple a) (untuple b)++tuple :: T tuple -> T (StoreTuple.Tuple tuple)+tuple (Cons a) = Cons a++untuple :: T (StoreTuple.Tuple tuple) -> T tuple+untuple (Cons a) = Cons a+++class Struct struct where+   consStruct :: (Struct.T struct ~ a) => a -> T a+   undefStruct :: (Struct.T struct ~ a) => T a+   zeroStruct :: (Struct.T struct ~ a) => T a+   phiStruct :: (Struct.T struct ~ a) =>+      LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)+   addPhiStruct :: (Struct.T struct ~ a) =>+      LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()++instance (Struct struct) => C (Struct.T struct) where+   type Repr (Struct.T struct) = Struct.T (Repr struct)+   cons = consStruct+   undef = undefStruct+   zero = zeroStruct+   phi = phiStruct+   addPhi = addPhiStruct++instance Struct () where+   consStruct unit = Cons unit+   undefStruct = Cons (Struct.Cons ())+   zeroStruct = Cons (Struct.Cons ())+   phiStruct _bb = return+   addPhiStruct _bb _a _b = return ()++structCons :: T a -> T (Struct.T as) -> T (Struct.T (a,as))+structCons (Cons b) (Cons (Struct.Cons bs)) = Cons (Struct.Cons (b,bs))++structUncons :: T (Struct.T (a,as)) -> (T a, T (Struct.T as))+structUncons (Cons (Struct.Cons (b,bs))) = (Cons b, Cons (Struct.Cons bs))++instance (C a, Struct as) => Struct (a,as) where+   consStruct (Struct.Cons (a,as)) =+      structCons (cons a) (consStruct (Struct.Cons as))+   undefStruct = structCons undef undefStruct+   zeroStruct = structCons zero zeroStruct+   phiStruct bb at =+      case structUncons at of+         (a,as) -> Monad.lift2 structCons (phi bb a) (phiStruct bb as)+   addPhiStruct bb at bt =+      case (structUncons at, structUncons bt) of+         ((a,as), (b,bs)) -> addPhi bb a b >> addPhiStruct bb as bs+++instance (LLVM.IsConst a, LLVM.IsFirstClass a) => C (EE.Stored a) where+   type Repr (EE.Stored a) = LLVM.Value a+   cons = Cons . LLVM.valueOf . EE.getStored+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+++instance C a => C (Tagged tag a) where+   type Repr (Tagged tag a) = Repr a+   cons = tag . cons . unTagged+   undef = tag undef+   zero = tag zero+   phi bb = fmap tag . phi bb . untag+   addPhi bb a b = addPhi bb (untag a) (untag b)++tag :: T a -> T (Tagged tag a)+tag = cast++untag :: T (Tagged tag a) -> T a+untag = cast++liftTaggedM ::+   (Monad m) => (T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))+liftTaggedM f = Monad.lift tag . f . untag++liftTaggedM2 ::+   (Monad m) =>+   (T a -> T b -> m (T c)) ->+   T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))+liftTaggedM2 f a b = Monad.lift tag $ f (untag a) (untag b)+++instance (C a) => C (Complex a) where+   type Repr (Complex a) = Complex (Repr a)+   cons (a:+b) = consComplex (cons a) (cons b)+   undef = consComplex undef undef+   zero = consComplex zero zero+   phi bb a =+      case deconsComplex a of+         (a0,a1) ->+            Monad.lift2 consComplex (phi bb a0) (phi bb a1)+   addPhi bb a b =+      case (deconsComplex a, deconsComplex b) of+         ((a0,a1), (b0,b1)) ->+            addPhi bb a0 b0 >>+            addPhi bb a1 b1++consComplex :: T a -> T a -> T (Complex a)+consComplex (Cons a) (Cons b) = Cons (a:+b)++deconsComplex :: T (Complex a) -> (T a, T a)+deconsComplex (Cons (a:+b)) = (Cons a, Cons b)++++class Compose nicetuple where+   type Composed nicetuple+   {- |+   A nested 'zip'.+   -}+   compose :: nicetuple -> T (Composed nicetuple)++class+   (Composed (Decomposed T pattern) ~ PatternTuple pattern) =>+      Decompose pattern where+   {- |+   A nested 'unzip'.+   Since it is not obvious how deep to decompose nested tuples,+   you must provide a pattern of the decomposed tuple.+   E.g.++   > f :: NiceValue ((a,b),(c,d)) ->+   >      ((NiceValue a, NiceValue b), NiceValue (c,d))+   > f = decompose ((atom,atom),atom)+   -}+   decompose :: pattern -> T (PatternTuple pattern) -> Decomposed T pattern++type family Decomposed (f :: * -> *) pattern+type family PatternTuple pattern+++{- |+A combination of 'compose' and 'decompose'+that let you operate on tuple NiceValues as Haskell tuples.+-}+modify ::+   (Compose a, Decompose pattern) =>+   pattern ->+   (Decomposed T pattern -> a) ->+   T (PatternTuple pattern) -> T (Composed a)+modify p f = compose . f . decompose p++modify2 ::+   (Compose a, Decompose patternA, Decompose patternB) =>+   patternA ->+   patternB ->+   (Decomposed T patternA -> Decomposed T patternB -> a) ->+   T (PatternTuple patternA) -> T (PatternTuple patternB) -> T (Composed a)+modify2 pa pb f a b = compose $ f (decompose pa a) (decompose pb b)++modifyF ::+   (Compose a, Decompose pattern, Functor f) =>+   pattern ->+   (Decomposed T pattern -> f a) ->+   T (PatternTuple pattern) -> f (T (Composed a))+modifyF p f = fmap compose . f . decompose p++modifyF2 ::+   (Compose a, Decompose patternA, Decompose patternB,+    Functor f) =>+   patternA ->+   patternB ->+   (Decomposed T patternA -> Decomposed T patternB -> f a) ->+   T (PatternTuple patternA) -> T (PatternTuple patternB) -> f (T (Composed a))+modifyF2 pa pb f a b = fmap compose $ f (decompose pa a) (decompose pb b)++++instance Compose (T a) where+   type Composed (T a) = a+   compose = id++instance Decompose (Atom a) where+   decompose _ = id++type instance Decomposed f (Atom a) = f a+type instance PatternTuple (Atom a) = a++data Atom a = Atom++atom :: Atom a+atom = Atom+++instance Compose () where+   type Composed () = ()+   compose = cons++instance Decompose () where+   decompose () _ = ()++type instance Decomposed f () = ()+type instance PatternTuple () = ()+++instance (Compose a, Compose b) => Compose (a,b) where+   type Composed (a,b) = (Composed a, Composed b)+   compose = Tup.uncurry zip . TupleHT.mapPair (compose, compose)++instance (Decompose pa, Decompose pb) => Decompose (pa,pb) where+   decompose (pa,pb) =+      TupleHT.mapPair (decompose pa, decompose pb) . unzip++type instance Decomposed f (pa,pb) = (Decomposed f pa, Decomposed f pb)+type instance PatternTuple (pa,pb) = (PatternTuple pa, PatternTuple pb)+++instance (Compose a, Compose b, Compose c) => Compose (a,b,c) where+   type Composed (a,b,c) = (Composed a, Composed b, Composed c)+   compose = TupleHT.uncurry3 zip3 . TupleHT.mapTriple (compose, compose, compose)++instance+   (Decompose pa, Decompose pb, Decompose pc) =>+      Decompose (pa,pb,pc) where+   decompose (pa,pb,pc) =+      TupleHT.mapTriple (decompose pa, decompose pb, decompose pc) . unzip3++type instance Decomposed f (pa,pb,pc) =+        (Decomposed f pa, Decomposed f pb, Decomposed f pc)+type instance PatternTuple (pa,pb,pc) =+        (PatternTuple pa, PatternTuple pb, PatternTuple pc)+++instance (Compose a, Compose b, Compose c, Compose d) => Compose (a,b,c,d) where+   type Composed (a,b,c,d) = (Composed a, Composed b, Composed c, Composed d)+   compose (a,b,c,d) = zip4 (compose a) (compose b) (compose c) (compose d)++instance+   (Decompose pa, Decompose pb, Decompose pc, Decompose pd) =>+      Decompose (pa,pb,pc,pd) where+   decompose (pa,pb,pc,pd) x =+      case unzip4 x of+         (a,b,c,d) ->+            (decompose pa a, decompose pb b, decompose pc c, decompose pd d)+type instance Decomposed f (pa,pb,pc,pd) =+        (Decomposed f pa, Decomposed f pb, Decomposed f pc, Decomposed f pd)+type instance PatternTuple (pa,pb,pc,pd) =+        (PatternTuple pa, PatternTuple pb, PatternTuple pc, PatternTuple pd)+++instance (Compose tuple) => Compose (StoreTuple.Tuple tuple) where+   type Composed (StoreTuple.Tuple tuple) = StoreTuple.Tuple (Composed tuple)+   compose = tuple . compose . StoreTuple.getTuple++instance (Decompose p) => Decompose (StoreTuple.Tuple p) where+   decompose (StoreTuple.Tuple p) = StoreTuple.Tuple . decompose p . untuple++type instance Decomposed f (StoreTuple.Tuple p) =+                  StoreTuple.Tuple (Decomposed f p)+type instance PatternTuple (StoreTuple.Tuple p) =+                  StoreTuple.Tuple (PatternTuple p)+++instance (Compose a) => Compose (Tagged tag a) where+   type Composed (Tagged tag a) = Tagged tag (Composed a)+   compose = tag . compose . unTagged++instance (Decompose pa) => Decompose (Tagged tag pa) where+   decompose (Tagged p) = Tagged . decompose p . untag++type instance Decomposed f (Tagged tag pa) = Tagged tag (Decomposed f pa)+type instance PatternTuple (Tagged tag pa) = Tagged tag (PatternTuple pa)+++instance (Compose a) => Compose (Complex a) where+   type Composed (Complex a) = Complex (Composed a)+   compose (a:+b) = consComplex (compose a) (compose b)++instance (Decompose pa) => Decompose (Complex pa) where+   decompose (pa:+pb) =+      Tup.uncurry (:+) .+      TupleHT.mapPair (decompose pa, decompose pb) . deconsComplex++type instance Decomposed f (Complex pa) = Complex (Decomposed f pa)+type instance PatternTuple (Complex pa) = Complex (PatternTuple pa)++realPart, imagPart :: T (Complex a) -> T a+realPart (Cons (a:+_)) = Cons a+imagPart (Cons (_:+b)) = Cons b++++lift1 :: (Repr a -> Repr b) -> T a -> T b+lift1 f (Cons a) = Cons $ f a++liftM0 ::+   (Monad m) =>+   m (Repr a) ->+   m (T a)+liftM0 f = Monad.lift Cons f++liftM ::+   (Monad m) =>+   (Repr a -> m (Repr b)) ->+   T a -> m (T b)+liftM f (Cons a) = Monad.lift Cons $ f a++liftM2 ::+   (Monad m) =>+   (Repr a -> Repr b -> m (Repr c)) ->+   T a -> T b -> m (T c)+liftM2 f (Cons a) (Cons b) = Monad.lift Cons $ f a b++liftM3 ::+   (Monad m) =>+   (Repr a -> Repr b -> Repr c ->+    m (Repr d)) ->+   T a -> T b -> T c -> m (T d)+liftM3 f (Cons a) (Cons b) (Cons c) = Monad.lift Cons $ f a b c+++instance (C a) => Tuple.Zero (T a) where+   zero = zero++instance (C a) => Tuple.Undefined (T a) where+   undef = undef++instance (C a) => Tuple.Phi (T a) where+   phi = phi+   addPhi = addPhi+++class (C a) => IntegerConstant a where+   fromInteger' :: Integer -> T a++class (IntegerConstant a) => RationalConstant a where+   fromRational' :: Rational -> T a++instance IntegerConstant Float  where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Double where fromInteger' = Cons . LLVM.value . SoV.constFromInteger++instance IntegerConstant Word where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Word8 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Word16 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Word32 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Word64 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger++instance IntegerConstant Int where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Int8 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Int16 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Int32 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance IntegerConstant Int64 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger++instance (Dec.Positive n) => IntegerConstant (WordN n) where fromInteger' = Cons . LLVM.value . SoV.constFromInteger+instance (Dec.Positive n) => IntegerConstant (IntN n) where fromInteger' = Cons . LLVM.value . SoV.constFromInteger++instance IntegerConstant a => IntegerConstant (Tagged tag a) where+   fromInteger' = tag . fromInteger'++instance RationalConstant Float  where fromRational' = Cons . LLVM.value . SoV.constFromRational+instance RationalConstant Double where fromRational' = Cons . LLVM.value . SoV.constFromRational++instance RationalConstant a => RationalConstant (Tagged tag a) where+   fromRational' = tag . fromRational'+++instance (IntegerConstant a) => A.IntegerConstant (T a) where+   fromInteger' = fromInteger'++instance (RationalConstant a) => A.RationalConstant (T a) where+   fromRational' = fromRational'+++class (C a) => Additive a where+   add :: T a -> T a -> LLVM.CodeGenFunction r (T a)+   sub :: T a -> T a -> LLVM.CodeGenFunction r (T a)+   neg :: T a -> LLVM.CodeGenFunction r (T a)++instance Additive Float where+   add = liftM2 LLVM.add+   sub = liftM2 LLVM.sub+   neg = liftM LLVM.neg++instance Additive Double where+   add = liftM2 LLVM.add+   sub = liftM2 LLVM.sub+   neg = liftM LLVM.neg++instance Additive Word where+   add = liftM2 LLVM.add+   sub = liftM2 LLVM.sub+   neg = liftM LLVM.neg++instance Additive Word8 where+   add = liftM2 LLVM.add+   sub = liftM2 LLVM.sub+   neg = liftM LLVM.neg++instance Additive Word16 where+   add = liftM2 LLVM.add+   sub = liftM2 LLVM.sub+   neg = liftM LLVM.neg++instance Additive Word32 where+   add = liftM2 LLVM.add+   sub = liftM2 LLVM.sub+   neg = liftM LLVM.neg++instance Additive Word64 where+   add = liftM2 LLVM.add+   sub = liftM2 LLVM.sub+   neg = liftM LLVM.neg++instance Additive Int where+   add = liftM2 LLVM.add+   sub = liftM2 LLVM.sub+   neg = liftM LLVM.neg++instance Additive Int8 where+   add = liftM2 LLVM.add+   sub = liftM2 LLVM.sub+   neg = liftM LLVM.neg++instance Additive Int16 where+   add = liftM2 LLVM.add+   sub = liftM2 LLVM.sub+   neg = liftM LLVM.neg++instance Additive Int32 where+   add = liftM2 LLVM.add+   sub = liftM2 LLVM.sub+   neg = liftM LLVM.neg++instance Additive Int64 where+   add = liftM2 LLVM.add+   sub = liftM2 LLVM.sub+   neg = liftM LLVM.neg++instance (Dec.Positive n) => Additive (WordN n) where+   add = liftM2 LLVM.add+   sub = liftM2 LLVM.sub+   neg = liftM LLVM.neg++instance (Dec.Positive n) => Additive (IntN n) where+   add = liftM2 LLVM.add+   sub = liftM2 LLVM.sub+   neg = liftM LLVM.neg++instance Additive a => Additive (Tagged tag a) where+   add = liftTaggedM2 add+   sub = liftTaggedM2 sub+   neg = liftTaggedM neg++instance (Additive a) => A.Additive (T a) where+   zero = zero+   add = add+   sub = sub+   neg = neg++inc, dec ::+   (Additive i, IntegerConstant i) => T i -> LLVM.CodeGenFunction r (T i)+inc x = add x A.one+dec x = sub x A.one+++class (Additive a) => PseudoRing a where+   mul :: T a -> T a -> LLVM.CodeGenFunction r (T a)++instance PseudoRing Float where mul = liftM2 LLVM.mul+instance PseudoRing Double where mul = liftM2 LLVM.mul+instance PseudoRing Word where mul = liftM2 LLVM.mul+instance PseudoRing Word8 where mul = liftM2 LLVM.mul+instance PseudoRing Word16 where mul = liftM2 LLVM.mul+instance PseudoRing Word32 where mul = liftM2 LLVM.mul+instance PseudoRing Word64 where mul = liftM2 LLVM.mul+instance PseudoRing Int where mul = liftM2 LLVM.mul+instance PseudoRing Int8 where mul = liftM2 LLVM.mul+instance PseudoRing Int16 where mul = liftM2 LLVM.mul+instance PseudoRing Int32 where mul = liftM2 LLVM.mul+instance PseudoRing Int64 where mul = liftM2 LLVM.mul++instance (PseudoRing a) => PseudoRing (Tagged tag a) where+   mul = liftTaggedM2 mul++instance (PseudoRing a) => A.PseudoRing (T a) where+   mul = mul+++class (PseudoRing a) => Field a where+   fdiv :: T a -> T a -> LLVM.CodeGenFunction r (T a)++instance Field Float where+   fdiv = liftM2 LLVM.fdiv++instance Field Double where+   fdiv = liftM2 LLVM.fdiv++instance (Field a) => Field (Tagged tag a) where+   fdiv = liftTaggedM2 fdiv++instance (Field a) => A.Field (T a) where+   fdiv = fdiv+++type family Scalar vector+type instance Scalar Float = Float+type instance Scalar Double = Double+type instance Scalar (Tagged tag a) = Tagged tag (Scalar a)+type instance A.Scalar (T a) = T (Scalar a)++class (PseudoRing (Scalar v), Additive v) => PseudoModule v where+   scale :: T (Scalar v) -> T v -> LLVM.CodeGenFunction r (T v)++instance PseudoModule Float where+   scale = liftM2 A.mul++instance PseudoModule Double where+   scale = liftM2 A.mul++instance (PseudoModule a) => PseudoModule (Tagged tag a) where+   scale = liftTaggedM2 scale++instance (PseudoModule a) => A.PseudoModule (T a) where+   scale = scale+++class (Additive a) => Real a where+   min :: T a -> T a -> LLVM.CodeGenFunction r (T a)+   max :: T a -> T a -> LLVM.CodeGenFunction r (T a)+   abs :: T a -> LLVM.CodeGenFunction r (T a)+   signum :: T a -> LLVM.CodeGenFunction r (T a)++instance Real Float where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Double where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Word where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Word8 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Word16 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Word32 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Word64 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Int where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Int8 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Int16 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Int32 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Int64 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance (Dec.Positive n) => Real (WordN n) where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance (Dec.Positive n) => Real (IntN n) where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance (Real a) => Real (Tagged tag a) where+   min = liftTaggedM2 min+   max = liftTaggedM2 max+   abs = liftTaggedM abs+   signum = liftTaggedM signum++instance (Real a) => A.Real (T a) where+   min = min+   max = max+   abs = abs+   signum = signum+++class (Real a) => Fraction a where+   truncate :: T a -> LLVM.CodeGenFunction r (T a)+   fraction :: T a -> LLVM.CodeGenFunction r (T a)++instance Fraction Float where+   truncate = liftM A.truncate+   fraction = liftM A.fraction++instance Fraction Double where+   truncate = liftM A.truncate+   fraction = liftM A.fraction++instance (Fraction a) => Fraction (Tagged tag a) where+   truncate = liftTaggedM truncate+   fraction = liftTaggedM fraction++instance (Fraction a) => A.Fraction (T a) where+   truncate = truncate+   fraction = fraction+++class+   (Repr i ~ LLVM.Value ir,+    LLVM.IsInteger ir, SoV.IntegerConstant ir,+    LLVM.CmpRet ir, LLVM.IsPrimitive ir) =>+      NativeInteger i ir where++instance NativeInteger Word   Word   where+instance NativeInteger Word8  Word8  where+instance NativeInteger Word16 Word16 where+instance NativeInteger Word32 Word32 where+instance NativeInteger Word64 Word64 where++instance NativeInteger Int   Int   where+instance NativeInteger Int8  Int8  where+instance NativeInteger Int16 Int16 where+instance NativeInteger Int32 Int32 where+instance NativeInteger Int64 Int64 where++instance NativeInteger a a => NativeInteger (Tagged tag a) a where+++class+   (Repr a ~ LLVM.Value ar,+    LLVM.IsFloating ar, SoV.RationalConstant ar,+    LLVM.CmpRet ar, LLVM.IsPrimitive ar) =>+      NativeFloating a ar where++instance NativeFloating Float  Float where+instance NativeFloating Double Double where+++truncateToInt, floorToInt, ceilingToInt, roundToIntFast ::+   (NativeInteger i ir, NativeFloating a ar) =>+   T a -> LLVM.CodeGenFunction r (T i)+truncateToInt  = liftM SoV.truncateToInt+floorToInt     = liftM SoV.floorToInt+ceilingToInt   = liftM SoV.ceilingToInt+roundToIntFast = liftM SoV.roundToIntFast++splitFractionToInt ::+   (NativeInteger i ir, NativeFloating a ar) =>+   T a -> LLVM.CodeGenFunction r (T (i,a))+splitFractionToInt = liftM SoV.splitFractionToInt+++class Field a => Algebraic a where+   sqrt :: T a -> LLVM.CodeGenFunction r (T a)++instance Algebraic Float where+   sqrt = liftM A.sqrt++instance Algebraic Double where+   sqrt = liftM A.sqrt++instance (Algebraic a) => Algebraic (Tagged tag a) where+   sqrt = liftTaggedM sqrt++instance (Algebraic a) => A.Algebraic (T a) where+   sqrt = sqrt+++class Algebraic a => Transcendental a where+   pi :: LLVM.CodeGenFunction r (T a)+   sin, cos, exp, log :: T a -> LLVM.CodeGenFunction r (T a)+   pow :: T a -> T a -> LLVM.CodeGenFunction r (T a)++instance Transcendental Float where+   pi = liftM0 A.pi+   sin = liftM A.sin+   cos = liftM A.cos+   exp = liftM A.exp+   log = liftM A.log+   pow = liftM2 A.pow++instance Transcendental Double where+   pi = liftM0 A.pi+   sin = liftM A.sin+   cos = liftM A.cos+   exp = liftM A.exp+   log = liftM A.log+   pow = liftM2 A.pow++instance (Transcendental a) => Transcendental (Tagged tag a) where+   pi = fmap tag pi+   sin = liftTaggedM sin+   cos = liftTaggedM cos+   exp = liftTaggedM exp+   log = liftTaggedM log+   pow = liftTaggedM2 pow++instance (Transcendental a) => A.Transcendental (T a) where+   pi = pi+   sin = sin+   cos = cos+   exp = exp+   log = log+   pow = pow++++class (C a) => Select a where+   select ::+      T Bool -> T a -> T a ->+      LLVM.CodeGenFunction r (T a)++instance Select Bool where select = liftM3 LLVM.select+instance Select Bool8 where select = liftM3 LLVM.select+instance Select Float where select = liftM3 LLVM.select+instance Select Double where select = liftM3 LLVM.select+instance Select Word where select = liftM3 LLVM.select+instance Select Word8 where select = liftM3 LLVM.select+instance Select Word16 where select = liftM3 LLVM.select+instance Select Word32 where select = liftM3 LLVM.select+instance Select Word64 where select = liftM3 LLVM.select+instance Select Int where select = liftM3 LLVM.select+instance Select Int8 where select = liftM3 LLVM.select+instance Select Int16 where select = liftM3 LLVM.select+instance Select Int32 where select = liftM3 LLVM.select+instance Select Int64 where select = liftM3 LLVM.select++instance (Select a, Select b) => Select (a,b) where+   select b =+      modifyF2 (atom,atom) (atom,atom) $+      \(a0,b0) (a1,b1) ->+         Monad.lift2 (,)+            (select b a0 a1)+            (select b b0 b1)++instance (Select a, Select b, Select c) => Select (a,b,c) where+   select b =+      modifyF2 (atom,atom,atom) (atom,atom,atom) $+      \(a0,b0,c0) (a1,b1,c1) ->+         Monad.lift3 (,,)+            (select b a0 a1)+            (select b b0 b1)+            (select b c0 c1)++instance (Select a) => Select (Tagged tag a) where+   select = liftTaggedM2 . select++instance (Select a) => C.Select (T a) where+   select b = select (Cons b)++++class (Real a) => Comparison a where+   {- |+   It must hold++   > max x y  ==  do gt <- cmp CmpGT x y; select gt x y+   -}+   cmp ::+      LLVM.CmpPredicate -> T a -> T a ->+      LLVM.CodeGenFunction r (T Bool)++instance Comparison Float where cmp = liftM2 . LLVM.cmp+instance Comparison Double where cmp = liftM2 . LLVM.cmp++instance Comparison Int where cmp = liftM2 . LLVM.cmp+instance Comparison Int8 where cmp = liftM2 . LLVM.cmp+instance Comparison Int16 where cmp = liftM2 . LLVM.cmp+instance Comparison Int32 where cmp = liftM2 . LLVM.cmp+instance Comparison Int64 where cmp = liftM2 . LLVM.cmp++instance Comparison Word where cmp = liftM2 . LLVM.cmp+instance Comparison Word8 where cmp = liftM2 . LLVM.cmp+instance Comparison Word16 where cmp = liftM2 . LLVM.cmp+instance Comparison Word32 where cmp = liftM2 . LLVM.cmp+instance Comparison Word64 where cmp = liftM2 . LLVM.cmp++instance (Dec.Positive n) => Comparison (IntN n) where cmp = liftM2 . LLVM.cmp+instance (Dec.Positive n) => Comparison (WordN n) where cmp = liftM2 . LLVM.cmp++instance (Comparison a) => Comparison (Tagged tag a) where+   cmp p a b = cmp p (untag a) (untag b)++instance (Comparison a) => A.Comparison (T a) where+   type CmpResult (T a) = T Bool+   cmp = cmp++++class (Comparison a) => FloatingComparison a where+   fcmp ::+      LLVM.FPPredicate -> T a -> T a ->+      LLVM.CodeGenFunction r (T Bool)++instance FloatingComparison Float where+   fcmp = liftM2 . LLVM.fcmp++instance (FloatingComparison a) => FloatingComparison (Tagged tag a) where+   fcmp p a b = fcmp p (untag a) (untag b)++instance (FloatingComparison a) => A.FloatingComparison (T a) where+   fcmp = fcmp++++class (C a) => Logic a where+   and :: T a -> T a -> LLVM.CodeGenFunction r (T a)+   or :: T a -> T a -> LLVM.CodeGenFunction r (T a)+   xor :: T a -> T a -> LLVM.CodeGenFunction r (T a)+   inv :: T a -> LLVM.CodeGenFunction r (T a)++instance Logic Bool where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++instance Logic Bool8 where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++instance Logic Word8 where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++instance Logic Word16 where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++instance Logic Word32 where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++instance Logic Word64 where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++instance (Dec.Positive n) => Logic (WordN n) where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++instance (LLVM.IsInteger w, LLVM.IsConst w) => Logic (EnumBitSet.T w i) where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++instance Logic a => Logic (Tagged tag a) where+   and = liftTaggedM2 and; or = liftTaggedM2 or+   xor = liftTaggedM2 xor; inv = liftTaggedM inv+++instance Logic a => A.Logic (T a) where+   and = and+   or = or+   xor = xor+   inv = inv++++class BitShift a where+   shl :: T a -> T a -> LLVM.CodeGenFunction r (T a)+   shr :: T a -> T a -> LLVM.CodeGenFunction r (T a)++instance BitShift Word where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Word8 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Word16 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Word32 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Word64 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Int where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++instance BitShift Int8 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++instance BitShift Int16 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++instance BitShift Int32 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++instance BitShift Int64 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++++class (PseudoRing a) => Integral a where+   idiv :: T a -> T a -> LLVM.CodeGenFunction r (T a)+   irem :: T a -> T a -> LLVM.CodeGenFunction r (T a)++instance Integral Word where+   idiv = liftM2 LLVM.idiv+   irem = liftM2 LLVM.irem++instance Integral Word32 where+   idiv = liftM2 LLVM.idiv+   irem = liftM2 LLVM.irem++instance Integral Word64 where+   idiv = liftM2 LLVM.idiv+   irem = liftM2 LLVM.irem++instance Integral Int where+   idiv = liftM2 LLVM.idiv+   irem = liftM2 LLVM.irem++instance Integral Int32 where+   idiv = liftM2 LLVM.idiv+   irem = liftM2 LLVM.irem++instance Integral Int64 where+   idiv = liftM2 LLVM.idiv+   irem = liftM2 LLVM.irem++instance (Integral a) => Integral (Tagged tag a) where+   idiv = liftTaggedM2 idiv+   irem = liftTaggedM2 irem+++fromIntegral ::+   (NativeInteger i ir, NativeFloating a ar) =>+   T i -> LLVM.CodeGenFunction r (T a)+fromIntegral = liftM LLVM.inttofp
+ src/LLVM/Extra/Nice/Value/Storable.hs view
@@ -0,0 +1,417 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module LLVM.Extra.Nice.Value.Storable (+   -- * Basic class+   C(load, store),+   storeNext,+   modify,++   -- * Classes for tuples and vectors+   Tuple(..),+   Vector(..),+   TupleVector(..),++   -- * Standard method implementations+   loadTraversable,+   loadApplicative,+   storeFoldable,++   -- * Pointer handling+   Storable.advancePtr,+   Storable.incrementPtr,+   Storable.decrementPtr,++   -- * Loops over Storable arrays+   Array.arrayLoop,+   Array.arrayLoop2,+   Array.arrayLoopMaybeCont,+   Array.arrayLoopMaybeCont2,+   ) where++import qualified LLVM.Extra.Storable.Private as Storable+import qualified LLVM.Extra.Storable.Array as Array+import LLVM.Extra.Storable.Private+         (BytePtr, advancePtrStatic, incPtrState, incrementPtr, update,+          castFromBytePtr, castToBytePtr,+          runElements, elementOffset, castElementPtr,+          assemblePrimitive, disassemblePrimitive, proxyFromElement3)++import qualified LLVM.Extra.Nice.Vector as NiceVector+import qualified LLVM.Extra.Nice.Value as NiceValue+import qualified LLVM.Extra.ArithmeticPrivate as A++import qualified LLVM.ExecutionEngine as EE+import qualified LLVM.Util.Proxy as LP+import qualified LLVM.Core as LLVM+import LLVM.Core (CodeGenFunction, Value)++import qualified Type.Data.Num.Decimal as TypeNum++import qualified Control.Monad.Trans.Class as MT+import qualified Control.Monad.Trans.Reader as MR+import qualified Control.Monad.Trans.State as MS+import qualified Control.Applicative.HT as App+import qualified Control.Functor.HT as FuncHT+import Control.Monad (foldM, replicateM, replicateM_, (<=<))+import Control.Applicative (Applicative, pure, (<$>))++import qualified Foreign.Storable.Record.Tuple as StoreTuple+import qualified Foreign.Storable as Store+import Foreign.Ptr (Ptr)++import qualified Data.NonEmpty.Class as NonEmptyC+import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold+import Data.Orphans ()+import Data.Tuple.HT (uncurry3)+import Data.Complex (Complex)+import Data.Word (Word8, Word16, Word32, Word64, Word)+import Data.Int  (Int8,  Int16,  Int32,  Int64)+import Data.Bool8 (Bool8)++++class (Store.Storable a, NiceValue.C a) => C a where+   {-+   Not all Storable types have a compatible LLVM type,+   or even more, one LLVM type that is compatible on all platforms.+   -}+   load :: Value (Ptr a) -> CodeGenFunction r (NiceValue.T a)+   store :: NiceValue.T a -> Value (Ptr a) -> CodeGenFunction r ()++storeNext ::+   (C a, Value (Ptr a) ~ ptr) => NiceValue.T a -> ptr -> CodeGenFunction r ptr+storeNext a ptr  =  store a ptr >> incrementPtr ptr++modify ::+   (C a, NiceValue.T a ~ al) =>+   (al -> CodeGenFunction r al) ->+   Value (Ptr a) -> CodeGenFunction r ()+modify f ptr  =  flip store ptr =<< f =<< load ptr+++instance+   (EE.Marshal a, LLVM.IsConst a, LLVM.IsFirstClass a) =>+      C (EE.Stored a) where+   load = fmap NiceValue.Cons . LLVM.load <=< castFromStoredPtr+   store (NiceValue.Cons a) = LLVM.store a <=< castFromStoredPtr++castFromStoredPtr ::+   (LLVM.IsType a) =>+   Value (Ptr (EE.Stored a)) -> CodeGenFunction r (Value (LLVM.Ptr a))+castFromStoredPtr = LLVM.bitcast+++loadPrimitive ::+   (LLVM.Storable a, NiceValue.Repr a ~ LLVM.Value a) =>+   Value (Ptr a) -> CodeGenFunction r (NiceValue.T a)+loadPrimitive ptr = fmap NiceValue.Cons $ LLVM.load =<< LLVM.bitcast ptr++storePrimitive ::+   (LLVM.Storable a, NiceValue.Repr a ~ LLVM.Value a) =>+   NiceValue.T a -> Value (Ptr a) -> CodeGenFunction r ()+storePrimitive (NiceValue.Cons a) ptr = LLVM.store a =<< LLVM.bitcast ptr++instance C Float where+   load = loadPrimitive; store = storePrimitive++instance C Double where+   load = loadPrimitive; store = storePrimitive++instance C Word where+   load = loadPrimitive; store = storePrimitive++instance C Word8 where+   load = loadPrimitive; store = storePrimitive++instance C Word16 where+   load = loadPrimitive; store = storePrimitive++instance C Word32 where+   load = loadPrimitive; store = storePrimitive++instance C Word64 where+   load = loadPrimitive; store = storePrimitive++instance C Int where+   load = loadPrimitive; store = storePrimitive++instance C Int8 where+   load = loadPrimitive; store = storePrimitive++instance C Int16 where+   load = loadPrimitive; store = storePrimitive++instance C Int32 where+   load = loadPrimitive; store = storePrimitive++instance C Int64 where+   load = loadPrimitive; store = storePrimitive++{- |+Not very efficient implementation+because we want to adapt to @sizeOf Bool@ dynamically.+Unfortunately, LLVM-9's optimizer does not recognize the instruction pattern.+Better use 'Bool8' for booleans.+-}+instance C Bool where+   load ptr = do+      bytePtr <- castToBytePtr ptr+      bytes <-+         flip MS.evalStateT bytePtr $+            replicateM (Store.sizeOf (False :: Bool))+               (MT.lift . LLVM.load =<< incPtrState)+      let zero = LLVM.valueOf 0+      mask <- foldM A.or zero bytes+      NiceValue.Cons <$> A.cmp LLVM.CmpNE mask zero+   store (NiceValue.Cons b) ptr = do+      bytePtr <- castToBytePtr ptr+      byte <- LLVM.sext b+      flip MS.evalStateT bytePtr $+         replicateM_ (Store.sizeOf (False :: Bool))+            (MT.lift . LLVM.store byte =<< incPtrState)++instance C Bool8 where+   load ptr =+      fmap NiceValue.Cons $+      A.cmp LLVM.CmpNE (LLVM.valueOf 0) =<< LLVM.load =<< castToBytePtr ptr+   store (NiceValue.Cons b) ptr = do+      byte <- LLVM.zext b+      LLVM.store byte =<< castToBytePtr ptr++instance (C a) => C (Complex a) where+   load = loadApplicative; store = storeFoldable++++instance (Tuple tuple) => C (StoreTuple.Tuple tuple) where+   load ptr = NiceValue.tuple <$> loadTuple ptr+   store = storeTuple . NiceValue.untuple++class (StoreTuple.Storable tuple, NiceValue.C tuple) => Tuple tuple where+   loadTuple ::+      Value (Ptr (StoreTuple.Tuple tuple)) ->+      CodeGenFunction r (NiceValue.T tuple)+   storeTuple ::+      NiceValue.T tuple ->+      Value (Ptr (StoreTuple.Tuple tuple)) ->+      CodeGenFunction r ()++instance (C a, C b) => Tuple (a,b) where+   loadTuple ptr =+      runElements ptr $ fmap (uncurry NiceValue.zip) $+         App.mapPair (loadElement, loadElement) $+         FuncHT.unzip $ proxyFromElement3 ptr+   storeTuple = NiceValue.uncurry $ \a b ptr ->+      case FuncHT.unzip $ proxyFromElement3 ptr of+         (pa,pb) -> runElements ptr $ storeElement pa a >> storeElement pb b++instance (C a, C b, C c) => Tuple (a,b,c) where+   loadTuple ptr =+      runElements ptr $ fmap (uncurry3 NiceValue.zip3) $+         App.mapTriple (loadElement, loadElement, loadElement) $+         FuncHT.unzip3 $ proxyFromElement3 ptr+   storeTuple = NiceValue.uncurry3 $ \a b c ptr ->+      case FuncHT.unzip3 $ proxyFromElement3 ptr of+         (pa,pb,pc) ->+            runElements ptr $+               storeElement pa a >> storeElement pb b >> storeElement pc c++loadElement ::+   (C a) =>+   LP.Proxy a ->+   MR.ReaderT BytePtr (MS.StateT Int (CodeGenFunction r)) (NiceValue.T a)+loadElement proxy =+   MT.lift . MT.lift . load =<< elementPtr proxy++storeElement ::+   (C a) =>+   LP.Proxy a -> NiceValue.T a ->+   MR.ReaderT BytePtr (MS.StateT Int (CodeGenFunction r)) ()+storeElement proxy a =+   MT.lift . MT.lift . store a =<< elementPtr proxy++elementPtr ::+   (C a) =>+   LP.Proxy a ->+   MR.ReaderT BytePtr+      (MS.StateT Int (CodeGenFunction r)) (LLVM.Value (Ptr a))+elementPtr proxy = do+   ptr <- MR.ask+   MT.lift $ do+      offset <- elementOffset proxy+      MT.lift $ castFromBytePtr =<< LLVM.getElementPtr ptr (offset, ())+++instance+   (TypeNum.Positive n, Vector a) =>+      C (LLVM.Vector n a) where+   load ptr =+      fmap NiceValue.Cons $+      assembleVector (proxyFromElement3 ptr) =<< loadApplicativeRepr ptr+   store (NiceValue.Cons a) ptr =+      flip storeFoldableRepr ptr+         =<< disassembleVector (proxyFromElement3 ptr) a++class (C a, NiceVector.C a) => Vector a where+   assembleVector ::+      (TypeNum.Positive n) =>+      LP.Proxy a -> LLVM.Vector n (NiceValue.Repr a) ->+      CodeGenFunction r (NiceVector.Repr n a)+   disassembleVector ::+      (TypeNum.Positive n) =>+      LP.Proxy a -> NiceVector.Repr n a ->+      CodeGenFunction r (LLVM.Vector n (NiceValue.Repr a))++instance Vector Float where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Double where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word8 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word16 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word32 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word64 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int8 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int16 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int32 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int64 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Bool where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Bool8 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive+++instance+   (Tuple tuple, TupleVector tuple) =>+      Vector (StoreTuple.Tuple tuple) where+   assembleVector = deinterleave . fmap StoreTuple.getTuple+   disassembleVector = interleave . fmap StoreTuple.getTuple+++class (NiceVector.C a) => TupleVector a where+   deinterleave ::+      (TypeNum.Positive n) =>+      LP.Proxy a -> LLVM.Vector n (NiceValue.Repr a) ->+      CodeGenFunction r (NiceVector.Repr n a)+   interleave ::+      (TypeNum.Positive n) =>+      LP.Proxy a -> NiceVector.Repr n a ->+      CodeGenFunction r (LLVM.Vector n (NiceValue.Repr a))++instance (Vector a, Vector b) => TupleVector (a,b) where+   deinterleave = FuncHT.uncurry $ \pa pb -> FuncHT.uncurry $ \a b ->+      App.lift2 (,) (assembleVector pa a) (assembleVector pb b)+   interleave = FuncHT.uncurry $ \pa pb (a,b) ->+      App.lift2 (App.lift2 (,))+         (disassembleVector pa a) (disassembleVector pb b)++instance (Vector a, Vector b, Vector c) => TupleVector (a,b,c) where+   deinterleave = FuncHT.uncurry3 $ \pa pb pc -> FuncHT.uncurry3 $ \a b c ->+      App.lift3 (,,)+         (assembleVector pa a)+         (assembleVector pb b)+         (assembleVector pc c)+   interleave = FuncHT.uncurry3 $ \pa pb pc (a,b,c) ->+      App.lift3 (App.lift3 (,,))+         (disassembleVector pa a)+         (disassembleVector pb b)+         (disassembleVector pc c)+++{-+instance Storable () available since base-4.9/GHC-8.0.+Before we need Data.Orphans.+-}+instance C () where+   load _ptr = return $ NiceValue.Cons ()+   store (NiceValue.Cons ()) _ptr = return ()+++loadTraversable ::+   (NonEmptyC.Repeat f, Trav.Traversable f,+    C a, NiceValue.Repr fa ~ f (NiceValue.Repr a)) =>+   Value (Ptr (f a)) -> CodeGenFunction r (NiceValue.T fa)+loadTraversable =+   (MS.evalStateT $ fmap NiceValue.Cons $+    Trav.sequence $ NonEmptyC.repeat $ loadState)+      <=< castElementPtr++loadApplicative ::+   (Applicative f, Trav.Traversable f,+    C a, NiceValue.Repr fa ~ f (NiceValue.Repr a)) =>+   Value (Ptr (f a)) -> CodeGenFunction r (NiceValue.T fa)+loadApplicative = fmap NiceValue.Cons . loadApplicativeRepr++loadApplicativeRepr ::+   (Applicative f, Trav.Traversable f, C a) =>+   Value (Ptr (f a)) -> CodeGenFunction r (f (NiceValue.Repr a))+loadApplicativeRepr =+   (MS.evalStateT $ Trav.sequence $ pure loadState) <=< castElementPtr++loadState ::+   (C a, NiceValue.Repr a ~ al) =>+   MS.StateT (Value (Ptr a)) (CodeGenFunction r) al+loadState =+   MT.lift . fmap (\(NiceValue.Cons a) -> a) . load =<< advancePtrState+++storeFoldable ::+   (Fold.Foldable f, C a, NiceValue.Repr fa ~ f (NiceValue.Repr a)) =>+    NiceValue.T fa -> Value (Ptr (f a)) -> CodeGenFunction r ()+storeFoldable (NiceValue.Cons xs) = storeFoldableRepr xs++storeFoldableRepr ::+   (Fold.Foldable f, C a) =>+   f (NiceValue.Repr a) -> Value (Ptr (f a)) -> CodeGenFunction r ()+storeFoldableRepr xs =+   MS.evalStateT (Fold.mapM_ storeState xs) <=< castElementPtr++storeState ::+   (C a, NiceValue.Repr a ~ al) =>+   al -> MS.StateT (Value (Ptr a)) (CodeGenFunction r) ()+storeState a = MT.lift . store (NiceValue.Cons a) =<< advancePtrState+++advancePtrState ::+   (C a, Value (Ptr a) ~ ptr) =>+   MS.StateT ptr (CodeGenFunction r) ptr+advancePtrState = update $ advancePtrStatic 1
+ src/LLVM/Extra/Nice/Value/Vector.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module LLVM.Extra.Nice.Value.Vector (+   cons,+   fst, snd,+   fst3, snd3, thd3,+   zip, zip3,+   unzip, unzip3,++   swap,+   mapFst, mapSnd,+   mapFst3, mapSnd3, mapThd3,++   extract, insert,+   replicate,+   iterate,+   dissect,+   dissect1,+   select,+   cmp,+   take, takeRev,++   NativeInteger,+   NativeFloating,+   fromIntegral,+   truncateToInt,+   splitFractionToInt,+   ) where++import qualified LLVM.Extra.Nice.Vector.Instance as Inst+import qualified LLVM.Extra.Nice.Vector as NiceVector+import qualified LLVM.Extra.Nice.Value.Private as NiceValue+import qualified LLVM.Extra.ScalarOrVector as SoV+import LLVM.Extra.Nice.Vector.Instance (NVVector)++import qualified LLVM.Core as LLVM++import qualified Type.Data.Num.Decimal as TypeNum+++import qualified Data.NonEmpty as NonEmpty+import qualified Data.Tuple.HT as TupleHT+import qualified Data.Tuple as Tuple+import Data.Word (Word8, Word16, Word32, Word64, Word)+import Data.Int (Int8, Int16, Int32, Int64, Int)++import Prelude (Float, Double, Bool, fmap, (.))+++cons ::+   (TypeNum.Positive n, NiceVector.C a) =>+   LLVM.Vector n a -> NVVector n a+cons = Inst.toNiceValue . NiceVector.cons++fst :: NVVector n (a,b) -> NVVector n a+fst = NiceValue.lift1 Tuple.fst++snd :: NVVector n (a,b) -> NVVector n b+snd = NiceValue.lift1 Tuple.snd++swap :: NVVector n (a,b) -> NVVector n (b,a)+swap = NiceValue.lift1 TupleHT.swap++mapFst ::+   (NVVector n a0 -> NVVector n a1) ->+   NVVector n (a0,b) -> NVVector n (a1,b)+mapFst f = Tuple.uncurry zip . TupleHT.mapFst f . unzip++mapSnd ::+   (NVVector n b0 -> NVVector n b1) ->+   NVVector n (a,b0) -> NVVector n (a,b1)+mapSnd f = Tuple.uncurry zip . TupleHT.mapSnd f . unzip+++fst3 :: NVVector n (a,b,c) -> NVVector n a+fst3 = NiceValue.lift1 TupleHT.fst3++snd3 :: NVVector n (a,b,c) -> NVVector n b+snd3 = NiceValue.lift1 TupleHT.snd3++thd3 :: NVVector n (a,b,c) -> NVVector n c+thd3 = NiceValue.lift1 TupleHT.thd3++mapFst3 ::+   (NVVector n a0 -> NVVector n a1) ->+   NVVector n (a0,b,c) -> NVVector n (a1,b,c)+mapFst3 f = TupleHT.uncurry3 zip3 . TupleHT.mapFst3 f . unzip3++mapSnd3 ::+   (NVVector n b0 -> NVVector n b1) ->+   NVVector n (a,b0,c) -> NVVector n (a,b1,c)+mapSnd3 f = TupleHT.uncurry3 zip3 . TupleHT.mapSnd3 f . unzip3++mapThd3 ::+   (NVVector n c0 -> NVVector n c1) ->+   NVVector n (a,b,c0) -> NVVector n (a,b,c1)+mapThd3 f = TupleHT.uncurry3 zip3 . TupleHT.mapThd3 f . unzip3+++zip :: NVVector n a -> NVVector n b -> NVVector n (a,b)+zip (NiceValue.Cons a) (NiceValue.Cons b) = NiceValue.Cons (a,b)++zip3 :: NVVector n a -> NVVector n b -> NVVector n c -> NVVector n (a,b,c)+zip3 (NiceValue.Cons a) (NiceValue.Cons b) (NiceValue.Cons c) =+   NiceValue.Cons (a,b,c)++unzip :: NVVector n (a,b) -> (NVVector n a, NVVector n b)+unzip (NiceValue.Cons (a,b)) = (NiceValue.Cons a, NiceValue.Cons b)++unzip3 :: NVVector n (a,b,c) -> (NVVector n a, NVVector n b, NVVector n c)+unzip3 (NiceValue.Cons (a,b,c)) =+   (NiceValue.Cons a, NiceValue.Cons b, NiceValue.Cons c)+++extract ::+   (TypeNum.Positive n, NiceVector.C a) =>+   LLVM.Value Word32 -> NVVector n a ->+   LLVM.CodeGenFunction r (NiceValue.T a)+extract k v = NiceVector.extract k (Inst.fromNiceValue v)++insert ::+   (TypeNum.Positive n, NiceVector.C a) =>+   LLVM.Value Word32 -> NiceValue.T a ->+   NVVector n a -> LLVM.CodeGenFunction r (NVVector n a)+insert k a = Inst.liftNiceValueM (NiceVector.insert k a)+++replicate ::+   (TypeNum.Positive n, NiceVector.C a) =>+   NiceValue.T a -> LLVM.CodeGenFunction r (NVVector n a)+replicate = fmap Inst.toNiceValue . NiceVector.replicate++iterate ::+   (TypeNum.Positive n, NiceVector.C a) =>+   (NiceValue.T a -> LLVM.CodeGenFunction r (NiceValue.T a)) ->+   NiceValue.T a -> LLVM.CodeGenFunction r (NVVector n a)+iterate f = fmap Inst.toNiceValue . NiceVector.iterate f++take ::+   (TypeNum.Positive n, TypeNum.Positive m, NiceVector.C a) =>+   NVVector n a -> LLVM.CodeGenFunction r (NVVector m a)+take = Inst.liftNiceValueM NiceVector.take++takeRev ::+   (TypeNum.Positive n, TypeNum.Positive m, NiceVector.C a) =>+   NVVector n a -> LLVM.CodeGenFunction r (NVVector m a)+takeRev = Inst.liftNiceValueM NiceVector.takeRev+++dissect ::+   (TypeNum.Positive n, NiceVector.C a) =>+   NVVector n a -> LLVM.CodeGenFunction r [NiceValue.T a]+dissect = NiceVector.dissect . Inst.fromNiceValue++dissect1 ::+   (TypeNum.Positive n, NiceVector.C a) =>+   NVVector n a -> LLVM.CodeGenFunction r (NonEmpty.T [] (NiceValue.T a))+dissect1 = NiceVector.dissect1 . Inst.fromNiceValue++select ::+   (TypeNum.Positive n, NiceVector.Select a) =>+   NVVector n Bool ->+   NVVector n a -> NVVector n a ->+   LLVM.CodeGenFunction r (NVVector n a)+select = Inst.liftNiceValueM3 NiceVector.select++cmp ::+   (TypeNum.Positive n, NiceVector.Comparison a) =>+   LLVM.CmpPredicate ->+   NVVector n a -> NVVector n a ->+   LLVM.CodeGenFunction r (NVVector n Bool)+cmp = Inst.liftNiceValueM2 . NiceVector.cmp+++{-+ToDo: make this a super-class of NiceValue.NativeInteger+problem: we need NiceValue.Repr, which provokes an import cycle+maybe we should break the cycle using a ConstraintKind,+i.e. define class NativeIntegerVec in NiceValue,+and define NativeInteger = NiceValue.NativeIntegerVec here+and export only NiceValueVec.NativeInteger constraint synonym.+-}+class+   (NiceValue.Repr i ~ LLVM.Value ir,+    LLVM.CmpRet ir, LLVM.IsInteger ir, SoV.IntegerConstant ir) =>+      NativeInteger i ir where++instance NativeInteger Word   Word   where+instance NativeInteger Word8  Word8  where+instance NativeInteger Word16 Word16 where+instance NativeInteger Word32 Word32 where+instance NativeInteger Word64 Word64 where++instance NativeInteger Int   Int   where+instance NativeInteger Int8  Int8  where+instance NativeInteger Int16 Int16 where+instance NativeInteger Int32 Int32 where+instance NativeInteger Int64 Int64 where++instance+   (TypeNum.Positive n, n ~ m,+    NiceVector.NativeInteger n i ir,+    NiceValue.NativeInteger i ir) =>+      NativeInteger (LLVM.Vector n i) (LLVM.Vector m ir) where+++class+   (NiceValue.Repr a ~ LLVM.Value ar,+    LLVM.CmpRet ar,  SoV.RationalConstant ar, LLVM.IsFloating ar) =>+      NativeFloating a ar where++instance NativeFloating Float  Float  where+instance NativeFloating Double Double where++instance+   (TypeNum.Positive n, n ~ m,+    NiceVector.NativeFloating n a ar,+    NiceValue.NativeFloating a ar) =>+      NativeFloating (LLVM.Vector n a) (LLVM.Vector m ar) where++fromIntegral ::+   (NativeInteger i ir, NativeFloating a ar,+    LLVM.ShapeOf ir ~ LLVM.ShapeOf ar) =>+   NiceValue.T i -> LLVM.CodeGenFunction r (NiceValue.T a)+fromIntegral = NiceValue.liftM LLVM.inttofp+++truncateToInt ::+   (NativeInteger i ir, NativeFloating a ar,+    LLVM.ShapeOf ir ~ LLVM.ShapeOf ar) =>+   NiceValue.T a -> LLVM.CodeGenFunction r (NiceValue.T i)+truncateToInt = NiceValue.liftM LLVM.fptoint++splitFractionToInt ::+   (NativeInteger i ir, NativeFloating a ar,+    LLVM.ShapeOf ir ~ LLVM.ShapeOf ar) =>+   NiceValue.T a -> LLVM.CodeGenFunction r (NiceValue.T (i,a))+splitFractionToInt = NiceValue.liftM SoV.splitFractionToInt
+ src/LLVM/Extra/Nice/Vector.hs view
@@ -0,0 +1,1346 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+module LLVM.Extra.Nice.Vector (+   T(Cons), consPrim, deconsPrim,+   C(..),+   Value,+   map,+   zip, zip3, unzip, unzip3,+   replicate,+   iterate,+   take,+   takeRev,++   sum,+   dotProduct,+   cumulate,+   cumulate1,++   lift1,++   modify,+   assemble,+   dissect,+   dissectList,++   assemble1,+   dissect1,+   dissectList1,++   assembleFromVector,+   consVarArg,++   reverse,+   rotateUp,+   rotateDown,+   shiftUp,+   shiftDown,+   shiftUpMultiZero,+   shiftDownMultiZero,+   shiftUpMultiUndef,+   shiftDownMultiUndef,++   undefPrimitive,+   shufflePrimitive,+   extractPrimitive,+   insertPrimitive,++   shuffleMatchTraversable,+   insertTraversable,+   extractTraversable,++   IntegerConstant(..),+   RationalConstant(..),+   Additive(..),+   PseudoRing(..),+   Field(..),+   scale,+   PseudoModule(..),+   Real(..),+   Fraction(..),+   NativeInteger, NativeFloating, fromIntegral,+   Algebraic(..),+   Transcendental(..),+   FloatingComparison(..),+   Select(..),+   Comparison(..),+   Logic(..),+   BitShift(..),+   ) where++import qualified LLVM.Extra.Nice.Value.Private as NiceValue+import qualified LLVM.Extra.ScalarOrVector as SoV+import qualified LLVM.Extra.Arithmetic as A+import qualified LLVM.Extra.Tuple as Tuple++import qualified LLVM.Core as LLVM+import LLVM.Core (CodeGenFunction, IsPrimitive, valueOf, value, )++import qualified Type.Data.Num.Decimal as TypeNum+import qualified Type.Data.Num.Decimal as Dec+import qualified Type.Data.Num.Unary as Unary++import qualified Foreign.Storable.Record.Tuple as StoreTuple++import qualified Data.Traversable as Trav+import qualified Data.NonEmpty.Class as NonEmptyC+import qualified Data.NonEmpty as NonEmpty+import qualified Data.List as List+import qualified Data.Bool8 as Bool8+import Data.Traversable (mapM, sequence, )+import Data.Foldable (foldlM)+import Data.NonEmpty ((!:), )+import Data.Function (flip, (.), ($), )+import Data.Tuple (snd, )+import Data.Maybe (maybe, )+import Data.Ord ((<), )+import Data.Word (Word8, Word16, Word32, Word64, Word)+import Data.Int (Int8, Int16, Int32, Int64, )+import Data.Bool8 (Bool8)+import Data.Bool (Bool, )++import qualified Control.Monad.HT as Monad+import qualified Control.Applicative as App+import qualified Control.Functor.HT as FuncHT+import Control.Monad.HT ((<=<), )+import Control.Monad (Monad, join, fmap, return, (>>), (=<<))+import Control.Applicative (liftA2, (<$>))++import qualified Prelude as P+import Prelude+         (Float, Double, Integer, Int, Rational, asTypeOf, (-), (+), (*), error)+++newtype T n a = Cons (Repr n a)++type Value n a = LLVM.Value (LLVM.Vector n a)+++consPrim :: (Repr n a ~ Value n ar) => Value n ar -> T n a+consPrim = Cons++deconsPrim :: (Repr n a ~ Value n ar) => T n a -> Value n ar+deconsPrim (Cons a) = a+++instance (TypeNum.Positive n, C a) => Tuple.Undefined (T n a) where+   undef = undef++instance (TypeNum.Positive n, C a) => Tuple.Zero (T n a) where+   zero = zero++instance (TypeNum.Positive n, C a) => Tuple.Phi (T n a) where+   phi = phi+   addPhi = addPhi+++sizeS :: TypeNum.Positive n => T n a -> TypeNum.Singleton n+sizeS _ = TypeNum.singleton++size :: (TypeNum.Positive n, P.Integral i) => T n a -> i+size = TypeNum.integralFromSingleton . sizeS++last ::+   (TypeNum.Positive n, C a) =>+   T n a -> CodeGenFunction r (NiceValue.T a)+last x = extract (valueOf (size x - 1)) x+++zip :: T n a -> T n b -> T n (a,b)+zip (Cons a) (Cons b) = Cons (a,b)++zip3 :: T n a -> T n b -> T n c -> T n (a,b,c)+zip3 (Cons a) (Cons b) (Cons c) = Cons (a,b,c)++unzip :: T n (a,b) -> (T n a, T n b)+unzip (Cons (a,b)) = (Cons a, Cons b)++unzip3 :: T n (a,b,c) -> (T n a, T n b, T n c)+unzip3 (Cons (a,b,c)) = (Cons a, Cons b, Cons c)+++class (NiceValue.C a) => C a where+   type Repr n a+   cons :: (TypeNum.Positive n) => LLVM.Vector n a -> T n a+   undef :: (TypeNum.Positive n) => T n a+   zero :: (TypeNum.Positive n) => T n a+   phi ::+      (TypeNum.Positive n) =>+      LLVM.BasicBlock -> T n a -> LLVM.CodeGenFunction r (T n a)+   addPhi ::+      (TypeNum.Positive n) =>+      LLVM.BasicBlock -> T n a -> T n a -> LLVM.CodeGenFunction r ()++   shuffle ::+      (TypeNum.Positive n, TypeNum.Positive m) =>+      LLVM.ConstValue (LLVM.Vector m Word32) -> T n a -> T n a ->+      CodeGenFunction r (T m a)+   extract ::+      (TypeNum.Positive n) =>+      LLVM.Value Word32 -> T n a -> CodeGenFunction r (NiceValue.T a)+   insert ::+      (TypeNum.Positive n) =>+      LLVM.Value Word32 -> NiceValue.T a ->+      T n a -> CodeGenFunction r (T n a)++instance C Bool where+   type Repr n Bool = LLVM.Value (LLVM.Vector n Bool)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+   shuffle = shufflePrimitive+   extract = extractPrimitive+   insert = insertPrimitive++instance C Bool8 where+   type Repr n Bool8 = LLVM.Value (LLVM.Vector n Bool)+   cons = consPrimitive . fmap Bool8.toBool+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+   shuffle = shufflePrimitive+   extract = extractPrimitive+   insert = insertPrimitive++instance C Float where+   type Repr n Float = LLVM.Value (LLVM.Vector n Float)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+   shuffle = shufflePrimitive+   extract = extractPrimitive+   insert = insertPrimitive++instance C Double where+   type Repr n Double = LLVM.Value (LLVM.Vector n Double)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+   shuffle = shufflePrimitive+   extract = extractPrimitive+   insert = insertPrimitive++instance C Int where+   type Repr n Int = LLVM.Value (LLVM.Vector n Int)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+   shuffle = shufflePrimitive+   extract = extractPrimitive+   insert = insertPrimitive++instance C Int8 where+   type Repr n Int8 = LLVM.Value (LLVM.Vector n Int8)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+   shuffle = shufflePrimitive+   extract = extractPrimitive+   insert = insertPrimitive++instance C Int16 where+   type Repr n Int16 = LLVM.Value (LLVM.Vector n Int16)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+   shuffle = shufflePrimitive+   extract = extractPrimitive+   insert = insertPrimitive++instance C Int32 where+   type Repr n Int32 = LLVM.Value (LLVM.Vector n Int32)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+   shuffle = shufflePrimitive+   extract = extractPrimitive+   insert = insertPrimitive++instance C Int64 where+   type Repr n Int64 = LLVM.Value (LLVM.Vector n Int64)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+   shuffle = shufflePrimitive+   extract = extractPrimitive+   insert = insertPrimitive++instance C Word where+   type Repr n Word = LLVM.Value (LLVM.Vector n Word)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+   shuffle = shufflePrimitive+   extract = extractPrimitive+   insert = insertPrimitive++instance C Word8 where+   type Repr n Word8 = LLVM.Value (LLVM.Vector n Word8)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+   shuffle = shufflePrimitive+   extract = extractPrimitive+   insert = insertPrimitive++instance C Word16 where+   type Repr n Word16 = LLVM.Value (LLVM.Vector n Word16)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+   shuffle = shufflePrimitive+   extract = extractPrimitive+   insert = insertPrimitive++instance C Word32 where+   type Repr n Word32 = LLVM.Value (LLVM.Vector n Word32)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+   shuffle = shufflePrimitive+   extract = extractPrimitive+   insert = insertPrimitive++instance C Word64 where+   type Repr n Word64 = LLVM.Value (LLVM.Vector n Word64)+   cons = consPrimitive+   undef = undefPrimitive+   zero = zeroPrimitive+   phi = phiPrimitive+   addPhi = addPhiPrimitive+   shuffle = shufflePrimitive+   extract = extractPrimitive+   insert = insertPrimitive++consPrimitive ::+   (TypeNum.Positive n, LLVM.IsConst al, IsPrimitive al,+    Repr n a ~ Value n al) =>+   LLVM.Vector n al -> T n a+consPrimitive = Cons . LLVM.valueOf++undefPrimitive ::+   (TypeNum.Positive n, IsPrimitive al,+    Repr n a ~ Value n al) =>+   T n a+undefPrimitive = Cons $ LLVM.value LLVM.undef++zeroPrimitive ::+   (TypeNum.Positive n, IsPrimitive al,+    Repr n a ~ Value n al) =>+   T n a+zeroPrimitive = Cons $ LLVM.value LLVM.zero++phiPrimitive ::+   (TypeNum.Positive n, IsPrimitive al, Repr n a ~ Value n al) =>+   LLVM.BasicBlock -> T n a -> LLVM.CodeGenFunction r (T n a)+phiPrimitive bb (Cons a) = fmap Cons $ Tuple.phi bb a++addPhiPrimitive ::+   (TypeNum.Positive n, IsPrimitive al, Repr n a ~ Value n al) =>+   LLVM.BasicBlock -> T n a -> T n a -> LLVM.CodeGenFunction r ()+addPhiPrimitive bb (Cons a) (Cons b) = Tuple.addPhi bb a b+++shufflePrimitive ::+   (TypeNum.Positive n, TypeNum.Positive m, IsPrimitive al,+    NiceValue.Repr a ~ LLVM.Value al,+    Repr n a ~ Value n al,+    Repr m a ~ Value m al) =>+   LLVM.ConstValue (LLVM.Vector m Word32) ->+   T n a -> T n a -> CodeGenFunction r (T m a)+shufflePrimitive k (Cons u) (Cons v) =+   fmap Cons $ LLVM.shufflevector u v k++extractPrimitive ::+   (TypeNum.Positive n, IsPrimitive al,+    NiceValue.Repr a ~ LLVM.Value al,+    Repr n a ~ Value n al) =>+   LLVM.Value Word32 -> T n a -> CodeGenFunction r (NiceValue.T a)+extractPrimitive k (Cons v) =+   fmap NiceValue.Cons $ LLVM.extractelement v k++insertPrimitive ::+   (TypeNum.Positive n, IsPrimitive al,+    NiceValue.Repr a ~ LLVM.Value al,+    Repr n a ~ Value n al) =>+   LLVM.Value Word32 ->+   NiceValue.T a -> T n a -> CodeGenFunction r (T n a)+insertPrimitive k (NiceValue.Cons a) (Cons v) =+   fmap Cons $ LLVM.insertelement v a k+++instance (C a, C b) => C (a,b) where+   type Repr n (a,b) = (Repr n a, Repr n b)+   cons v = case FuncHT.unzip v of (a,b) -> zip (cons a) (cons b)+   undef = zip undef undef+   zero = zip zero zero++   phi bb a =+      case unzip a of+         (a0,a1) ->+            Monad.lift2 zip (phi bb a0) (phi bb a1)+   addPhi bb a b =+      case (unzip a, unzip b) of+         ((a0,a1), (b0,b1)) ->+            addPhi bb a0 b0 >>+            addPhi bb a1 b1++   shuffle is u v =+      case (unzip u, unzip v) of+         ((u0,u1), (v0,v1)) ->+            Monad.lift2 zip+               (shuffle is u0 v0)+               (shuffle is u1 v1)++   extract k v =+      case unzip v of+         (v0,v1) ->+            Monad.lift2 NiceValue.zip+               (extract k v0)+               (extract k v1)++   insert k a v =+      case (NiceValue.unzip a, unzip v) of+         ((a0,a1), (v0,v1)) ->+            Monad.lift2 zip+               (insert k a0 v0)+               (insert k a1 v1)+++instance (C a, C b, C c) => C (a,b,c) where+   type Repr n (a,b,c) = (Repr n a, Repr n b, Repr n c)+   cons v = case FuncHT.unzip3 v of (a,b,c) -> zip3 (cons a) (cons b) (cons c)+   undef = zip3 undef undef undef+   zero = zip3 zero zero zero++   phi bb a =+      case unzip3 a of+         (a0,a1,a2) ->+            Monad.lift3 zip3 (phi bb a0) (phi bb a1) (phi bb a2)+   addPhi bb a b =+      case (unzip3 a, unzip3 b) of+         ((a0,a1,a2), (b0,b1,b2)) ->+            addPhi bb a0 b0 >>+            addPhi bb a1 b1 >>+            addPhi bb a2 b2++   shuffle is u v =+      case (unzip3 u, unzip3 v) of+         ((u0,u1,u2), (v0,v1,v2)) ->+            Monad.lift3 zip3+               (shuffle is u0 v0)+               (shuffle is u1 v1)+               (shuffle is u2 v2)++   extract k v =+      case unzip3 v of+         (v0,v1,v2) ->+            Monad.lift3 NiceValue.zip3+               (extract k v0)+               (extract k v1)+               (extract k v2)++   insert k a v =+      case (NiceValue.unzip3 a, unzip3 v) of+         ((a0,a1,a2), (v0,v1,v2)) ->+            Monad.lift3 zip3+               (insert k a0 v0)+               (insert k a1 v1)+               (insert k a2 v2)+++instance (C tuple) => C (StoreTuple.Tuple tuple) where+   type Repr n (StoreTuple.Tuple tuple) = Repr n tuple+   cons = tuple . cons . fmap StoreTuple.getTuple+   undef = tuple undef+   zero = tuple zero+   phi bb = fmap tuple . phi bb . untuple+   addPhi bb a b = addPhi bb (untuple a) (untuple b)+   shuffle is u v = tuple <$> shuffle is (untuple u) (untuple v)+   extract k v = NiceValue.tuple <$> extract k (untuple v)+   insert k a v = tuple <$> insert k (NiceValue.untuple a) (untuple v)++tuple :: T n tuple -> T n (StoreTuple.Tuple tuple)+tuple (Cons a) = Cons a++untuple :: T n (StoreTuple.Tuple tuple) -> T n tuple+untuple (Cons a) = Cons a+++class (NiceValue.IntegerConstant a, C a) => IntegerConstant a where+   fromInteger' :: (TypeNum.Positive n) => Integer -> T n a++class+   (NiceValue.RationalConstant a, IntegerConstant a) =>+      RationalConstant a where+   fromRational' :: (TypeNum.Positive n) => Rational -> T n a++instance IntegerConstant Float  where fromInteger' = fromIntegerPrimitive+instance IntegerConstant Double where fromInteger' = fromIntegerPrimitive+instance IntegerConstant Word   where fromInteger' = fromIntegerPrimitive+instance IntegerConstant Word8  where fromInteger' = fromIntegerPrimitive+instance IntegerConstant Word16 where fromInteger' = fromIntegerPrimitive+instance IntegerConstant Word32 where fromInteger' = fromIntegerPrimitive+instance IntegerConstant Word64 where fromInteger' = fromIntegerPrimitive+instance IntegerConstant Int   where fromInteger' = fromIntegerPrimitive+instance IntegerConstant Int8  where fromInteger' = fromIntegerPrimitive+instance IntegerConstant Int16 where fromInteger' = fromIntegerPrimitive+instance IntegerConstant Int32 where fromInteger' = fromIntegerPrimitive+instance IntegerConstant Int64 where fromInteger' = fromIntegerPrimitive++fromIntegerPrimitive ::+   (TypeNum.Positive n, IsPrimitive a, SoV.IntegerConstant a,+    Repr n a ~ Value n a) =>+   Integer -> T n a+fromIntegerPrimitive = Cons . LLVM.value . SoV.constFromInteger++instance RationalConstant Float  where fromRational' = fromRationalPrimitive+instance RationalConstant Double where fromRational' = fromRationalPrimitive++fromRationalPrimitive ::+   (TypeNum.Positive n, IsPrimitive a, SoV.RationalConstant a,+    Repr n a ~ Value n a) =>+   Rational -> T n a+fromRationalPrimitive = Cons . LLVM.value . SoV.constFromRational++instance+   (TypeNum.Positive n, IntegerConstant a) =>+      A.IntegerConstant (T n a) where+   fromInteger' = fromInteger'++instance+   (TypeNum.Positive n, RationalConstant a) =>+      A.RationalConstant (T n a) where+   fromRational' = fromRational'+++modify ::+   (TypeNum.Positive n, C a) =>+   LLVM.Value Word32 ->+   (NiceValue.T a -> CodeGenFunction r (NiceValue.T a)) ->+   (T n a -> CodeGenFunction r (T n a))+modify k f v =+   flip (insert k) v =<< f =<< extract k v+++assemble ::+   (TypeNum.Positive n, C a) =>+   [NiceValue.T a] -> CodeGenFunction r (T n a)+assemble =+   foldlM (\v (k,x) -> insert (valueOf k) x v) undef .+   List.zip [0..]++dissect ::+   (TypeNum.Positive n, C a) =>+   T n a -> LLVM.CodeGenFunction r [NiceValue.T a]+dissect = sequence . dissectList++dissectList ::+   (TypeNum.Positive n, C a) =>+   T n a -> [LLVM.CodeGenFunction r (NiceValue.T a)]+dissectList x =+   List.map+      (flip extract x . LLVM.valueOf)+      (List.take (size x) [0..])+++assemble1 ::+   (TypeNum.Positive n, C a) =>+   NonEmpty.T [] (NiceValue.T a) -> CodeGenFunction r (T n a)+assemble1 = assemble . NonEmpty.flatten++dissect1 ::+   (TypeNum.Positive n, C a) =>+   T n a -> LLVM.CodeGenFunction r (NonEmpty.T [] (NiceValue.T a))+dissect1 = sequence . dissectList1++dissectList1 ::+   (TypeNum.Positive n, C a) =>+   T n a -> NonEmpty.T [] (LLVM.CodeGenFunction r (NiceValue.T a))+dissectList1 x =+   fmap+      (flip extract x . LLVM.valueOf)+      (0 !: List.take (size x - 1) [1 ..])+++assembleFromVector ::+   (TypeNum.Positive n, C a) =>+   LLVM.Vector n (NiceValue.T a) -> CodeGenFunction r (T n a)+assembleFromVector =+   fmap snd .+   foldlM (\(k,v) x -> (,) (k+1) <$> insert (valueOf k) x v) (0,undef)+++type family VectorSize v+type instance VectorSize (T n a) = n++type family VectorElement v+type instance VectorElement (T n a) = a++class+   (Dec.Positive n, C a, ResultRet f ~ r,+    VectorSize (ResultVector f) ~ n, VectorElement (ResultVector f) ~ a) =>+      Cons r n a f where+   type NumberOfArguments f+   type ResultRet f+   type ResultVector f+   consAux :: Word32 -> CodeGenFunction r (T n a) -> f++instance+   (Dec.Positive n, C a, r0 ~ r, T n a ~ v) =>+      Cons r0 n a (CodeGenFunction r v) where+   type NumberOfArguments (CodeGenFunction r v) = Unary.Zero+   type ResultRet (CodeGenFunction r v) = r+   type ResultVector (CodeGenFunction r v) = v+   consAux _ mv = mv++instance (NiceValue.T a ~ arg, Cons r n a f) => Cons r n a (arg -> f) where+   type NumberOfArguments (arg -> f) = Unary.Succ (NumberOfArguments f)+   type ResultRet (arg -> f) = ResultRet f+   type ResultVector (arg -> f) = ResultVector f+   consAux k mv x = consAux (k+1) (insert (LLVM.valueOf k) x =<< mv)++consVarArg ::+   (Cons r n a f, NumberOfArguments f ~ u,+    u ~ Dec.ToUnary n, Dec.FromUnary u ~ n, Dec.Natural n) =>+   f+consVarArg = consAux 0 (return undef)++++map ::+   (TypeNum.Positive n, C a, C b) =>+   (NiceValue.T a -> CodeGenFunction r (NiceValue.T b)) ->+   (T n a -> CodeGenFunction r (T n b))+map f  =  assemble <=< mapM f <=< dissect+++singleton :: (C a) => NiceValue.T a -> CodeGenFunction r (T TypeNum.D1 a)+singleton x = insert (LLVM.value LLVM.zero) x undef++replicate ::+   (TypeNum.Positive n, C a) =>+   NiceValue.T a -> CodeGenFunction r (T n a)+replicate x = do+   single <- singleton x+   shuffle (constCyclicVector $ NonEmpty.singleton 0) single undef++iterate ::+   (TypeNum.Positive n, C a) =>+   (NiceValue.T a -> CodeGenFunction r (NiceValue.T a)) ->+   NiceValue.T a -> CodeGenFunction r (T n a)+iterate f x = fmap snd $ iterateCore f x Tuple.undef++iterateCore ::+   (TypeNum.Positive n, C a) =>+   (NiceValue.T a -> CodeGenFunction r (NiceValue.T a)) ->+   NiceValue.T a -> T n a ->+   CodeGenFunction r (NiceValue.T a, T n a)+iterateCore f x0 v0 =+   foldlM+      (\(x,v) k -> Monad.lift2 (,) (f x) (insert (valueOf k) x v))+      (x0,v0)+      (List.take (size v0) [0..])+++sum ::+   (TypeNum.Positive n, Additive a) =>+   T n a -> CodeGenFunction r (NiceValue.T a)+sum =+   NonEmpty.foldBalanced (\x y -> join $ liftA2 NiceValue.add x y) .+   dissectList1++dotProduct ::+   (TypeNum.Positive n, PseudoRing a) =>+   T n a -> T n a -> CodeGenFunction r (NiceValue.T a)+dotProduct x y = sum =<< mul x y+++cumulate ::+   (TypeNum.Positive n, Additive a) =>+   NiceValue.T a -> T n a ->+   CodeGenFunction r (NiceValue.T a, T n a)+cumulate a x0 = do+   (b,x1) <- shiftUp a x0+   y <- cumulate1 x1+   z <- A.add b =<< last y+   return (z,y)++{- |+Needs (log n) vector additions+-}+cumulate1 ::+   (TypeNum.Positive n, Additive a) =>+   T n a -> CodeGenFunction r (T n a)+cumulate1 x =+   foldlM+      (\y k -> A.add y =<< shiftUpMultiZero k y)+      x+      (List.takeWhile (< size x) $ List.iterate (2*) 1)+++-- * re-ordering of elements++constCyclicVector ::+   (LLVM.IsConst a, TypeNum.Positive n) =>+   NonEmpty.T [] a -> LLVM.ConstValue (LLVM.Vector n a)+constCyclicVector =+   LLVM.constCyclicVector . fmap LLVM.constOf++shuffleMatch ::+   (TypeNum.Positive n, C a) =>+   LLVM.ConstValue (LLVM.Vector n Word32) -> T n a ->+   CodeGenFunction r (T n a)+shuffleMatch k v = shuffle k v undef++{- |+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 ::+   (TypeNum.Positive n, C a) =>+   T n a -> CodeGenFunction r (T n a)+rotateUp x =+   shuffleMatch (constCyclicVector $ (size x - 1) !: [0..]) x++rotateDown ::+   (TypeNum.Positive n, C a) =>+   T n a -> CodeGenFunction r (T n a)+rotateDown x =+   shuffleMatch+      (constCyclicVector $+       NonEmpty.snoc (List.take (size x - 1) [1..]) 0) x++reverse ::+   (TypeNum.Positive n, C a) =>+   T n a -> CodeGenFunction r (T n a)+reverse x =+   shuffleMatch+      (constCyclicVector $+       maybe (error "vector size must be positive") NonEmpty.reverse $+       NonEmpty.fetch $+       List.take (size x) [0..])+      x++take ::+   (TypeNum.Positive n, TypeNum.Positive m, C a) =>+   T n a -> CodeGenFunction r (T m a)+take u = shuffle (constCyclicVector $ NonEmptyC.iterate (1+) 0) u undef++takeRev ::+   (TypeNum.Positive n, TypeNum.Positive m, C a) =>+   T n a -> CodeGenFunction r (T m a)+takeRev u = do+   let v0 = zero+   v <-+      shuffle+         (constCyclicVector $ NonEmptyC.iterate (1+) (size u - size v0))+         u undef+   return $ v `asTypeOf` v0++shiftUp ::+   (TypeNum.Positive n, C a) =>+   NiceValue.T a -> T n a -> CodeGenFunction r (NiceValue.T a, T n a)+shiftUp x0 x = do+   y <-+      shuffleMatch+         (LLVM.constCyclicVector $ LLVM.undef !: List.map LLVM.constOf [0..]) x+   Monad.lift2 (,) (last x) (insert (value LLVM.zero) x0 y)++shiftDown ::+   (TypeNum.Positive n, C a) =>+   NiceValue.T a -> T n a -> CodeGenFunction r (NiceValue.T a, T n a)+shiftDown x0 x = do+   y <-+      shuffleMatch+         (LLVM.constCyclicVector $+          NonEmpty.snoc+             (List.map LLVM.constOf $ List.take (size x - 1) [1..])+             LLVM.undef) x+   Monad.lift2 (,)+      (extract (value LLVM.zero) x)+      (insert (LLVM.valueOf (size x - 1)) x0 y)++shiftUpMultiIndices ::+   (TypeNum.Positive n) => Int -> Int -> LLVM.ConstValue (LLVM.Vector n Word32)+shiftUpMultiIndices n sizev =+   constCyclicVector $ fmap P.fromIntegral $+   NonEmpty.appendLeft (List.replicate n sizev) (NonEmptyC.iterate (1+) 0)++shiftDownMultiIndices ::+   (TypeNum.Positive n) => Int -> Int -> LLVM.ConstValue (LLVM.Vector n Word32)+shiftDownMultiIndices n sizev =+   constCyclicVector $ fmap P.fromIntegral $+   NonEmpty.appendLeft+      (List.takeWhile (< sizev) $ List.iterate (1+) n)+      (NonEmptyC.repeat sizev)++shiftUpMultiZero ::+   (TypeNum.Positive n, C a) =>+   Int -> T n a -> LLVM.CodeGenFunction r (T n a)+shiftUpMultiZero n v =+   shuffle (shiftUpMultiIndices n (size v)) v zero++shiftDownMultiZero ::+   (TypeNum.Positive n, C a) =>+   Int -> T n a -> LLVM.CodeGenFunction r (T n a)+shiftDownMultiZero n v =+   shuffle (shiftDownMultiIndices n (size v)) v zero++shiftUpMultiUndef ::+   (TypeNum.Positive n, C a) =>+   Int -> T n a -> LLVM.CodeGenFunction r (T n a)+shiftUpMultiUndef n v =+   shuffle (shiftUpMultiIndices n (size v)) v undef++shiftDownMultiUndef ::+   (TypeNum.Positive n, C a) =>+   Int -> T n a -> LLVM.CodeGenFunction r (T n a)+shiftDownMultiUndef n v =+   shuffle (shiftDownMultiIndices n (size v)) v undef+++-- * method implementations based on Traversable++shuffleMatchTraversable ::+   (TypeNum.Positive n, C a, Trav.Traversable f) =>+   LLVM.ConstValue (LLVM.Vector n Word32) ->+   f (T n a) -> CodeGenFunction r (f (T n a))+shuffleMatchTraversable is v =+   Trav.mapM (shuffleMatch is) v++insertTraversable ::+   (TypeNum.Positive n, C a, Trav.Traversable f, App.Applicative f) =>+   LLVM.Value Word32 -> f (NiceValue.T a) ->+   f (T n a) -> CodeGenFunction r (f (T n a))+insertTraversable n a v =+   Trav.sequence (liftA2 (insert n) a v)++extractTraversable ::+   (TypeNum.Positive n, C a, Trav.Traversable f) =>+   LLVM.Value Word32 -> f (T n a) ->+   CodeGenFunction r (f (NiceValue.T a))+extractTraversable n v =+   Trav.mapM (extract n) v++++lift1 :: (Repr n a -> Repr n b) -> T n a -> T n b+lift1 f (Cons a) = Cons $ f a++_liftM0 ::+   (Monad m) =>+   m (Repr n a) ->+   m (T n a)+_liftM0 f = Monad.lift Cons f++liftM0 ::+   (Monad m,+    Repr n a ~ Value n ar) =>+   m (Value n ar) ->+   m (T n a)+liftM0 f = Monad.lift consPrim f++liftM ::+   (Monad m,+    Repr n a ~ Value n ar,+    Repr n b ~ Value n br) =>+   (Value n ar -> m (Value n br)) ->+   T n a -> m (T n b)+liftM f a = Monad.lift consPrim $ f (deconsPrim a)++liftM2 ::+   (Monad m,+    Repr n a ~ Value n ar,+    Repr n b ~ Value n br,+    Repr n c ~ Value n cr) =>+   (Value n ar -> Value n br -> m (Value n cr)) ->+   T n a -> T n b -> m (T n c)+liftM2 f a b = Monad.lift consPrim $ f (deconsPrim a) (deconsPrim b)++liftM3 ::+   (Monad m,+    Repr n a ~ Value n ar,+    Repr n b ~ Value n br,+    Repr n c ~ Value n cr,+    Repr n d ~ Value n dr) =>+   (Value n ar -> Value n br -> Value n cr -> m (Value n dr)) ->+   T n a -> T n b -> T n c -> m (T n d)+liftM3 f a b c =+   Monad.lift consPrim $ f (deconsPrim a) (deconsPrim b) (deconsPrim c)++++class (NiceValue.Additive a, C a) => Additive a where+   add ::+      (TypeNum.Positive n) =>+      T n a -> T n a -> LLVM.CodeGenFunction r (T n a)+   sub ::+      (TypeNum.Positive n) =>+      T n a -> T n a -> LLVM.CodeGenFunction r (T n a)+   neg ::+      (TypeNum.Positive n) =>+      T n a -> LLVM.CodeGenFunction r (T n a)++instance Additive Float where+   add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg++instance Additive Double where+   add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg++instance Additive Int where+   add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg++instance Additive Int8 where+   add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg++instance Additive Int16 where+   add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg++instance Additive Int32 where+   add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg++instance Additive Int64 where+   add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg++instance Additive Word where+   add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg++instance Additive Word8 where+   add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg++instance Additive Word16 where+   add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg++instance Additive Word32 where+   add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg++instance Additive Word64 where+   add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg++instance (TypeNum.Positive n, Additive a) => A.Additive (T n a) where+   zero = zero+   add = add+   sub = sub+   neg = neg+++class (NiceValue.PseudoRing a, Additive a) => PseudoRing a where+   mul ::+      (TypeNum.Positive n) =>+      T n a -> T n a -> LLVM.CodeGenFunction r (T n a)++instance PseudoRing Float where+   mul = liftM2 LLVM.mul++instance PseudoRing Double where+   mul = liftM2 LLVM.mul++instance (TypeNum.Positive n, PseudoRing a) => A.PseudoRing (T n a) where+   mul = mul+++class (NiceValue.Field a, PseudoRing a) => Field a where+   fdiv ::+      (TypeNum.Positive n) =>+      T n a -> T n a -> LLVM.CodeGenFunction r (T n a)++instance Field Float where+   fdiv = liftM2 LLVM.fdiv++instance Field Double where+   fdiv = liftM2 LLVM.fdiv++instance (TypeNum.Positive n, Field a) => A.Field (T n a) where+   fdiv = fdiv+++scale ::+   (TypeNum.Positive n, PseudoRing a) =>+   NiceValue.T a -> T n a -> LLVM.CodeGenFunction r (T n a)+scale a v = flip mul v =<< replicate a+++type instance A.Scalar (T n a) = T n (NiceValue.Scalar a)++class+   (NiceValue.PseudoModule v, PseudoRing (NiceValue.Scalar v), Additive v) =>+      PseudoModule v where+   scaleMulti ::+      (TypeNum.Positive n) =>+      T n (NiceValue.Scalar v) -> T n v -> LLVM.CodeGenFunction r (T n v)++instance PseudoModule Float where+   scaleMulti = liftM2 A.mul++instance PseudoModule Double where+   scaleMulti = liftM2 A.mul++instance (TypeNum.Positive n, PseudoModule a) => A.PseudoModule (T n a) where+   scale = scaleMulti+++class (NiceValue.Real a, Additive a) => Real a where+   min :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)+   max :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)+   abs :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)+   signum :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)++instance Real Float where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Double where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Word where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Word8 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Word16 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Word32 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Word64 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Int where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Int8 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Int16 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Int32 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance Real Int64 where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum+++instance (TypeNum.Positive n, Real a) => A.Real (T n a) where+   min = min+   max = max+   abs = abs+   signum = signum+++class (NiceValue.Fraction a, Real a) => Fraction a where+   truncate :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)+   fraction :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)++instance Fraction Float where+   truncate = liftM A.truncate+   fraction = liftM A.fraction++instance Fraction Double where+   truncate = liftM A.truncate+   fraction = liftM A.fraction++instance (TypeNum.Positive n, Fraction a) => A.Fraction (T n a) where+   truncate = truncate+   fraction = fraction+++class+   (TypeNum.Positive n, Repr n i ~ Value n ir,+    NiceValue.NativeInteger i ir, IsPrimitive ir, LLVM.IsInteger ir) =>+      NativeInteger n i ir where++instance (TypeNum.Positive n) => NativeInteger n Word   Word   where+instance (TypeNum.Positive n) => NativeInteger n Word8  Word8  where+instance (TypeNum.Positive n) => NativeInteger n Word16 Word16 where+instance (TypeNum.Positive n) => NativeInteger n Word32 Word32 where+instance (TypeNum.Positive n) => NativeInteger n Word64 Word64 where++instance (TypeNum.Positive n) => NativeInteger n Int   Int   where+instance (TypeNum.Positive n) => NativeInteger n Int8  Int8  where+instance (TypeNum.Positive n) => NativeInteger n Int16 Int16 where+instance (TypeNum.Positive n) => NativeInteger n Int32 Int32 where+instance (TypeNum.Positive n) => NativeInteger n Int64 Int64 where++class+   (TypeNum.Positive n, Repr n a ~ Value n ar,+    NiceValue.NativeFloating a ar, IsPrimitive ar, LLVM.IsFloating ar) =>+      NativeFloating n a ar where++instance (TypeNum.Positive n) => NativeFloating n Float  Float where+instance (TypeNum.Positive n) => NativeFloating n Double Double where++fromIntegral ::+   (NativeInteger n i ir, NativeFloating n a ar) =>+   T n i -> LLVM.CodeGenFunction r (T n a)+fromIntegral = liftM LLVM.inttofp+++class (NiceValue.Algebraic a, Field a) => Algebraic a where+   sqrt :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)++instance Algebraic Float where+   sqrt = liftM A.sqrt++instance Algebraic Double where+   sqrt = liftM A.sqrt++instance (TypeNum.Positive n, Algebraic a) => A.Algebraic (T n a) where+   sqrt = sqrt+++class (NiceValue.Transcendental a, Algebraic a) => Transcendental a where+   pi :: (TypeNum.Positive n) => LLVM.CodeGenFunction r (T n a)+   sin, cos, exp, log ::+      (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)+   pow ::+      (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)++instance Transcendental Float where+   pi = liftM0 A.pi+   sin = liftM A.sin+   cos = liftM A.cos+   exp = liftM A.exp+   log = liftM A.log+   pow = liftM2 A.pow++instance Transcendental Double where+   pi = liftM0 A.pi+   sin = liftM A.sin+   cos = liftM A.cos+   exp = liftM A.exp+   log = liftM A.log+   pow = liftM2 A.pow++instance (TypeNum.Positive n, Transcendental a) => A.Transcendental (T n a) where+   pi = pi+   sin = sin+   cos = cos+   exp = exp+   log = log+   pow = pow++++class (NiceValue.Select a, C a) => Select a where+   select ::+      (TypeNum.Positive n) =>+      T n Bool -> T n a -> T n a ->+      LLVM.CodeGenFunction r (T n a)++instance Select Float where select = liftM3 LLVM.select+instance Select Double where select = liftM3 LLVM.select+instance Select Bool where select = liftM3 LLVM.select+instance Select Word where select = liftM3 LLVM.select+instance Select Word8 where select = liftM3 LLVM.select+instance Select Word16 where select = liftM3 LLVM.select+instance Select Word32 where select = liftM3 LLVM.select+instance Select Word64 where select = liftM3 LLVM.select+instance Select Int where select = liftM3 LLVM.select+instance Select Int8 where select = liftM3 LLVM.select+instance Select Int16 where select = liftM3 LLVM.select+instance Select Int32 where select = liftM3 LLVM.select+instance Select Int64 where select = liftM3 LLVM.select++instance (Select a, Select b) => Select (a,b) where+   select x y0 y1 =+      case (unzip y0, unzip y1) of+         ((a0,b0), (a1,b1)) ->+            Monad.lift2 zip+               (select x a0 a1)+               (select x b0 b1)++instance (Select a, Select b, Select c) => Select (a,b,c) where+   select x y0 y1 =+      case (unzip3 y0, unzip3 y1) of+         ((a0,b0,c0), (a1,b1,c1)) ->+            Monad.lift3 zip3+               (select x a0 a1)+               (select x b0 b1)+               (select x c0 c1)++++class (NiceValue.Comparison a, Real a) => Comparison a where+   cmp ::+      (TypeNum.Positive n) =>+      LLVM.CmpPredicate -> T n a -> T n a ->+      LLVM.CodeGenFunction r (T n Bool)++instance Comparison Float where cmp = liftM2 . LLVM.cmp+instance Comparison Double where cmp = liftM2 . LLVM.cmp+instance Comparison Word where cmp = liftM2 . LLVM.cmp+instance Comparison Word8 where cmp = liftM2 . LLVM.cmp+instance Comparison Word16 where cmp = liftM2 . LLVM.cmp+instance Comparison Word32 where cmp = liftM2 . LLVM.cmp+instance Comparison Word64 where cmp = liftM2 . LLVM.cmp+instance Comparison Int where cmp = liftM2 . LLVM.cmp+instance Comparison Int8 where cmp = liftM2 . LLVM.cmp+instance Comparison Int16 where cmp = liftM2 . LLVM.cmp+instance Comparison Int32 where cmp = liftM2 . LLVM.cmp+instance Comparison Int64 where cmp = liftM2 . LLVM.cmp++instance (TypeNum.Positive n, Comparison a) => A.Comparison (T n a) where+   type CmpResult (T n a) = T n Bool+   cmp = cmp++++class+   (NiceValue.FloatingComparison a, Comparison a) =>+      FloatingComparison a where+   fcmp ::+      (TypeNum.Positive n) =>+      LLVM.FPPredicate -> T n a -> T n a ->+      LLVM.CodeGenFunction r (T n Bool)++instance FloatingComparison Float where+   fcmp = liftM2 . LLVM.fcmp++instance+   (TypeNum.Positive n, FloatingComparison a) =>+      A.FloatingComparison (T n a) where+   fcmp = fcmp++++class (NiceValue.Logic a, C a) => Logic a where+   and, or, xor ::+      (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)+   inv :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)++instance Logic Bool where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++instance Logic Word8 where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++instance Logic Word16 where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++instance Logic Word32 where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++instance Logic Word64 where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv+++instance (TypeNum.Positive n, Logic a) => A.Logic (T n a) where+   and = and+   or = or+   xor = xor+   inv = inv++++class (NiceValue.BitShift a, C a) => BitShift a where+   shl :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)+   shr :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)++instance BitShift Word where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Word8 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Word16 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Word32 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Word64 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Int where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++instance BitShift Int8 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++instance BitShift Int16 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++instance BitShift Int32 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++instance BitShift Int64 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr
+ src/LLVM/Extra/Nice/Vector/Instance.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module LLVM.Extra.Nice.Vector.Instance where++import qualified LLVM.Extra.Nice.Vector as Vector+import qualified LLVM.Extra.Nice.Value.Private as NiceValue+import LLVM.Extra.Nice.Value.Private (Repr, )++import qualified LLVM.Core as LLVM++import qualified Type.Data.Num.Decimal as TypeNum++import Data.Functor ((<$>), )++import Prelude2010+import Prelude ()+++type NVVector n a = NiceValue.T (LLVM.Vector n a)++toNiceValue :: Vector.T n a -> NVVector n a+toNiceValue (Vector.Cons x) = NiceValue.Cons x++fromNiceValue :: NVVector n a -> Vector.T n a+fromNiceValue (NiceValue.Cons x) = Vector.Cons x++liftNiceValueM ::+   (Functor f) =>+   (Vector.T n a -> f (Vector.T m b)) ->+   (NVVector n a -> f (NVVector m b))+liftNiceValueM f a =+   toNiceValue <$> f (fromNiceValue a)++liftNiceValueM2 ::+   (Functor f) =>+   (Vector.T n a -> Vector.T m b -> f (Vector.T k c)) ->+   (NVVector n a -> NVVector m b -> f (NVVector k c))+liftNiceValueM2 f a b =+   toNiceValue <$> f (fromNiceValue a) (fromNiceValue b)++liftNiceValueM3 ::+   (Functor f) =>+   (Vector.T n a -> Vector.T m b -> Vector.T m c -> f (Vector.T k d)) ->+   (NVVector n a -> NVVector m b -> NVVector m c -> f (NVVector k d))+liftNiceValueM3 f a b c =+   toNiceValue <$> f (fromNiceValue a) (fromNiceValue b) (fromNiceValue c)++instance+   (TypeNum.Positive n, Vector.C a) =>+      NiceValue.C (LLVM.Vector n a) where+   type Repr (LLVM.Vector n a) = Vector.Repr n a+   cons = toNiceValue . Vector.cons+   undef = toNiceValue Vector.undef+   zero = toNiceValue Vector.zero+   phi = liftNiceValueM . Vector.phi+   addPhi bb x y = Vector.addPhi bb (fromNiceValue x) (fromNiceValue y)++instance+   (TypeNum.Positive n, Vector.IntegerConstant a) =>+      NiceValue.IntegerConstant (LLVM.Vector n a) where+   fromInteger' = toNiceValue . Vector.fromInteger'++instance+   (TypeNum.Positive n, Vector.RationalConstant a) =>+      NiceValue.RationalConstant (LLVM.Vector n a) where+   fromRational' = toNiceValue . Vector.fromRational'++instance+   (TypeNum.Positive n, Vector.Additive a) =>+      NiceValue.Additive (LLVM.Vector n a) where+   add = liftNiceValueM2 Vector.add+   sub = liftNiceValueM2 Vector.sub+   neg = liftNiceValueM Vector.neg++instance+   (TypeNum.Positive n, Vector.PseudoRing a) =>+      NiceValue.PseudoRing (LLVM.Vector n a) where+   mul = liftNiceValueM2 Vector.mul++instance+   (TypeNum.Positive n, Vector.Real a) =>+      NiceValue.Real (LLVM.Vector n a) where+   min = liftNiceValueM2 Vector.min+   max = liftNiceValueM2 Vector.max+   abs = liftNiceValueM Vector.abs+   signum = liftNiceValueM Vector.signum++instance+   (TypeNum.Positive n, Vector.Fraction a) =>+      NiceValue.Fraction (LLVM.Vector n a) where+   truncate = liftNiceValueM Vector.truncate+   fraction = liftNiceValueM Vector.fraction++instance+   (TypeNum.Positive n, Vector.Logic a) =>+      NiceValue.Logic (LLVM.Vector n a) where+   and = liftNiceValueM2 Vector.and+   or = liftNiceValueM2 Vector.or+   xor = liftNiceValueM2 Vector.xor+   inv = liftNiceValueM Vector.inv++instance+   (TypeNum.Positive n, Vector.BitShift a) =>+      NiceValue.BitShift (LLVM.Vector n a) where+   shl = liftNiceValueM2 Vector.shl+   shr = liftNiceValueM2 Vector.shr
src/LLVM/Extra/Scalar.hs view
@@ -1,12 +1,9 @@ {-# LANGUAGE TypeFamilies #-} module LLVM.Extra.Scalar where -import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Arithmetic as A -import qualified LLVM.Util.Loop as Loop-import LLVM.Util.Loop (Phi, )- import qualified Control.Monad as Monad  @@ -66,15 +63,15 @@    Monad.liftM decons $ f (Cons a) (Cons b) (Cons c) (Cons d) (Cons e)  -instance (Class.Zero a) => Class.Zero (T a) where-   zeroTuple = Cons Class.zeroTuple+instance (Tuple.Zero a) => Tuple.Zero (T a) where+   zero = Cons Tuple.zero -instance (Class.Undefined a) => Class.Undefined (T a) where-   undefTuple = Cons Class.undefTuple+instance (Tuple.Undefined a) => Tuple.Undefined (T a) where+   undef = Cons Tuple.undef -instance (Phi a) => Phi (T a) where-   phis bb = fmap Cons . Loop.phis bb . decons-   addPhis bb (Cons a) (Cons b) = Loop.addPhis bb a b+instance (Tuple.Phi a) => Tuple.Phi (T a) where+   phi bb = fmap Cons . Tuple.phi bb . decons+   addPhi bb (Cons a) (Cons b) = Tuple.addPhi bb a b  instance (A.IntegerConstant a) => A.IntegerConstant (T a) where    fromInteger' = Cons . A.fromInteger'
src/LLVM/Extra/ScalarOrVector.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {- | Support for unified handling of scalars and vectors.@@ -24,39 +25,36 @@    Replicate (replicate, replicateConst),    replicateOf,    Real (min, max, abs, signum),-   PseudoModule (scale, scaleConst),+   Saturated(addSat, subSat),+   PseudoModule (scale),    IntegerConstant(constFromInteger),    RationalConstant(constFromRational),    TranscendentalConstant(constPi),    ) where -import LLVM.Extra.Vector (Element, Size, )-+import qualified LLVM.Extra.ScalarOrVectorPrivate as Priv import qualified LLVM.Extra.Vector as Vector-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.ArithmeticPrivate as A--import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal (D1, )+import LLVM.Extra.ScalarOrVectorPrivate+   (Scalar, Replicate(replicate, replicateConst)) +import qualified LLVM.Util.Intrinsic as Intrinsic+import qualified LLVM.Util.Proxy as LP import qualified LLVM.Core as LLVM import LLVM.Core-   (Value, ConstValue, valueOf, constOf,-    CmpRet, CmpResult, NumberOfElements,-    Vector, FP128,+   (Value, ConstValue, constOf,+    CmpRet, CmpResult, ShapeOf,+    Vector, WordN(WordN), IntN(IntN), FP128,     IsConst, IsInteger, IsFloating,     CodeGenFunction, ) -import Control.Monad.HT ((<=<), )+import qualified Type.Data.Num.Decimal as TypeNum -import qualified Data.NonEmpty as NonEmpty-import Data.Word (Word8, Word16, Word32, Word64, )+import Data.Word (Word8, Word16, Word32, Word64, Word) import Data.Int  (Int8,  Int16,  Int32,  Int64, )+import Data.Maybe (fromMaybe) -import Prelude hiding (Real, replicate, min, max, abs, truncate, floor, round, )+import Prelude hiding (Real, replicate, min, max, abs, truncate)   @@ -65,42 +63,12 @@    fraction :: Value a -> CodeGenFunction r (Value a)  instance Fraction Float where-   truncate =-      mapAuto-         (LLVM.inttofp . flip asTypeOf (undefined :: Value Int32) <=< LLVM.fptoint)-         (Ext.with X86.roundss $ \round x -> round x (valueOf 3))-   fraction =-      (\x ->-         fractionGen x-         `Ext.run`-         (Ext.with X86.cmpss $ \cmp ->-            fractionLogical (\modus -> curry (runScalar (uncurry (cmp modus)))) x))-      `mapAuto`-      (Ext.with X86.roundss $ \round x ->-         A.sub x =<< round x (valueOf 1))+   truncate = Intrinsic.truncate+   fraction = A.fraction  instance Fraction Double where-   truncate =-      mapAuto-         -- X86 only converts Double to Int32, it cannot target Int64-         (LLVM.inttofp . flip asTypeOf (undefined :: Value Int32) <=< LLVM.fptoint)-         (Ext.with X86.roundsd $ \round x -> round x (valueOf 3))-   fraction =-      (\x ->-         fractionGen x-         `Ext.run`-         (Ext.with X86.cmpsd $ \cmp ->-            fractionLogical (\modus -> curry (runScalar (uncurry (cmp modus)))) x))-{--For Doubles it would be more efficient to convert the lower 32 bit-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.bitcast )--}-      `mapAuto`-      (Ext.with X86.roundsd $ \round x ->-         A.sub x =<< round x (valueOf 1))+   truncate = Intrinsic.truncate+   fraction = A.fraction  instance (TypeNum.Positive n, Vector.Real a, IsFloating a, IsConst a) =>       Fraction (Vector n a) where@@ -118,21 +86,21 @@ signedFraction x =    A.sub x =<< truncate x -fractionGen ::+_fractionGen ::    (IntegerConstant v, Fraction v, CmpRet v) =>    Value v -> CodeGenFunction r (Value v)-fractionGen x =+_fractionGen x =    do xf <- signedFraction x       b <- A.fcmp LLVM.FPOGE xf zero       LLVM.select b xf =<< A.add xf (LLVM.value $ constFromInteger 1) -fractionLogical ::-   (Fraction a, LLVM.IsScalarOrVector a, NumberOfElements a ~ D1,-    IsInteger b, LLVM.IsScalarOrVector b, NumberOfElements b ~ D1) =>+_fractionLogical ::+   (Fraction a, LLVM.IsPrimitive a,+    IsInteger b, LLVM.IsPrimitive b) =>    (LLVM.FPPredicate ->     Value a -> Value a -> CodeGenFunction r (Value b)) ->    Value a -> CodeGenFunction r (Value a)-fractionLogical cmp x =+_fractionLogical cmp x =    do xf <- signedFraction x       b <- cmp LLVM.FPOLT xf zero       A.sub xf =<< LLVM.inttofp b@@ -159,8 +127,7 @@   truncateToInt ::-   (IsFloating a, IsInteger i,-    NumberOfElements a ~ NumberOfElements i) =>+   (IsFloating a, IsInteger i, ShapeOf a ~ ShapeOf i) =>    Value a -> CodeGenFunction r (Value i) truncateToInt = LLVM.fptoint @@ -174,7 +141,7 @@    (IsFloating a, RationalConstant a, CmpRet a,     IsInteger i, IntegerConstant i, CmpRet i,     CmpResult a ~ CmpResult i,-    NumberOfElements a ~ NumberOfElements i) =>+    ShapeOf a ~ ShapeOf i) =>    Value a -> CodeGenFunction r (Value i) roundToIntFast x = do    pos <- A.cmp LLVM.CmpGT x zero@@ -185,7 +152,7 @@    (IsFloating a, CmpRet a,     IsInteger i, IntegerConstant i, CmpRet i,     CmpResult a ~ CmpResult i,-    NumberOfElements a ~ NumberOfElements i) =>+    ShapeOf a ~ ShapeOf i) =>    Value a -> CodeGenFunction r (Value i) floorToInt x = do    i <- truncateToInt x@@ -196,7 +163,7 @@    (IsFloating a, CmpRet a,     IsInteger i, IntegerConstant i, CmpRet i,     CmpResult a ~ CmpResult i,-    NumberOfElements a ~ NumberOfElements i) =>+    ShapeOf a ~ ShapeOf i) =>    Value a -> CodeGenFunction r (Value i, Value a) splitFractionToInt x = do    i <- floorToInt x@@ -207,7 +174,7 @@    (IsFloating a, CmpRet a,     IsInteger i, IntegerConstant i, CmpRet i,     CmpResult a ~ CmpResult i,-    NumberOfElements a ~ NumberOfElements i) =>+    ShapeOf a ~ ShapeOf i) =>    Value a -> CodeGenFunction r (Value i) ceilingToInt x = do    i <- truncateToInt x@@ -225,66 +192,7 @@ ratio = LLVM.value . constFromRational  -type family Scalar vector :: * -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.Positive 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-      LLVM.shufflevector v (LLVM.value LLVM.undef) LLVM.zero-{- crashes LLVM-2.5-   replicate x = do-      v <- LLVM.insertelement (LLVM.value LLVM.undef) x (valueOf 1)-      LLVM.shufflevector v (LLVM.value LLVM.undef) (constVector $ repeat $ LLVM.constOf 1)--}-{- the (repeat zero) is also converted to 'zeroinitializer' and crashes LLVM compiler--         (constVector $ repeat LLVM.zero)--}-{--   replicate = Vector.replicate--}-   replicateConst x = LLVM.constCyclicVector $ NonEmpty.Cons x []--singleton ::-   (LLVM.IsPrimitive a) =>-   Value a -> CodeGenFunction r (Value (Vector D1 a))-singleton x =-   LLVM.insertelement (LLVM.value LLVM.undef) x (valueOf 0)- replicateOf ::    (IsConst (Scalar v), Replicate v) =>    Scalar v -> Value v@@ -300,119 +208,143 @@   instance Real Float  where-   min = zipAutoWith A.min X86.minss-   max = zipAutoWith A.max X86.maxss-   abs = mapAuto     A.abs X86.absss-   -- abs x = max x =<< LLVM.neg x-   -- abs x = A.abs+   min = Intrinsic.min+   max = Intrinsic.max+   abs = Intrinsic.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+   min = Intrinsic.min+   max = Intrinsic.max+   abs = Intrinsic.abs    signum = A.signum  instance Real FP128  where-   min = A.min-   max = A.max-   abs = A.abs+   min = Intrinsic.min+   max = Intrinsic.max+   abs = Intrinsic.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`--{- |-There are functions that are intended for processing scalars-but have formally vector input and output.-This function breaks vector function down to a scalar function-by accessing the lowest vector element.--}-runScalar ::-   (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.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.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 Int    where min = A.min; max = A.max; signum = A.signum; abs = A.abs; 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 Word   where min = A.min; max = A.max; signum = A.signum; abs = return; 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.Positive n, Vector.Real a) =>-         Real (Vector n a) where+instance (TypeNum.Positive n) => Real (IntN n) where+   min = A.min; max = A.max; abs = A.abs+   signum = A.signumGen (LLVM.valueOf $ IntN (-1)) (LLVM.valueOf $ IntN 1)+instance (TypeNum.Positive n) => Real (WordN n) where+   min = A.min; max = A.max; abs = return+   signum = A.signumGen (LLVM.value LLVM.undef) (LLVM.valueOf $ WordN 1)++instance (TypeNum.Positive n, Vector.Real a) => Real (Vector n a) where    min = Vector.min    max = Vector.max    abs = Vector.abs    signum = Vector.signum  +class (IsInteger a) => Saturated a where+   addSat, subSat :: Value a -> Value a -> CodeGenFunction r (Value a) +instance Saturated Int    where+   addSat = addSatProxy LP.Proxy; subSat = subSatProxy LP.Proxy;+instance Saturated Int8   where+   addSat = addSatProxy LP.Proxy; subSat = subSatProxy LP.Proxy;+instance Saturated Int16  where+   addSat = addSatProxy LP.Proxy; subSat = subSatProxy LP.Proxy;+instance Saturated Int32  where+   addSat = addSatProxy LP.Proxy; subSat = subSatProxy LP.Proxy;+instance Saturated Int64  where+   addSat = addSatProxy LP.Proxy; subSat = subSatProxy LP.Proxy;+instance Saturated Word   where+   addSat = addSatProxy LP.Proxy; subSat = subSatProxy LP.Proxy;+instance Saturated Word8  where+   addSat = addSatProxy LP.Proxy; subSat = subSatProxy LP.Proxy;+instance Saturated Word16 where+   addSat = addSatProxy LP.Proxy; subSat = subSatProxy LP.Proxy;+instance Saturated Word32 where+   addSat = addSatProxy LP.Proxy; subSat = subSatProxy LP.Proxy;+instance Saturated Word64 where+   addSat = addSatProxy LP.Proxy; subSat = subSatProxy LP.Proxy;+instance (TypeNum.Positive d) => Saturated (IntN  d) where+   addSat = addSatProxy LP.Proxy; subSat = subSatProxy LP.Proxy;+instance (TypeNum.Positive d) => Saturated (WordN d) where+   addSat = addSatProxy LP.Proxy; subSat = subSatProxy LP.Proxy;+instance+   (TypeNum.Positive n, LLVM.IsPrimitive a,+    Saturated a, Bounded a, CmpRet a, IsConst a) =>+      Saturated (Vector n a) where+   addSat = addSatProxy LP.Proxy; subSat = subSatProxy LP.Proxy;++addSatProxy, subSatProxy ::+   (IsInteger v, CmpRet v, Replicate v, ShapeOf v ~ shape,+    LLVM.ShapedType shape Bool ~ bv, ShapeOf bv ~ shape, CmpRet bv,+    Scalar v ~ a, IsConst a, Bounded a) =>+   LP.Proxy v -> Value v -> Value v -> CodeGenFunction r (Value v)+addSatProxy proxy =+   if LLVM.isSigned proxy+      then fromMaybe Priv.saddSat Intrinsic.maybeSAddSat+      else fromMaybe Priv.uaddSat Intrinsic.maybeUAddSat+subSatProxy proxy =+   if LLVM.isSigned proxy+      then fromMaybe Priv.ssubSat Intrinsic.maybeSSubSat+      else fromMaybe Priv.usubSat Intrinsic.maybeUSubSat+++ class    (LLVM.IsArithmetic (Scalar v), LLVM.IsArithmetic v) =>       PseudoModule v where    scale :: (a ~ Scalar v) => Value a -> Value v -> CodeGenFunction r (Value v)-   scaleConst :: (a ~ Scalar v) => ConstValue a -> ConstValue v -> CodeGenFunction r (ConstValue v) -instance PseudoModule Word8  where scale = LLVM.mul; scaleConst = LLVM.mul-instance PseudoModule Word16 where scale = LLVM.mul; scaleConst = LLVM.mul-instance PseudoModule Word32 where scale = LLVM.mul; scaleConst = LLVM.mul-instance PseudoModule Word64 where scale = LLVM.mul; scaleConst = LLVM.mul-instance PseudoModule Int8   where scale = LLVM.mul; scaleConst = LLVM.mul-instance PseudoModule Int16  where scale = LLVM.mul; scaleConst = LLVM.mul-instance PseudoModule Int32  where scale = LLVM.mul; scaleConst = LLVM.mul-instance PseudoModule Int64  where scale = LLVM.mul; scaleConst = LLVM.mul-instance PseudoModule Float  where scale = LLVM.mul; scaleConst = LLVM.mul-instance PseudoModule Double where scale = LLVM.mul; scaleConst = LLVM.mul+instance PseudoModule Word   where scale = LLVM.mul+instance PseudoModule Word8  where scale = LLVM.mul+instance PseudoModule Word16 where scale = LLVM.mul+instance PseudoModule Word32 where scale = LLVM.mul+instance PseudoModule Word64 where scale = LLVM.mul+instance PseudoModule Int    where scale = LLVM.mul+instance PseudoModule Int8   where scale = LLVM.mul+instance PseudoModule Int16  where scale = LLVM.mul+instance PseudoModule Int32  where scale = LLVM.mul+instance PseudoModule Int64  where scale = LLVM.mul+instance PseudoModule Float  where scale = LLVM.mul+instance PseudoModule Double where scale = LLVM.mul instance (LLVM.IsArithmetic a, LLVM.IsPrimitive a, TypeNum.Positive n) =>          PseudoModule (Vector n a) where    scale a v = flip A.mul v =<< replicate a-   scaleConst a v = LLVM.mul (replicateConst a `asTypeOf` v) v    class (LLVM.IsConst a) => IntegerConstant a where    constFromInteger :: Integer -> ConstValue a +instance IntegerConstant Word   where constFromInteger = constOf . fromInteger instance IntegerConstant Word8  where constFromInteger = constOf . fromInteger instance IntegerConstant Word16 where constFromInteger = constOf . fromInteger instance IntegerConstant Word32 where constFromInteger = constOf . fromInteger instance IntegerConstant Word64 where constFromInteger = constOf . fromInteger+instance IntegerConstant Int    where constFromInteger = constOf . fromInteger instance IntegerConstant Int8   where constFromInteger = constOf . fromInteger instance IntegerConstant Int16  where constFromInteger = constOf . fromInteger instance IntegerConstant Int32  where constFromInteger = constOf . fromInteger instance IntegerConstant Int64  where constFromInteger = constOf . fromInteger instance IntegerConstant Float  where constFromInteger = constOf . fromInteger instance IntegerConstant Double where constFromInteger = constOf . fromInteger+instance (TypeNum.Positive n) => IntegerConstant (WordN n) where+   constFromInteger = constOf . WordN+instance (TypeNum.Positive n) => IntegerConstant (IntN n)  where+   constFromInteger = constOf . IntN instance (IntegerConstant a, LLVM.IsPrimitive a, TypeNum.Positive n) =>          IntegerConstant (Vector n a) where    constFromInteger = replicateConst . constFromInteger
+ src/LLVM/Extra/Storable.hs view
@@ -0,0 +1,41 @@+{- |+Transfer values between Haskell and JIT generated code+in a Haskell-compatible format as dictated by the 'Foreign.Storable' class.+E.g. instance 'Bool' may use more than a byte (e.g. Word32).+For tuples, you may use the @Tuple@ wrapper from the @storable-record@ package.+The 'Storable' instance for 'Vector's is compatible with arrays,+i.e. indices always count upwards irrespective of machine endianess+and tuple elements are interleaved.+-}+module LLVM.Extra.Storable (+   -- * Basic class+   Store.C(..),+   Store.storeNext,+   Store.modify,++   -- * Classes for tuples and vectors+   Store.Tuple(..),+   Store.Vector(..),+   Store.TupleVector(..),++   -- * Standard method implementations+   Store.loadNewtype,+   Store.storeNewtype,+   Store.loadTraversable,+   Store.loadApplicative,+   Store.storeFoldable,++   -- * Pointer handling+   Store.advancePtr,+   Store.incrementPtr,+   Store.decrementPtr,++   -- * Loops over Storable arrays+   Array.arrayLoop,+   Array.arrayLoop2,+   Array.arrayLoopMaybeCont,+   Array.arrayLoopMaybeCont2,+   ) where++import qualified LLVM.Extra.Storable.Private as Store+import qualified LLVM.Extra.Storable.Array as Array
+ src/LLVM/Extra/Storable/Array.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{- |+Loops over Storable arrays.+-}+module LLVM.Extra.Storable.Array where++import qualified LLVM.Extra.Storable.Private as Storable+import qualified LLVM.Extra.MaybeContinuation as MaybeCont+import qualified LLVM.Extra.Maybe as Maybe+import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.Extra.Control as C+import LLVM.Core+   (CodeGenFunction, Value, CmpRet, IsInteger, IsConst, IsPrimitive)++import Foreign.Storable (Storable)+import Foreign.Ptr (Ptr)++import Control.Monad (liftM2)++import Data.Tuple.HT (mapSnd)+++arrayLoop ::+   (Tuple.Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,+    Storable a, Value (Ptr a) ~ ptrA) =>+   Value i -> ptrA -> s ->+   (ptrA -> s -> CodeGenFunction r s) ->+   CodeGenFunction r s+arrayLoop len ptr start body =+   fmap snd $+   C.fixedLengthLoop len (ptr, start) $ \(p,s) ->+      liftM2 (,) (Storable.incrementPtr p) (body p s)++arrayLoop2 ::+   (Tuple.Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,+    Storable a, Value (Ptr a) ~ ptrA,+    Storable b, Value (Ptr b) ~ ptrB) =>+   Value i -> ptrA -> ptrB -> s ->+   (ptrA -> ptrB -> s -> CodeGenFunction r s) ->+   CodeGenFunction r s+arrayLoop2 len ptrA ptrB start body =+   fmap snd $+   arrayLoop len ptrA (ptrB,start) $ \pa (pb,s) ->+      liftM2 (,) (Storable.incrementPtr pb) (body pa pb s)+++arrayLoopMaybeCont ::+   (Tuple.Phi s, Tuple.Undefined s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,+    Storable a, Value (Ptr a) ~ ptrA,+    Maybe.T (ptrA, s) ~ z) =>+   Value i ->+   ptrA -> s ->+   (ptrA -> s -> MaybeCont.T r z s) ->+   CodeGenFunction r (Value i, Maybe.T s)+arrayLoopMaybeCont len ptr start body =+   fmap (mapSnd (fmap snd)) $+   MaybeCont.fixedLengthLoop len (ptr,start) $ \(ptr0,s0) ->+      liftM2 (,)+         (MaybeCont.lift $ Storable.incrementPtr ptr0)+         (body ptr0 s0)++arrayLoopMaybeCont2 ::+   (Tuple.Phi s, Tuple.Undefined s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,+    Storable a, Value (Ptr a) ~ ptrA,+    Storable b, Value (Ptr b) ~ ptrB,+    Maybe.T (ptrA, (ptrB, s)) ~ z) =>+   Value i ->+   ptrA -> ptrB -> s ->+   (ptrA -> ptrB -> s -> MaybeCont.T r z s) ->+   CodeGenFunction r (Value i, Maybe.T s)+arrayLoopMaybeCont2 len ptrA ptrB start body =+   fmap (mapSnd (fmap snd)) $+   arrayLoopMaybeCont len ptrA (ptrB,start) $ \ptrAi (ptrB0,s0) ->+      liftM2 (,)+         (MaybeCont.lift $ Storable.incrementPtr ptrB0)+         (body ptrAi ptrB0 s0)
+ src/LLVM/Extra/Storable/Private.hs view
@@ -0,0 +1,477 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+module LLVM.Extra.Storable.Private where++import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.Extra.ArithmeticPrivate as A+import qualified LLVM.Util.Proxy as LP+import qualified LLVM.Core as LLVM+import LLVM.Core (CodeGenFunction, Value)++import qualified Type.Data.Num.Decimal as TypeNum++import qualified Control.Monad.Trans.Class as MT+import qualified Control.Monad.Trans.Reader as MR+import qualified Control.Monad.Trans.State as MS+import qualified Control.Applicative.HT as App+import qualified Control.Functor.HT as FuncHT+import Control.Monad (foldM, replicateM, replicateM_, (<=<))+import Control.Applicative (Applicative, pure)++import qualified Foreign.Storable.Record.Tuple as StoreTuple+import qualified Foreign.Storable as Store+import Foreign.Storable.FixedArray (roundUp)+import Foreign.Ptr (Ptr)++import qualified Data.NonEmpty.Class as NonEmptyC+import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold+import Data.Orphans ()+import Data.Complex (Complex)+import Data.Word (Word8, Word16, Word32, Word64, Word)+import Data.Int  (Int8,  Int16,  Int32,  Int64)+import Data.Bool8 (Bool8)++++class+   (Store.Storable a, Tuple.Value a,+    Tuple.Phi (Tuple.ValueOf a), Tuple.Undefined (Tuple.ValueOf a)) =>+      C a where++   {-+   Not all Storable types have a compatible LLVM type,+   or even more, one LLVM type that is compatible on all platforms.+   -}+   load :: Value (Ptr a) -> CodeGenFunction r (Tuple.ValueOf a)+   store :: Tuple.ValueOf a -> Value (Ptr a) -> CodeGenFunction r ()++storeNext ::+   (C a, Tuple.ValueOf a ~ al, Value (Ptr a) ~ ptr) =>+   al -> ptr -> CodeGenFunction r ptr+storeNext a ptr  =  store a ptr >> incrementPtr ptr++modify ::+   (C a, Tuple.ValueOf a ~ al) =>+   (al -> CodeGenFunction r al) ->+   Value (Ptr a) -> CodeGenFunction r ()+modify f ptr  =  flip store ptr =<< f =<< load ptr+++loadPrimitive ::+   (LLVM.Storable a) => Value (Ptr a) -> CodeGenFunction r (Value a)+loadPrimitive ptr = LLVM.load =<< LLVM.bitcast ptr++storePrimitive ::+   (LLVM.Storable a) => Value a -> Value (Ptr a) -> CodeGenFunction r ()+storePrimitive a ptr = LLVM.store a =<< LLVM.bitcast ptr++instance C Float where+   load = loadPrimitive; store = storePrimitive++instance C Double where+   load = loadPrimitive; store = storePrimitive++instance C Word where+   load = loadPrimitive; store = storePrimitive++instance C Word8 where+   load = loadPrimitive; store = storePrimitive++instance C Word16 where+   load = loadPrimitive; store = storePrimitive++instance C Word32 where+   load = loadPrimitive; store = storePrimitive++instance C Word64 where+   load = loadPrimitive; store = storePrimitive++instance C Int where+   load = loadPrimitive; store = storePrimitive++instance C Int8 where+   load = loadPrimitive; store = storePrimitive++instance C Int16 where+   load = loadPrimitive; store = storePrimitive++instance C Int32 where+   load = loadPrimitive; store = storePrimitive++instance C Int64 where+   load = loadPrimitive; store = storePrimitive++{- |+Not very efficient implementation+because we want to adapt to @sizeOf Bool@ dynamically.+Unfortunately, LLVM-9's optimizer does not recognize the instruction pattern.+Better use 'Bool8' for booleans.+-}+instance C Bool where+   load ptr = do+      bytePtr <- castToBytePtr ptr+      bytes <-+         flip MS.evalStateT bytePtr $+            replicateM (Store.sizeOf (False :: Bool))+               (MT.lift . LLVM.load =<< incPtrState)+      let zero = LLVM.valueOf 0+      mask <- foldM A.or zero bytes+      A.cmp LLVM.CmpNE mask zero+   store b ptr = do+      bytePtr <- castToBytePtr ptr+      byte <- LLVM.sext b+      flip MS.evalStateT bytePtr $+         replicateM_ (Store.sizeOf (False :: Bool))+            (MT.lift . LLVM.store byte =<< incPtrState)++incPtrState :: MS.StateT BytePtr (CodeGenFunction r) BytePtr+incPtrState = update A.advanceArrayElementPtr++instance C Bool8 where+   load ptr =+      A.cmp LLVM.CmpNE (LLVM.valueOf 0) =<< LLVM.load =<< castToBytePtr ptr+   store b ptr = do+      byte <- LLVM.zext b+      LLVM.store byte =<< castToBytePtr ptr++instance (C a) => C (Complex a) where+   load = loadApplicative; store = storeFoldable++++instance (Tuple tuple) => C (StoreTuple.Tuple tuple) where+   load = loadTuple+   store = storeTuple++class+   (StoreTuple.Storable tuple, Tuple.Value tuple,+    Tuple.Phi (Tuple.ValueOf tuple), Tuple.Undefined (Tuple.ValueOf tuple)) =>+      Tuple tuple where+   loadTuple ::+      Value (Ptr (StoreTuple.Tuple tuple)) ->+      CodeGenFunction r (Tuple.ValueOf tuple)+   storeTuple ::+      Tuple.ValueOf tuple ->+      Value (Ptr (StoreTuple.Tuple tuple)) ->+      CodeGenFunction r ()++instance (C a, C b) => Tuple (a,b) where+   loadTuple ptr =+      runElements ptr $+         App.mapPair (loadElement, loadElement) $+         FuncHT.unzip $ proxyFromElement3 ptr+   storeTuple (a,b) ptr =+      case FuncHT.unzip $ proxyFromElement3 ptr of+         (pa,pb) -> runElements ptr $ storeElement pa a >> storeElement pb b++instance (C a, C b, C c) => Tuple (a,b,c) where+   loadTuple ptr =+      runElements ptr $+         App.mapTriple (loadElement, loadElement, loadElement) $+         FuncHT.unzip3 $ proxyFromElement3 ptr+   storeTuple (a,b,c) ptr =+      case FuncHT.unzip3 $ proxyFromElement3 ptr of+         (pa,pb,pc) ->+            runElements ptr $+               storeElement pa a >> storeElement pb b >> storeElement pc c++runElements ::+   Value (Ptr a) ->+   MR.ReaderT BytePtr (MS.StateT Int (CodeGenFunction r)) c ->+   CodeGenFunction r c+runElements ptr act = do+   bytePtr <- castToBytePtr ptr+   flip MS.evalStateT 0 $ flip MR.runReaderT bytePtr act++loadElement ::+   (C a) =>+   LP.Proxy a ->+   MR.ReaderT BytePtr (MS.StateT Int (CodeGenFunction r)) (Tuple.ValueOf a)+loadElement proxy =+   MT.lift . MT.lift . load =<< elementPtr proxy++storeElement ::+   (C a) =>+   LP.Proxy a -> Tuple.ValueOf a ->+   MR.ReaderT BytePtr (MS.StateT Int (CodeGenFunction r)) ()+storeElement proxy a =+   MT.lift . MT.lift . store a =<< elementPtr proxy++elementPtr ::+   (C a) =>+   LP.Proxy a ->+   MR.ReaderT BytePtr+      (MS.StateT Int (CodeGenFunction r)) (LLVM.Value (Ptr a))+elementPtr proxy = do+   ptr <- MR.ask+   MT.lift $ do+      offset <- elementOffset proxy+      MT.lift $ castFromBytePtr =<< LLVM.getElementPtr ptr (offset, ())++elementOffset ::+   (Monad m, Store.Storable a) => LP.Proxy a -> MS.StateT Int m Int+elementOffset proxy = do+   let dummy = elementFromProxy proxy+   MS.modify (roundUp $ Store.alignment dummy)+   offset <- MS.get+   MS.modify (+ Store.sizeOf dummy)+   return offset+++instance+   (TypeNum.Positive n, Vector a, Tuple.VectorValue n a,+    Tuple.Phi (Tuple.VectorValueOf n a)) =>+      C (LLVM.Vector n a) where+   load ptr =+      assembleVector (proxyFromElement3 ptr) =<< loadApplicative ptr+   store a ptr =+      flip storeFoldable ptr+         =<< disassembleVector (proxyFromElement3 ptr) a++class (C a) => Vector a where+   assembleVector ::+      (TypeNum.Positive n) =>+      LP.Proxy a -> LLVM.Vector n (Tuple.ValueOf a) ->+      CodeGenFunction r (Tuple.VectorValueOf n a)+   disassembleVector ::+      (TypeNum.Positive n) =>+      LP.Proxy a -> Tuple.VectorValueOf n a ->+      CodeGenFunction r (LLVM.Vector n (Tuple.ValueOf a))++assemblePrimitive ::+   (TypeNum.Positive n, LLVM.IsPrimitive a) =>+   LLVM.Vector n (Value a) -> CodeGenFunction r (Value (LLVM.Vector n a))+assemblePrimitive =+   foldM+      (\v (i,x) -> LLVM.insertelement v x (LLVM.valueOf i))+      (LLVM.value LLVM.undef)+    . zip [0..] . Fold.toList++disassemblePrimitive ::+   (TypeNum.Positive n, LLVM.IsPrimitive a) =>+   Value (LLVM.Vector n a) -> CodeGenFunction r (LLVM.Vector n (Value a))+disassemblePrimitive v =+   Trav.mapM (LLVM.extractelement v . LLVM.valueOf) indices++indices :: (Applicative f, Trav.Traversable f) => f Word32+indices =+   flip MS.evalState 0 $ Trav.sequenceA $ pure $ MS.state (\k -> (k,k+1))++instance Vector Float where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Double where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word8 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word16 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word32 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word64 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int8 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int16 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int32 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int64 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Bool where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Bool8 where+   assembleVector LP.Proxy = assemblePrimitive+   disassembleVector LP.Proxy = disassemblePrimitive+++instance+   (Tuple tuple, TupleVector tuple) =>+      Vector (StoreTuple.Tuple tuple) where+   assembleVector = deinterleave . fmap StoreTuple.getTuple+   disassembleVector = interleave . fmap StoreTuple.getTuple+++class TupleVector a where+   deinterleave ::+      (TypeNum.Positive n) =>+      LP.Proxy a -> LLVM.Vector n (Tuple.ValueOf a) ->+      CodeGenFunction r (Tuple.VectorValueOf n a)+   interleave ::+      (TypeNum.Positive n) =>+      LP.Proxy a -> Tuple.VectorValueOf n a ->+      CodeGenFunction r (LLVM.Vector n (Tuple.ValueOf a))++instance (Vector a, Vector b) => TupleVector (a,b) where+   deinterleave = FuncHT.uncurry $ \pa pb -> FuncHT.uncurry $ \a b ->+      App.lift2 (,) (assembleVector pa a) (assembleVector pb b)+   interleave = FuncHT.uncurry $ \pa pb (a,b) ->+      App.lift2 (App.lift2 (,))+         (disassembleVector pa a) (disassembleVector pb b)++instance (Vector a, Vector b, Vector c) => TupleVector (a,b,c) where+   deinterleave = FuncHT.uncurry3 $ \pa pb pc -> FuncHT.uncurry3 $ \a b c ->+      App.lift3 (,,)+         (assembleVector pa a)+         (assembleVector pb b)+         (assembleVector pc c)+   interleave = FuncHT.uncurry3 $ \pa pb pc (a,b,c) ->+      App.lift3 (App.lift3 (,,))+         (disassembleVector pa a)+         (disassembleVector pb b)+         (disassembleVector pc c)+++{-+instance Storable () available since base-4.9/GHC-8.0.+Before we need Data.Orphans.+-}+instance C () where+   load _ptr = return ()+   store () _ptr = return ()+++loadNewtype ::+   (C a, Tuple.ValueOf a ~ al) =>+   (a -> wrapped) ->+   (al -> wrappedl) ->+   Value (Ptr wrapped) -> CodeGenFunction r wrappedl+loadNewtype wrap wrapl =+   fmap wrapl . load <=< rmapPtr wrap++storeNewtype ::+   (C a, Tuple.ValueOf a ~ al) =>+   (a -> wrapped) ->+   (wrappedl -> al) ->+   wrappedl -> Value (Ptr wrapped) -> CodeGenFunction r ()+storeNewtype wrap unwrapl y =+   store (unwrapl y) <=< rmapPtr wrap++rmapPtr :: (a -> b) -> Value (Ptr b) -> CodeGenFunction r (Value (Ptr a))+rmapPtr _f = LLVM.bitcast+++loadTraversable ::+   (NonEmptyC.Repeat f, Trav.Traversable f, C a, Tuple.ValueOf a ~ al) =>+   Value (Ptr (f a)) -> CodeGenFunction r (f al)+loadTraversable =+   (MS.evalStateT $ Trav.sequence $ NonEmptyC.repeat $ loadState)+      <=< castElementPtr++loadApplicative ::+   (Applicative f, Trav.Traversable f, C a, Tuple.ValueOf a ~ al) =>+   Value (Ptr (f a)) -> CodeGenFunction r (f al)+loadApplicative =+   (MS.evalStateT $ Trav.sequence $ pure loadState) <=< castElementPtr++loadState ::+   (C a, Tuple.ValueOf a ~ al) =>+   MS.StateT (Value (Ptr a)) (CodeGenFunction r) al+loadState = MT.lift . load =<< advancePtrState+++storeFoldable ::+   (Fold.Foldable f, C a, Tuple.ValueOf a ~ al) =>+   f al -> Value (Ptr (f a)) -> CodeGenFunction r ()+storeFoldable xs = MS.evalStateT (Fold.mapM_ storeState xs) <=< castElementPtr++storeState ::+   (C a, Tuple.ValueOf a ~ al) =>+   al -> MS.StateT (Value (Ptr a)) (CodeGenFunction r) ()+storeState a = MT.lift . store a =<< advancePtrState+++update :: (Monad m) => (a -> m a) -> MS.StateT a m a+update f = MS.StateT $ \a0 -> do a1 <- f a0; return (a0,a1)++advancePtrState ::+   (C a, Value (Ptr a) ~ ptr) =>+   MS.StateT ptr (CodeGenFunction r) ptr+advancePtrState = update $ advancePtrStatic 1++advancePtr ::+   (Store.Storable a, Value (Ptr a) ~ ptr) =>+   Value Int -> ptr -> CodeGenFunction r ptr+advancePtr n ptr = do+   size <- A.mul n $ LLVM.valueOf $ Store.sizeOf (elementFromPtr ptr)+   addPointer size ptr++advancePtrStatic ::+   (Store.Storable a, Value (Ptr a) ~ ptr) =>+   Int -> ptr -> CodeGenFunction r ptr+advancePtrStatic n ptr =+   addPointer (LLVM.valueOf (Store.sizeOf (elementFromPtr ptr) * n)) ptr++incrementPtr ::+   (Store.Storable a, Value (Ptr a) ~ ptr) =>+   ptr -> CodeGenFunction r ptr+incrementPtr = advancePtrStatic 1++decrementPtr ::+   (Store.Storable a, Value (Ptr a) ~ ptr) =>+   ptr -> CodeGenFunction r ptr+decrementPtr = advancePtrStatic (-1)++addPointer :: Value Int -> Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))+addPointer k ptr = do+   bytePtr <- castToBytePtr ptr+   castFromBytePtr =<< LLVM.getElementPtr bytePtr (k, ())++type BytePtr = Value (LLVM.Ptr Word8)++castToBytePtr :: Value (Ptr a) -> CodeGenFunction r BytePtr+castToBytePtr = LLVM.bitcast++castFromBytePtr :: BytePtr -> CodeGenFunction r (Value (Ptr a))+castFromBytePtr = LLVM.bitcast++castElementPtr :: Value (Ptr (f a)) -> CodeGenFunction r (Value (Ptr a))+castElementPtr = LLVM.bitcast+++sizeOf :: (Store.Storable a) => LP.Proxy a -> Int+sizeOf = Store.sizeOf . elementFromProxy++elementFromPtr :: LLVM.Value (Ptr a) -> a+elementFromPtr _ = error "elementFromProxy"++elementFromProxy :: LP.Proxy a -> a+elementFromProxy LP.Proxy = error "elementFromProxy"++proxyFromElement2 :: f (g a) -> LP.Proxy a+proxyFromElement2 _ = LP.Proxy++proxyFromElement3 :: f (g (h a)) -> LP.Proxy a+proxyFromElement3 _ = LP.Proxy
+ src/LLVM/Extra/Struct.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{- |+In contrast to 'LLVM.Struct' it allows to store high-level values+and thus allows to implement arbitrary-sized tuples of NiceValue's.+-}+module LLVM.Extra.Struct where++import qualified LLVM.Extra.Tuple as Tuple++import qualified LLVM.Core as LLVM++import qualified Control.Applicative.HT as App+import Control.Applicative ((<$>))+++newtype T struct = Cons struct+++class Undefined struct where+   undef :: struct++instance (Undefined struct) => Tuple.Undefined (T struct) where+   undef = Cons undef++instance+   (Tuple.Undefined a, Undefined as) =>+      Undefined (a,as) where+   undef = (Tuple.undef, undef)++instance Undefined () where+   undef = ()+++class Zero struct where+   zero :: struct++instance (Zero struct) => Tuple.Zero (T struct) where+   zero = Cons zero++instance (Tuple.Zero a, Zero as) => Zero (a,as) where+   zero = (Tuple.zero, zero)++instance Zero () where+   zero = ()+++class Phi struct where+   phi :: LLVM.BasicBlock -> struct -> LLVM.CodeGenFunction r struct+   addPhi :: LLVM.BasicBlock -> struct -> struct -> LLVM.CodeGenFunction r ()++instance (Phi struct) => Tuple.Phi (T struct) where+   phi bb (Cons s) = Cons <$> phi bb s+   addPhi bb (Cons a) (Cons b) = addPhi bb a b++instance (Tuple.Phi a, Phi as) => Phi (a,as) where+   phi bb (a,as) = App.lift2 (,) (Tuple.phi bb a) (phi bb as)+   addPhi bb (a,as) (b,bs) = Tuple.addPhi bb a b >> addPhi bb as bs++instance Phi () where+   phi _bb = return+   addPhi _bb () () = return ()+++class (Undefined (ValueOf struct)) => Value struct where+   type ValueOf struct+   valueOf :: struct -> ValueOf struct++instance (Value struct) => Tuple.Value (T struct) where+   type ValueOf (T struct) = T (ValueOf struct)+   valueOf (Cons struct) = Cons $ valueOf struct++instance (Tuple.Value a, Value as) => Value (a,as) where+   type ValueOf (a,as) = (Tuple.ValueOf a, ValueOf as)+   valueOf (a,as) = (Tuple.valueOf a, valueOf as)++instance Value () where+   type ValueOf () = ()+   valueOf () = ()
+ src/LLVM/Extra/Tuple.hs view
@@ -0,0 +1,246 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+module LLVM.Extra.Tuple (+   Phi(..), phiTraversable, addPhiFoldable,+   Undefined(..), undefPointed,+   Zero(..), zeroPointed,+   Value(..), valueOfFunctor,+   VectorValue(..),+   ) where++import LLVM.Extra.TuplePrivate (+   Phi(..), phiTraversable, addPhiFoldable,+   Undefined(..), undefPointed,+   Zero(..), zeroPointed,+   )+import qualified LLVM.Extra.EitherPrivate as Either+import qualified LLVM.Extra.MaybePrivate as Maybe+import qualified LLVM.Core as LLVM+import LLVM.Core (IsType, Vector)++import qualified Type.Data.Num.Decimal as TypeNum+import Type.Data.Num.Decimal ((:*:))++import qualified Control.Monad.Trans.State as MS+import qualified Control.Applicative as App+import qualified Control.Functor.HT as FuncHT++import qualified Data.Foldable as Fold+import qualified Data.Traversable as Trav++import qualified Foreign.Storable.Record.Tuple as StoreTuple+import Foreign.StablePtr (StablePtr, )+import Foreign.Ptr (FunPtr, Ptr, )++import qualified Data.EnumBitSet as EnumBitSet+import qualified Data.Enum.Storable as Enum+import qualified Data.Bool8 as Bool8+import Data.Complex (Complex((:+)))+import Data.Tagged (Tagged(unTagged))+import Data.Word (Word8, Word16, Word32, Word64, Word)+import Data.Int  (Int8,  Int16,  Int32,  Int64, )+import Data.Bool8 (Bool8)++import Prelude2010+import Prelude ()+++-- * class for creating tuples of constant values++class (Undefined (ValueOf a)) => Value a where+   type ValueOf a+   valueOf :: a -> ValueOf a++instance (Value a, Value b) => Value (a,b) where+   type ValueOf (a,b) = (ValueOf a, ValueOf b)+   valueOf ~(a,b) = (valueOf a, valueOf b)++instance (Value a, Value b, Value c) => Value (a,b,c) where+   type ValueOf (a,b,c) = (ValueOf a, ValueOf b, ValueOf c)+   valueOf ~(a,b,c) = (valueOf a, valueOf b, valueOf c)++instance (Value a, Value b, Value c, Value d) => Value (a,b,c,d) where+   type ValueOf (a,b,c,d) = (ValueOf a, ValueOf b, ValueOf c, ValueOf d)+   valueOf ~(a,b,c,d) = (valueOf a, valueOf b, valueOf c, valueOf d)++instance (Value tuple) => Value (StoreTuple.Tuple tuple) where+   type ValueOf (StoreTuple.Tuple tuple) = ValueOf tuple+   valueOf (StoreTuple.Tuple a) = valueOf a++instance (Value a) => Value (Maybe a) where+   type ValueOf (Maybe a) = Maybe.T (ValueOf a)+   valueOf = maybe (Maybe.nothing undef) (Maybe.just . valueOf)++instance (Value a, Value b) => Value (Either a b) where+   type ValueOf (Either a b) = Either.T (ValueOf a) (ValueOf b)+   valueOf =+      either+         (Either.left undef . valueOf)+         (Either.right undef . valueOf)++instance Value Float  where type ValueOf Float  = LLVM.Value Float  ; valueOf = LLVM.valueOf+instance Value Double where type ValueOf Double = LLVM.Value Double ; valueOf = LLVM.valueOf+-- instance Value FP128  where type ValueOf FP128  = LLVM.Value FP128  ; valueOf = LLVM.valueOf+instance Value Bool   where type ValueOf Bool   = LLVM.Value Bool   ; valueOf = LLVM.valueOf+instance Value Bool8  where type ValueOf Bool8  = LLVM.Value Bool   ; valueOf = LLVM.valueOf . Bool8.toBool+instance Value Int    where type ValueOf Int    = LLVM.Value Int    ; valueOf = LLVM.valueOf+instance Value Int8   where type ValueOf Int8   = LLVM.Value Int8   ; valueOf = LLVM.valueOf+instance Value Int16  where type ValueOf Int16  = LLVM.Value Int16  ; valueOf = LLVM.valueOf+instance Value Int32  where type ValueOf Int32  = LLVM.Value Int32  ; valueOf = LLVM.valueOf+instance Value Int64  where type ValueOf Int64  = LLVM.Value Int64  ; valueOf = LLVM.valueOf+instance Value Word   where type ValueOf Word   = LLVM.Value Word   ; valueOf = LLVM.valueOf+instance Value Word8  where type ValueOf Word8  = LLVM.Value Word8  ; valueOf = LLVM.valueOf+instance Value Word16 where type ValueOf Word16 = LLVM.Value Word16 ; valueOf = LLVM.valueOf+instance Value Word32 where type ValueOf Word32 = LLVM.Value Word32 ; valueOf = LLVM.valueOf+instance Value Word64 where type ValueOf Word64 = LLVM.Value Word64 ; valueOf = LLVM.valueOf+instance Value ()     where type ValueOf ()     = ()           ; valueOf = id+++instance (TypeNum.Positive n) => Value (LLVM.IntN n) where+   type ValueOf (LLVM.IntN n) = LLVM.Value (LLVM.IntN n)+   valueOf = LLVM.valueOf++instance (TypeNum.Positive n) => Value (LLVM.WordN n) where+   type ValueOf (LLVM.WordN n) = LLVM.Value (LLVM.WordN n)+   valueOf = LLVM.valueOf+++instance Value (Ptr a) where+   type ValueOf (Ptr a) = LLVM.Value (Ptr a)+   valueOf = LLVM.valueOf++instance IsType a => Value (LLVM.Ptr a) where+   type ValueOf (LLVM.Ptr a) = LLVM.Value (LLVM.Ptr a)+   valueOf = LLVM.valueOf++instance LLVM.IsFunction a => Value (FunPtr a) where+   type ValueOf (FunPtr a) = LLVM.Value (FunPtr a)+   valueOf = LLVM.valueOf++instance Value (StablePtr a) where+   type ValueOf (StablePtr a) = LLVM.Value (StablePtr a)+   valueOf = LLVM.valueOf++instance+   (TypeNum.Positive n, VectorValue n a, Undefined (VectorValueOf n a)) =>+      Value (Vector n a) where+   type ValueOf (Vector n a) = VectorValueOf n a+   valueOf = vectorValueOf+++instance Value a => Value (Tagged tag a) where+   type ValueOf (Tagged tag a) = ValueOf a+   valueOf = valueOf . unTagged++instance+   (LLVM.IsInteger w, LLVM.IsConst w, Num w, Enum e) =>+      Value (Enum.T w e) where+   type ValueOf (Enum.T w e) = LLVM.Value w+   valueOf = LLVM.valueOf . fromIntegral . fromEnum . Enum.toPlain++instance (LLVM.IsInteger w, LLVM.IsConst w) => Value (EnumBitSet.T w i) where+   type ValueOf (EnumBitSet.T w i) = LLVM.Value w+   valueOf = LLVM.valueOf . EnumBitSet.decons++instance (Value a) => Value (Complex a) where+   type ValueOf (Complex a) = Complex (ValueOf a)+   valueOf (a:+b) = valueOf a :+ valueOf b+++-- * class for vectors of tuples and other complex types++class+   (TypeNum.Positive n, Undefined (VectorValueOf n a)) =>+      VectorValue n a where+   type VectorValueOf n a+   vectorValueOf :: Vector n a -> VectorValueOf n a++-- may be simplified using a fake proof of TypeNum.Positive (n :*: m)+instance+   (TypeNum.Positive n, TypeNum.Positive m, TypeNum.Positive (n :*: m),+    Undefined (Vector (n :*: m) a)) =>+      VectorValue n (Vector m a) where+   type VectorValueOf n (Vector m a) = Vector (n :*: m) a+   vectorValueOf = vectorFromList . Fold.foldMap Fold.toList++vectorFromList :: (TypeNum.Positive n) => [a] -> Vector n a+vectorFromList =+   MS.evalState $ Trav.sequence $ App.pure $ MS.state $ \(y:ys) -> (y,ys)++instance (VectorValue n a, VectorValue n b) => VectorValue n (a,b) where+   type VectorValueOf n (a,b) = (VectorValueOf n a, VectorValueOf n b)+   vectorValueOf v =+      case FuncHT.unzip v of+         (a,b) -> (vectorValueOf a, vectorValueOf b)++instance+   (VectorValue n a, VectorValue n b, VectorValue n c) =>+      VectorValue n (a,b,c) where+   type VectorValueOf n (a,b,c) =+         (VectorValueOf n a, VectorValueOf n b, VectorValueOf n c)+   vectorValueOf v =+      case FuncHT.unzip3 v of+         (a,b,c) -> (vectorValueOf a, vectorValueOf b, vectorValueOf c)++instance (VectorValue n tuple) => VectorValue n (StoreTuple.Tuple tuple) where+   type VectorValueOf n (StoreTuple.Tuple tuple) = VectorValueOf n tuple+   vectorValueOf = vectorValueOf . fmap StoreTuple.getTuple++instance (TypeNum.Positive n) => VectorValue n Float where+   type VectorValueOf n Float  = LLVM.Value (Vector n Float)+   vectorValueOf = LLVM.valueOf++instance (TypeNum.Positive n) => VectorValue n Double where+   type VectorValueOf n Double = LLVM.Value (Vector n Double)+   vectorValueOf = LLVM.valueOf+{-+instance (TypeNum.Positive n) => VectorValue n FP128  where+   type VectorValueOf n FP128  = LLVM.Value (Vector n FP128)+   vectorValueOf = LLVM.valueOf+-}+instance (TypeNum.Positive n) => VectorValue n Bool   where+   type VectorValueOf n Bool   = LLVM.Value (Vector n Bool)+   vectorValueOf = LLVM.valueOf+instance (TypeNum.Positive n) => VectorValue n Bool8  where+   type VectorValueOf n Bool8  = LLVM.Value (Vector n Bool)+   vectorValueOf = LLVM.valueOf . fmap Bool8.toBool+instance (TypeNum.Positive n) => VectorValue n Int  where+   type VectorValueOf n Int    = LLVM.Value (Vector n Int)+   vectorValueOf = LLVM.valueOf+instance (TypeNum.Positive n) => VectorValue n Int8   where+   type VectorValueOf n Int8   = LLVM.Value (Vector n Int8)+   vectorValueOf = LLVM.valueOf+instance (TypeNum.Positive n) => VectorValue n Int16  where+   type VectorValueOf n Int16  = LLVM.Value (Vector n Int16)+   vectorValueOf = LLVM.valueOf+instance (TypeNum.Positive n) => VectorValue n Int32  where+   type VectorValueOf n Int32  = LLVM.Value (Vector n Int32)+   vectorValueOf = LLVM.valueOf+instance (TypeNum.Positive n) => VectorValue n Int64  where+   type VectorValueOf n Int64  = LLVM.Value (Vector n Int64)+   vectorValueOf = LLVM.valueOf+instance (TypeNum.Positive n) => VectorValue n Word   where+   type VectorValueOf n Word   = LLVM.Value (Vector n Word)+   vectorValueOf = LLVM.valueOf+instance (TypeNum.Positive n) => VectorValue n Word8  where+   type VectorValueOf n Word8  = LLVM.Value (Vector n Word8)+   vectorValueOf = LLVM.valueOf+instance (TypeNum.Positive n) => VectorValue n Word16 where+   type VectorValueOf n Word16 = LLVM.Value (Vector n Word16)+   vectorValueOf = LLVM.valueOf+instance (TypeNum.Positive n) => VectorValue n Word32 where+   type VectorValueOf n Word32 = LLVM.Value (Vector n Word32)+   vectorValueOf = LLVM.valueOf+instance (TypeNum.Positive n) => VectorValue n Word64 where+   type VectorValueOf n Word64 = LLVM.Value (Vector n Word64)+   vectorValueOf = LLVM.valueOf+++-- * default methods for LLVM classes++valueOfFunctor :: (Value h, Functor f) => f h -> f (ValueOf h)+valueOfFunctor = fmap valueOf
+ src/LLVM/Extra/TuplePrivate.hs view
@@ -0,0 +1,140 @@+module LLVM.Extra.TuplePrivate where++import qualified LLVM.Core as LLVM++import qualified Data.FixedLength as FixedLength+import Data.Complex (Complex)++import qualified Type.Data.Num.Unary as Unary++import qualified Control.Applicative.HT as App+import Control.Applicative (Applicative, liftA2, pure)++import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold++import Data.Orphans ()++++-- * class for phi operating on value tuples++class Phi a where+   phi :: LLVM.BasicBlock -> a -> LLVM.CodeGenFunction r a+   addPhi :: LLVM.BasicBlock -> a -> a -> LLVM.CodeGenFunction r ()++instance Phi () where+   phi _ _ = return ()+   addPhi _ _ _ = return ()++instance (LLVM.IsFirstClass a) => Phi (LLVM.Value a) where+   phi bb a = LLVM.phi [(a, bb)]+   addPhi bb a a' = LLVM.addPhiInputs a [(a', bb)]++instance (Phi a, Phi b) => Phi (a, b) where+   phi bb = App.mapPair (phi bb, phi bb)+   addPhi bb (a0,b0) (a1,b1) = do+      addPhi bb a0 a1+      addPhi bb b0 b1++instance (Phi a, Phi b, Phi c) => Phi (a, b, c) where+   phi bb = App.mapTriple (phi bb, phi bb, phi bb)+   addPhi bb (a0,b0,c0) (a1,b1,c1) = do+      addPhi bb a0 a1+      addPhi bb b0 b1+      addPhi bb c0 c1++instance (Phi a, Phi b, Phi c, Phi d) => Phi (a, b, c, d) where+   phi bb (a,b,c,d) =+      App.lift4 (,,,) (phi bb a) (phi bb b) (phi bb c) (phi bb d)+   addPhi bb (a0,b0,c0,d0) (a1,b1,c1,d1) = do+      addPhi bb a0 a1+      addPhi bb b0 b1+      addPhi bb c0 c1+      addPhi bb d0 d1++instance (Phi a) => Phi (Complex a) where+   phi = phiTraversable+   addPhi = addPhiFoldable++instance (Unary.Natural n, Phi a) => Phi (FixedLength.T n a) where+   phi = phiTraversable+   addPhi = addPhiFoldable++phiTraversable ::+   (Phi a, Trav.Traversable f) =>+   LLVM.BasicBlock -> f a -> LLVM.CodeGenFunction r (f a)+phiTraversable bb x = Trav.mapM (phi bb) x++addPhiFoldable ::+   (Phi a, Fold.Foldable f, Applicative f) =>+   LLVM.BasicBlock -> f a -> f a -> LLVM.CodeGenFunction r ()+addPhiFoldable bb x y = Fold.sequence_ (liftA2 (addPhi bb) x y)+++-- * class for tuples of undefined values++class Undefined a where+   undef :: a++instance Undefined () where+   undef = ()++instance (LLVM.IsFirstClass a) => Undefined (LLVM.Value a) where+   undef = LLVM.value LLVM.undef++instance (LLVM.IsFirstClass a) => Undefined (LLVM.ConstValue a) where+   undef = LLVM.undef++instance (Undefined a, Undefined b) => Undefined (a, b) where+   undef = (undef, undef)++instance (Undefined a, Undefined b, Undefined c) => Undefined (a, b, c) where+   undef = (undef, undef, undef)++instance+   (Undefined a, Undefined b, Undefined c, Undefined d) =>+      Undefined (a, b, c, d) where+   undef = (undef, undef, undef, undef)++instance (Undefined a) => Undefined (Complex a) where+   undef = undefPointed++instance (Unary.Natural n, Undefined a) => Undefined (FixedLength.T n a) where+   undef = undefPointed++undefPointed :: (Undefined a, Applicative f) => f a+undefPointed = pure undef+++-- * class for tuples of zero values++class Zero a where+   zero :: a++instance Zero () where+   zero = ()++instance (LLVM.IsFirstClass a) => Zero (LLVM.Value a) where+   zero = LLVM.value LLVM.zero++instance (LLVM.IsFirstClass a) => Zero (LLVM.ConstValue a) where+   zero = LLVM.zero++instance (Zero a, Zero b) => Zero (a, b) where+   zero = (zero, zero)++instance (Zero a, Zero b, Zero c) => Zero (a, b, c) where+   zero = (zero, zero, zero)++instance (Zero a, Zero b, Zero c, Zero d) => Zero (a, b, c, d) where+   zero = (zero, zero, zero, zero)++instance (Zero a) => Zero (Complex a) where+   zero = zeroPointed++instance (Unary.Natural n, Zero a) => Zero (FixedLength.T n a) where+   zero = zeroPointed++zeroPointed :: (Zero a, Applicative f) => f a+zeroPointed = pure zero
src/LLVM/Extra/Vector.hs view
@@ -29,9 +29,9 @@     insertChunk, modify,    map, mapChunks, zipChunksWith,-   chop, concat, select,+   chop, concat,    signedFraction,-   cumulate1, umul32to64,+   cumulate1,    Arithmetic       (sum, sumToPair, sumInterleavedToPair,        cumulate, dotProduct, mul),@@ -40,17 +40,11 @@        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.Tuple as Tuple import qualified LLVM.Extra.ArithmeticPrivate as A+import qualified LLVM.Util.Intrinsic as Intrinsic  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,@@ -59,9 +53,10 @@     CodeGenFunction, )  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal (D4, (:+:), )+import Type.Data.Num.Decimal ((:+:))  import qualified Control.Applicative as App+import qualified Control.Monad.HT as M import Control.Monad.HT ((<=<), ) import Control.Monad (liftM2, liftM3, foldM, ) import Control.Applicative (liftA2, )@@ -70,15 +65,12 @@ import qualified Data.Foldable as Fold import qualified Data.NonEmpty.Class as NonEmptyC import qualified Data.NonEmpty as NonEmpty-import qualified Data.Empty as Empty import qualified Data.List.HT as ListHT import qualified Data.List as List import Data.NonEmpty ((!:), )-import Data.Tuple.HT (uncurry3, ) --- import qualified Data.Bits as Bit import Data.Int  (Int8, Int16, Int32, Int64, )-import Data.Word (Word8, Word16, Word32, Word64, )+import Data.Word (Word8, Word16, Word32, Word64, Word)  import Prelude hiding           (Real, truncate, floor, round,@@ -107,11 +99,11 @@    insert :: Value Word32 -> Element v -> v -> CodeGenFunction r v  class-   (TypeNum.Positive (Size v), Phi v, Class.Undefined v) =>+   (TypeNum.Positive (Size v), Tuple.Phi v, Tuple.Undefined v) =>       Simple v where -   type Element v :: *-   type Size v :: *+   type Element v+   type Size v     shuffleMatch ::       ConstValue (Vector (Size v) Word32) -> v -> CodeGenFunction r v@@ -216,14 +208,14 @@    {-# INLINE sequenceA #-}    sequenceA (Constant a) = fmap Constant a -instance (Phi a) => Phi (Constant n a) where-   phis = Class.phisTraversable-   addPhis = Class.addPhisFoldable+instance (Tuple.Phi a) => Tuple.Phi (Constant n a) where+   phi = Tuple.phiTraversable+   addPhi = Tuple.addPhiFoldable -instance (Class.Undefined a) => Class.Undefined (Constant n a) where-   undefTuple = Class.undefTuplePointed+instance (Tuple.Undefined a) => Tuple.Undefined (Constant n a) where+   undef = Tuple.undefPointed -instance (TypeNum.Positive n, Phi a, Class.Undefined a) => Simple (Constant n a) where+instance (TypeNum.Positive n, Tuple.Phi a, Tuple.Undefined a) => Simple (Constant n a) where     type Element (Constant n a) = a    type Size (Constant n a) = n@@ -235,7 +227,7 @@ class (n ~ Size (Construct n a), a ~ Element (Construct n a),        C (Construct n a)) =>          Canonical n a where-   type Construct n a :: *+   type Construct n a  instance    (TypeNum.Positive n, LLVM.IsPrimitive a) =>@@ -283,10 +275,10 @@    (C v) =>    [Element v] -> CodeGenFunction r v assemble =-   foldM (\v (k,x) -> insert (valueOf k) x v) Class.undefTuple .+   foldM (\v (k,x) -> insert (valueOf k) x v) Tuple.undef .    List.zip [0..] {- sends GHC into an infinite loop-   foldM (\(k,x) -> insert (valueOf k) x) Class.undefTuple .+   foldM (\(k,x) -> insert (valueOf k) x) Tuple.undef .    List.zip [0..] -} @@ -309,7 +301,7 @@    Element v -> CodeGenFunction r v iterate f x =    fmap snd $-   iterateCore f x Class.undefTuple+   iterateCore f x Tuple.undef  iterateCore ::    (C v) =>@@ -419,18 +411,18 @@       (insert (LLVM.valueOf (fromIntegral (sizeInTuple x) - 1)) x0 y)  shiftUpMultiZero ::-   (C v, Class.Zero (Element v)) =>+   (C v, Tuple.Zero (Element v)) =>    Int -> v -> LLVM.CodeGenFunction r v shiftUpMultiZero n v =    assemble . take (sizeInTuple v) .-   (List.replicate n Class.zeroTuple ++) =<< extractAll v+   (List.replicate n Tuple.zero ++) =<< extractAll v  shiftDownMultiZero ::-   (C v, Class.Zero (Element v)) =>+   (C v, Tuple.Zero (Element v)) =>    Int -> v -> LLVM.CodeGenFunction r v shiftDownMultiZero n v =    assemble . take (sizeInTuple v) .-   (++ List.repeat Class.zeroTuple) . List.drop n+   (++ List.repeat Tuple.zero) . List.drop n       =<< extractAll v  @@ -528,7 +520,7 @@          extract (valueOf n) a >>=          f >>=          flip (insert (valueOf n)) b)-      Class.undefTuple+      Tuple.undef       (take (sizeInTuple a) [0..])  mapChunks ::@@ -543,7 +535,7 @@          am >>= \ac ->          f ac >>= \bc ->          insertChunk (k * sizeInTuple ac) bc b)-      Class.undefTuple $+      Tuple.undef $    List.zip (chop a) [0..]  zipChunksWith ::@@ -582,7 +574,7 @@               else extractAll =<< g =<< assemble c          assemble $ List.concat ds ++ d -zipChunks2With ::+_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,@@ -592,37 +584,11 @@    (ca -> cb -> CodeGenFunction r cc) ->    (la -> lb -> CodeGenFunction r lc) ->    (va -> vb -> CodeGenFunction r vc)-zipChunks2With f g a b =+_zipChunks2With f g a b =    mapChunks2 (uncurry f) (uncurry g) (a,b)  -infixl 1 `withRound` -withRound ::-   (IsPrimitive a, IsPrimitive b,-    TypeNum.Positive k, TypeNum.Positive m, TypeNum.Positive 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'. -}@@ -644,7 +610,7 @@    foldl1       {- quite the same as (+) using LLVM.Arithmetic instances,          but requires less type constraints -}-      (M.liftR2 A.add)+      (M.liftJoin2 A.add)       (List.map (LLVM.extractelement x . valueOf) $ take n $ [0..])  @@ -685,14 +651,14 @@                insert (valueOf j) x v)             v0 $          List.zip [0..] js)-      Class.undefTuple $+      Tuple.undef $    List.zip       (ListHT.sliceVertical (sizeInTuple (head xs)) [0..])       xs   getLowestPair ::-   (TypeNum.Positive n) =>+   (TypeNum.Positive n, IsPrimitive a) =>    Value (Vector n a) ->    CodeGenFunction r (Value a, Value a) getLowestPair x =@@ -786,7 +752,7 @@          a1 <- A.add a0 =<< extract (valueOf k) x          y1 <- insert (valueOf k) a0 y0          return (a1,y1))-      (a, Class.undefTuple)+      (a, Tuple.undef)       (take (sizeInTuple x) $ [0..])  cumulateGeneric =@@ -819,35 +785,7 @@       (takeWhile (<sizeInTuple x) $ List.iterate (2*) 1)  --inttofp ::-   (TypeNum.Positive n,-    IsPrimitive a, IsPrimitive b,-    LLVM.IsInteger a, IsFloating b) =>-   Value (Vector n a) -> CodeGenFunction r (Value (Vector n b))-inttofp = LLVM.inttofp- {--Can be used for both integer and float types,-but we need it only for Float types,-because LLVM produces ugly code for Float and even more ugly code for Double.--}-signumLogical ::-   (TypeNum.Positive 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.@@ -895,7 +833,7 @@    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+   A.sub negative positive  signumWordGeneric ::    (TypeNum.Positive n,@@ -928,210 +866,7 @@ signedFraction x =    A.sub x =<< truncate x -floorGeneric ::-   (IsFloating a, IsConst a, Real a, TypeNum.Positive 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.Positive 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.Positive 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.Positive 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.Positive n) =>-   Value (Vector n a) ->-   CodeGenFunction r (Value (Vector n a))-absGeneric x =-   maxGeneric x =<< LLVM.neg x--absAuto ::-   (TypeNum.Positive n, TypeNum.Positive m, TypeNum.Positive 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.Positive 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.Positive 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.Positive 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.Positive 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.Positive 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.Positive 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.Positive n, TypeNum.Positive m, TypeNum.Positive 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  {- |@@ -1190,184 +925,22 @@    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 Int    where instance Arithmetic Int8   where instance Arithmetic Int16  where instance Arithmetic Int32  where instance Arithmetic Int64  where+instance Arithmetic Word   where instance Arithmetic Word8  where instance Arithmetic Word16 where+instance Arithmetic Word32 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-                  (constVector4 (constOf 0, undef, constOf 2, undef))-               evenY <- shuffleMatchPlain1 cy-                  (constVector4 (constOf 0, undef, constOf 2, undef))-               evenZ64 <- pmul evenX evenY-               evenZ <- LLVM.bitcast evenZ64-               oddX <- shuffleMatchPlain1 cx-                  (constVector4 (constOf 1, undef, constOf 3, undef))-               oddY <- shuffleMatchPlain1 cy-                  (constVector4 (constOf 1, undef, constOf 3, undef))-               oddZ64 <- pmul oddX oddY-               oddZ <- LLVM.bitcast oddZ64-               shuffleMatchPlain2 evenZ oddZ-                  (constVector4 (constOf 0, constOf 4, constOf 2, constOf 6)))-            x y)-      `Ext.run`-      Ext.wrap X86C.sse41 (A.mul x y)  -umul32to64 ::-   (TypeNum.Positive 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-               (constVector4 (constOf 0, undef, constOf 2, undef))-            evenY <- shuffleMatchPlain1 cy-               (constVector4 (constOf 0, undef, constOf 2, undef))-            evenZ <- pmul evenX evenY-            oddX <- shuffleMatchPlain1 cx-               (constVector4 (constOf 1, undef, constOf 3, undef))-            oddY <- shuffleMatchPlain1 cy-               (constVector4 (constOf 1, undef, constOf 3, undef))-            oddZ <- pmul oddX oddY-{--            shuffleMatchPlain2 evenZ oddZ-               (constVector4 (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-               (constVector4 (constOf 0, undef, constOf 1, undef))-            lowerY <- shuffleMatchPlain1 cy-               (constVector4 (constOf 0, undef, constOf 1, undef))-            lowerZ <- pmul lowerX lowerY-            upperX <- shuffleMatchPlain1 cx-               (constVector4 (constOf 2, undef, constOf 3, undef))-            upperY <- shuffleMatchPlain1 cy-               (constVector4 (constOf 2, undef, constOf 3, undef))-            upperZ <- pmul upperX upperY-{--            shuffleMatchPlain2 lowerZ upperZ-               (constVector4 (constOf 0, constOf 1, constOf 2, constOf 3))--}-            concat [lowerZ, upperZ])--}-         x y)---constVector4 ::-   (IsConst a) =>-   (ConstValue a, ConstValue a, ConstValue a, ConstValue a) ->-   ConstValue (Vector D4 a)-constVector4 (a,b,c,d) =-   LLVM.constVector $ a!:b!:c!:d!:Empty.Cons---{- |-Attention:-The rounding and fraction functions only work-for floating point values with maximum magnitude of @maxBound :: Int32@.-This way we save expensive handling of possibly seldom cases.--}-class (Arithmetic a, LLVM.CmpRet a, LLVM.CmpResult a ~ Bool, IsConst a) =>+class (Arithmetic a, LLVM.CmpRet a, LLVM.IsPrimitive a, IsConst a) =>          Real a where    min, max ::       (TypeNum.Positive n) =>@@ -1391,165 +964,80 @@       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+   min = Intrinsic.min+   max = Intrinsic.max+   abs = Intrinsic.abs+   signum = signumFloatGeneric+   truncate = Intrinsic.truncate+   floor = Intrinsic.floor+   fraction = A.fraction  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+   min = Intrinsic.min+   max = Intrinsic.max+   abs = Intrinsic.abs+   signum = signumFloatGeneric+   truncate = Intrinsic.truncate+   floor = Intrinsic.floor+   fraction = A.fraction +instance Real Int where+   min = A.min+   max = A.max+   abs = A.abs+   signum = signumIntGeneric+   truncate = return+   floor = return+   fraction = const $ return (value LLVM.zero)+ instance Real Int8 where-   min = order minGeneric X86A.pminsb128 X86A.pminsb256-   max = order maxGeneric X86A.pmaxsb128 X86A.pmaxsb256-   abs = absAuto X86A.pabsb128 X86A.pabsb256+   min = A.min+   max = A.max+   abs = A.abs    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+   min = A.min+   max = A.max+   abs = A.abs    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+   min = A.min+   max = A.max+   abs = A.abs    signum = signumIntGeneric    truncate = return    floor = return    fraction = const $ return (value LLVM.zero)  instance Real Int64 where-   min = minGeneric-   max = maxGeneric-   abs = absGeneric+   min = A.min+   max = A.max+   abs = A.abs    signum = signumIntGeneric    truncate = return    floor = return    fraction = const $ return (value LLVM.zero) +instance Real Word where+   min = A.min+   max = A.max+   abs = return+   signum = signumWordGeneric+   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+   min = A.min+   max = A.max    abs = return    signum = signumWordGeneric    truncate = return@@ -1557,8 +1045,8 @@    fraction = const $ return (value LLVM.zero)  instance Real Word16 where-   min = order minGeneric X86A.pminuw128 X86A.pminuw256-   max = order maxGeneric X86A.pmaxuw128 X86A.pmaxuw256+   min = A.min+   max = A.max    abs = return    signum = signumWordGeneric    truncate = return@@ -1566,8 +1054,8 @@    fraction = const $ return (value LLVM.zero)  instance Real Word32 where-   min = order minGeneric X86A.pminud128 X86A.pminud256-   max = order maxGeneric X86A.pmaxud128 X86A.pmaxud256+   min = A.min+   max = A.max    abs = return    signum = signumWordGeneric    truncate = return@@ -1575,8 +1063,8 @@    fraction = const $ return (value LLVM.zero)  instance Real Word64 where-   min = minGeneric-   max = maxGeneric+   min = A.min+   max = A.max    abs = return    signum = signumWordGeneric    truncate = return
− src/PrepareIntrinsics.hs 
@@ -1,326 +0,0 @@-{-# 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 Type.Data.Num.Decimal 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.8/include/llvm/IR/IntrinsicsX86.td"-   case parsed of-      Left msg -> IO.hPutStrLn IO.stderr $ show msg-      Right intrinsics ->-         writeFile "src/LLVM/Extra/Extension/X86Auto.hs" $ convertIntrinsics intrinsics
+ test/LLVM/Extra/VectorAlt.hs view
@@ -0,0 +1,225 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{- |+This maintains old code for LLVM-2.6+where vector comparison and select on X86+did not work or generated cumbersome assembly code.+It may still be useful for testing.+-}+module LLVM.Extra.VectorAlt where++import qualified LLVM.Extra.Vector as Vector+import qualified LLVM.Extra.Arithmetic as A++import qualified LLVM.Util.Intrinsic as Intrinsic+import qualified LLVM.Core.Guided as Guided+import qualified LLVM.Core as LLVM+import LLVM.Core+   (CodeGenFunction, Value, valueOf, value, Vector,+    CmpRet, IsConst, IsArithmetic, IsFloating, IsPrimitive)++import qualified Type.Data.Num.Decimal as TypeNum++import Data.Tuple.HT (uncurry3, )++import Data.Int  (Int8, Int16, Int32, Int64, )+import Data.Word (Word8, Word16, Word32, Word64, )++import Prelude hiding (max, min, abs, signum, floor, truncate)++++{-+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.+-}+signum ::+   (TypeNum.Positive 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))+signum gt x = do+   let zero = LLVM.value LLVM.zero+   negative <- gt zero x+   positive <- gt x zero+   A.sub negative positive++ext2 ::+   (TypeNum.Positive n) =>+   Value (Vector n Bool) ->+   CodeGenFunction r (Value (Vector n (LLVM.IntN TypeNum.D2)))+ext2 = Guided.extBool Guided.vector++{- |+This has least instruction count for Vector D4 Float on X86.+-}+signumFloat ::+   (TypeNum.Positive n,+    IsPrimitive a, IsArithmetic a, IsFloating a,+    LLVM.CmpRet a, LLVM.CmpResult a ~ Bool) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+signumFloat x = do+   let zero = LLVM.value LLVM.zero+   negative <- ext2 =<< A.cmp LLVM.CmpLT x zero+   positive <- ext2 =<< A.cmp LLVM.CmpGT x zero+   LLVM.sitofp =<< A.sub negative positive+++select ::+   (TypeNum.Positive n, LLVM.IsFirstClass a, IsPrimitive a,+    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 =+   Vector.map (uncurry3 LLVM.select) (b, x, y)+++floor ::+   (TypeNum.Positive n, IsFloating a, Vector.Real a) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+floor = floorLogical A.fcmp++fraction ::+   (TypeNum.Positive n, IsFloating a, Vector.Real a) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+fraction = fractionLogical A.fcmp+++floorLogical ::+   (TypeNum.Positive n, IsFloating a, Vector.Real a,+    IsPrimitive i, LLVM.IsInteger i) =>+   (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 <- Intrinsic.truncate x+   b <- cmp LLVM.FPOGT xr x+   A.add xr =<< LLVM.sitofp b++fractionLogical ::+   (TypeNum.Positive n, IsFloating a, Vector.Real a,+    IsPrimitive i, LLVM.IsInteger i) =>+   (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 <- Vector.signedFraction x+   b <- cmp LLVM.FPOLT xf (value LLVM.zero)+   A.sub xf =<< LLVM.sitofp b+++{- |+'floor' implemented using 'select'.+This will need jumps.+-}+floorSelect ::+   (TypeNum.Positive n, Num a, IsFloating a, Vector.Real a) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+floorSelect x = do+   xr <- Intrinsic.truncate x+   b <- A.fcmp LLVM.FPOLE xr x+   select b xr =<< A.sub xr =<< Vector.replicate (valueOf 1)++{- |+'fraction' implemented using 'select'.+This will need jumps.+-}+fractionSelect ::+   (TypeNum.Positive n, Num a, IsFloating a, Vector.Real a) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+fractionSelect x = do+   xf <- Vector.signedFraction x+   b <- A.fcmp LLVM.FPOGE xf (value LLVM.zero)+   select b xf =<< A.add xf =<< Vector.replicate (valueOf 1)+++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.Positive n) =>+   Value (Vector n a) ->+   Value (Vector n Bool) ->+   CodeGenFunction r (Value (Vector n (Mask a)))+makeMask _ = Guided.extBool Guided.vector+++min, max ::+   (IsConst a, IsArithmetic a, CmpRet a, Maskable a, TypeNum.Positive n) =>+   Value (Vector n a) ->+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))++min x y = do+   b <- makeMask x =<< A.cmp LLVM.CmpLT x y+   selectLogical b x y++max x y = do+   b <- makeMask x =<< A.cmp LLVM.CmpGT x y+   selectLogical b x y++abs ::+   (IsConst a, IsArithmetic a, CmpRet a, Maskable a, TypeNum.Positive n) =>+   Value (Vector n a) ->+   CodeGenFunction r (Value (Vector n a))+abs x = max x =<< LLVM.neg x+++{- |+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.Positive 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 <- LLVM.inv b+   xm <- A.and b    =<< Guided.bitcast Guided.vector x+   ym <- A.and bneg =<< Guided.bitcast Guided.vector y+   Guided.bitcast Guided.vector =<< A.or xm ym
+ test/Main.hs view
@@ -0,0 +1,25 @@+module Main where++import qualified Test.Storable as Storable+import qualified Test.Vector as Vector++import qualified LLVM.Core as LLVM++import Data.Tuple.HT (mapFst)++import Control.Monad.IO.Class (liftIO)++import qualified Test.DocTest.Driver as DocTest+++main :: IO ()+main = do+   LLVM.initializeNativeTarget++   DocTest.run $ mapM_+      (\(msg,prop) -> do+         DocTest.printPrefix (msg++": ")+         DocTest.property =<< liftIO prop) $+      map (mapFst ("Storable."++)) Storable.tests +++      map (mapFst ("Vector."++)) Vector.tests +++      []
+ test/Test/Storable.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module Test.Storable (tests) where++import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Tuple as Tuple++import qualified LLVM.ExecutionEngine as EE+import qualified LLVM.Core as LLVM++import qualified Type.Data.Num.Decimal as TypeNum++import qualified Foreign+import Foreign.Storable.Record.Tuple (Tuple(Tuple))+import Foreign.Ptr (FunPtr, Ptr)++import Data.Complex (Complex)+import Data.Word (Word16, Word32)+import Data.Int (Int8, Int16, Int32)+import Data.Tuple.HT (mapFst)++import qualified Test.QuickCheck.Monadic as QCMon+import qualified Test.QuickCheck as QC++++type Importer func = FunPtr func -> func++generateFunction ::+   EE.ExecutionFunction f =>+   Importer f -> LLVM.CodeGenModule (LLVM.Function f) -> IO f+generateFunction imprt code = do+   m <- LLVM.newModule+   fn <- do+      func <- LLVM.defineModule m $ LLVM.setTarget LLVM.hostTriple >> code+      EE.runEngineAccessWithModule m $ EE.getExecutionFunction imprt func+   LLVM.writeBitcodeToFile "test-storable.bc" m+   return fn+++foreign import ccall safe "dynamic" derefTestCasePtr ::+   Importer (Ptr inp -> Ptr out -> IO ())++modul ::+   (Storable.C a, Tuple.ValueOf a ~ al) =>+   (Storable.C b, Tuple.ValueOf b ~ bl) =>+   (al -> LLVM.CodeGenFunction () bl) ->+   LLVM.CodeGenModule (LLVM.Function (Ptr a -> Ptr b -> IO ()))+modul codegen =+   LLVM.createFunction LLVM.ExternalLinkage $ \aPtr bPtr -> do+      flip Storable.store bPtr =<< codegen =<< Storable.load aPtr+      LLVM.ret ()++run ::+   (Show a) =>+   (Storable.C a, Tuple.ValueOf a ~ al) =>+   (Storable.C b, Tuple.ValueOf b ~ bl) =>+   QC.Gen a ->+   (al -> LLVM.CodeGenFunction () bl) ->+   (a -> b -> Bool) ->+   IO QC.Property+run qcgen codegen predicate = do+   funIO <- generateFunction derefTestCasePtr $ modul codegen+   return $ QC.forAll qcgen $ \a ->+      QCMon.monadicIO $ do+         b <-+            QCMon.run $+               Foreign.with a $ \aPtr ->+               Foreign.alloca $ \bPtr -> do+                  funIO aPtr bPtr+                  Foreign.peek bPtr+         QCMon.assert $ predicate a b+++roundTrip ::+   (Show a, Eq a, Storable.C a) =>+   QC.Gen a -> IO QC.Property+roundTrip qcgen = run qcgen return (==)+++tests :: [(String, IO QC.Property)]+tests =+   map (mapFst ("RoundTrip." ++)) $+   ("()",+      roundTrip (QC.arbitrary :: QC.Gen ())) :+   ("Float",+      roundTrip (QC.arbitrary :: QC.Gen Float)) :+   ("(Word16,Float)",+      roundTrip (fmap Tuple (QC.arbitrary :: QC.Gen (Word16,Float)))) :+   ("(Int8,Bool,Double)",+      roundTrip (fmap Tuple (QC.arbitrary :: QC.Gen (Int8,Bool,Double)))) :+   ("Complex Float",+      roundTrip (QC.arbitrary :: QC.Gen (Complex Float))) :+   ("Vector D3 Int32",+      roundTrip (QC.arbitrary :: QC.Gen (LLVM.Vector TypeNum.D3 Int32))) :+   ("Vector D7 (Int16,Word32)",+      roundTrip (fmap (fmap Tuple)+         (QC.arbitrary :: QC.Gen (LLVM.Vector TypeNum.D7 (Int16,Word32))))) :+   []
+ test/Test/Vector.hs view
@@ -0,0 +1,323 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+module Test.Vector where++import qualified LLVM.Extra.ScalarOrVectorPrivate as SoVPriv+import qualified LLVM.Extra.ScalarOrVector as SoV+import qualified LLVM.Extra.VectorAlt as VectorAlt+import qualified LLVM.Extra.Vector as Vector+import qualified LLVM.Extra.Memory as Memory+import qualified LLVM.Extra.Marshal as Marshal+import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.ExecutionEngine as EE+import qualified LLVM.Core as LLVM++import qualified Type.Data.Num.Decimal as TypeNum+import Type.Base.Proxy (Proxy(Proxy))++import Foreign.Ptr (FunPtr)++import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold+import qualified Data.Bits as Bits+import Data.Word (Word8, Word16, Word32)+import Data.Int (Int8, Int32)++import qualified Test.QuickCheck as QC+import qualified Test.QuickCheck.Monadic as QCMon++import Control.Applicative (liftA2, pure)++import qualified Prelude as P+import Prelude hiding (min, max)+++type V4 = LLVM.Vector TypeNum.D4+type V5 = LLVM.Vector TypeNum.D5+type V4Word32 = V4 Word32+type V4Int32 = V4 Int32+type V4Float = V4 Float++type Importer func = FunPtr func -> func++generateFunction ::+   EE.ExecutionFunction f =>+   Importer f -> LLVM.CodeGenModule (LLVM.Function f) -> IO f+generateFunction imprt code = do+   m <- LLVM.newModule+   fn <- do+      func <- LLVM.defineModule m $ LLVM.setTarget LLVM.hostTriple >> code+      EE.runEngineAccessWithModule m $ EE.getExecutionFunction imprt func+   LLVM.writeBitcodeToFile "test-vector.bc" m+   return fn+++foreign import ccall safe "dynamic" derefTestCasePtr ::+   Importer (LLVM.Ptr inp -> LLVM.Ptr out -> IO ())++modul ::+   (Memory.C linp, Memory.Struct linp ~ minp, LLVM.IsType minp,+    Memory.C lout, Memory.Struct lout ~ mout, LLVM.IsType mout) =>+   (linp -> LLVM.CodeGenFunction () lout) ->+   LLVM.CodeGenModule (LLVM.Function (LLVM.Ptr minp -> LLVM.Ptr mout -> IO ()))+modul codegen =+   LLVM.createFunction LLVM.ExternalLinkage $ \xPtr yPtr -> do+      flip Memory.store yPtr =<< codegen =<< Memory.load xPtr+      LLVM.ret ()++run ::+   (Marshal.C inp, Marshal.Struct inp ~ minp, LLVM.IsType minp,+    Marshal.C out, Marshal.Struct out ~ mout, LLVM.IsType mout,+    Tuple.ValueOf inp ~ linp, Tuple.ValueOf out ~ lout) =>+   (Show inp, QC.Arbitrary inp) =>+   (linp -> LLVM.CodeGenFunction () lout) ->+   (inp -> out -> Bool) ->+   IO QC.Property+run codegen predicate = do+   funIO <- generateFunction derefTestCasePtr $ modul codegen+   return $ QC.property $ \x ->+      QCMon.monadicIO $ do+         y <-+            QCMon.run $+               Marshal.with x $ \xPtr ->+               Marshal.alloca $ \yPtr -> do+                  funIO xPtr yPtr+                  Marshal.peek yPtr+         QCMon.assert $ predicate x y+++vec4 :: V4 a -> V4 a+vec4 = id+++unop ::+   (LLVM.Value V4Int32 -> LLVM.CodeGenFunction () (LLVM.Value V4Int32)) ->+   (Int32 -> Int32) ->+   IO QC.Property+unop codegen fun =+   run codegen (\x y -> fmap fun (vec4 x) == vec4 y)++unopFloat ::+   (LLVM.Value V4Float -> LLVM.CodeGenFunction () (LLVM.Value V4Float)) ->+   (Float -> Float) ->+   IO QC.Property+unopFloat codegen fun =+   run codegen (\x y -> fmap fun (vec4 x) == vec4 y)+++binop ::+   ((TypeNum.D4 TypeNum.:*: LLVM.SizeOf a) ~ size, TypeNum.Natural size,+    QC.Arbitrary a, Show a, Eq a,+    Marshal.Vector TypeNum.D4 a, Tuple.VectorValueOf TypeNum.D4 a ~ v) =>+   (v -> v -> LLVM.CodeGenFunction () v) ->+   (a -> a -> a) ->+   IO QC.Property+binop codegen fun =+   run (uncurry codegen)+      (\(x,y) z -> liftA2 fun (vec4 x) (vec4 y)  ==  vec4 z)++binopInt ::+   (LLVM.Value V4Int32 ~ v) =>+   (v -> v -> LLVM.CodeGenFunction () v) ->+   (Int32 -> Int32 -> Int32) ->+   IO QC.Property+binopInt = binop+++type Int2 = LLVM.IntN TypeNum.D2+type Int3 = LLVM.IntN TypeNum.D3+type Word2 = LLVM.WordN TypeNum.D2+type Word3 = LLVM.WordN TypeNum.D3++vectorise ::+   (TypeNum.Positive n, Integral a) =>+   Integer -> a -> LLVM.Vector n Integer+vectorise modu x =+   snd $ Trav.mapAccumL (\xi f -> f xi) (toInteger x) $+   pure (\xi -> divMod xi modu)++unpackInts ::+   (TypeNum.Positive n, TypeNum.Positive d, Integral a) =>+   Integer -> a -> LLVM.Vector n (LLVM.IntN d)+unpackInts modu =+   fmap+      (\x ->+         LLVM.IntN $+         if Bits.shiftR modu 1 Bits..&. x /= 0+            then toInteger x - modu+            else toInteger x) .+   vectorise modu++unpackWords ::+   (TypeNum.Positive n, TypeNum.Positive d, Integral a) =>+   Integer -> a -> LLVM.Vector n (LLVM.WordN d)+unpackWords modu = fmap LLVM.WordN . vectorise modu++unpackInt2 :: Word8 -> V4 Int2+unpackInt2 = unpackInts 4++unpackWord2 :: Word8 -> V4 Word2+unpackWord2 = unpackWords 4++unpackInt3 :: Word16 -> V5 Int3+unpackInt3 = unpackInts 8++unpackWord3 :: Word16 -> V5 Word3+unpackWord3 = unpackWords 8++binopV4I2 ::+   (Eq a, LLVM.IsPrimitive a, LLVM.IsSized a, LLVM.SizeOf a ~ TypeNum.D2,+    LLVM.Value (V4 a) ~ v) =>+   (Word8 -> V4 a) ->+   (v -> v -> LLVM.CodeGenFunction () v) ->+   (a -> a -> a) ->+   IO QC.Property+binopV4I2 unpackBits codegen fun =+   run+      (\(x,y) -> do+         vx <- LLVM.bitcast x+         vy <- LLVM.bitcast y+         vz <- codegen vx vy+         LLVM.bitcast vz)+      (\(x,y) z ->+         liftA2 fun (unpackBits x) (unpackBits y)  ==  unpackBits z)++type Code15 r = LLVM.CodeGenFunction r (LLVM.Value (LLVM.WordN TypeNum.D15))++binopV5I3 ::+   (Eq a, LLVM.IsPrimitive a, LLVM.IsSized a, LLVM.SizeOf a ~ TypeNum.D3,+    LLVM.Value (V5 a) ~ v) =>+   (Word16 -> V5 a) ->+   (v -> v -> LLVM.CodeGenFunction () v) ->+   (a -> a -> a) ->+   IO QC.Property+binopV5I3 unpackBits codegen fun =+   run+      (\(x,y) -> do+         vx <- LLVM.bitcast =<< (LLVM.trunc x :: Code15 r)+         vy <- LLVM.bitcast =<< (LLVM.trunc y :: Code15 r)+         vz <- codegen vx vy+         LLVM.zext =<< (LLVM.bitcast vz :: Code15 r))+      (\(x,y) z ->+         liftA2 fun (unpackBits x) (unpackBits y)  ==  unpackBits z)++binopInt8 ::+   (LLVM.Value (V4 Int8) ~ v) =>+   (v -> v -> LLVM.CodeGenFunction () v) ->+   (Int8 -> Int8 -> Int8) ->+   IO QC.Property+binopInt8 = binop++binopWord8 ::+   (LLVM.Value (V4 Word8) ~ v) =>+   (v -> v -> LLVM.CodeGenFunction () v) ->+   (Word8 -> Word8 -> Word8) ->+   IO QC.Property+binopWord8 = binop+++addSat, subSat :: (Bounded a, Integral a) => a -> a -> a+addSat = addSatMan (toInteger, fromInteger)+subSat = subSatMan (toInteger, fromInteger)++addSatMan, subSatMan ::+   (Bounded a) => (a -> Integer, Integer -> a) -> a -> a -> a+addSatMan = opSat (+)+subSatMan = opSat (-)++convertIntN :: Proxy d -> (LLVM.IntN d -> Integer, Integer -> LLVM.IntN d)+convertIntN Proxy = (\(LLVM.IntN n) -> n, LLVM.IntN)++convertWordN :: Proxy d -> (LLVM.WordN d -> Integer, Integer -> LLVM.WordN d)+convertWordN Proxy = (\(LLVM.WordN n) -> n, LLVM.WordN)++opSat ::+   (Bounded a) =>+   (Integer -> Integer -> Integer) ->+   (a -> Integer, Integer -> a) ->+   a -> a -> a+opSat op (toIntg, fromIntg) x y =+   fromIntg $+   P.max (toIntg $ minBound `asTypeOf` x) $+   P.min (toIntg $ maxBound `asTypeOf` x) $+   op (toIntg x) (toIntg y)+++fraction :: RealFrac a => a -> a+fraction x = x - fromInteger (floor x)+++split :: String -> (a -> b -> c) -> (a,a) -> b -> [(String, c)]+split name driver (intrinsic, fallback) f =+   (name ++ ".intrinsic", driver intrinsic f) :+   (name ++ ".fallback",  driver fallback  f) :+   []++tests :: [(String, IO QC.Property)]+tests =+   ("abs", unop Vector.abs P.abs) :+   ("signum", unop Vector.signum P.signum) :+   ("Alt.abs", unop VectorAlt.abs P.abs) :++   ("min", binopInt Vector.min P.min) :+   ("max", binopInt Vector.max P.max) :+   ("Alt.min", binopInt VectorAlt.min P.min) :+   ("Alt.max", binopInt VectorAlt.max P.max) :++   split "addSat.Word8" binopWord8 (SoV.addSat, SoVPriv.uaddSat) addSat +++   split "subSat.Word8" binopWord8 (SoV.subSat, SoVPriv.usubSat) subSat +++   split "addSat.Int8"  binopInt8  (SoV.addSat, SoVPriv.saddSat) addSat +++   split "subSat.Int8"  binopInt8  (SoV.subSat, SoVPriv.ssubSat) subSat ++++   split "addSat.Word3"+      (binopV5I3 unpackWord3) (SoV.addSat, SoVPriv.uaddSat)+      (addSatMan $ convertWordN TypeNum.d3) +++   split "subSat.Word3"+      (binopV5I3 unpackWord3) (SoV.subSat, SoVPriv.usubSat)+      (subSatMan $ convertWordN TypeNum.d3) +++   split "addSat.Int3"+      (binopV5I3 unpackInt3) (SoV.addSat, SoVPriv.saddSat)+      (addSatMan $ convertIntN TypeNum.d3) +++   split "subSat.Int3"+      (binopV5I3 unpackInt3) (SoV.subSat, SoVPriv.ssubSat)+      (subSatMan $ convertIntN TypeNum.d3) ++++   split "addSat.Word2"+      (binopV4I2 unpackWord2) (SoV.addSat, SoVPriv.uaddSat)+      (addSatMan $ convertWordN TypeNum.d2) +++   split "subSat.Word2"+      (binopV4I2 unpackWord2) (SoV.subSat, SoVPriv.usubSat)+      (subSatMan $ convertWordN TypeNum.d2) +++   split "addSat.Int2"+      (binopV4I2 unpackInt2) (SoV.addSat, SoVPriv.saddSat)+      (addSatMan $ convertIntN TypeNum.d2) +++   split "subSat.Int2"+      (binopV4I2 unpackInt2) (SoV.subSat, SoVPriv.ssubSat)+      (subSatMan $ convertIntN TypeNum.d2) ++++   ("sum",+      run Vector.sum (\x y -> Fold.sum (vec4 x) == (y::Int32))) :+   ("cumulate",+      run+         (uncurry Vector.cumulate)+         (\(x0,xv) (y0,yv) ->+            scanl (+) x0 (Fold.toList (vec4 xv))+            ==+            Fold.toList (vec4 yv) ++ [y0::Int32])) :+   ("dot",+      run+         (uncurry Vector.dotProduct)+         (\(x,y) z ->+            Fold.sum (liftA2 (*) (vec4 x) (vec4 y))  ==  (z::Int32))) :++   ("truncate", unopFloat Vector.truncate (fromInteger . P.truncate)) :+   ("floor", unopFloat Vector.floor (fromInteger . P.floor)) :+   ("fraction", unopFloat Vector.fraction fraction) :++   ("floorLogical", unopFloat VectorAlt.floor (fromInteger . P.floor)) :+   ("fractionLogical", unopFloat VectorAlt.fraction fraction) :+   ("floorSelect", unopFloat VectorAlt.floorSelect (fromInteger . P.floor)) :+   ("fractionSelect", unopFloat VectorAlt.fractionSelect fraction) :+   []
− x86/cpuid/LLVM/Extra/ExtensionCheck/X86.hs 
@@ -1,71 +0,0 @@-module LLVM.Extra.ExtensionCheck.X86 (-   sse1, sse2, sse3, ssse3, sse41, sse42, avx, avx2, avx512,-   fma, amd3dnow, amd3dnowa, aes, sse4a,-   ) where--import qualified LLVM.Extra.Extension as Ext-import qualified System.Cpuid as CPUID-import qualified System.Unsafe as Unsafe--{--I expect that the cpuid does not suddenly change-and thus calling Unsafe.performIO is safe.--}-subtarget ::-   String ->-   (CPUID.FlagSet CPUID.Feature1C -> CPUID.FlagSet CPUID.Feature1D -> Bool) ->-   Ext.Subtarget-subtarget name q =-   Ext.Subtarget "x86" name-      (return $ Unsafe.performIO $ check q)--check ::-   (CPUID.FlagSet CPUID.Feature1C -> CPUID.FlagSet CPUID.Feature1D -> Bool) ->-   IO Bool-check q =-   fmap (uncurry q) $ CPUID.features----- * target specific extensions--sse1 :: Ext.Subtarget-sse1 = subtarget "sse" (\_ecx edx -> CPUID.testFlag CPUID.sse edx)--sse2 :: Ext.Subtarget-sse2 = subtarget "sse2" (\_ecx edx -> CPUID.testFlag CPUID.sse2 edx)--sse3 :: Ext.Subtarget-sse3 = subtarget "sse3" (\ecx _edx -> CPUID.testFlag CPUID.sse3 ecx)--ssse3 :: Ext.Subtarget-ssse3 = subtarget "ssse3" (\ecx _edx -> CPUID.testFlag CPUID.ssse3 ecx)--sse41 :: Ext.Subtarget-sse41 = subtarget "sse41" (\ecx _edx -> CPUID.testFlag CPUID.sse4_1 ecx)--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)--avx512 :: Ext.Subtarget-avx512 = subtarget "avx512" (\ _ecx _edx -> False)--fma :: Ext.Subtarget-fma = subtarget "fma" (\ ecx _edx -> CPUID.testFlag CPUID.fma ecx)--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)--sse4a :: Ext.Subtarget-sse4a = subtarget "sse4a" (\ _ecx _edx -> False)
− x86/none/LLVM/Extra/ExtensionCheck/X86.hs 
@@ -1,55 +0,0 @@-module LLVM.Extra.ExtensionCheck.X86 (-   sse1, sse2, sse3, ssse3, sse41, sse42, avx, avx2, avx512,-   fma, amd3dnow, amd3dnowa, aes, sse4a,-   ) where--import qualified LLVM.Extra.Extension as Ext--subtarget :: String -> Bool -> Ext.Subtarget-subtarget name q =-   Ext.Subtarget "x86" name (return q)----- * target specific extensions--sse1 :: Ext.Subtarget-sse1 = subtarget "sse" False--sse2 :: Ext.Subtarget-sse2 = subtarget "sse2" False--sse3 :: Ext.Subtarget-sse3 = subtarget "sse3" False--ssse3 :: Ext.Subtarget-ssse3 = subtarget "ssse3" False--sse41 :: Ext.Subtarget-sse41 = subtarget "sse41" False--sse42 :: Ext.Subtarget-sse42 = subtarget "sse42" False--avx :: Ext.Subtarget-avx = subtarget "avx" False--avx2 :: Ext.Subtarget-avx2 = subtarget "avx2" False--avx512 :: Ext.Subtarget-avx512 = subtarget "avx512" False--fma :: Ext.Subtarget-fma = subtarget "fma" False--amd3dnow :: Ext.Subtarget-amd3dnow = subtarget "3dnow" False--amd3dnowa :: Ext.Subtarget-amd3dnowa = subtarget "3dnowa" False--aes :: Ext.Subtarget-aes = subtarget "aesni" False--sse4a :: Ext.Subtarget-sse4a = subtarget "sse4a" False