diff --git a/Changes.md b/Changes.md
new file mode 100644
--- /dev/null
+++ b/Changes.md
@@ -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.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,31 @@
+Copyright (c) 2010, Henning Thielemann
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * The names of contributors may not be used to endorse or promote
+      products derived from this software without specific prior
+      written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Makefile b/Makefile
new file mode 100644
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,36 @@
+.PHONY:	sharedobj
+
+testbuild:
+	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
+
+sharedobj:	libLLVM.so
+
+libLLVM.so:	libLLVM.so.$(llvmversion)
+	ln -s $< $@
+
+libLLVM.so.%:
+	for src in `llvm-config --libdir`/libLLVM*.a; do ar -x $$src ; done
+	gcc -shared -Wl,-soname,$@ -o $@ *.o
+#	gcc -shared -Wl,-soname,$@ -o $@ `llvm-config --libdir`/LLVM*.o *.o
+	rm *.o
+
+%.s:	%.bc
+	llc  $<
+
+# This would lead to a cycle with llvm-as.
+# %.ll:	%.bc
+#	llvm-dis -f $<
+
+%-dis.ll:	%.bc
+	llvm-dis -o $@ -f $<
+
+%.bc:	%.ll
+	llvm-as -f $<
+
+%-opt.bc:	%.bc
+	opt -O3 < $< > $@
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#! /usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/llvm-extra.cabal b/llvm-extra.cabal
new file mode 100644
--- /dev/null
+++ b/llvm-extra.cabal
@@ -0,0 +1,193 @@
+Cabal-Version:  2.2
+Name:           llvm-extra
+Version:        0.13
+License:        BSD-3-Clause
+License-File:   LICENSE
+Author:         Henning Thielemann <haskell@henning-thielemann.de>
+Maintainer:     Henning Thielemann <haskell@henning-thielemann.de>
+Homepage:       https://wiki.haskell.org/LLVM
+Category:       Compilers/Interpreters, Code Generation
+Synopsis:       Utility functions for the llvm interface
+Description:
+  The Low-Level Virtual-Machine is a compiler back-end with optimizer.
+  You may also call it a high-level portable assembler.
+  This package provides various utility functions
+  for the Haskell interface to LLVM, for example:
+  .
+  * arithmetic operations with more general types
+    but better type inference than the @llvm@ interface
+    in "LLVM.Extra.Arithmetic",
+  .
+  * a type class for loading and storing sets of values with one command (macro)
+    in "LLVM.Extra.Memory",
+  .
+  * 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"
+  .
+  * various kinds of loops (while) and condition structures (if-then-else)
+    in "LLVM.Extra.Control"
+  .
+  * more functional loop construction using "LLVM.Extra.Iterator"
+  .
+  * complex Haskell values mapped to LLVM values in "LLVM.Extra.Nice.Value"
+  .
+  * advanced vector operations
+    such as sum of all vector elements, cumulative sum,
+    floor, non-negative fraction, absolute value
+    in "LLVM.Extra.Vector"
+  .
+  * type classes for handling scalar and vector operations
+    in a uniform way
+    in "LLVM.Extra.ScalarOrVector"
+Stability:      Experimental
+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
+
+Extra-Doc-Files:
+  Changes.md
+
+Flag buildExamples
+  description: Build example executables
+  default:     False
+
+Source-Repository this
+  Tag:         0.13
+  Type:        darcs
+  Location:    http://code.haskell.org/~thielema/llvm-extra/
+
+Source-Repository head
+  Type:        darcs
+  Location:    http://code.haskell.org/~thielema/llvm-extra/
+
+Library
+  Build-Depends:
+    private,
+    llvm-tf >=12.1 && <21.1,
+    tfp >=1.0 && <1.1,
+    non-empty >=0.2.1 && <0.4,
+    fixed-length >=0.2.1 && <0.3,
+    containers >=0.1 && <0.8,
+    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 >=3 && <5
+
+  Default-Language: Haskell98
+  GHC-Options: -Wall
+  Hs-source-dirs: src
+  Exposed-Modules:
+    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.Tuple
+    LLVM.Extra.Struct
+    LLVM.Extra.Control
+    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.Vector
+    LLVM.Extra.Multi.Value.Marshal
+    LLVM.Extra.Multi.Value.Storable
+    LLVM.Extra.Multi.Vector
+    LLVM.Extra.Multi.Vector.Instance
+    LLVM.Extra.Multi.Class
+  Other-Modules:
+    LLVM.Extra.Storable.Array
+    LLVM.Extra.Storable.Private
+    LLVM.Extra.TuplePrivate
+    LLVM.Extra.MaybePrivate
+    LLVM.Extra.EitherPrivate
+    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:
+      llvm-extra,
+      llvm-tf,
+      tfp,
+      non-empty,
+      containers >=0.1 && <0.8,
+      transformers,
+      utility-ht >=0.0.1 && <0.1,
+      base >=3 && <5
+  Else
+    Buildable: False
+  Default-Language: Haskell98
+  GHC-Options: -Wall
+  Main-Is: src/Array.hs
+
+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
+  Hs-Source-Dirs: test
+  Main-Is: Main.hs
+  Other-Modules:
+    Test.Storable
+    Test.Vector
+    LLVM.Extra.VectorAlt
diff --git a/private/LLVM/Extra/ArithmeticPrivate.hs b/private/LLVM/Extra/ArithmeticPrivate.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/Extra/ArithmeticPrivate.hs
@@ -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
diff --git a/private/LLVM/Extra/ScalarOrVectorPrivate.hs b/private/LLVM/Extra/ScalarOrVectorPrivate.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/Extra/ScalarOrVectorPrivate.hs
@@ -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
diff --git a/src/Array.hs b/src/Array.hs
new file mode 100644
--- /dev/null
+++ b/src/Array.hs
@@ -0,0 +1,316 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+module Main where
+
+import qualified LLVM.Extra.ScalarOrVector as SoV
+import qualified LLVM.Extra.Vector as Vector
+
+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),
+          CodeGenModule, CodeGenFunction,
+          Vector, extractelement, insertelement, shufflevector, )
+import qualified System.IO as IO
+
+import Type.Data.Num.Decimal(D4, )
+import Data.Word (Word32, )
+import qualified Foreign.Storable as St
+import Foreign.Marshal.Array (allocaArray, )
+import Foreign.Ptr (FunPtr, Ptr, )
+
+import qualified Data.Empty as Empty
+import Data.NonEmpty ((!:), )
+
+import Control.Monad.Trans.State (StateT(StateT), runStateT)
+import Control.Monad.HT ((<=<))
+import Control.Monad (liftM2)
+import Control.Applicative (liftA2)
+
+
+
+type Vec = LLVM.ConstValue (Vector D4 Float)
+
+constVec ::
+   Float -> CodeGenFunction r (Value (Vector D4 Float))
+constVec x =
+   return $ valueOf $ LLVM.consVector x x x x
+
+constVecInsert ::
+   Float -> CodeGenFunction r (Value (Vector D4 Float))
+constVecInsert x' =
+   let x = valueOf x'
+   in  foldr
+          (\n mv v -> insertelement v x (valueOf n) >>= mv)
+          return
+          [0..3]
+          (value (undef :: Vec))
+
+{-
+This implementation cannot make use of vector operations,
+because 'frem' is only available in the FPU.
+-}
+fractionVector0 ::
+   Value (Vector D4 Float) -> CodeGenFunction r (Value (Vector D4 Float))
+fractionVector0 x =
+   frem x =<< constVec 1
+
+
+{-
+This call
+
+    fill (fromIntegral len) ptr
+       (LLVM.consVector 0.01003 0.01001 0.00999 0.00997) >>
+
+would not work, because Vector is not of type Generic.
+-}
+mChorusVectorArg ::
+  CodeGenModule (Function (Word32 -> Ptr Float -> Vector D4 Float -> IO Float))
+mChorusVectorArg =
+  createFunction ExternalLinkage $ \ size ptr freq -> do
+    const1 <- constVec 1
+    const2 <- constVec 2
+    s <- arrayLoop size ptr (value (zero :: Vec)) $ \ ptri phase -> do
+      y <- sub const1 =<< mul const2 phase
+      s0 <- extractelement y (valueOf 0)
+      s1 <- extractelement y (valueOf 1)
+      s2 <- extractelement y (valueOf 2)
+      s3 <- extractelement y (valueOf 3)
+      s01 <- add s0 s1
+      s23 <- add s2 s3
+      s0123 <- add s01 s23
+      flip store ptri =<< A.mul (valueOf 0.25) s0123
+      Vector.fraction =<< add phase freq
+    ss <- extractelement s (valueOf 0)
+    ret (ss :: Value Float)
+
+
+{- |
+differing vector sizes are allowed according to documentation,
+but not supported by C++ library of LLVM-2.5
+
+mixReduceSize :: Value (Vector D4 Float) -> CodeGenFunction r (Value Float)
+mixReduceSize y = do
+    y01 <- shufflevector y (value undef) (LLVM.constVector [constOf 0, constOf 1])
+    y23 <- shufflevector y (value undef) (LLVM.constVector [constOf 2, constOf 3])
+    z <- add
+       (y01 :: Value (Vector D2 Float))
+       (y23 :: Value (Vector D2 Float))
+    s0 <- extractelement z (valueOf 0)
+    s1 <- extractelement z (valueOf 1)
+    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
+the code is efficient.
+-}
+mixGeneric :: Value (Vector D4 Float) -> CodeGenFunction r (Value Float)
+mixGeneric y = do
+    -- that is translated to movhlps
+    y23 <-
+       shufflevector y (value undef)
+          (LLVM.constVector $ constOf 2 !: constOf 3 !: undef !: undef !: Empty.Cons)
+    z <- A.add y y23
+    s0 <- extractelement z (valueOf 0)
+    s1 <- extractelement z (valueOf 1)
+    A.mul (valueOf 0.25) =<< A.add s0 s1
+
+
+mChorusVector ::
+  CodeGenModule
+    (Function
+      (Word32 -> Ptr Float -> Float -> Float -> Float -> Float -> IO Float))
+mChorusVector =
+  createFunction ExternalLinkage $ \ size ptr f0 f1 f2 f3 -> do
+    freq <- Vector.assemble [f0,f1,f2,f3]
+    const1 <- constVec 1
+    const2 <- constVec (-2)
+    s <- arrayLoop size ptr (value (zero :: Vec)) $ \ ptri phase -> do
+      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 freq phase =
+  liftM2 (,) (waveSaw phase) (SoV.incPhase freq phase)
+
+mChorus ::
+  CodeGenModule
+    (Function
+      (Word32 -> Ptr Float -> Float -> Float -> Float -> Float -> IO Float))
+mChorus =
+  createFunction ExternalLinkage $ \ size ptr f0 f1 f2 f3 -> do
+    s <- arrayLoop size ptr Tuple.zero $
+         \ ptri ((phase0, phase1), (phase2, phase3)) -> do
+      (y0, phase0') <- osciSaw f0 phase0
+      (y1, phase1') <- osciSaw f1 phase1
+      (y2, phase2') <- osciSaw f2 phase2
+      (y3, phase3') <- osciSaw f3 phase3
+      y01 <- A.add y0 y1
+      y23 <- A.add y2 y3
+      y0123 <- A.add y01 y23
+      flip store ptri =<< A.mul (valueOf 0.25) y0123
+      return ((phase0', phase1'), (phase2', phase3'))
+    ret (fst (fst s) :: Value Float)
+
+
+sawOsciAction ::
+  Value Float ->
+  StateT (Value Float) (CodeGenFunction r) (Value Float)
+sawOsciAction freq =
+  StateT $ osciSaw freq
+
+{-
+(***) :: StateT s m a -> StateT t m b -> StateT (s,t) m (a,b)
+(***) sta stb =
+  StateT $ \(s0,t0) ->
+  do (a,s1) <- runStateT sta s0
+     (b,t1) <- runStateT stb t0
+     return ((a,b), (s1,t1))
+-}
+
+(=+=) ::
+  StateT s (CodeGenFunction r) (Value Float) ->
+  StateT t (CodeGenFunction r) (Value Float) ->
+  StateT (s,t) (CodeGenFunction r) (Value Float)
+(=+=) sta stb =
+  StateT $ \(s0,t0) ->
+  do (a,s1) <- runStateT sta s0
+     (b,t1) <- runStateT stb t0
+     c <- add a b
+     return (c, (s1,t1))
+
+mChorusMonadic ::
+  CodeGenModule
+    (Function
+      (Word32 -> Ptr Float -> Float -> Float -> Float -> Float -> IO Float))
+mChorusMonadic =
+  createFunction ExternalLinkage $ \ size ptr f0 f1 f2 f3 -> do
+    s <- arrayLoop size ptr Tuple.zero $
+         \ ptri phases -> do
+      (y, phases') <-
+         flip runStateT phases $
+            (sawOsciAction f0 =+= sawOsciAction f1) =+=
+            (sawOsciAction f2 =+= sawOsciAction f3)
+      flip store ptri =<< A.mul (valueOf 0.25) y
+      return phases'
+    ret (fst (fst s))
+
+
+type Importer func = FunPtr func -> func
+
+generateFunction ::
+  EE.ExecutionFunction f =>
+  Importer f -> CodeGenModule (Function f) -> IO f
+generateFunction imprt code = do
+  m <- LLVM.newModule
+  fill <- do
+    func <- LLVM.defineModule m $ LLVM.setTarget LLVM.hostTriple >> code
+    EE.runEngineAccessWithModule m $ EE.getExecutionFunction imprt func
+  LLVM.writeBitcodeToFile "array.bc" m
+  return fill
+
+
+foreign import ccall safe "dynamic" derefChorusPtr ::
+  Importer
+    (Word32 -> Ptr Float -> Float -> Float -> Float -> Float -> IO Float)
+
+renderChorus :: IO ()
+renderChorus = do
+  fill <- generateFunction derefChorusPtr mChorusVectorIterator
+  IO.withFile "speedtest.f32" IO.WriteMode $ \h ->
+    let len = 10000000
+    in  allocaArray len $ \ ptr ->
+          fill (fromIntegral len) ptr 0.01003 0.01001 0.00999 0.00997 >>
+          IO.hPutBuf h ptr (len*St.sizeOf(undefined::Float))
+
+
+mSaw :: CodeGenModule (Function (Word32 -> Ptr Float -> Float -> IO Float))
+mSaw =
+  createFunction ExternalLinkage $ \ size ptr freq -> do
+    s <- arrayLoop size ptr (valueOf 0) $ \ ptri phase -> do
+      (y, phase') <- osciSaw freq phase
+      store y ptri
+      return phase'
+    ret (s :: Value Float)
+
+foreign import ccall safe "dynamic" derefSawPtr ::
+  Importer (Word32 -> Ptr Float -> Float -> IO Float)
+
+renderSaw :: IO ()
+renderSaw = do
+  fill <- generateFunction derefSawPtr mSaw
+  IO.withFile "speedtest.f32" IO.WriteMode $ \h ->
+    let len = 10000000
+    in  allocaArray len $ \ ptr ->
+          fill (fromIntegral len) ptr 0.01 >>
+          IO.hPutBuf h ptr (len*St.sizeOf(undefined::Float))
+
+
+mRamp :: CodeGenModule (Function (Word32 -> Ptr Float -> Float -> IO Float))
+mRamp =
+  createFunction ExternalLinkage $ \ size ptr slope -> do
+    s <- arrayLoop size ptr (valueOf 0) $ \ ptri y -> do
+      store y ptri
+      add slope y
+    ret (s :: Value Float)
+
+renderRamp :: IO ()
+renderRamp = do
+  fill <- simpleFunction mRamp
+  IO.withFile "speedtest.f32" IO.WriteMode $ \h ->
+    let len = 10000000
+    in  allocaArray len $ \ ptr ->
+          fill (fromIntegral len) ptr (recip $ fromIntegral len) >>
+          IO.hPutBuf h ptr (len*St.sizeOf(undefined::Float))
+
+main :: IO ()
+main = do
+   LLVM.initializeNativeTarget
+   renderChorus
diff --git a/src/LLVM/Extra/Arithmetic.hs b/src/LLVM/Extra/Arithmetic.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Arithmetic.hs
@@ -0,0 +1,287 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+module LLVM.Extra.Arithmetic (
+   -- * arithmetic: generalized and improved type inference
+   Additive (zero, add, sub, neg), one, inc, dec,
+   PseudoRing (mul), square,
+   Scalar,
+   PseudoModule (scale),
+   Field (fdiv),
+   IntegerConstant(fromInteger'),
+   RationalConstant(fromRational'),
+   idiv, irem,
+   FloatingComparison(fcmp), Comparison(cmp),
+   CmpResult, LLVM.CmpPredicate(..),
+   Logic (and, or, xor, inv),
+   Real (min, max, abs, signum),
+   Fraction (truncate, fraction),
+   signedFraction, addToPhase, incPhase,
+   -- * pointer arithmetic
+   advanceArrayElementPtr,
+   decreaseArrayElementPtr,
+   -- * 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.Tuple as Tuple
+import qualified LLVM.Extra.ScalarOrVector as SoV
+import qualified LLVM.Core as LLVM
+import LLVM.Core
+   (CodeGenFunction, value, Value, ConstValue,
+    IsInteger, IsFloating, IsArithmetic)
+
+import Control.Monad (liftM2, liftM3, )
+
+import Prelude hiding
+   (Real, and, or, sqrt, sin, cos, exp, log, abs, min, max, truncate, )
+
+
+
+{- |
+This and the following type classes
+are intended for arithmetic operations on wrappers around LLVM types.
+E.g. you might define a fixed point fraction type by
+
+> newtype Fixed = Fixed Int32
+
+and then use the same methods for floating point and fixed point arithmetic.
+
+In contrast to the arithmetic methods in the @llvm@ wrapper,
+in our methods the types of operands and result match.
+Advantage: Type inference determines most of the types automatically.
+Disadvantage: You cannot use constant values directly,
+but you have to convert them all to 'Value'.
+-}
+class (Tuple.Zero a) => Additive a where
+   zero :: a
+   add :: a -> a -> CodeGenFunction r a
+   sub :: a -> a -> CodeGenFunction r a
+   neg :: a -> CodeGenFunction r a
+
+instance (IsArithmetic a) => Additive (Value a) where
+   zero = LLVM.value LLVM.zero
+   add = LLVM.add
+   sub = LLVM.sub
+   neg = LLVM.neg
+
+instance (IsInteger a) => Additive (ConstValue a) where
+   zero = 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)
+   add (x0,x1) (y0,y1) =
+      liftM2 (,) (add x0 y0) (add x1 y1)
+   sub (x0,x1) (y0,y1) =
+      liftM2 (,) (sub x0 y0) (sub x1 y1)
+   neg (x0,x1) =
+      liftM2 (,) (neg x0)    (neg x1)
+
+instance (Additive a, Additive b, Additive c) => Additive (a,b,c) where
+   zero = (zero, zero, zero)
+   add (x0,x1,x2) (y0,y1,y2) =
+      liftM3 (,,) (add x0 y0) (add x1 y1) (add x2 y2)
+   sub (x0,x1,x2) (y0,y1,y2) =
+      liftM3 (,,) (sub x0 y0) (sub x1 y1) (sub x2 y2)
+   neg (x0,x1,x2) =
+      liftM3 (,,) (neg x0)    (neg x1)    (neg x2)
+
+
+class (Additive a) => PseudoRing a where
+   mul :: a -> a -> CodeGenFunction r a
+
+instance (IsArithmetic v) => PseudoRing (Value v) where
+   mul = LLVM.mul
+
+
+type family Scalar vector
+type instance Scalar (Value a) = Value (SoV.Scalar a)
+type instance Scalar (ConstValue a) = ConstValue (SoV.Scalar a)
+
+class (PseudoRing (Scalar v), Additive v) => PseudoModule v where
+   scale :: Scalar v -> v -> CodeGenFunction r v
+
+instance (SoV.PseudoModule v) => PseudoModule (Value v) where
+   scale = SoV.scale
+
+
+class IntegerConstant a where
+   fromInteger' :: Integer -> a
+
+instance SoV.IntegerConstant a => IntegerConstant (ConstValue a) where
+   fromInteger' = SoV.constFromInteger
+
+instance SoV.IntegerConstant a => IntegerConstant (Value a) where
+   fromInteger' = value . SoV.constFromInteger
+
+
+one :: (IntegerConstant a) => a
+one = fromInteger' 1
+
+
+{-
+more general alternative to 'inc',
+but you may not like the resulting type constraints
+-}
+_inc ::
+   (PseudoRing a, IntegerConstant a) =>
+   a -> CodeGenFunction r a
+_inc x = add x one
+
+_dec ::
+   (PseudoRing a, IntegerConstant a) =>
+   a -> CodeGenFunction r a
+_dec x = sub x one
+
+
+square ::
+   (PseudoRing a) =>
+   a -> CodeGenFunction r a
+square x = mul x x
+
+
+class (PseudoRing a) => Field a where
+   fdiv :: a -> a -> CodeGenFunction r a
+
+instance (LLVM.IsFloating v) => Field (Value v) where
+   fdiv = LLVM.fdiv
+
+
+class (IntegerConstant a) => RationalConstant a where
+   fromRational' :: Rational -> a
+
+instance SoV.RationalConstant a => RationalConstant (ConstValue a) where
+   fromRational' = SoV.constFromRational
+
+instance SoV.RationalConstant a => RationalConstant (Value a) where
+   fromRational' = value . SoV.constFromRational
+
+
+
+{- |
+In Haskell terms this is a 'quot'.
+-}
+idiv ::
+   (IsInteger a) =>
+   Value a -> Value a -> CodeGenFunction r (Value a)
+idiv = LLVM.idiv
+
+irem ::
+   (IsInteger a) =>
+   Value a -> Value a -> CodeGenFunction r (Value a)
+irem = LLVM.irem
+
+
+
+class (Additive a) => Real a where
+   min :: a -> a -> CodeGenFunction r a
+   max :: a -> a -> CodeGenFunction r a
+   abs :: a -> CodeGenFunction r a
+   signum :: a -> CodeGenFunction r a
+
+instance (SoV.Real a) => Real (Value a) where
+   min = SoV.min
+   max = SoV.max
+   abs = SoV.abs
+   signum = SoV.signum
+
+
+class (Real a) => Fraction a where
+   truncate :: a -> CodeGenFunction r a
+   fraction :: a -> CodeGenFunction r a
+
+instance (SoV.Fraction a) => Fraction (Value a) where
+   truncate = SoV.truncate
+   fraction = SoV.fraction
+
+signedFraction ::
+   (Fraction a) =>
+   a -> CodeGenFunction r a
+signedFraction x =
+   sub x =<< truncate x
+
+addToPhase ::
+   (Fraction a) =>
+   a -> a -> CodeGenFunction r a
+addToPhase d p =
+   fraction =<< add d p
+
+{- |
+both increment and phase must be non-negative
+-}
+incPhase ::
+   (Fraction a) =>
+   a -> a -> CodeGenFunction r a
+incPhase d p =
+   signedFraction =<< add d p
+
+
+class Comparison a where
+   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
+
+
+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
+
+
+
+class Logic a where
+   and :: a -> a -> CodeGenFunction r a
+   or :: a -> a -> CodeGenFunction r a
+   xor :: a -> a -> CodeGenFunction r a
+   inv :: a -> CodeGenFunction r a
+
+instance (LLVM.IsInteger a) => Logic (Value a) where
+   and = LLVM.and
+   or = LLVM.or
+   xor = LLVM.xor
+   inv = LLVM.inv
+
+
+
+class Field a => Algebraic a where
+   sqrt :: a -> CodeGenFunction r a
+
+instance (IsFloating a) => Algebraic (Value a) where
+   sqrt = Intrinsic.call1 "sqrt"
+
+
+class Algebraic a => Transcendental a where
+   pi :: CodeGenFunction r a
+   sin, cos, exp, log :: a -> CodeGenFunction r a
+   pow :: a -> a -> CodeGenFunction r a
+
+instance (IsFloating a, SoV.TranscendentalConstant a) => Transcendental (Value a) where
+   pi = return $ value SoV.constPi
+   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"
diff --git a/src/LLVM/Extra/Array.hs b/src/LLVM/Extra/Array.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Array.hs
@@ -0,0 +1,72 @@
+module LLVM.Extra.Array (
+   size,
+   assemble,
+   extractAll,
+   map,
+   ) where
+
+import qualified LLVM.Extra.Tuple as Tuple
+
+import qualified LLVM.Core as LLVM
+import LLVM.Core (Value, Array, CodeGenFunction, )
+
+import qualified Type.Data.Num.Decimal as TypeNum
+import Control.Monad.HT ((<=<), )
+import Control.Monad (foldM, )
+
+import qualified Data.List as List
+
+import Data.Word (Word32, )
+
+import Prelude hiding
+          (Real, truncate, floor, round,
+           map, zipWith, iterate, replicate, reverse, concat, sum, )
+
+
+-- * target independent functions
+
+size ::
+   (TypeNum.Natural n) =>
+   Value (Array n a) -> Int
+size =
+   let sz :: (TypeNum.Natural n) => TypeNum.Singleton n -> Value (Array n a) -> Int
+       sz n _ = TypeNum.integralFromSingleton n
+   in  sz TypeNum.singleton
+
+{- |
+construct an array out of single elements
+
+You must assert that the length of the list matches the array size.
+
+This can be considered the inverse of 'extractAll'.
+-}
+assemble ::
+   (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)) Tuple.undef .
+   List.zip [0..]
+
+{- |
+provide the elements of an array as a list of individual virtual registers
+
+This can be considered the inverse of 'assemble'.
+-}
+extractAll ::
+   (TypeNum.Natural n, LLVM.IsSized a) =>
+   Value (Array n a) -> LLVM.CodeGenFunction r [Value a]
+extractAll x =
+   mapM
+      (LLVM.extractvalue x)
+      (take (size x) [(0::Word32)..])
+
+{- |
+The loop is unrolled,
+since 'LLVM.insertvalue' and 'LLVM.extractvalue' expect constant indices.
+-}
+map ::
+   (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 =
+   assemble <=< mapM f <=< extractAll
diff --git a/src/LLVM/Extra/Control.hs b/src/LLVM/Extra/Control.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Control.hs
@@ -0,0 +1,384 @@
+{-# LANGUAGE TypeFamilies #-}
+{- |
+Useful control structures additionally to those in "LLVM.Util.Loop".
+-}
+module LLVM.Extra.Control (
+   arrayLoop,
+   arrayLoop2,
+   arrayLoopWithExit,
+   arrayLoop2WithExit,
+   fixedLengthLoop,
+   whileLoop,
+   whileLoopShared,
+   loopWithExit,
+   ifThenElse,
+   ifThen,
+   Select(select),
+   selectTraversable,
+   ifThenSelect,
+   ret,
+   retVoid,
+   ) where
+
+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.Core
+   (getCurrentBasicBlock, newBasicBlock, defineBasicBlock,
+    br, condBr,
+    Value, value, valueOf,
+    phi, addPhiInputs,
+    CmpPredicate(CmpGT), CmpRet,
+    IsInteger, IsType, IsConst, IsPrimitive,
+    CodeGenFunction,
+    CodeGenModule, newModule, defineModule, writeBitcodeToFile, )
+
+import qualified Control.Applicative as App
+import qualified Data.Traversable as Trav
+import Control.Monad (liftM3, liftM2, )
+
+import Data.Tuple.HT (mapSnd, )
+
+
+
+-- * control structures
+
+{-
+I had to export Tuple.Phi's methods in llvm-0.6.8
+in order to be able to implement this function.
+-}
+arrayLoop ::
+   (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 $
+   fixedLengthLoop len (ptr, start) $ \(p,s) ->
+      liftM2 (,)
+         (advanceArrayElementPtr p)
+         (loopBody p s)
+
+arrayLoop2 ::
+   (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 $
+   arrayLoop len ptrA (ptrB,start)
+      (\pa (pb,s) ->
+         liftM2 (,)
+            (advanceArrayElementPtr pb)
+            (loopBody pa pb s))
+
+
+arrayLoopWithExit ::
+   (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,_)) <-
+      whileLoopShared ((valueOf True, start), (len, ptr)) $ \((b,v0), (i,p)) ->
+         (A.and b =<< cmp CmpGT i (value LLVM.zero),
+          do bv1 <- loopBody p v0
+             ip1 <-
+                ifThen (fst bv1) (i,p) $
+                   liftM2 (,)
+                      (dec i)
+                      (advanceArrayElementPtr p)
+             return (bv1,ip1))
+   pos <- sub len i
+   return (pos, vars)
+
+
+{- |
+An alternative to 'arrayLoopWithExit'
+where I try to persuade LLVM to use x86's LOOP instruction.
+Unfortunately it becomes even worse.
+LLVM developers say that x86 LOOP is actually slower
+than manual decrement, zero test and conditional branch.
+-}
+_arrayLoopWithExitDecLoop ::
+   (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
+   checkEnd <- newBasicBlock
+   loop <- newBasicBlock
+   next <- newBasicBlock
+   exit <- newBasicBlock
+
+   {- unfortunately, t0 is not just stored as processor flag
+      but is written to a register and then tested again in checkEnd -}
+   t0 <- cmp CmpGT len (value LLVM.zero)
+   br checkEnd
+
+   defineBasicBlock checkEnd
+   i <- phi [(len, top)]
+   p <- phi [(ptr, top)]
+   vars <- Tuple.phi top start
+   t <- phi [(t0, top)]
+   condBr t loop exit
+
+   defineBasicBlock loop
+
+   (cont, vars') <- loopBody p vars
+   Tuple.addPhi next vars vars'
+   condBr cont next exit
+
+   defineBasicBlock next
+   p' <- advanceArrayElementPtr p
+   i' <- dec i
+   t' <- cmp CmpGT i' (value LLVM.zero)
+
+   addPhiInputs i [(i', next)]
+   addPhiInputs p [(p', next)]
+   addPhiInputs t [(t', next)]
+   br checkEnd
+
+   defineBasicBlock exit
+   pos <- sub len i
+   return (pos, vars)
+
+
+arrayLoop2WithExit ::
+   (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) $
+   arrayLoopWithExit len ptrA (ptrB,start)
+      (\ptrAi (ptrB0,s0) -> do
+         (cont, s1) <- loopBody ptrAi ptrB0 s0
+         ptrB1 <- advanceArrayElementPtr ptrB0
+         return (cont, (ptrB1,s1)))
+
+
+fixedLengthLoop ::
+   (Tuple.Phi s,
+    Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
+   Value i -> s ->
+   (s -> CodeGenFunction r s) ->
+   CodeGenFunction r s
+fixedLengthLoop len start loopBody =
+   fmap snd $
+   whileLoopShared (len,start) $ \(i,s) ->
+      (cmp LLVM.CmpGT i (value LLVM.zero),
+       liftM2 (,) (dec i) (loopBody s))
+
+
+whileLoop, _whileLoop ::
+   Tuple.Phi a =>
+   a ->
+   (a -> CodeGenFunction r (Value Bool)) ->
+   (a -> CodeGenFunction r a) ->
+   CodeGenFunction r a
+whileLoop start check body =
+   loopWithExit start
+      (\a -> fmap (flip (,) a) $ check a)
+      body
+
+_whileLoop start check body = do
+   top <- getCurrentBasicBlock
+   loop <- newBasicBlock
+   cont <- newBasicBlock
+   exit <- newBasicBlock
+   br loop
+
+   defineBasicBlock loop
+   state <- Tuple.phi top start
+   b <- check state
+   condBr b cont exit
+   defineBasicBlock cont
+   res <- body state
+   cont' <- getCurrentBasicBlock
+   Tuple.addPhi cont' state res
+   br loop
+
+   defineBasicBlock exit
+   return state
+
+
+{- |
+This is a loop with a single point for exit from within the loop.
+The @Bool@ value indicates whether the loop shall be continued.
+-}
+loopWithExit ::
+   Tuple.Phi a =>
+   a ->
+   (a -> CodeGenFunction r (Value Bool, b)) ->
+   (b -> CodeGenFunction r a) ->
+   CodeGenFunction r b
+loopWithExit start check body = do
+   top <- getCurrentBasicBlock
+   loop <- newBasicBlock
+   cont <- newBasicBlock
+   exit <- newBasicBlock
+   br loop
+
+   defineBasicBlock loop
+   state <- Tuple.phi top start
+   (contB,b) <- check state
+   condBr contB cont exit
+   defineBasicBlock cont
+   a <- body b
+   cont' <- getCurrentBasicBlock
+   Tuple.addPhi cont' state a
+   br loop
+
+   defineBasicBlock exit
+   return b
+
+
+{- |
+This is a variant of 'whileLoop' that may be more convient,
+because you only need one lambda expression
+for both loop condition and loop body.
+-}
+whileLoopShared ::
+   Tuple.Phi a =>
+   a ->
+   (a ->
+      (CodeGenFunction r (Value Bool),
+       CodeGenFunction r a)) ->
+   CodeGenFunction r a
+whileLoopShared start checkBody =
+   whileLoop start
+      (fst . checkBody)
+      (snd . checkBody)
+
+{- |
+This construct starts new blocks,
+so be prepared when continueing after an 'ifThenElse'.
+-}
+ifThenElse ::
+   Tuple.Phi a =>
+   Value Bool ->
+   CodeGenFunction r a ->
+   CodeGenFunction r a ->
+   CodeGenFunction r a
+ifThenElse cond thenCode elseCode = do
+   thenBlock <- newBasicBlock
+   elseBlock <- newBasicBlock
+   mergeBlock <- newBasicBlock
+   condBr cond thenBlock elseBlock
+
+   defineBasicBlock thenBlock
+   a0 <- thenCode
+   thenBlock' <- getCurrentBasicBlock
+   br mergeBlock
+
+   defineBasicBlock elseBlock
+   a1 <- elseCode
+   elseBlock' <- getCurrentBasicBlock
+   br mergeBlock
+
+   defineBasicBlock mergeBlock
+   a2 <- Tuple.phi thenBlock' a0
+   Tuple.addPhi elseBlock' a2 a1
+   return a2
+
+
+ifThen ::
+   Tuple.Phi a =>
+   Value Bool ->
+   a ->
+   CodeGenFunction r a ->
+   CodeGenFunction r a
+ifThen cond deflt thenCode = do
+   defltBlock <- getCurrentBasicBlock
+   thenBlock <- newBasicBlock
+   mergeBlock <- newBasicBlock
+   condBr cond thenBlock mergeBlock
+
+   defineBasicBlock thenBlock
+   a0 <- thenCode
+   thenBlock' <- getCurrentBasicBlock
+   br mergeBlock
+
+   defineBasicBlock mergeBlock
+   a1 <- Tuple.phi defltBlock deflt
+   Tuple.addPhi thenBlock' a1 a0
+   return a1
+
+
+class Tuple.Phi a => Select a where
+   select :: Value Bool -> a -> a -> CodeGenFunction r a
+
+instance (CmpRet a, IsPrimitive a) => Select (Value a) where
+   select = LLVM.select
+
+instance Select () where
+   select _ () () = return ()
+
+instance (Select a, Select b) => Select (a,b) where
+   select cond (a0,b0) (a1,b1) =
+      liftM2 (,)
+         (select cond a0 a1)
+         (select cond b0 b1)
+
+instance (Select a, Select b, Select c) => Select (a,b,c) where
+   select cond (a0,b0,c0) (a1,b1,c1) =
+      liftM3 (,,)
+         (select cond a0 a1)
+         (select cond b0 b1)
+         (select cond c0 c1)
+
+selectTraversable ::
+   (Select a, Trav.Traversable f, App.Applicative f) =>
+   Value Bool -> f a -> f a -> CodeGenFunction r (f a)
+selectTraversable b x y =
+   Trav.sequence (App.liftA2 (select b) x y)
+
+
+{- |
+Branch-free variant of 'ifThen'
+that is faster if the enclosed block is very simply,
+say, if it contains at most two instructions.
+It can only be used as alternative to 'ifThen'
+if the enclosed block is free of side effects.
+-}
+ifThenSelect ::
+   Select a =>
+   Value Bool ->
+   a ->
+   CodeGenFunction r a ->
+   CodeGenFunction r a
+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
+
+_emitCode :: FilePath -> CodeGenModule a -> IO ()
+_emitCode fileName cgm = do
+   m <- newModule
+   _ <- defineModule m cgm
+   writeBitcodeToFile fileName m
diff --git a/src/LLVM/Extra/Either.hs b/src/LLVM/Extra/Either.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Either.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE TypeFamilies #-}
+{- |
+LLVM counterpart to 'Either' datatype.
+-}
+module LLVM.Extra.Either (
+   Either.T(..),
+   Either.run,
+   Either.getIsLeft,
+   Either.mapLeft,
+   Either.mapRight,
+   left,
+   right,
+   ) where
+
+import qualified LLVM.Extra.EitherPrivate as Either
+import qualified LLVM.Extra.Tuple as Tuple
+
+
+left :: (Tuple.Undefined b) => a -> Either.T a b
+left = Either.left Tuple.undef
+
+right :: (Tuple.Undefined a) => b -> Either.T a b
+right = Either.right Tuple.undef
diff --git a/src/LLVM/Extra/EitherPrivate.hs b/src/LLVM/Extra/EitherPrivate.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/EitherPrivate.hs
@@ -0,0 +1,63 @@
+{-# 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 Control.Monad (liftM3, )
+
+
+{- |
+If @isRight@, then @fromLeft@ is an @undefTuple@.
+If @not isRight@, then @fromRight@ is an @undefTuple@.
+I would prefer a union type,
+but it was temporarily removed in LLVM-2.8 and did not return since then.
+-}
+data T a b = Cons {isRight :: Value Bool, fromLeft :: a, fromRight :: b}
+
+
+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 ::
+   (Tuple.Phi c) =>
+   T a b ->
+   (a -> CodeGenFunction r c) ->
+   (b -> CodeGenFunction r c) ->
+   CodeGenFunction r c
+run (Cons r a b) fa fb =
+   ifThenElse r (fb b) (fa a)
+
+
+mapLeft :: (a0 -> a1) -> T a0 b -> T a1 b
+mapLeft f (Cons r a b) = Cons r (f a) b
+
+mapRight :: (b0 -> b1) -> T a b0 -> T a b1
+mapRight f (Cons r a b) = Cons r a (f b)
+
+
+getIsLeft :: T a b -> CodeGenFunction r (Value Bool)
+getIsLeft (Cons r _ _) = LLVM.inv r
+
+left :: b -> a -> T a b
+left undef a =
+   Cons {isRight = valueOf False, fromLeft = a, fromRight = undef}
+
+right :: a -> b -> T a b
+right undef b =
+   Cons {isRight = valueOf True, fromLeft = undef, fromRight = b}
diff --git a/src/LLVM/Extra/FastMath.hs b/src/LLVM/Extra/FastMath.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/FastMath.hs
@@ -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
diff --git a/src/LLVM/Extra/Function.hs b/src/LLVM/Extra/Function.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Function.hs
@@ -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
diff --git a/src/LLVM/Extra/Iterator.hs b/src/LLVM/Extra/Iterator.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Iterator.hs
@@ -0,0 +1,274 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TypeFamilies #-}
+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.Tuple as Tuple
+import qualified LLVM.Extra.Control as C
+import qualified LLVM.Core as LLVM
+import LLVM.Core
+   (CodeGenFunction, Value, value, valueOf,
+    CmpRet, IsInteger, IsType, IsConst, IsPrimitive)
+
+import Foreign.Ptr (Ptr, )
+
+import qualified Control.Monad.Trans.State as MS
+import qualified Control.Applicative as App
+import qualified Control.Functor.HT as FuncHT
+import Control.Monad (void, (<=<), )
+import Control.Applicative (Applicative, liftA2, (<$>), (<$), )
+
+import Data.Tuple.HT (mapFst, mapSnd, )
+
+import Prelude2010 hiding (iterate, takeWhile, take, mapM, mapM_)
+import Prelude ()
+
+
+{- |
+Simulates a non-strict list.
+-}
+data T r a =
+   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) =
+   void $
+   C.loopWithExit s
+      (\s0 ->
+         MaybeCont.resolve (next s0)
+            (return (valueOf False, s0))
+            (\(a,s1) -> (valueOf True, s1) <$ f a))
+      return
+
+mapState_ ::
+   (Tuple.Phi t) =>
+   (a -> t -> CodeGenFunction r t) ->
+   T r a -> t -> CodeGenFunction r t
+mapState_ f (Cons s next) t =
+   snd <$>
+   C.loopWithExit (s,t)
+      (\(s0,t0) ->
+         MaybeCont.resolve (next s0)
+            (return (valueOf False, (s0,t0)))
+            (\(a,s1) -> (\t1 -> (valueOf True, (s1,t1))) <$> f a t0))
+      return
+
+mapStateM_ ::
+   (Tuple.Phi t) =>
+   (a -> MS.StateT t (CodeGenFunction r) ()) ->
+   T r a -> MS.StateT t (CodeGenFunction r) ()
+mapStateM_ f xs =
+   MS.StateT $ \t ->
+      (,) () <$> mapState_ (\a t0 -> snd <$> MS.runStateT (f a) t0) xs t
+
+
+mapWhileState_ ::
+   (Tuple.Phi t) =>
+   (a -> t -> CodeGenFunction r (Value Bool, t)) ->
+   T r a -> t -> CodeGenFunction r t
+mapWhileState_ f (Cons s next) t =
+   snd <$>
+   C.loopWithExit (s,t)
+      (\(s0,t0) ->
+         MaybeCont.resolve (next s0)
+            (return (valueOf False, (s0,t0)))
+            (\(a,s1) -> (\(b,t1) -> (b, (s1,t1))) <$> f a t0))
+      return
+
+
+empty :: T r a
+empty = Cons () (\() -> MaybeCont.nothing)
+
+singleton :: a -> T r a
+singleton a =
+   Cons
+      (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)
+
+{- |
+@ZipList@ semantics
+-}
+instance Applicative (T r) where
+   pure a = Cons () (\() -> return (a,()))
+   Cons fs fnext <*> Cons as anext =
+      Cons (fs,as)
+         (\(fs0,as0) -> do
+            (f,fs1) <- fnext fs0
+            (a,as1) <- anext as0
+            return (f a, (fs1,as1)))
+
+
+{-
+On the one hand,
+I did not want to name it @map@ because it differs from @fmap@.
+On the other hand, @mapM@ does not fit very well
+because the result is not in the CodeGenFunction monad.
+-}
+mapM :: (a -> CodeGenFunction r b) -> T r a -> T r b
+mapM f (Cons s next) = Cons s (MaybeCont.lift . FuncHT.mapFst f <=< next)
+
+mapMaybe ::
+   (Tuple.Phi b, Tuple.Undefined b) =>
+   (a -> CodeGenFunction r (Maybe.T b)) -> T r a -> T r b
+mapMaybe f = catMaybes . mapM f
+
+catMaybes :: (Tuple.Phi a, Tuple.Undefined a) => T r (Maybe.T a) -> T r a
+catMaybes (Cons s next) =
+   Cons s
+      (\s0 ->
+         MaybeCont.fromMaybe $
+         fmap (\(ma,s2) -> fmap (flip (,) s2) ma) $
+         C.loopWithExit s0
+            (\s1 ->
+               MaybeCont.resolve (next s1)
+                  (return (valueOf False, (Maybe.nothing, s1)))
+                  (\(ma,s2) ->
+                     Maybe.run ma
+                        (return (valueOf True, (Maybe.nothing, s2)))
+                        (\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 = takeWhileJust . mapM (\a -> flip Maybe.fromBool a <$> p a)
+
+{- |
+Attention:
+This always performs one function call more than necessary.
+I.e. if 'f' reads from or writes to memory
+make sure that accessing one more pointer is legal.
+-}
+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)
+
+
+cartesianAux ::
+   (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.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))))
+
+cartesian ::
+   (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, 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, IsPrimitive i) =>
+   Value i -> T r a -> T r a
+take len xs = liftA2 const xs (countDown len)
+
+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 ::
+   (Tuple.Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
+   Value i -> s ->
+   (s -> CodeGenFunction r s) ->
+   CodeGenFunction r s
+fixedLengthLoop len start loopBody =
+   mapState_ (const loopBody) (countDown len) start
+
+arrayLoop ::
+   (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 ::
+   (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) <-
+      mapWhileState_
+         (\(i,ptr) (_i,s) -> mapSnd ((,) i) <$> loopBody ptr s)
+         (liftA2 (,) (countDown len) (arrayPtrs ptr0))
+         (len,start)
+   pos <- A.sub len i
+   return (pos, end)
+
+arrayLoop2 ::
+   (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)
+      (take len $ liftA2 (,) (arrayPtrs ptrA) (arrayPtrs ptrB)) start
diff --git a/src/LLVM/Extra/Marshal.hs b/src/LLVM/Extra/Marshal.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Marshal.hs
@@ -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
diff --git a/src/LLVM/Extra/Maybe.hs b/src/LLVM/Extra/Maybe.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Maybe.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE TypeFamilies #-}
+{- |
+LLVM counterpart to 'Maybe' datatype.
+-}
+module LLVM.Extra.Maybe (
+   Maybe.T(..),
+   Maybe.run,
+   Maybe.for,
+   Maybe.select,
+   Maybe.alternative,
+   Maybe.fromBool,
+   Maybe.toBool,
+   Maybe.getIsNothing,
+   Maybe.just,
+   nothing,
+   Maybe.sequence,
+   Maybe.traverse,
+   Maybe.lift2,
+   Maybe.liftM2,
+
+   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.Core (CodeGenFunction, )
+
+
+nothing :: (Tuple.Undefined a) => Maybe.T a
+nothing = Maybe.nothing Tuple.undef
+
+
+loopWithExit ::
+   Tuple.Phi a =>
+   a ->
+   (a -> CodeGenFunction r (Maybe.T c, b)) ->
+   ((c,b) -> CodeGenFunction r a) ->
+   CodeGenFunction r b
+loopWithExit start check body =
+   fmap snd $
+   C.loopWithExit start
+      (\a -> do
+         (mc,b) <- check a
+         let (j,c) = Maybe.toBool mc
+         return (j, (c,b)))
+      body
diff --git a/src/LLVM/Extra/MaybeContinuation.hs b/src/LLVM/Extra/MaybeContinuation.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/MaybeContinuation.hs
@@ -0,0 +1,232 @@
+{-# LANGUAGE TypeFamilies #-}
+{- |
+Maybe transformer datatype implemented in continuation passing style.
+-}
+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 qualified LLVM.Core as LLVM
+import LLVM.Core
+   (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 Data.Tuple.HT (mapSnd, )
+
+import Prelude hiding (map, )
+
+
+{- |
+Isomorphic to @ReaderT (CodeGenFunction r z) (ContT z (CodeGenFunction r)) a@,
+where the reader provides the block for 'Nothing'
+and the continuation part manages the 'Just'.
+-}
+newtype T r z a =
+   Cons {resolve ::
+      CodeGenFunction r z ->
+      (a -> CodeGenFunction r z) ->
+      CodeGenFunction r z
+   }
+
+
+map :: (a -> CodeGenFunction r b) -> T r z a -> T r z b
+map f (Cons m) = Cons $ \n j ->
+   m n (j <=< f)
+
+instance Functor (T r z) where
+   fmap f (Cons m) = Cons $ \n j -> m n (j . f)
+
+instance App.Applicative (T r z) where
+   pure a = lift (pure a)
+   (<*>) = M.ap
+
+instance Monad (T r z) where
+   return = pure
+   (>>=) = bind
+
+instance MonadIO (T r z) where
+   liftIO = lift . liftIO
+
+{- |
+counterpart to Data.Maybe.HT.toMaybe
+-}
+withBool ::
+   (Tuple.Phi z) =>
+   Value Bool -> CodeGenFunction r a -> T r z a
+withBool b a =
+   guard b >> lift a
+{-
+withBool b a = Cons $ \n j ->
+   ifThenElse b (j =<< a) n
+-}
+
+fromBool ::
+   (Tuple.Phi z) =>
+   CodeGenFunction r (Value Bool, a) ->
+   T r z a
+fromBool m = do
+   (b,a) <- lift m
+   guard b
+   return a
+
+toBool ::
+   (Tuple.Undefined a) =>
+   T r (Value Bool, a) a -> CodeGenFunction r (Value Bool, a)
+toBool (Cons m) =
+   m (return (valueOf False, Tuple.undef)) (return . (,) (valueOf True))
+
+
+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 ::
+   (Tuple.Undefined a) =>
+   T r (Maybe.T a) a -> CodeGenFunction r (Maybe.T a)
+toMaybe (Cons m) =
+   m (return Maybe.nothing) (return . Maybe.just)
+
+
+isJust ::
+   T r (Value Bool) a -> CodeGenFunction r (Value Bool)
+isJust (Cons m) =
+   m (return (valueOf False)) (const $ return (valueOf True))
+
+lift :: CodeGenFunction r a -> T r z a
+lift a = Cons $ \ _n j -> j =<< a
+
+guard ::
+   (Tuple.Phi z) =>
+   Value Bool -> T r z ()
+guard b = Cons $ \n j ->
+   ifThenElse b (j ()) n
+
+just :: a -> T r z a
+just a = Cons $ \ _n j -> j a
+
+nothing :: T r z a
+nothing = Cons $ \n _j -> n
+
+bind ::
+   T r z a ->
+   (a -> T r z b) ->
+   T r z b
+bind (Cons ma) mb = Cons $ \n j ->
+   ma n (\a -> resolve (mb a) n j)
+
+{- |
+Run an exception handler if the Maybe-action fails.
+The exception is propagated.
+That is, the handler is intended for a cleanup procedure.
+-}
+onFail :: CodeGenFunction r () -> T r z a -> T r z a
+onFail handler m = Cons $ \n j -> resolve m (handler >> n) j
+
+{- |
+Run the first action and if that fails run the second action.
+If both actions fail, then the composed action fails, too.
+-}
+alternative ::
+   (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 ::
+   (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)
+fixedLengthLoop len start loopBody = do
+   (vars, i) <-
+      C.loopWithExit (start, len)
+         (\(s0, i) -> do
+            counterRunning <- A.cmp LLVM.CmpGT i (value LLVM.zero)
+            (running, ms1) <-
+               C.ifThen counterRunning (valueOf False, Maybe.just s0) $
+               fmap (\m -> (Maybe.isJust m, m)) $ toMaybe $ loopBody s0
+            return (running, (ms1, i)))
+         (\(ms, i) ->
+            fmap ((,) (Maybe.fromJust ms)) $ A.dec i)
+   pos <- A.sub len i
+   return (pos, vars)
+
+
+{- |
+If the returned position is smaller than the array size,
+then returned final state is 'Maybe.nothing'.
+-}
+arrayLoop ::
+   (Tuple.Phi s, Tuple.Undefined 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 -> 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)) $
+   fixedLengthLoop len (ptr,start) $ \(ptr0,s0) -> do
+      s1 <- loopBody ptr0 s0
+      ptr1 <- lift $ A.advanceArrayElementPtr ptr0
+      return (ptr1,s1)
+
+
+arrayLoop2 ::
+   (Tuple.Phi s, Tuple.Undefined 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 ->
+      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)) $
+   arrayLoop len ptrA (ptrB,start) $ \ptrAi (ptrB0,s0) -> do
+      s1 <- loopBody ptrAi ptrB0 s0
+      ptrB1 <- lift $ A.advanceArrayElementPtr ptrB0
+      return (ptrB1,s1)
+
+
+{-
+In case of early exit we would not have a final state.
+However, the loop could be in the T monad
+and we could just propagate a Nothing.
+
+whileLoop ::
+   Tuple.Phi a =>
+   a ->
+   (a -> T r z a) ->
+   CodeGenFunction r a
+whileLoop start check body = do
+   top <- getCurrentBasicBlock
+   loop <- newBasicBlock
+   cont <- newBasicBlock
+   exit <- newBasicBlock
+   br loop
+
+   defineBasicBlock loop
+   state <- phi top start
+   b <- check state
+   condBr b cont exit
+   defineBasicBlock cont
+   res <- body state
+   cont' <- getCurrentBasicBlock
+   addPhi cont' state res
+   br loop
+
+   defineBasicBlock exit
+   return state
+-}
diff --git a/src/LLVM/Extra/MaybePrivate.hs b/src/LLVM/Extra/MaybePrivate.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/MaybePrivate.hs
@@ -0,0 +1,116 @@
+{-# 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 qualified Control.Monad as Monad
+
+import Prelude hiding (map, sequence)
+
+
+{- |
+If @isJust = False@, then @fromJust@ is an @undefTuple@.
+-}
+data T a = Cons {isJust :: Value Bool, fromJust :: a}
+
+
+instance Functor T where
+   fmap f (Cons b a) = Cons b (f a)
+
+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 ::
+   (Tuple.Phi b) =>
+   T a ->
+   CodeGenFunction r b ->
+   (a -> CodeGenFunction r b) ->
+   CodeGenFunction r b
+run (Cons b a) n j =
+   ifThenElse b (j a) n
+
+for ::
+   T a ->
+   (a -> CodeGenFunction r ()) ->
+   CodeGenFunction r ()
+for = flip run (return ())
+
+{- |
+counterpart to 'Data.Maybe.fromMaybe' with swapped arguments
+-}
+select ::
+   (C.Select a) =>
+   T a ->
+   a ->
+   CodeGenFunction r a
+select (Cons b a) d = C.select b a d
+
+alternative ::
+   (C.Select a) =>
+   T a -> T a -> CodeGenFunction r (T a)
+alternative (Cons b0 a0) (Cons b1 a1) =
+   Monad.liftM2 Cons
+      (LLVM.or b0 b1)
+      (C.select b0 a0 a1)
+
+
+{- |
+counterpart to Data.Maybe.HT.toMaybe
+-}
+fromBool :: Value Bool -> a -> T a
+fromBool = Cons
+
+toBool :: T a -> (Value Bool, a)
+toBool (Cons b a) = (b,a)
+
+just :: a -> T a
+just = Cons (valueOf True)
+
+nothing :: a -> T a
+nothing undef = Cons (valueOf False) undef
+
+getIsNothing :: T a -> CodeGenFunction r (Value Bool)
+getIsNothing (Cons b _a) = LLVM.inv b
+
+
+lift2 ::
+   (a -> b -> c) ->
+   T a -> T b -> CodeGenFunction r (T c)
+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 (Cons b0 a0) =
+   Monad.liftM (Cons b0) a0
+
+traverse ::
+   (a -> CodeGenFunction r b) ->
+   T a -> CodeGenFunction r (T b)
+traverse f = sequence . fmap f
+
+liftM2 ::
+   (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
diff --git a/src/LLVM/Extra/Memory.hs b/src/LLVM/Extra/Memory.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Memory.hs
@@ -0,0 +1,407 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+module LLVM.Extra.Memory (
+   C(load, store, decompose, compose), modify,
+   Struct,
+   Record, Element, element,
+   loadRecord, storeRecord, decomposeRecord, composeRecord,
+   loadNewtype, storeNewtype, decomposeNewtype, composeNewtype,
+   ) where
+
+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.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.Core as LLVM
+import LLVM.Core
+   (CodeGenFunction, Value, IsType, IsSized,
+    getElementPtr0, extractvalue, insertvalue)
+
+import qualified Type.Data.Num.Decimal as TypeNum
+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 qualified Control.Applicative.HT as App
+import Control.Monad (ap, (<=<))
+import Control.Applicative (Applicative, pure, liftA2, liftA3, (<*>))
+
+import Prelude2010 hiding (maybe, either, )
+import Prelude ()
+
+
+class
+   (Tuple.Phi llvmValue, Tuple.Undefined llvmValue,
+    IsType (Struct llvmValue), IsSized (Struct llvmValue)) =>
+      C llvmValue where
+   type Struct llvmValue
+   load :: Value (LLVM.Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
+   load ptr  =  decompose =<< LLVM.load ptr
+   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
+   {- |
+   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))
+
+modify ::
+   (C llvmValue) =>
+   (llvmValue -> CodeGenFunction r llvmValue) ->
+   Value (LLVM.Ptr (Struct llvmValue)) -> CodeGenFunction r ()
+modify f ptr =
+   flip store ptr =<< f =<< load ptr
+
+
+instance C () where
+   type Struct () = LLVM.Struct ()
+   load _ = return ()
+   store _ _ = return ()
+   decompose _ = return ()
+   compose _ = return (LLVM.value $ LLVM.constStruct ())
+
+
+type Record r o v = Element r o v v
+
+data Element r o v x =
+   Element {
+      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, 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
+element field n =
+   Element {
+      loadElement = \ptr -> load =<< getElementPtr0 ptr (n, ()),
+      storeElement = \ptr v -> store (field v) =<< getElementPtr0 ptr (n, ()),
+      extractElement = \o -> decompose =<< extractvalue o n,
+      insertElement = \v o -> flip (insertvalue o) n =<< compose (field v)
+   }
+
+instance Functor (Element r o v) where
+   fmap f m =
+      Element {
+         loadElement = fmap f . loadElement m,
+         storeElement = storeElement m,
+         extractElement = fmap f . extractElement m,
+         insertElement = insertElement m
+      }
+
+instance Applicative (Element r o v) where
+   pure x =
+      Element {
+         loadElement = \ _ptr -> return x,
+         storeElement = \ _ptr _v -> return (),
+         extractElement = \ _o -> return x,
+         insertElement = \ _v o -> return o
+      }
+   f <*> x =
+      Element {
+         loadElement = \ptr -> loadElement f ptr `ap` loadElement x ptr,
+         storeElement = \ptr y -> storeElement f ptr y >> storeElement x ptr y,
+         extractElement = \o -> extractElement f o `ap` extractElement x o,
+         insertElement = \y o -> insertElement f y o >>= insertElement x y
+      }
+
+
+loadRecord ::
+   Record r o llvmValue ->
+   Value (LLVM.Ptr o) -> CodeGenFunction r llvmValue
+loadRecord = loadElement
+
+storeRecord ::
+   Record r o llvmValue ->
+   llvmValue -> Value (LLVM.Ptr o) -> CodeGenFunction r ()
+storeRecord m y ptr = storeElement m ptr y
+
+decomposeRecord ::
+   Record r o llvmValue ->
+   Value o -> CodeGenFunction r llvmValue
+decomposeRecord m =
+   extractElement m
+
+composeRecord ::
+   (IsType o) =>
+   Record r o llvmValue ->
+   llvmValue -> CodeGenFunction r (Value o)
+composeRecord m v =
+   insertElement m v (LLVM.value LLVM.undef)
+
+
+
+pair ::
+   (C a, C b) =>
+   Record r (LLVM.Struct (Struct a, (Struct b, ()))) (a, b)
+pair =
+   liftA2 (,)
+      (element fst d0)
+      (element snd d1)
+
+instance (C a, C b) => C (a, b) where
+   type Struct (a, b) = LLVM.Struct (Struct a, (Struct b, ()))
+   load = loadRecord pair
+   store = storeRecord pair
+   decompose = decomposeRecord pair
+   compose = composeRecord pair
+
+
+triple ::
+   (C a, C b, C c) =>
+   Record r (LLVM.Struct (Struct a, (Struct b, (Struct c, ())))) (a, b, c)
+triple =
+   liftA3 (,,)
+      (element fst3 d0)
+      (element snd3 d1)
+      (element thd3 d2)
+
+instance (C a, C b, C c) => C (a, b, c) where
+   type Struct (a, b, c) =
+           LLVM.Struct (Struct a, (Struct b, (Struct c, ())))
+   load = loadRecord triple
+   store = storeRecord triple
+   decompose = decomposeRecord triple
+   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 (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 (Bool, (Struct a, ()))
+   load = loadRecord maybe
+   store = storeRecord maybe
+   decompose = decomposeRecord maybe
+   compose = composeRecord maybe
+
+
+either ::
+   (C a, C b) =>
+   Record r (LLVM.Struct (Bool, (Struct a, (Struct b, ())))) (Either.T a b)
+either =
+   liftA3 Either.Cons
+      (element Either.isRight d0)
+      (element Either.fromLeft d1)
+      (element Either.fromRight d2)
+
+instance (C a, C b) => C (Either.T a b) where
+   type Struct (Either.T a b) = LLVM.Struct (Bool, (Struct a, (Struct b, ())))
+   load = loadRecord either
+   store = storeRecord either
+   decompose = decomposeRecord either
+   compose = composeRecord either
+
+
+
+instance (C a) => C (Scalar.T a) where
+   type Struct (Scalar.T a) = Struct a
+   load = loadNewtype Scalar.Cons
+   store = storeNewtype Scalar.decons
+   decompose = decomposeNewtype Scalar.Cons
+   compose = composeNewtype Scalar.decons
+
+
+instance (IsSized a) => C (Value a) where
+   type Struct (Value a) = a
+   load = LLVM.load
+   store = LLVM.store
+   decompose = return
+   compose = return
+
+
+type family StructStruct s
+type instance StructStruct (a,as) = (Struct a, StructStruct as)
+type instance StructStruct () = ()
+
+instance
+   (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
+   decomposeFields ::
+      Proxy i -> Value (LLVM.Struct s) -> CodeGenFunction r rem
+   composeFields ::
+      Proxy i -> rem -> CodeGenFunction r (Value (LLVM.Struct s))
+
+instance
+   (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
+   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 (LLVM.StructFields s) => ConvertStruct s i () where
+   decomposeFields _ _ = return ()
+   composeFields _ _ = return (LLVM.value LLVM.undef)
+
+
+
+-- 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
+
+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 (LLVM.Ptr (Struct a)) -> CodeGenFunction r llvmValue
+loadNewtype wrap ptr =
+   fmap wrap $ load ptr
+
+storeNewtype ::
+   (C a) =>
+   (llvmValue -> a) ->
+   llvmValue -> Value (LLVM.Ptr (Struct a)) -> CodeGenFunction r ()
+storeNewtype unwrap y ptr =
+   store (unwrap y) ptr
+
+decomposeNewtype ::
+   (C a) =>
+   (a -> llvmValue) ->
+   Value (Struct a) -> CodeGenFunction r llvmValue
+decomposeNewtype wrap y =
+   fmap wrap $ decompose y
+
+composeNewtype ::
+   (C a) =>
+   (llvmValue -> a) ->
+   llvmValue -> CodeGenFunction r (Value (Struct a))
+composeNewtype unwrap y =
+   compose (unwrap y)
diff --git a/src/LLVM/Extra/Monad.hs b/src/LLVM/Extra/Monad.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Monad.hs
@@ -0,0 +1,24 @@
+{- |
+These functions work in arbitrary monads
+but are especially helpful when working with the @CodeGenFunction@ monad.
+-}
+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)
diff --git a/src/LLVM/Extra/Multi/Class.hs b/src/LLVM/Extra/Multi/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Multi/Class.hs
@@ -0,0 +1,5 @@
+module LLVM.Extra.Multi.Class
+   {-# DEPRECATED "Use LLVM.Extra.Nice.Class instead." #-}
+   (module LLVM.Extra.Nice.Class) where
+
+import LLVM.Extra.Nice.Class
diff --git a/src/LLVM/Extra/Multi/Iterator.hs b/src/LLVM/Extra/Multi/Iterator.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Multi/Iterator.hs
@@ -0,0 +1,5 @@
+module LLVM.Extra.Multi.Iterator
+   {-# DEPRECATED "Use LLVM.Extra.Nice.Iterator instead." #-}
+   (module LLVM.Extra.Nice.Iterator) where
+
+import LLVM.Extra.Nice.Iterator
diff --git a/src/LLVM/Extra/Multi/Value.hs b/src/LLVM/Extra/Multi/Value.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Multi/Value.hs
@@ -0,0 +1,5 @@
+module LLVM.Extra.Multi.Value
+   {-# DEPRECATED "Use LLVM.Extra.Nice.Value instead." #-}
+   (module LLVM.Extra.Nice.Value) where
+
+import LLVM.Extra.Nice.Value
diff --git a/src/LLVM/Extra/Multi/Value/Marshal.hs b/src/LLVM/Extra/Multi/Value/Marshal.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Multi/Value/Marshal.hs
@@ -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
diff --git a/src/LLVM/Extra/Multi/Value/Storable.hs b/src/LLVM/Extra/Multi/Value/Storable.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Multi/Value/Storable.hs
@@ -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
diff --git a/src/LLVM/Extra/Multi/Value/Vector.hs b/src/LLVM/Extra/Multi/Value/Vector.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Multi/Value/Vector.hs
@@ -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
diff --git a/src/LLVM/Extra/Multi/Vector.hs b/src/LLVM/Extra/Multi/Vector.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Multi/Vector.hs
@@ -0,0 +1,5 @@
+module LLVM.Extra.Multi.Vector
+   {-# DEPRECATED "Use LLVM.Extra.Nice.Vector instead." #-}
+   (module LLVM.Extra.Nice.Vector) where
+
+import LLVM.Extra.Nice.Vector
diff --git a/src/LLVM/Extra/Multi/Vector/Instance.hs b/src/LLVM/Extra/Multi/Vector/Instance.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Multi/Vector/Instance.hs
@@ -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
diff --git a/src/LLVM/Extra/Nice/Class.hs b/src/LLVM/Extra/Nice/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Nice/Class.hs
@@ -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)
diff --git a/src/LLVM/Extra/Nice/Iterator.hs b/src/LLVM/Extra/Nice/Iterator.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Nice/Iterator.hs
@@ -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
diff --git a/src/LLVM/Extra/Nice/Value.hs b/src/LLVM/Extra/Nice/Value.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Nice/Value.hs
@@ -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
diff --git a/src/LLVM/Extra/Nice/Value/Array.hs b/src/LLVM/Extra/Nice/Value/Array.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Nice/Value/Array.hs
@@ -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)
diff --git a/src/LLVM/Extra/Nice/Value/Marshal.hs b/src/LLVM/Extra/Nice/Value/Marshal.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Nice/Value/Marshal.hs
@@ -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
diff --git a/src/LLVM/Extra/Nice/Value/Private.hs b/src/LLVM/Extra/Nice/Value/Private.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Nice/Value/Private.hs
@@ -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
diff --git a/src/LLVM/Extra/Nice/Value/Storable.hs b/src/LLVM/Extra/Nice/Value/Storable.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Nice/Value/Storable.hs
@@ -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
diff --git a/src/LLVM/Extra/Nice/Value/Vector.hs b/src/LLVM/Extra/Nice/Value/Vector.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Nice/Value/Vector.hs
@@ -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
diff --git a/src/LLVM/Extra/Nice/Vector.hs b/src/LLVM/Extra/Nice/Vector.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Nice/Vector.hs
@@ -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
diff --git a/src/LLVM/Extra/Nice/Vector/Instance.hs b/src/LLVM/Extra/Nice/Vector/Instance.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Nice/Vector/Instance.hs
@@ -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
diff --git a/src/LLVM/Extra/Scalar.hs b/src/LLVM/Extra/Scalar.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Scalar.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE TypeFamilies #-}
+module LLVM.Extra.Scalar where
+
+import qualified LLVM.Extra.Tuple as Tuple
+import qualified LLVM.Extra.Arithmetic as A
+
+import qualified Control.Monad as Monad
+
+
+{- |
+The entire purpose of this datatype is to mark a type as scalar,
+although it might also be interpreted as vector.
+This way you can write generic operations for vectors
+using the 'A.PseudoModule' class,
+and specialise them to scalar types with respect to the 'A.PseudoRing' class.
+From another perspective
+you can consider the 'Scalar.T' type constructor a marker
+where the 'A.Scalar' type function
+stops reducing nested vector types to scalar types.
+-}
+newtype T a = Cons {decons :: a}
+
+liftM :: (Monad m) => (a -> m b) -> T a -> m (T b)
+liftM f (Cons a) = Monad.liftM Cons $ f a
+
+liftM2 :: (Monad m) => (a -> b -> m c) -> T a -> T b -> m (T c)
+liftM2 f (Cons a) (Cons b) = Monad.liftM Cons $ f a b
+
+
+unliftM ::
+   (Monad m) =>
+   (T a -> m (T r)) ->
+   a -> m r
+unliftM f a =
+   Monad.liftM decons $ f (Cons a)
+
+unliftM2 ::
+   (Monad m) =>
+   (T a -> T b -> m (T r)) ->
+   a -> b -> m r
+unliftM2 f a b =
+   Monad.liftM decons $ f (Cons a) (Cons b)
+
+unliftM3 ::
+   (Monad m) =>
+   (T a -> T b -> T c -> m (T r)) ->
+   a -> b -> c -> m r
+unliftM3 f a b c =
+   Monad.liftM decons $ f (Cons a) (Cons b) (Cons c)
+
+unliftM4 ::
+   (Monad m) =>
+   (T a -> T b -> T c -> T d -> m (T r)) ->
+   a -> b -> c -> d -> m r
+unliftM4 f a b c d =
+   Monad.liftM decons $ f (Cons a) (Cons b) (Cons c) (Cons d)
+
+unliftM5 ::
+   (Monad m) =>
+   (T a -> T b -> T c -> T d -> T e -> m (T r)) ->
+   a -> b -> c -> d -> e -> m r
+unliftM5 f a b c d e =
+   Monad.liftM decons $ f (Cons a) (Cons b) (Cons c) (Cons d) (Cons e)
+
+
+instance (Tuple.Zero a) => Tuple.Zero (T a) where
+   zero = Cons Tuple.zero
+
+instance (Tuple.Undefined a) => Tuple.Undefined (T a) where
+   undef = Cons Tuple.undef
+
+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'
+
+instance (A.RationalConstant a) => A.RationalConstant (T a) where
+   fromRational' = Cons . A.fromRational'
+
+instance (A.Additive a) => A.Additive (T a) where
+   zero = Cons A.zero
+   add = liftM2 A.add
+   sub = liftM2 A.sub
+   neg = liftM A.neg
+
+instance (A.PseudoRing a) => A.PseudoRing (T a) where
+   mul = liftM2 A.mul
+
+instance (A.Field a) => A.Field (T a) where
+   fdiv = liftM2 A.fdiv
+
+type instance A.Scalar (T a) = T a
+
+instance (A.PseudoRing a) => A.PseudoModule (T a) where
+   scale = liftM2 A.mul
+
+
+instance (A.Real a) => A.Real (T a) where
+   min = liftM2 A.min
+   max = liftM2 A.max
+   abs = liftM A.abs
+   signum = liftM A.signum
+
+instance (A.Fraction a) => A.Fraction (T a) where
+   truncate = liftM A.truncate
+   fraction = liftM A.fraction
+
+instance (A.Algebraic a) => A.Algebraic (T a) where
+   sqrt = liftM A.sqrt
+
+instance (A.Transcendental a) => A.Transcendental (T a) where
+   pi = fmap Cons A.pi
+   sin = liftM A.sin
+   cos = liftM A.cos
+   exp = liftM A.exp
+   log = liftM A.log
+   pow = liftM2 A.pow
diff --git a/src/LLVM/Extra/ScalarOrVector.hs b/src/LLVM/Extra/ScalarOrVector.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/ScalarOrVector.hs
@@ -0,0 +1,370 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+{- |
+Support for unified handling of scalars and vectors.
+
+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.
+-}
+module LLVM.Extra.ScalarOrVector (
+   Fraction (truncate, fraction),
+   signedFraction,
+   addToPhase,
+   incPhase,
+
+   truncateToInt,
+   floorToInt,
+   ceilingToInt,
+   roundToIntFast,
+   splitFractionToInt,
+
+   Scalar,
+   Replicate (replicate, replicateConst),
+   replicateOf,
+   Real (min, max, abs, signum),
+   Saturated(addSat, subSat),
+   PseudoModule (scale),
+   IntegerConstant(constFromInteger),
+   RationalConstant(constFromRational),
+   TranscendentalConstant(constPi),
+   ) where
+
+import qualified LLVM.Extra.ScalarOrVectorPrivate as Priv
+import qualified LLVM.Extra.Vector as Vector
+import qualified LLVM.Extra.ArithmeticPrivate as A
+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, constOf,
+    CmpRet, CmpResult, ShapeOf,
+    Vector, WordN(WordN), IntN(IntN), FP128,
+    IsConst, IsInteger, IsFloating,
+    CodeGenFunction, )
+
+import qualified Type.Data.Num.Decimal as TypeNum
+
+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)
+
+
+
+class (Real a, IsFloating a) => Fraction a where
+   truncate :: Value a -> CodeGenFunction r (Value a)
+   fraction :: Value a -> CodeGenFunction r (Value a)
+
+instance Fraction Float where
+   truncate = Intrinsic.truncate
+   fraction = A.fraction
+
+instance Fraction Double where
+   truncate = Intrinsic.truncate
+   fraction = A.fraction
+
+instance (TypeNum.Positive n, Vector.Real a, IsFloating a, IsConst a) =>
+      Fraction (Vector n a) where
+   truncate = Vector.truncate
+   fraction = Vector.fraction
+
+
+{- |
+The fraction has the same sign as the argument.
+This is not particular useful but fast on IEEE implementations.
+-}
+signedFraction ::
+   (Fraction a) =>
+   Value a -> CodeGenFunction r (Value a)
+signedFraction x =
+   A.sub x =<< truncate x
+
+_fractionGen ::
+   (IntegerConstant v, Fraction v, CmpRet v) =>
+   Value v -> CodeGenFunction r (Value v)
+_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.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 =
+   do xf <- signedFraction x
+      b <- cmp LLVM.FPOLT xf zero
+      A.sub xf =<< LLVM.inttofp b
+
+{- |
+increment (first operand) may be negative,
+phase must always be non-negative
+-}
+addToPhase ::
+   (Fraction a) =>
+   Value a -> Value a -> CodeGenFunction r (Value a)
+addToPhase d p =
+   fraction =<< A.add d p
+
+{- |
+both increment and phase must be non-negative
+-}
+incPhase ::
+   (Fraction a) =>
+   Value a -> Value a -> CodeGenFunction r (Value a)
+incPhase d p =
+   signedFraction =<< A.add d p
+
+
+
+truncateToInt ::
+   (IsFloating a, IsInteger i, ShapeOf a ~ ShapeOf i) =>
+   Value a -> CodeGenFunction r (Value i)
+truncateToInt = LLVM.fptoint
+
+{- |
+Rounds to the next integer.
+For numbers of the form @n+0.5@,
+we choose one of the neighboured integers
+such that the overall implementation is most efficient.
+-}
+roundToIntFast ::
+   (IsFloating a, RationalConstant a, CmpRet a,
+    IsInteger i, IntegerConstant i, CmpRet i,
+    CmpResult a ~ CmpResult i,
+    ShapeOf a ~ ShapeOf i) =>
+   Value a -> CodeGenFunction r (Value i)
+roundToIntFast x = do
+   pos <- A.cmp LLVM.CmpGT x zero
+   truncateToInt =<< A.add x =<<
+      LLVM.select pos (ratio 0.5) (ratio (-0.5))
+
+floorToInt ::
+   (IsFloating a, CmpRet a,
+    IsInteger i, IntegerConstant i, CmpRet i,
+    CmpResult a ~ CmpResult i,
+    ShapeOf a ~ ShapeOf i) =>
+   Value a -> CodeGenFunction r (Value i)
+floorToInt x = do
+   i <- truncateToInt x
+   lt <- A.cmp LLVM.CmpLT x =<< LLVM.inttofp i
+   A.sub i =<< LLVM.select lt (int 1) (int 0)
+
+splitFractionToInt ::
+   (IsFloating a, CmpRet a,
+    IsInteger i, IntegerConstant i, CmpRet i,
+    CmpResult a ~ CmpResult i,
+    ShapeOf a ~ ShapeOf i) =>
+   Value a -> CodeGenFunction r (Value i, Value a)
+splitFractionToInt x = do
+   i <- floorToInt x
+   frac <- A.sub x =<< LLVM.inttofp i
+   return (i, frac)
+
+ceilingToInt ::
+   (IsFloating a, CmpRet a,
+    IsInteger i, IntegerConstant i, CmpRet i,
+    CmpResult a ~ CmpResult i,
+    ShapeOf a ~ ShapeOf i) =>
+   Value a -> CodeGenFunction r (Value i)
+ceilingToInt x = do
+   i <- truncateToInt x
+   gt <- A.cmp LLVM.CmpGT x =<< LLVM.inttofp i
+   A.add i =<< LLVM.select gt (int 1) (int 0)
+
+
+zero :: (LLVM.IsType a) => Value a
+zero = LLVM.value LLVM.zero
+
+int :: (IntegerConstant a) => Integer -> Value a
+int = LLVM.value . constFromInteger
+
+ratio :: (RationalConstant a) => Rational -> Value a
+ratio = LLVM.value . constFromRational
+
+
+
+replicateOf ::
+   (IsConst (Scalar v), Replicate v) =>
+   Scalar v -> Value v
+replicateOf =
+   LLVM.value . replicateConst . LLVM.constOf
+
+
+class (LLVM.IsArithmetic a) => Real a where
+   min :: Value a -> Value a -> CodeGenFunction r (Value a)
+   max :: Value a -> Value a -> CodeGenFunction r (Value a)
+   abs :: Value a -> CodeGenFunction r (Value a)
+   signum :: Value a -> CodeGenFunction r (Value a)
+
+
+instance Real Float  where
+   min = Intrinsic.min
+   max = Intrinsic.max
+   abs = Intrinsic.abs
+   signum = A.signum
+
+instance Real Double where
+   min = Intrinsic.min
+   max = Intrinsic.max
+   abs = Intrinsic.abs
+   signum = A.signum
+
+instance Real FP128  where
+   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
+
+
+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) => 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)
+
+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
+
+
+
+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
+
+
+class (IntegerConstant a) => RationalConstant a where
+   constFromRational :: Rational -> ConstValue a
+
+instance RationalConstant Float  where constFromRational = constOf . fromRational
+instance RationalConstant Double where constFromRational = constOf . fromRational
+instance (RationalConstant a, LLVM.IsPrimitive a, TypeNum.Positive n) =>
+         RationalConstant (Vector n a) where
+   constFromRational = replicateConst . constFromRational
+
+
+class (RationalConstant a) => TranscendentalConstant a where
+   constPi :: ConstValue a
+
+instance TranscendentalConstant Float  where constPi = constOf pi
+instance TranscendentalConstant Double where constPi = constOf pi
+instance (TranscendentalConstant a, LLVM.IsPrimitive a, TypeNum.Positive n) =>
+         TranscendentalConstant (Vector n a) where
+   constPi = replicateConst constPi
diff --git a/src/LLVM/Extra/Storable.hs b/src/LLVM/Extra/Storable.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Storable.hs
@@ -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
diff --git a/src/LLVM/Extra/Storable/Array.hs b/src/LLVM/Extra/Storable/Array.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Storable/Array.hs
@@ -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)
diff --git a/src/LLVM/Extra/Storable/Private.hs b/src/LLVM/Extra/Storable/Private.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Storable/Private.hs
@@ -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
diff --git a/src/LLVM/Extra/Struct.hs b/src/LLVM/Extra/Struct.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Struct.hs
@@ -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 () = ()
diff --git a/src/LLVM/Extra/Tuple.hs b/src/LLVM/Extra/Tuple.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Tuple.hs
@@ -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
diff --git a/src/LLVM/Extra/TuplePrivate.hs b/src/LLVM/Extra/TuplePrivate.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/TuplePrivate.hs
@@ -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
diff --git a/src/LLVM/Extra/Vector.hs b/src/LLVM/Extra/Vector.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/Vector.hs
@@ -0,0 +1,1072 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+module LLVM.Extra.Vector (
+   Simple (shuffleMatch, extract), C (insert),
+   Element, Size,
+   Canonical, Construct,
+
+   size, sizeInTuple,
+   replicate, iterate, assemble,
+
+   shuffle,
+   rotateUp, rotateDown, reverse,
+   shiftUp, shiftDown,
+   shiftUpMultiZero, shiftDownMultiZero,
+
+   shuffleMatchTraversable,
+   shuffleMatchAccess,
+   shuffleMatchPlain1,
+   shuffleMatchPlain2,
+
+   insertTraversable,
+   extractTraversable,
+   extractAll,
+
+   Constant, constant,
+
+   insertChunk, modify,
+   map, mapChunks, zipChunksWith,
+   chop, concat,
+   signedFraction,
+   cumulate1,
+   Arithmetic
+      (sum, sumToPair, sumInterleavedToPair,
+       cumulate, dotProduct, mul),
+   Real
+      (min, max, abs, signum,
+       truncate, floor, fraction),
+   ) where
+
+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.Core
+   (Value, ConstValue, valueOf, value, constOf, undef,
+    Vector, insertelement, extractelement,
+    IsConst, IsArithmetic, IsFloating,
+    IsPrimitive,
+    CodeGenFunction, )
+
+import qualified Type.Data.Num.Decimal as TypeNum
+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, )
+
+import qualified Data.Traversable as Trav
+import qualified Data.Foldable as Fold
+import qualified Data.NonEmpty.Class as NonEmptyC
+import qualified Data.NonEmpty as NonEmpty
+import qualified Data.List.HT as ListHT
+import qualified Data.List as List
+import Data.NonEmpty ((!:), )
+
+import Data.Int  (Int8, Int16, Int32, Int64, )
+import Data.Word (Word8, Word16, Word32, Word64, Word)
+
+import Prelude hiding
+          (Real, truncate, floor, round,
+           map, zipWith, iterate, replicate, reverse, concat, sum, )
+
+
+-- * target independent functions
+
+{- |
+Allow to work on records of vectors as if they are vectors of records.
+This is a reasonable approach for records of different element types
+since processor vectors can only be built from elements of the same type.
+But also, say, for chunked stereo signal this makes sense.
+In this case we would work on @Stereo (Value a)@.
+
+Formerly we used a two-way dependency Vector <-> (Element, Size).
+Now we have only the dependency Vector -> (Element, Size).
+This means that we need some more type annotations
+as in umul32to64/assemble,
+on the other hand we can allow multiple vector types
+with respect to the same element type.
+E.g. we can provide a vector type with pair elements
+where the pair elements are interleaved in the vector.
+-}
+class (Simple v) => C v where
+   insert :: Value Word32 -> Element v -> v -> CodeGenFunction r v
+
+class
+   (TypeNum.Positive (Size v), Tuple.Phi v, Tuple.Undefined v) =>
+      Simple v where
+
+   type Element v
+   type Size v
+
+   shuffleMatch ::
+      ConstValue (Vector (Size v) Word32) -> v -> CodeGenFunction r v
+
+   extract :: Value Word32 -> v -> CodeGenFunction r (Element v)
+
+
+instance
+   (TypeNum.Positive n, LLVM.IsPrimitive a) =>
+      Simple (Value (Vector n a)) where
+
+   type Element (Value (Vector n a)) = Value a
+   type Size (Value (Vector n a)) = n
+
+   shuffleMatch is v = shuffleMatchPlain1 v is
+   extract k v = extractelement v k
+
+instance
+   (TypeNum.Positive n, LLVM.IsPrimitive a) =>
+      C (Value (Vector n a)) where
+
+   insert k a v = insertelement v a k
+
+
+instance
+   (Simple v0, Simple v1, Size v0 ~ Size v1) =>
+      Simple (v0, v1) where
+
+   type Element (v0, v1) = (Element v0, Element v1)
+   type Size (v0, v1) = Size v0
+
+   shuffleMatch is (v0,v1) =
+      liftM2 (,)
+         (shuffleMatch is v0)
+         (shuffleMatch is v1)
+
+   extract k (v0,v1) =
+      liftM2 (,)
+         (extract k v0)
+         (extract k v1)
+
+instance
+   (C v0, C v1, Size v0 ~ Size v1) =>
+      C (v0, v1) where
+
+   insert k (a0,a1) (v0,v1) =
+      liftM2 (,)
+         (insert k a0 v0)
+         (insert k a1 v1)
+
+
+instance
+   (Simple v0, Simple v1, Simple v2, Size v0 ~ Size v1, Size v1 ~ Size v2) =>
+      Simple (v0, v1, v2) where
+
+   type Element (v0, v1, v2) = (Element v0, Element v1, Element v2)
+   type Size (v0, v1, v2) = Size v0
+
+   shuffleMatch is (v0,v1,v2) =
+      liftM3 (,,)
+         (shuffleMatch is v0)
+         (shuffleMatch is v1)
+         (shuffleMatch is v2)
+
+   extract k (v0,v1,v2) =
+      liftM3 (,,)
+         (extract k v0)
+         (extract k v1)
+         (extract k v2)
+
+instance
+   (C v0, C v1, C v2, Size v0 ~ Size v1, Size v1 ~ Size v2) =>
+      C (v0, v1, v2) where
+
+   insert k (a0,a1,a2) (v0,v1,v2) =
+      liftM3 (,,)
+         (insert k a0 v0)
+         (insert k a1 v1)
+         (insert k a2 v2)
+
+
+newtype Constant n a = Constant a
+
+constant :: (TypeNum.Positive n) => a -> Constant n a
+constant = Constant
+
+instance Functor (Constant n) where
+   {-# INLINE fmap #-}
+   fmap f (Constant a) = Constant (f a)
+
+instance App.Applicative (Constant n) where
+   {-# INLINE pure #-}
+   pure = Constant
+   {-# INLINE (<*>) #-}
+   Constant f <*> Constant a = Constant (f a)
+
+instance Fold.Foldable (Constant n) where
+   {-# INLINE foldMap #-}
+   foldMap = Trav.foldMapDefault
+
+instance Trav.Traversable (Constant n) where
+   {-# INLINE sequenceA #-}
+   sequenceA (Constant a) = fmap Constant a
+
+instance (Tuple.Phi a) => Tuple.Phi (Constant n a) where
+   phi = Tuple.phiTraversable
+   addPhi = Tuple.addPhiFoldable
+
+instance (Tuple.Undefined a) => Tuple.Undefined (Constant n a) where
+   undef = Tuple.undefPointed
+
+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
+
+   shuffleMatch _ = return
+   extract _ (Constant a) = return a
+
+
+class (n ~ Size (Construct n a), a ~ Element (Construct n a),
+       C (Construct n a)) =>
+         Canonical n a where
+   type Construct n a
+
+instance
+   (TypeNum.Positive n, LLVM.IsPrimitive a) =>
+      Canonical n (Value a) where
+   type Construct n (Value a) = Value (Vector n a)
+
+instance (Canonical n a0, Canonical n a1) => Canonical n (a0, a1) where
+   type Construct n (a0, a1) = (Construct n a0, Construct n a1)
+
+instance (Canonical n a0, Canonical n a1, Canonical n a2) => Canonical n (a0, a1, a2) where
+   type Construct n (a0, a1, a2) = (Construct n a0, Construct n a1, Construct n a2)
+
+
+size ::
+   (TypeNum.Positive n) =>
+   Value (Vector n a) -> Int
+size =
+   let sz :: (TypeNum.Positive n) => TypeNum.Singleton n -> Value (Vector n a) -> Int
+       sz n _ = TypeNum.integralFromSingleton n
+   in  sz TypeNum.singleton
+
+{- |
+Manually assemble a vector of equal values.
+Better use ScalarOrVector.replicate.
+-}
+replicate ::
+   (C v) =>
+   Element v -> CodeGenFunction r v
+replicate = replicateCore TypeNum.singleton
+
+replicateCore ::
+   (C v) =>
+   TypeNum.Singleton (Size v) -> Element v -> CodeGenFunction r v
+replicateCore n =
+   assemble . List.replicate (TypeNum.integralFromSingleton n)
+
+{- |
+construct a vector out of single elements
+
+You must assert that the length of the list matches the vector size.
+
+This can be considered the inverse of 'extractAll'.
+-}
+assemble ::
+   (C v) =>
+   [Element v] -> CodeGenFunction r v
+assemble =
+   foldM (\v (k,x) -> insert (valueOf k) x v) Tuple.undef .
+   List.zip [0..]
+{- sends GHC into an infinite loop
+   foldM (\(k,x) -> insert (valueOf k) x) Tuple.undef .
+   List.zip [0..]
+-}
+
+insertChunk ::
+   (C c, C v, Element c ~ Element v) =>
+   Int -> c ->
+   v -> CodeGenFunction r v
+insertChunk k x =
+   M.chain $
+   List.zipWith
+      (\i j -> \v ->
+          extract (valueOf i) x >>= \e ->
+          insert (valueOf j) e v)
+      (take (sizeInTuple x) [0..])
+      [fromIntegral k ..]
+
+iterate ::
+   (C v) =>
+   (Element v -> CodeGenFunction r (Element v)) ->
+   Element v -> CodeGenFunction r v
+iterate f x =
+   fmap snd $
+   iterateCore f x Tuple.undef
+
+iterateCore ::
+   (C v) =>
+   (Element v -> CodeGenFunction r (Element v)) ->
+   Element v -> v ->
+   CodeGenFunction r (Element v, v)
+iterateCore f x0 v0 =
+   foldM
+      (\(x,v) k ->
+         liftM2 (,) (f x)
+            (insert (valueOf k) x v))
+      (x0,v0)
+      (take (sizeInTuple v0) [0..])
+
+{- |
+Manually implement vector shuffling using insertelement and extractelement.
+In contrast to LLVM's built-in instruction it supports distinct vector sizes,
+but it allows only one input vector
+(or a tuple of vectors, but we cannot shuffle between them).
+For more complex shuffling we recommend 'extractAll' and 'assemble'.
+-}
+shuffle ::
+   (C v, C w, Element v ~ Element w) =>
+   v ->
+   ConstValue (Vector (Size w) Word32) ->
+   CodeGenFunction r w
+shuffle x i =
+   assemble =<<
+   mapM
+      (flip extract x <=< extractelement (value i) . valueOf)
+      (take (size (value i)) [0..])
+
+
+sizeInTuple :: Simple v => v -> Int
+sizeInTuple =
+   let sz :: Simple v => TypeNum.Singleton (Size v) -> v -> Int
+       sz n _ = TypeNum.integralFromSingleton n
+   in  sz TypeNum.singleton
+
+constCyclicVector ::
+   (IsConst a, TypeNum.Positive n) =>
+   NonEmpty.T [] a -> ConstValue (Vector n a)
+constCyclicVector =
+   LLVM.constCyclicVector . fmap 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 ::
+   (Simple v) =>
+   v -> CodeGenFunction r v
+rotateUp x =
+   shuffleMatch
+      (constCyclicVector $
+       (fromIntegral (sizeInTuple x) - 1) !: [0..]) x
+
+rotateDown ::
+   (Simple v) =>
+   v -> CodeGenFunction r v
+rotateDown x =
+   shuffleMatch
+      (constCyclicVector $
+       NonEmpty.snoc (List.take (sizeInTuple x - 1) [1..]) 0) x
+
+reverse ::
+   (Simple v) =>
+   v -> CodeGenFunction r v
+reverse x =
+   shuffleMatch
+      (constCyclicVector $
+       maybe (error "vector size must be positive") NonEmpty.reverse $
+       NonEmpty.fetch $
+       List.take (sizeInTuple x) [0..])
+      x
+
+shiftUp ::
+   (C v) =>
+   Element v -> v -> CodeGenFunction r (Element v, v)
+shiftUp x0 x = do
+   y <-
+      shuffleMatch
+         (LLVM.constCyclicVector $ undef !: List.map constOf [0..]) x
+   liftM2 (,)
+      (extract (LLVM.valueOf (fromIntegral (sizeInTuple x) - 1)) x)
+      (insert (value LLVM.zero) x0 y)
+
+shiftDown ::
+   (C v) =>
+   Element v -> v -> CodeGenFunction r (Element v, v)
+shiftDown x0 x = do
+   y <-
+      shuffleMatch
+         (LLVM.constCyclicVector $
+          NonEmpty.snoc
+             (List.map constOf $ List.take (sizeInTuple x - 1) [1..])
+             undef) x
+   liftM2 (,)
+      (extract (value LLVM.zero) x)
+      (insert (LLVM.valueOf (fromIntegral (sizeInTuple x) - 1)) x0 y)
+
+shiftUpMultiZero ::
+   (C v, Tuple.Zero (Element v)) =>
+   Int -> v -> LLVM.CodeGenFunction r v
+shiftUpMultiZero n v =
+   assemble . take (sizeInTuple v) .
+   (List.replicate n Tuple.zero ++) =<< extractAll v
+
+shiftDownMultiZero ::
+   (C v, Tuple.Zero (Element v)) =>
+   Int -> v -> LLVM.CodeGenFunction r v
+shiftDownMultiZero n v =
+   assemble . take (sizeInTuple v) .
+   (++ List.repeat Tuple.zero) . List.drop n
+      =<< extractAll v
+
+
+shuffleMatchTraversable ::
+   (Simple v, Trav.Traversable f) =>
+   ConstValue (Vector (Size v) Word32) -> f v -> CodeGenFunction r (f v)
+shuffleMatchTraversable is v =
+   Trav.mapM (shuffleMatch is) v
+
+{- |
+Implement the 'shuffleMatch' method using the methods of the 'C' class.
+-}
+shuffleMatchAccess ::
+   (C v) =>
+   ConstValue (Vector (Size v) Word32) -> v -> CodeGenFunction r v
+shuffleMatchAccess is v =
+   assemble =<<
+   mapM
+      (flip extract v <=<
+       flip extract (value is) . valueOf)
+      (take (size (value is)) [0..])
+
+
+shuffleMatchPlain1 ::
+   (TypeNum.Positive n, IsPrimitive a) =>
+   Value (Vector n a) ->
+   ConstValue (Vector n Word32) ->
+   CodeGenFunction r (Value (Vector n a))
+shuffleMatchPlain1 x =
+   shuffleMatchPlain2 x (value undef)
+
+shuffleMatchPlain2 ::
+   (TypeNum.Positive n, IsPrimitive a) =>
+   Value (Vector n a) ->
+   Value (Vector n a) ->
+   ConstValue (Vector n Word32) ->
+   CodeGenFunction r (Value (Vector n a))
+shuffleMatchPlain2 =
+   LLVM.shufflevector
+
+
+insertTraversable ::
+   (C v, Trav.Traversable f, App.Applicative f) =>
+   Value Word32 -> f (Element v) -> f v -> CodeGenFunction r (f v)
+insertTraversable n a v =
+   Trav.sequence (liftA2 (insert n) a v)
+
+extractTraversable ::
+   (Simple v, Trav.Traversable f) =>
+   Value Word32 -> f v -> CodeGenFunction r (f (Element v))
+extractTraversable n v =
+   Trav.mapM (extract n) v
+
+{- |
+provide the elements of a vector as a list of individual virtual registers
+
+This can be considered the inverse of 'assemble'.
+-}
+extractAll ::
+   (Simple v) =>
+   v -> LLVM.CodeGenFunction r [Element v]
+extractAll = sequence . extractList
+
+extractList ::
+   (Simple v) =>
+   v -> [LLVM.CodeGenFunction r (Element v)]
+extractList x =
+   List.map
+      (flip extract x . LLVM.valueOf)
+      (take (sizeInTuple x) [0..])
+
+
+modify ::
+   (C v) =>
+   Value Word32 ->
+   (Element v -> CodeGenFunction r (Element v)) ->
+   (v -> CodeGenFunction r v)
+modify k f v =
+   flip (insert k) v =<< f =<< extract k v
+
+{- |
+Like LLVM.Util.Loop.mapVector but the loop is unrolled,
+which is faster since it can be packed by the code generator.
+-}
+map, _mapByFold ::
+   (C v, C w, Size v ~ Size w) =>
+   (Element v -> CodeGenFunction r (Element w)) ->
+   (v -> CodeGenFunction r w)
+map f =
+   assemble <=< mapM f <=< extractAll
+
+_mapByFold f a =
+   foldM
+      (\b n ->
+         extract (valueOf n) a >>=
+         f >>=
+         flip (insert (valueOf n)) b)
+      Tuple.undef
+      (take (sizeInTuple a) [0..])
+
+mapChunks ::
+   (C ca, C cb, Size ca ~ Size cb,
+    C va, C vb, Size va ~ Size vb,
+    Element ca ~ Element va, Element cb ~ Element vb) =>
+   (ca -> CodeGenFunction r cb) ->
+   (va -> CodeGenFunction r vb)
+mapChunks f a =
+   foldM
+      (\b (am,k) ->
+         am >>= \ac ->
+         f ac >>= \bc ->
+         insertChunk (k * sizeInTuple ac) bc b)
+      Tuple.undef $
+   List.zip (chop a) [0..]
+
+zipChunksWith ::
+   (C ca, C cb, C cc, Size ca ~ Size cb, Size cb ~ Size cc,
+    C va, C vb, C vc, Size va ~ Size vb, Size vb ~ Size vc,
+    Element ca ~ Element va, Element cb ~ Element vb, Element cc ~ Element vc) =>
+   (ca -> cb -> CodeGenFunction r cc) ->
+   (va -> vb -> CodeGenFunction r vc)
+zipChunksWith f a b =
+   mapChunks (uncurry f) (a,b)
+
+
+mapChunks2 ::
+   (C ca, C cb, Size ca ~ Size cb,
+    C la, C lb, Size la ~ Size lb,
+    C va, C vb, Size va ~ Size vb,
+    Element ca ~ Element va, Element la ~ Element va,
+    Element cb ~ Element vb, Element lb ~ Element vb) =>
+   (ca -> CodeGenFunction r cb) ->
+   (la -> CodeGenFunction r lb) ->
+   (va -> CodeGenFunction r vb)
+mapChunks2 f g a = do
+   let chunkSize :: C ca => (ca -> cgf) -> TypeNum.Singleton (Size ca) -> Int
+       chunkSize _ = TypeNum.integralFromSingleton
+   xs <- extractAll a
+   case ListHT.viewR $
+        ListHT.sliceVertical (chunkSize g TypeNum.singleton) xs of
+      Nothing -> assemble []
+      Just (cs,c) -> do
+         ds <- mapM (extractAll <=< g <=< assemble) cs
+         d <-
+            if List.length c <= chunkSize f TypeNum.singleton
+              then fmap List.concat $
+                   mapM (extractAll <=< f <=< assemble) $
+                   ListHT.sliceVertical (chunkSize f TypeNum.singleton) c
+              else extractAll =<< g =<< assemble c
+         assemble $ List.concat ds ++ d
+
+_zipChunks2With ::
+   (C ca, C cb, C cc, Size ca ~ Size cb, Size cb ~ Size cc,
+    C la, C lb, C lc, Size la ~ Size lb, Size lb ~ Size lc,
+    C va, C vb, C vc, Size va ~ Size vb, Size vb ~ Size vc,
+    Element ca ~ Element va, Element la ~ Element va,
+    Element cb ~ Element vb, Element lb ~ Element vb,
+    Element cc ~ Element vc, Element lc ~ Element vc) =>
+   (ca -> cb -> CodeGenFunction r cc) ->
+   (la -> lb -> CodeGenFunction r lc) ->
+   (va -> vb -> CodeGenFunction r vc)
+_zipChunks2With f g a b =
+   mapChunks2 (uncurry f) (uncurry g) (a,b)
+
+
+
+{- |
+Ideally on ix86 with SSE41 this would be translated to 'dpps'.
+-}
+dotProductPartial ::
+   (TypeNum.Positive n, LLVM.IsPrimitive a, LLVM.IsArithmetic a) =>
+   Int ->
+   Value (Vector n a) ->
+   Value (Vector n a) ->
+   CodeGenFunction r (Value a)
+dotProductPartial n x y =
+   sumPartial n =<< A.mul x y
+
+sumPartial ::
+   (TypeNum.Positive n, LLVM.IsPrimitive a, LLVM.IsArithmetic a) =>
+   Int ->
+   Value (Vector n a) ->
+   CodeGenFunction r (Value a)
+sumPartial n x =
+   foldl1
+      {- quite the same as (+) using LLVM.Arithmetic instances,
+         but requires less type constraints -}
+      (M.liftJoin2 A.add)
+      (List.map (LLVM.extractelement x . valueOf) $ take n $ [0..])
+
+
+{- |
+If the target vector type is a native type
+then the chop operation produces no actual machine instruction. (nop)
+If the vector cannot be evenly divided into chunks
+the last chunk will be padded with undefined values.
+-}
+chop ::
+   (C c, C v, Element c ~ Element v) =>
+   v -> [CodeGenFunction r c]
+chop = chopCore TypeNum.singleton
+
+chopCore ::
+   (C c, C v, Element c ~ Element v) =>
+   TypeNum.Singleton (Size c) -> v -> [CodeGenFunction r c]
+chopCore m x =
+   List.map (assemble <=< sequence) $
+   ListHT.sliceVertical (TypeNum.integralFromSingleton m) $
+   extractList x
+
+{- |
+The target size is determined by the type.
+If the chunk list provides more data, the exceeding data is dropped.
+If the chunk list provides too few data,
+the target vector is filled with undefined elements.
+-}
+concat ::
+   (C c, C v, Element c ~ Element v) =>
+   [c] -> CodeGenFunction r v
+concat xs =
+   foldM
+      (\v0 (js,c) ->
+         foldM
+            (\v (i,j) -> do
+               x <- extract (valueOf i) c
+               insert (valueOf j) x v)
+            v0 $
+         List.zip [0..] js)
+      Tuple.undef $
+   List.zip
+      (ListHT.sliceVertical (sizeInTuple (head xs)) [0..])
+      xs
+
+
+getLowestPair ::
+   (TypeNum.Positive n, IsPrimitive a) =>
+   Value (Vector n a) ->
+   CodeGenFunction r (Value a, Value a)
+getLowestPair x =
+   liftM2 (,)
+      (extractelement x (valueOf 0))
+      (extractelement x (valueOf 1))
+
+
+_reduceAddInterleaved ::
+   (IsArithmetic a, IsPrimitive a,
+    TypeNum.Positive n, TypeNum.Positive m, (m :+: m) ~ n) =>
+   TypeNum.Singleton m ->
+   Value (Vector n a) ->
+   CodeGenFunction r (Value (Vector m a))
+_reduceAddInterleaved tm v = do
+   let m = TypeNum.integralFromSingleton tm
+   x <- shuffle v (constCyclicVector $ NonEmptyC.iterate succ 0)
+   y <- shuffle v (constCyclicVector $ NonEmptyC.iterate succ m)
+   A.add x y
+
+sumGeneric ::
+   (IsArithmetic a, IsPrimitive a, TypeNum.Positive n) =>
+   Value (Vector n a) ->
+   CodeGenFunction r (Value a)
+sumGeneric =
+   flip extractelement (valueOf 0) <=<
+   reduceSumInterleaved 1
+
+sumToPairGeneric ::
+   (Arithmetic a, TypeNum.Positive n) =>
+   Value (Vector n a) ->
+   CodeGenFunction r (Value a, Value a)
+sumToPairGeneric v =
+   let n2 = div (size v) 2
+   in  sumInterleavedToPair =<<
+       shuffleMatchPlain1 v
+          (maybe (error "vector size must be positive") LLVM.constCyclicVector $
+           NonEmpty.fetch $
+           List.map (constOf . fromIntegral) $
+           concatMap (\k -> [k, k+n2]) [0..])
+
+{- |
+We partition a vector of size n into chunks of size m
+and add these chunks using vector additions.
+We do this by repeated halving of the vector,
+since this way we do not need assumptions about the native vector size.
+
+We reduce the vector size only virtually,
+that is we maintain the vector size and fill with undefined values.
+This is reasonable
+since LLVM-2.5 and LLVM-2.6 does not allow shuffling between vectors of different size
+and because it likes to do computations on Vector D2 Float
+in MMX registers on ix86 CPU's,
+which interacts badly with FPU usage.
+Since we fill the vector with undefined values,
+LLVM actually treats the vectors like vectors of smaller size.
+-}
+reduceSumInterleaved ::
+   (IsArithmetic a, IsPrimitive a, TypeNum.Positive n) =>
+   Int ->
+   Value (Vector n a) ->
+   CodeGenFunction r (Value (Vector n a))
+reduceSumInterleaved m x0 =
+   let go ::
+          (IsArithmetic a, IsPrimitive a, TypeNum.Positive n) =>
+          Int ->
+          Value (Vector n a) ->
+          CodeGenFunction r (Value (Vector n a))
+       go n x =
+          if m==n
+            then return x
+            else
+               let n2 = div n 2
+               in  go n2
+                      =<< A.add x
+                      =<< shuffleMatchPlain1 x
+                             (LLVM.constCyclicVector $
+                              NonEmpty.appendLeft
+                                 (List.map constOf $
+                                  take n2 [fromIntegral n2 ..])
+                                 (NonEmptyC.repeat undef))
+   in  go (size x0) x0
+
+cumulateGeneric, _cumulateSimple ::
+   (IsArithmetic a, IsPrimitive a, TypeNum.Positive n) =>
+   Value a -> Value (Vector n a) ->
+   CodeGenFunction r (Value a, Value (Vector n a))
+_cumulateSimple a x =
+   foldM
+      (\(a0,y0) k -> do
+         a1 <- A.add a0 =<< extract (valueOf k) x
+         y1 <- insert (valueOf k) a0 y0
+         return (a1,y1))
+      (a, Tuple.undef)
+      (take (sizeInTuple x) $ [0..])
+
+cumulateGeneric =
+   cumulateFrom1 cumulate1
+
+cumulateFrom1 ::
+   (IsArithmetic a, IsPrimitive a, TypeNum.Positive n) =>
+   (Value (Vector n a) ->
+    CodeGenFunction r (Value (Vector n a))) ->
+   Value a -> Value (Vector n a) ->
+   CodeGenFunction r (Value a, Value (Vector n a))
+cumulateFrom1 cum a x0 = do
+   (b,x1) <- shiftUp a x0
+   y <- cum x1
+   z <- A.add b =<< extract (valueOf (fromIntegral (sizeInTuple x0) - 1)) y
+   return (z,y)
+
+
+{- |
+Needs (log n) vector additions
+-}
+cumulate1 ::
+   (IsArithmetic a, IsPrimitive a, TypeNum.Positive n) =>
+   Value (Vector n a) ->
+   CodeGenFunction r (Value (Vector n a))
+cumulate1 x =
+   foldM
+      (\y k -> A.add y =<< shiftUpMultiZero k y)
+      x
+      (takeWhile (<sizeInTuple x) $ List.iterate (2*) 1)
+
+
+{-
+{- |
+This one does not use vectorized select.
+Cf. the outcommented signumInt.
+-}
+signumInt ::
+   (TypeNum.Positive n,
+    IsPrimitive a, IsArithmetic a, IsConst a, Num a,
+    LLVM.CmpRet a, LLVM.CmpResult a ~ b,
+    IsPrimitive b, LLVM.IsInteger b) =>
+   Value (Vector n a) ->
+   CodeGenFunction r (Value (Vector n a))
+signumInt x = do
+   let zero = LLVM.value LLVM.zero
+   negative <- A.cmp LLVM.CmpLT x zero
+   positive <- A.cmp LLVM.CmpGT x zero
+   map
+      (\(n,p) ->
+         LLVM.select n (valueOf (-1))
+            =<< LLVM.select p (valueOf 1) (LLVM.value LLVM.zero))
+      (negative, positive)
+
+signumWord ::
+   (TypeNum.Positive n,
+    IsPrimitive a, IsArithmetic a, IsConst a, Num a,
+    LLVM.CmpRet a, LLVM.CmpResult a ~ b,
+    IsPrimitive b, LLVM.IsInteger b) =>
+   Value (Vector n a) ->
+   CodeGenFunction r (Value (Vector n a))
+signumWord x = do
+   positive <- A.cmp LLVM.CmpGT x (LLVM.value LLVM.zero)
+   map
+      (\p -> LLVM.select p (valueOf 1) (LLVM.value LLVM.zero))
+      positive
+-}
+
+signumIntGeneric ::
+   (TypeNum.Positive n,
+    {- TypeNum.Positive (n :*: LLVM.SizeOf a), -}
+    IsPrimitive a, LLVM.IsInteger a,
+    LLVM.CmpRet a, LLVM.CmpResult a ~ b,
+    IsPrimitive b, LLVM.IsInteger b) =>
+   Value (Vector n a) ->
+   CodeGenFunction r (Value (Vector n a))
+signumIntGeneric x = do
+   let zero = LLVM.value LLVM.zero
+   negative <- LLVM.sadapt =<< A.cmp LLVM.CmpLT x zero
+   positive <- LLVM.sadapt =<< A.cmp LLVM.CmpGT x zero
+   A.sub negative positive
+
+signumWordGeneric ::
+   (TypeNum.Positive n,
+    IsPrimitive a, LLVM.IsInteger a,
+    LLVM.CmpRet a, LLVM.CmpResult a ~ b,
+    IsPrimitive b, LLVM.IsInteger b) =>
+   Value (Vector n a) ->
+   CodeGenFunction r (Value (Vector n a))
+signumWordGeneric x =
+   LLVM.zadapt =<< A.cmp LLVM.CmpGT x (LLVM.value LLVM.zero)
+
+signumFloatGeneric ::
+   (TypeNum.Positive n,
+    IsPrimitive a, IsArithmetic a, IsFloating a,
+    LLVM.CmpRet a, LLVM.CmpResult a ~ b,
+    IsPrimitive b, LLVM.IsInteger b) =>
+   Value (Vector n a) ->
+   CodeGenFunction r (Value (Vector n a))
+signumFloatGeneric x = do
+   let zero = LLVM.value LLVM.zero
+   negative <- LLVM.sitofp =<< A.cmp LLVM.CmpLT x zero
+   positive <- LLVM.sitofp =<< A.cmp LLVM.CmpGT x zero
+   A.sub negative positive
+
+
+signedFraction ::
+   (IsFloating a, IsConst a, Real a, TypeNum.Positive n) =>
+   Value (Vector n a) ->
+   CodeGenFunction r (Value (Vector n a))
+signedFraction x =
+   A.sub x =<< truncate x
+
+
+-- * target independent functions with target dependent optimizations
+
+{- |
+The order of addition is chosen for maximum efficiency.
+We do not try to prevent cancelations.
+-}
+class (IsArithmetic a, IsPrimitive a) => Arithmetic a where
+   sum ::
+      (TypeNum.Positive n) =>
+      Value (Vector n a) ->
+      CodeGenFunction r (Value a)
+   sum = sumGeneric
+
+   {- |
+   The first result value is the sum of all vector elements from 0 to @div n 2 + 1@
+   and the second result value is the sum of vector elements from @div n 2@ to @n-1@.
+   n must be at least D2.
+   -}
+   sumToPair ::
+      (TypeNum.Positive n) =>
+      Value (Vector n a) ->
+      CodeGenFunction r (Value a, Value a)
+   sumToPair = sumToPairGeneric
+
+   {- |
+   Treat the vector as concatenation of pairs and all these pairs are added.
+   Useful for stereo signal processing.
+   n must be at least D2.
+   -}
+   sumInterleavedToPair ::
+      (TypeNum.Positive n) =>
+      Value (Vector n a) ->
+      CodeGenFunction r (Value a, Value a)
+   sumInterleavedToPair v =
+      getLowestPair =<< reduceSumInterleaved 2 v
+
+   cumulate ::
+      (TypeNum.Positive n) =>
+      Value a -> Value (Vector n a) ->
+      CodeGenFunction r (Value a, Value (Vector n a))
+   cumulate = cumulateGeneric
+
+   dotProduct ::
+      (TypeNum.Positive n) =>
+      Value (Vector n a) ->
+      Value (Vector n a) ->
+      CodeGenFunction r (Value a)
+   dotProduct x y =
+      dotProductPartial (size x) x y
+
+   mul ::
+      (TypeNum.Positive n) =>
+      Value (Vector n a) ->
+      Value (Vector n a) ->
+      CodeGenFunction r (Value (Vector n a))
+   mul = A.mul
+
+instance Arithmetic Float where
+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
+
+
+
+class (Arithmetic a, LLVM.CmpRet a, LLVM.IsPrimitive a, IsConst a) =>
+         Real a where
+   min, max ::
+      (TypeNum.Positive n) =>
+      Value (Vector n a) ->
+      Value (Vector n a) ->
+      CodeGenFunction r (Value (Vector n a))
+
+   abs ::
+      (TypeNum.Positive n) =>
+      Value (Vector n a) ->
+      CodeGenFunction r (Value (Vector n a))
+
+   signum ::
+      (TypeNum.Positive n) =>
+      Value (Vector n a) ->
+      CodeGenFunction r (Value (Vector n a))
+
+   truncate, floor, fraction ::
+      (TypeNum.Positive n) =>
+      Value (Vector n a) ->
+      CodeGenFunction r (Value (Vector n a))
+
+instance Real Float where
+   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 = 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 = 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 = 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 = 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 = 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 = A.min
+   max = A.max
+   abs = return
+   signum = signumWordGeneric
+   truncate = return
+   floor = return
+   fraction = const $ return (value LLVM.zero)
+
+instance Real Word16 where
+   min = A.min
+   max = A.max
+   abs = return
+   signum = signumWordGeneric
+   truncate = return
+   floor = return
+   fraction = const $ return (value LLVM.zero)
+
+instance Real Word32 where
+   min = A.min
+   max = A.max
+   abs = return
+   signum = signumWordGeneric
+   truncate = return
+   floor = return
+   fraction = const $ return (value LLVM.zero)
+
+instance Real Word64 where
+   min = A.min
+   max = A.max
+   abs = return
+   signum = signumWordGeneric
+   truncate = return
+   floor = return
+   fraction = const $ return (value LLVM.zero)
diff --git a/test/LLVM/Extra/VectorAlt.hs b/test/LLVM/Extra/VectorAlt.hs
new file mode 100644
--- /dev/null
+++ b/test/LLVM/Extra/VectorAlt.hs
@@ -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
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -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 ++
+      []
diff --git a/test/Test/Storable.hs b/test/Test/Storable.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Storable.hs
@@ -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))))) :
+   []
diff --git a/test/Test/Vector.hs b/test/Test/Vector.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Vector.hs
@@ -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) :
+   []