diff --git a/Changes.md b/Changes.md
--- a/Changes.md
+++ b/Changes.md
@@ -1,5 +1,33 @@
 # Change log for the `llvm-tf` package
 
+## 9.2
+
+* custom `Ptr` type:
+  We leave the original `Ptr` type for data in `Storable` compatible format,
+  and use `LLVM.Ptr` for data in LLVM layout.
+
+* `instance Storable Vector`:
+  Allows non-primitive elements and interleaves them.
+
+* `instance Marshal Vector`:
+  Should now be really compatible with LLVM.
+  Formerly, it was wrong on big-endian systems
+  and vectors of Bool, WordN, IntN.
+  The correct implementation required a new class for storing vectors.
+
+* `Ret` class: turned from multi-parameter type class
+  to single parameter type class with type function `Result`.
+  You may replace `Ret a r` by `Ret a, Result a ~ r` in your code,
+  which may enable further simplifications.
+
+* `CallArgs f g r` -> `CallArgs r f g`,
+  `CallerFunction f r` -> `CallerFunction r f`
+
+* `ArithFunction`, `ToArithFunction`:
+  Replaced functional dependencies by type functions.
+
+* `ArithFunction`: split off `Return`
+
 ## 9.0
 
 * `Instructions.bitcastElements`:
diff --git a/example/Align.hs b/example/Align.hs
--- a/example/Align.hs
+++ b/example/Align.hs
@@ -17,6 +17,7 @@
     td <- EE.getTargetData
     print (
         EE.littleEndian td,
+        EE.dataLayoutStr td,
         EE.abiAlignmentOfType td $ unsafeTypeRef (Proxy :: Proxy Word32),
         EE.abiAlignmentOfType td $ unsafeTypeRef (Proxy :: Proxy Word64),
         EE.abiAlignmentOfType td $ unsafeTypeRef (Proxy :: Proxy (Vector D4 Float)),
diff --git a/example/Arith.hs b/example/Arith.hs
--- a/example/Arith.hs
+++ b/example/Arith.hs
@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -fno-warn-type-defaults #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 module Main (main) where
 
 import qualified LLVM.Util.Arithmetic as A
@@ -7,25 +5,27 @@
 import LLVM.Util.Arithmetic (CallIntrinsic, arithFunction, (%<), (?))
 import LLVM.Util.File (writeCodeGenModule)
 
-import LLVM.ExecutionEngine (simpleFunction, unsafeRemoveIO)
+import qualified LLVM.ExecutionEngine as EE
 import LLVM.Core
 
 import Type.Data.Num.Decimal.Literal (D4)
 
 import Data.Int (Int32)
 
-import Foreign.Storable (peek)
-import Foreign.Ptr (Ptr)
-{-
-import Foreign.Marshal.Utils
-import Foreign.Marshal.Alloc as F
--}
+import qualified Prelude as P
+import Prelude hiding ((^))
 
-mSomeFn :: forall a.
+
+(^) :: (Num a) => a -> Int -> a
+(^) = (P.^)
+
+mSomeFn ::
     (IsConst a, Floating a, IsFloating a, CallIntrinsic a, CmpRet a) =>
     CodeGenModule (Function (a -> IO a))
 mSomeFn = do
-    foo <- createFunction InternalLinkage $ arithFunction $ \ x y -> exp (sin x) + y
+    foo <-
+        createFunction InternalLinkage $ arithFunction $ \ x y ->
+            exp (sin x) + y
     let foo' = A.toArithFunction foo
     createFunction ExternalLinkage $ arithFunction $ \ x -> do
         y <- A.set $ x^3
@@ -38,8 +38,7 @@
 
 mVFun :: CodeGenModule (Function (Ptr V -> Ptr V -> IO ()))
 mVFun = do
-    fn :: Function (V -> IO V)
-       <- createFunction ExternalLinkage $ arithFunction $ \ x ->
+    fn <- createFunction ExternalLinkage $ arithFunction $ \ x ->
             log x * exp x * x - 16
 
     vectorToPtr fn
@@ -51,9 +50,9 @@
     initializeNativeTarget
 
     let mSomeFn' = mSomeFn
-    ioSomeFn <- simpleFunction mSomeFn'
+    ioSomeFn <- EE.simpleFunction mSomeFn'
     let someFn :: Double -> Double
-        someFn = unsafeRemoveIO ioSomeFn
+        someFn = EE.unsafeRemoveIO ioSomeFn
 
     writeCodeGenModule "Arith.bc" mSomeFn'
 
@@ -62,19 +61,20 @@
 
     writeCodeGenModule "ArithFib.bc" mFib
 
-    fib <- simpleFunction mFib
+    fib <- EE.simpleFunction mFib
     fib 22 >>= print
 
     writeCodeGenModule "VArith.bc" mVFun
 
-    ioVFun <- simpleFunction mVFun
-    let v = toVector (1,2,3,4)
+    ioVFun <- EE.simpleFunction mVFun
+    let v = consVector 1 2 3 4
 
     r <- vectorPtrWrap ioVFun v
     print r
 
 
-vectorToPtr :: Function (V -> IO V) -> CodeGenModule (Function (Ptr V -> Ptr V -> IO ()))
+vectorToPtr ::
+    Function (V -> IO V) -> CodeGenModule (Function (Ptr V -> Ptr V -> IO ()))
 vectorToPtr f =
     createFunction ExternalLinkage $ \ px py -> do
         x <- load px
@@ -87,4 +87,4 @@
     F.with v $ \ aPtr ->
         F.alloca $ \ bPtr -> do
              f aPtr bPtr
-             peek bPtr
+             EE.peek bPtr
diff --git a/example/Array.hs b/example/Array.hs
--- a/example/Array.hs
+++ b/example/Array.hs
@@ -4,9 +4,8 @@
 import LLVM.Util.Optimize (optimizeModule)
 import LLVM.Core
 
-import Foreign.Ptr (Ptr)
 import Control.Monad (foldM, void)
-import Data.Word (Word32)
+import Data.Word (Word, Word32)
 
 
 cg :: CodeGenModule (Function (Double -> IO (Ptr Double)))
@@ -43,11 +42,11 @@
             foldM (\ptr x -> store x ptr >> getElementPtr ptr (1::Word32,()))
 
     test <- createNamedFunction ExternalLinkage "test" $ \ x -> do
-        a <- arrayMalloc (4 :: Word32)
+        a <- arrayMalloc (4 :: Word)
         fillArray a $ map valueOf [1,2,3,4]
-        b <- arrayMalloc (4 :: Word32)
+        b <- arrayMalloc (4 :: Word)
         fillArray b [x,x,x,x]
-        c <- arrayMalloc (4 :: Word32)
+        c <- arrayMalloc (4 :: Word)
         _ <- call matMul (valueOf 2) (valueOf 2) (valueOf 2) a b c
         ret c
     let _ = test :: Function (Double -> IO (Ptr Double))
@@ -58,8 +57,7 @@
 main = do
     -- Initialize jitter
     initializeNativeTarget
-    m <- newModule
-    _f <- defineModule m $ setTarget hostTriple >> cg
+    m <- createModule $ setTarget hostTriple >> cg >> getModule
     writeBitcodeToFile "Arr.bc" m
     _ <- optimizeModule 3 m
     writeBitcodeToFile "Arr-opt.bc" m
diff --git a/example/BrainF.hs b/example/BrainF.hs
--- a/example/BrainF.hs
+++ b/example/BrainF.hs
@@ -16,8 +16,8 @@
 -- ]         }               End loop
 --
 
+import qualified LLVM.ExecutionEngine as EE
 import qualified LLVM.Util.Memory as Memory
-import LLVM.ExecutionEngine (simpleFunction)
 import LLVM.Util.File (writeCodeGenModule)
 import LLVM.Core
 
@@ -26,7 +26,7 @@
 import System.Exit (exitFailure)
 
 import Control.Monad (when)
-import Data.Word (Word8, Word32)
+import Data.Word (Word8, Word32, Word)
 import Data.Int (Int32)
 
 
@@ -59,12 +59,12 @@
     when debug $
        writeCodeGenModule "BrainF.bc" $ brainCompile debug prog 65536
 
-    bfprog <- simpleFunction $ brainCompile debug prog 65536
+    bfprog <- EE.simpleFunction $ brainCompile debug prog 65536
     when (prog == text) $
         putStrLn "Should print '!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGH' on the next line:"
     bfprog
 
-brainCompile :: Bool -> String -> Word32 -> CodeGenModule (Function (IO ()))
+brainCompile :: Bool -> String -> Word -> CodeGenModule (Function (IO ()))
 brainCompile _debug instrs wmemtotal = do
     -- LLVM functions
     memset    <- Memory.memset
diff --git a/example/CallConv.hs b/example/CallConv.hs
--- a/example/CallConv.hs
+++ b/example/CallConv.hs
@@ -8,25 +8,22 @@
 
 -- Our module will have these two functions.
 data Mod = Mod {
-    m1 :: Function (Word32 -> IO Word32),
-    m2 :: Function (Word32 -> Word32 -> IO Word32)
+    f1 :: Function (Word32 -> IO Word32),
+    f2 :: Function (Word32 -> Word32 -> IO Word32)
     }
 
 main :: IO ()
 main = do
-    m <- newModule
-    _fns <- defineModule m $ setTarget hostTriple >> buildMod
+    m <- createModule $ setTarget hostTriple >> buildMod >> getModule
     --_ <- optimizeModule 3 m
     writeBitcodeToFile "CallConv.bc" m
 
 buildMod :: CodeGenModule Mod
 buildMod = do
-    mod2 <- createNamedFunction InternalLinkage "plus" $ \ x y -> do
-      r <- add x y
-      ret r
-    setFuncCallConv mod2 GHC
-    mod1 <- newNamedFunction ExternalLinkage "test"
-    defineFunction mod1 $ \ arg -> do
-      r <- callWithConv GHC mod2 arg (valueOf 1)
-      ret r
-    return $ Mod {m1 = mod1, m2 = mod2}
+    fun2 <- createNamedFunction InternalLinkage "plus" $ \ x y ->
+      ret =<< add x y
+    setFuncCallConv fun2 GHC
+    fun1 <- newNamedFunction ExternalLinkage "test"
+    defineFunction fun1 $ \ arg ->
+      ret =<< callWithConv GHC fun2 arg (valueOf 1)
+    return $ Mod {f1 = fun1, f2 = fun2}
diff --git a/example/DotProd.hs b/example/DotProd.hs
--- a/example/DotProd.hs
+++ b/example/DotProd.hs
@@ -1,11 +1,6 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 module Main (main) where
 
-import LLVM.ExecutionEngine (simpleFunction, unsafeRemoveIO)
+import qualified LLVM.ExecutionEngine as EE
 import LLVM.Core
 
 import LLVM.Util.Loop (forLoop)
@@ -13,19 +8,28 @@
 import LLVM.Util.Foreign (withArrayLen)
 
 import qualified Type.Data.Num.Decimal.Number as Dec
-import Type.Data.Num.Decimal.Literal (D2, D4, D8)
+import qualified Type.Data.Num.Decimal.Literal as TypeNum
+import Type.Base.Proxy (Proxy(Proxy))
 
-import Foreign.Ptr (Ptr)
+import qualified Data.Traversable as Trav
+import qualified Data.List.HT as ListHT
+import qualified Data.List as List
+import Data.Maybe.HT (toMaybe)
+import Data.Maybe (fromMaybe)
+import Data.Tuple.HT (swap)
 import Data.Word (Word32)
 
+import Control.Applicative (pure)
 
-mDotProd :: forall n a .
-   (Dec.Positive n,
-    IsPrimitive a, IsArithmetic a, IsFirstClass a, IsConst a, Num a) =>
-   CodeGenModule (Function (Word32 -> Ptr (Vector n a) -> Ptr (Vector n a) -> IO a))
+
+mDotProd ::
+    (Dec.Positive n,
+     IsPrimitive a, IsArithmetic a, IsFirstClass a, IsConst a, Num a) =>
+    CodeGenModule
+        (Function (Word32 -> Ptr (Vector n a) -> Ptr (Vector n a) -> IO a))
 mDotProd =
   createFunction ExternalLinkage $ \ size aPtr bPtr -> do
-    s <- forLoop (valueOf 0) size (value (zero :: ConstValue (Vector n a))) $ \ i s -> do
+    s <- forLoop (valueOf 0) size (value zero) $ \ i s -> do
 
         ap <- getElementPtr aPtr (i, ()) -- index into aPtr
         bp <- getElementPtr bPtr (i, ()) -- index into bPtr
@@ -34,14 +38,20 @@
         ab <- mul a b                    -- multiply them
         add s ab                         -- accumulate sum
 
-    r <- forLoop (valueOf (0::Word32)) (valueOf (Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n)))
-              (valueOf 0) $ \ i r -> do
-              ri <- extractelement s i
-              add r ri
-    ret (r :: Value a)
+    r <-
+        forLoop
+            (valueOf (0::Word32))
+            (valueOf (Dec.integralFromProxy (vectorSize aPtr)))
+            (valueOf 0)
+            (\ i r -> add r =<< extractelement s i)
+    ret r
 
+vectorSize :: Value (Ptr (Vector n a)) -> Proxy n
+vectorSize _ = Proxy
+
+
 type R = Float
-type T = Vector D4 R
+type T = Vector TypeNum.D4 R
 
 main :: IO ()
 main = do
@@ -50,10 +60,10 @@
     let mDotProd' = mDotProd
     writeCodeGenModule "DotProd.bc" mDotProd'
 
-    ioDotProd <- simpleFunction mDotProd'
+    ioDotProd <- EE.simpleFunction mDotProd'
     let dotProd :: [T] -> [T] -> R
         dotProd a b =
-         unsafeRemoveIO $
+         EE.unsafeRemoveIO $
          withArrayLen a $ \ aLen aPtr ->
          withArrayLen b $ \ bLen bPtr ->
          ioDotProd (fromIntegral (aLen `min` bLen)) aPtr bPtr
@@ -64,26 +74,13 @@
     print $ dotProd (vectorize 0 a) (vectorize 0 b)
     print $ sum $ zipWith (*) a b
 
-class Vectorize n a where
-    vectorize :: a -> [a] -> [Vector n a]
-
-{-
-instance (IsPrimitive a) => Vectorize D1 a where
-    vectorize _ [] = []
-    vectorize x (x1:xs) = toVector x1 : vectorize x xs
--}
-
-instance (IsPrimitive a) => Vectorize D2 a where
-    vectorize _ [] = []
-    vectorize x (x1:x2:xs) = toVector (x1, x2) : vectorize x xs
-    vectorize x xs = vectorize x $ xs ++ [x]
-
-instance (IsPrimitive a) => Vectorize D4 a where
-    vectorize _ [] = []
-    vectorize x (x1:x2:x3:x4:xs) = toVector (x1, x2, x3, x4) : vectorize x xs
-    vectorize x xs = vectorize x $ xs ++ [x]
+vectorize :: (Positive n) => a -> [a] -> [Vector n a]
+vectorize deflt =
+    List.unfoldr (\xs -> toMaybe (not $ null xs) (vectorizeHead deflt xs))
 
-instance (IsPrimitive a) => Vectorize D8 a where
-    vectorize _ [] = []
-    vectorize x (x1:x2:x3:x4:x5:x6:x7:x8:xs) = toVector (x1, x2, x3, x4, x5, x6, x7, x8) : vectorize x xs
-    vectorize x xs = vectorize x $ xs ++ [x]
+vectorizeHead :: (Positive n) => a -> [a] -> (Vector n a, [a])
+vectorizeHead deflt ys =
+    swap $
+    Trav.mapAccumL
+        (\xt () -> swap $ fromMaybe (deflt,[]) $ ListHT.viewL xt)
+        ys (pure ())
diff --git a/example/Fibonacci.hs b/example/Fibonacci.hs
--- a/example/Fibonacci.hs
+++ b/example/Fibonacci.hs
@@ -27,7 +27,12 @@
     -- Create a module,
     m <- newNamedModule "fib"
     -- and define its contents.
-    fns <- defineModule m buildMod
+    td <- EE.getTargetData
+    fns <-
+        defineModule m $ do
+            setTarget hostTriple
+            setDataLayout (EE.dataLayoutStr td)
+            buildMod
 
     -- Show the code for the two functions, just for fun.
     --dumpValue $ mfib fns
diff --git a/example/HelloJIT.hs b/example/HelloJIT.hs
--- a/example/HelloJIT.hs
+++ b/example/HelloJIT.hs
@@ -1,9 +1,8 @@
 module Main (main) where
 
-import LLVM.ExecutionEngine (simpleFunction)
+import qualified LLVM.ExecutionEngine as EE
 import LLVM.Core
 
-import Foreign.Ptr (Ptr)
 import Data.Word (Word8, Word32)
 
 
@@ -11,15 +10,14 @@
 bldGreet = withStringNul "Hello, JIT!" (\greetz -> do
     puts <- newNamedFunction ExternalLinkage "puts" :: TFunction (Ptr Word8 -> IO Word32)
     func <- createFunction ExternalLinkage $ do
-      tmp <- getElementPtr0 greetz (0::Word32, ())
-      _ <- call puts tmp :: CodeGenFunction r (Value Word32)
+      _ <- call puts =<< getElementPtr0 greetz (0::Word32, ())
       ret ()
     return func)
 
 main :: IO ()
 main = do
     initializeNativeTarget
-    greet <- simpleFunction bldGreet
+    greet <- EE.simpleFunction bldGreet
     greet
     greet
     greet
diff --git a/example/Intrinsic.hs b/example/Intrinsic.hs
--- a/example/Intrinsic.hs
+++ b/example/Intrinsic.hs
@@ -4,10 +4,7 @@
 import qualified LLVM.Core as LLVM
 import qualified LLVM.ExecutionEngine as EE
 
-import qualified Foreign.Marshal.Utils as MU
-import Foreign.Marshal.Alloc (alloca, )
-import Foreign.Storable (peek, )
-import Foreign.Ptr (Ptr, FunPtr, )
+import Foreign.Ptr (FunPtr)
 
 import qualified Type.Data.Num.Decimal as TypeNum
 import qualified Data.Word as W
@@ -42,7 +39,8 @@
    LLVM.call f xs mode
 
 modul ::
-   LLVM.CodeGenModule (LLVM.Function (Ptr Vector -> Ptr Vector -> IO ()))
+   LLVM.CodeGenModule
+      (LLVM.Function (LLVM.Ptr Vector -> LLVM.Ptr Vector -> IO ()))
 modul =
    LLVM.createFunction LLVM.ExternalLinkage $ \ptr0 ptr1 -> do
       flip LLVM.store ptr1 =<< flip roundps (LLVM.valueOf 1) =<< LLVM.load ptr0
@@ -51,7 +49,7 @@
 type Importer func = FunPtr func -> func
 
 foreign import ccall safe "dynamic" derefFloorPtr ::
-   Importer (Ptr Vector -> Ptr Vector -> IO ())
+   Importer (LLVM.Ptr Vector -> LLVM.Ptr Vector -> IO ())
 
 run :: IO ()
 run = do
@@ -63,10 +61,10 @@
    LLVM.writeBitcodeToFile "floor.bc" m
 
    print vector
-   MU.with vector $ \ptr0 ->
-      alloca $ \ptr1 -> do
+   EE.with vector $ \ptr0 ->
+      EE.alloca $ \ptr1 -> do
          floorFunc ptr0 ptr1
-         print =<< peek ptr1
+         print =<< EE.peek ptr1
 
 
 main :: IO ()
diff --git a/example/List.hs b/example/List.hs
--- a/example/List.hs
+++ b/example/List.hs
@@ -3,9 +3,9 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 module Main (main) where
 
+import qualified LLVM.ExecutionEngine as EE
 import LLVM.Util.Loop (Phi, phis, addPhis, )
-import LLVM.ExecutionEngine (simpleFunction, )
-import LLVM.Core
+import LLVM.Core as LLVM
 import qualified System.IO as IO
 
 import Data.Word (Word32, )
@@ -14,7 +14,7 @@
 import qualified Foreign.Storable as St
 
 import Foreign.StablePtr (StablePtr, newStablePtr, freeStablePtr, deRefStablePtr, )
-import Foreign.Ptr (FunPtr, Ptr, )
+import Foreign.Ptr (FunPtr)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef, )
 
 
@@ -64,8 +64,7 @@
       (StablePtr (IORef [Word32]) -> Word32 -> Ptr Word32 -> IO Int32))
 mList =
    createFunction ExternalLinkage $ \ ref size ptr -> do
-     next <- staticFunction nelem
-     let _ = next :: Function (StablePtr (IORef [Word32]) -> IO Word32)
+     next <- staticNamedFunction "next" nelem
      s <- arrayLoop size ptr (valueOf 0) $ \ ptri y -> do
        flip store ptri =<< call next ref
        return y
@@ -73,16 +72,15 @@
 
 renderList :: IO ()
 renderList = do
-   m <- newModule
-   _f <- defineModule m $ setTarget hostTriple >> mList
+   m <- createModule $ setTarget hostTriple >> mList >> getModule
    writeBitcodeToFile "List.bc" m
 
-   fill <- simpleFunction mList
+   fill <- EE.simpleFunction mList
    stable <- newStablePtr =<< newIORef [3,5..]
    IO.withFile "listcontent.u32" IO.WriteMode $ \h ->
      let len = 100
      in  allocaArray len $ \ ptr ->
-           fill stable (fromIntegral len) ptr >>
+           fill stable (fromIntegral len) (LLVM.fromPtr ptr) >>
            IO.hPutBuf h ptr (len * St.sizeOf(undefined::Int32))
    freeStablePtr stable
 
diff --git a/example/Struct.hs b/example/Struct.hs
--- a/example/Struct.hs
+++ b/example/Struct.hs
@@ -3,13 +3,12 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Main (main) where
 
-import LLVM.ExecutionEngine (simpleFunction)
+import qualified LLVM.ExecutionEngine as EE
 import LLVM.Util.File (writeCodeGenModule)
 import LLVM.Core
 
 import Type.Data.Num.Decimal.Literal (D10, d0, d1, d2)
 
-import Foreign.Ptr (Ptr)
 import Data.Word (Word32)
 
 
@@ -38,7 +37,7 @@
 main = do
     initializeNativeTarget
     writeCodeGenModule "Struct.bc" mStruct
-    struct <- simpleFunction mStruct
+    struct <- EE.simpleFunction mStruct
     let a = 10
     p <- struct a
     putStrLn $ if structCheck a p /= 0 then "OK" else "failed"
diff --git a/example/Varargs.hs b/example/Varargs.hs
--- a/example/Varargs.hs
+++ b/example/Varargs.hs
@@ -1,12 +1,16 @@
 module Main (main) where
 
-import LLVM.ExecutionEngine (simpleFunction)
+import qualified LLVM.ExecutionEngine as EE
 import LLVM.Core
 
-import Foreign.Ptr (Ptr)
 import Data.Word (Word8, Word32)
 
 
+firstChar ::
+    (Natural n) =>
+    Value (Ptr (Array n Word8)) -> CodeGenFunction r (Value (Ptr Word8))
+firstChar str = getElementPtr0 str (0::Word32, ())
+
 bldVarargs :: CodeGenModule (Function (Word32 -> IO ()))
 bldVarargs =
    withStringNul "Hello\n" (\fmt1 ->
@@ -15,17 +19,14 @@
       printf <- newNamedFunction ExternalLinkage "printf" :: TFunction (Ptr Word8 -> VarArgs Word32)
       func <- createFunction ExternalLinkage $ \ x -> do
 
-        tmp1 <- getElementPtr0 fmt1 (0::Word32, ())
-        let p1 = castVarArgs printf :: Function (Ptr Word8 -> IO Word32)
-        _ <- call p1 tmp1
+        tmp1 <- firstChar fmt1
+        _ <- call (castVarArgs printf) tmp1
 
-        tmp2 <- getElementPtr0 fmt2 (0::Word32, ())
-        let p2 = castVarArgs printf :: Function (Ptr Word8 -> Word32 -> IO Word32)
-        _ <- call p2 tmp2 x
+        tmp2 <- firstChar fmt2
+        _ <- call (castVarArgs printf) tmp2 x
 
-        tmp3 <- getElementPtr0 fmt3 (0::Word32, ())
-        let p3 = castVarArgs printf :: Function (Ptr Word8 -> Word32 -> Word32 -> IO Word32)
-        _ <- call p3 tmp3 x x
+        tmp3 <- firstChar fmt3
+        _ <- call (castVarArgs printf) tmp3 x x
 
         ret ()
       return func
@@ -34,5 +35,5 @@
 main :: IO ()
 main = do
     initializeNativeTarget
-    varargs <- simpleFunction bldVarargs
+    varargs <- EE.simpleFunction bldVarargs
     varargs 42
diff --git a/example/Vector.hs b/example/Vector.hs
--- a/example/Vector.hs
+++ b/example/Vector.hs
@@ -68,10 +68,8 @@
     return f
 
 createFuncModule :: IO (Module, Function (T -> IO T))
-createFuncModule = do
-    m <- newModule
-    iovec <- defineModule m $ setTarget hostTriple >> cgvec
-    return (m, iovec)
+createFuncModule =
+    createModule $ setTarget hostTriple >> liftM2 (,) getModule cgvec
 
 main :: IO ()
 main = do
diff --git a/llvm-tf.cabal b/llvm-tf.cabal
--- a/llvm-tf.cabal
+++ b/llvm-tf.cabal
@@ -1,16 +1,10 @@
 Name:          llvm-tf
-Version:       9.1.1
+Version:       9.2
 License:       BSD3
 License-File:  LICENSE
 Synopsis:      Bindings to the LLVM compiler toolkit using type families.
 Description:
-  High-level bindings to the LLVM compiler toolkit
-  using type families instead of functional dependencies.
-  .
-  We use the same module names as the @llvm@ package,
-  which makes it harder to work with both packages from GHCi.
-  You may use the @-hide-package@ option.
-  We may change the module names later.
+  High-level bindings to the LLVM compiler toolkit using type families.
   .
   A note on versioning:
   The versions of this package are loosely based on the LLVM version.
@@ -21,17 +15,20 @@
   but not necessarily when we add support for a new LLVM version.
   We support all those LLVM versions
   that are supported by our @llvm-ffi@ dependency.
+  .
+  This package is a descendant of the @llvm@ package
+  which used functional dependencies.
+  The original @llvm@ package will no longer work
+  with current versions of LLVM nor GHC.
 Author:        Henning Thielemann, Bryan O'Sullivan, Lennart Augustsson
 Maintainer:    Henning Thielemann <llvm@henning-thielemann.de>
 Stability:     experimental
 Category:      Compilers/Interpreters, Code Generation
 Tested-With:   GHC == 7.4.2, GHC == 8.6.5
-Cabal-Version: 1.14
+Cabal-Version: 2.0
 Build-Type:    Simple
 
 Extra-Source-Files:
-  test/*.hs
-  test/Makefile
   Changes.md
 
 Source-Repository head
@@ -39,7 +36,7 @@
   Location: http://code.haskell.org/~thielema/llvm-tf/
 
 Source-Repository this
-  Tag:      9.1.1
+  Tag:      9.2
   Type:     darcs
   Location: http://code.haskell.org/~thielema/llvm-tf/
 
@@ -52,7 +49,7 @@
   Description: Build example executables
   Default:     False
 
-Library
+Library private
   Default-Language: Haskell98
   Build-Depends:
     llvm-ffi >=9.1 && <9.2,
@@ -68,7 +65,7 @@
     containers >=0.4 && <0.7,
     base >=3 && <5
 
-  Hs-Source-Dirs: src
+  Hs-Source-Dirs: private
   GHC-Options: -Wall
 
   If flag(developer)
@@ -84,6 +81,34 @@
     cbits/malloc.c
 
   Exposed-Modules:
+    LLVM.Core.CodeGen
+    LLVM.Core.CodeGenMonad
+    LLVM.Core.Data
+    LLVM.Core.Instructions
+    LLVM.Core.Instructions.Guided
+    LLVM.Core.Instructions.Private
+    LLVM.Core.Proxy
+    LLVM.Core.Type
+    LLVM.Core.Util
+    LLVM.Core.Vector
+    LLVM.Core.UnaryVector
+    LLVM.ExecutionEngine.Engine
+    LLVM.ExecutionEngine.Target
+    LLVM.ExecutionEngine.Marshal
+
+Library
+  Default-Language: Haskell98
+  Build-Depends:
+    private,
+    llvm-ffi,
+    tfp,
+    utility-ht,
+    base
+
+  Hs-Source-Dirs: src
+  GHC-Options: -Wall
+
+  Exposed-Modules:
     LLVM.Core
     LLVM.Core.Attribute
     LLVM.Core.Guided
@@ -97,20 +122,22 @@
     LLVM.Util.Optimize
     LLVM.Util.Proxy
 
+Test-Suite llvm-test
+  Type: exitcode-stdio-1.0
+  Build-Depends:
+    QuickCheck,
+    private,
+    llvm-tf,
+    tfp,
+    utility-ht,
+    base
+  Default-Language: Haskell98
+  GHC-Options: -Wall
+  Hs-Source-Dirs: test
+  Main-Is: Main.hs
   Other-Modules:
-    LLVM.Core.CodeGen
-    LLVM.Core.CodeGenMonad
-    LLVM.Core.Data
-    LLVM.Core.Instructions
-    LLVM.Core.Instructions.Guided
-    LLVM.Core.Instructions.Private
-    LLVM.Core.Type
-    LLVM.Core.Util
-    LLVM.Core.Vector
-    LLVM.Core.UnaryVector
-    LLVM.ExecutionEngine.Engine
-    LLVM.ExecutionEngine.Target
-    LLVM.ExecutionEngine.Marshal
+    Test.Chop
+    Test.Marshal
 
 Executable llvm-align
   If flag(buildExamples)
@@ -183,6 +210,7 @@
     Build-Depends:
       llvm-tf,
       tfp,
+      utility-ht,
       base
   Else
     Buildable: False
diff --git a/private/LLVM/Core/CodeGen.hs b/private/LLVM/Core/CodeGen.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/Core/CodeGen.hs
@@ -0,0 +1,721 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TypeFamilies #-}
+module LLVM.Core.CodeGen(
+    -- * Module creation
+    newModule, newNamedModule, defineModule, createModule, createNamedModule,
+    getModuleValues, ModuleValue, castModuleValue, setTarget, setDataLayout,
+    -- * Globals
+    Linkage(..),
+    Visibility(..),
+    -- * Function creation
+    Function, newFunction, newNamedFunction, defineFunction,
+    createFunction, createNamedFunction, setFuncCallConv, functionParameter,
+    addAttributes,
+    FFI.AttributeIndex(..), Attribute(..),
+    externFunction, staticFunction, staticNamedFunction,
+    FunctionArgs, FunctionCodeGen, FunctionResult,
+    TFunction,
+    CodeValue, CodeResult,
+    -- * Global variable creation
+    Global, newGlobal, newNamedGlobal,
+    defineGlobal, createGlobal, createNamedGlobal, TGlobal,
+    externGlobal, staticGlobal,
+    -- * Values
+    Value(..), ConstValue(..), UnValue,
+    IsConst(..), valueOf, value,
+    IsConstFields,
+    zero, allOnes, undef,
+    createString, createStringNul,
+    withString, withStringNul,
+    constVector, constArray, constStruct, constPackedStruct,
+    constCyclicVector, constCyclicArray,
+    -- * Basic blocks
+    BasicBlock(..), newBasicBlock, newNamedBasicBlock,
+    defineBasicBlock, createBasicBlock, getCurrentBasicBlock,
+    fromLabel, toLabel,
+    -- * Misc
+    withCurrentBuilder
+    ) where
+
+import qualified LLVM.Core.UnaryVector as UnaryVector
+import qualified LLVM.Core.Util as U
+import qualified LLVM.Core.Data as Data
+import qualified LLVM.Core.Proxy as LP
+import LLVM.Core.CodeGenMonad
+import LLVM.Core.Type
+import LLVM.Core.Data hiding (Ptr)
+
+import qualified LLVM.FFI.Core.Attribute as Attr
+import qualified LLVM.FFI.Core as FFI
+import LLVM.FFI.Core(Linkage(..), Visibility(..))
+
+import qualified Type.Data.Num.Decimal.Proof as DecProof
+import qualified Type.Data.Num.Decimal.Number as Dec
+import qualified Type.Data.Num.Unary as Un
+import Type.Base.Proxy (Proxy)
+
+import qualified Foreign
+import Foreign.C.String (withCString, withCStringLen)
+import Foreign.StablePtr (StablePtr, castStablePtrToPtr)
+import Foreign.Ptr (FunPtr, castFunPtrToPtr)
+import System.IO.Unsafe (unsafePerformIO)
+
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad (liftM, when)
+import Control.Applicative ((<*>))
+
+import qualified Data.NonEmpty as NonEmpty
+import qualified Data.Foldable as Fold
+import Data.Typeable (Typeable)
+import Data.Int (Int8, Int16, Int32, Int64)
+import Data.Word (Word8, Word16, Word32, Word64, Word)
+import Data.Tuple.HT (mapSnd)
+import Data.Maybe.HT (toMaybe)
+import Data.Maybe (fromMaybe)
+
+import Text.Printf (printf)
+
+--------------------------------------
+
+-- | Create a new module.
+newModule :: IO U.Module
+newModule = newNamedModule "_module"  -- XXX should generate a name
+
+-- | Create a new explicitely named module.
+newNamedModule :: String              -- ^ module name
+               -> IO U.Module
+newNamedModule = U.createModule
+
+-- | Give the body for a module.
+defineModule :: U.Module              -- ^ module that is defined
+             -> CodeGenModule a       -- ^ module body
+             -> IO a
+defineModule = runCodeGenModule
+
+-- | Create a new module with the given body.
+createModule :: CodeGenModule a       -- ^ module body
+             -> IO a
+createModule cgm = newModule >>= \ m -> defineModule m cgm
+
+-- | Create a new explicitly named module with the given body.
+createNamedModule :: String              -- ^ module name
+                  -> CodeGenModule a     -- ^ module body
+                  -> IO a
+createNamedModule name cgm = newNamedModule name >>= \ m -> defineModule m cgm
+
+setTarget :: String -> CodeGenModule ()
+setTarget triple = do
+    modul <- getModule
+    liftIO $ U.withModule modul $ \m -> withCString triple $ FFI.setTarget m
+
+setDataLayout :: String -> CodeGenModule ()
+setDataLayout layout = do
+    modul <- getModule
+    liftIO $ U.withModule modul $ \m -> withCString layout $ FFI.setDataLayout m
+
+
+--------------------------------------
+
+newtype ModuleValue = ModuleValue FFI.ValueRef
+    deriving (Show, Typeable)
+
+getModuleValues :: U.Module -> IO [(String, ModuleValue)]
+getModuleValues =
+    liftM (map (\ (s,p) -> (s, ModuleValue p))) . U.getModuleValues
+
+castModuleValue :: forall a . (IsType a) => ModuleValue -> Maybe (Value a)
+castModuleValue (ModuleValue f) =
+    toMaybe (U.valueHasType f (unsafeTypeRef (LP.Proxy :: LP.Proxy a))) (Value f)
+
+--------------------------------------
+
+newtype Value a = Value { unValue :: FFI.ValueRef }
+    deriving (Show, Typeable)
+
+newtype ConstValue a = ConstValue { unConstValue :: FFI.ValueRef }
+    deriving (Show, Typeable)
+
+-- XXX merge with IsArithmetic?
+class IsConst a where
+    constOf :: a -> ConstValue a
+
+instance IsConst Bool   where constOf = constEnum (typeRef (LP.Proxy :: LP.Proxy Bool))
+--instance IsConst Char   where constOf = constEnum (typeRef (0::Word8)) -- XXX Unicode
+instance IsConst Word   where constOf = constI
+instance IsConst Word8  where constOf = constI
+instance IsConst Word16 where constOf = constI
+instance IsConst Word32 where constOf = constI
+instance IsConst Word64 where constOf = constI
+instance IsConst Int    where constOf = constI
+instance IsConst Int8   where constOf = constI
+instance IsConst Int16  where constOf = constI
+instance IsConst Int32  where constOf = constI
+instance IsConst Int64  where constOf = constI
+instance IsConst Float  where constOf = constF
+instance IsConst Double where constOf = constF
+--instance IsConst FP128  where constOf = constF
+
+instance (Dec.Positive n) => IsConst (WordN n) where
+    constOf (WordN i) = constInteger i
+instance (Dec.Positive n) => IsConst (IntN n) where
+    constOf (IntN i) = constInteger i
+
+constOfPtr :: (IsType ptr) => ptr -> Foreign.Ptr b -> ConstValue ptr
+constOfPtr proto p =
+    let ip = p `Foreign.minusPtr` Foreign.nullPtr
+        inttoptrC :: ConstValue int -> ConstValue ptr
+        inttoptrC (ConstValue v) =
+           unsafeConstValue $
+           FFI.constIntToPtr v $ unsafeTypeRef $ LP.fromValue proto
+    in  inttoptrC $ constOf ip
+
+-- This instance doesn't belong here, but mutually recursive modules are painful.
+instance IsConst (Foreign.Ptr a) where
+    constOf p = constOfPtr p p
+
+instance (IsType a) => IsConst (Data.Ptr a) where
+    constOf p = constOfPtr p (Data.uncheckedToPtr p)
+
+instance (IsFunction a) => IsConst (FunPtr a) where
+    constOf p = constOfPtr p (castFunPtrToPtr p)
+
+instance IsConst (StablePtr a) where
+    constOf p = constOfPtr p (castStablePtrToPtr p)
+
+instance (IsPrimitive a, IsConst a, Dec.Positive n) => IsConst (Vector n a) where
+    constOf (Vector x) = constVectorGen constOf x
+
+instance (IsConst a, IsSized a, Dec.Natural n) => IsConst (Array n a) where
+    constOf (Array xs) = constArray (map constOf xs)
+
+instance (IsConstFields a) => IsConst (Struct a) where
+    constOf (Struct a) =
+        unsafeConstValue $ U.constStruct (constFieldsOf a) False
+instance (IsConstFields a) => IsConst (PackedStruct a) where
+    constOf (PackedStruct a) =
+        unsafeConstValue $ U.constStruct (constFieldsOf a) True
+
+class IsConstFields a where
+    constFieldsOf :: a -> [FFI.ValueRef]
+
+instance (IsConst a, IsConstFields as) => IsConstFields (a, as) where
+    constFieldsOf (a, as) = unConstValue (constOf a) : constFieldsOf as
+instance IsConstFields () where
+    constFieldsOf _ = []
+
+
+unsafeConstValue :: IO FFI.ValueRef -> ConstValue a
+unsafeConstValue =
+    ConstValue . unsafePerformIO
+
+unsafeWithConstValue ::
+    forall a.
+    (IsType a) =>
+    (FFI.TypeRef -> IO FFI.ValueRef) ->
+    ConstValue a
+unsafeWithConstValue f =
+    unsafePerformIO $ fmap ConstValue $
+        f =<< typeRef (LP.Proxy :: LP.Proxy a)
+
+constEnum :: (Enum a) => IO FFI.TypeRef -> a -> ConstValue a
+constEnum mt i =
+    unsafeConstValue $ mt >>= \t ->
+        FFI.constInt t (fromIntegral $ fromEnum i) FFI.false
+
+{-
+ToDo:
+Passes a BigInt as decimal number string.
+Not very efficient but quite generic.
+Maybe Hex is better?
+-}
+constInteger :: (IsType (intN n)) => Integer -> ConstValue (intN n)
+constInteger i =
+    unsafeWithConstValue $ \typ ->
+    withCString (show i) $ \cstr ->
+    FFI.constIntOfString typ cstr 10
+
+constI :: (IsInteger a, Integral a) => a -> ConstValue a
+constI i =
+    unsafeWithConstValue $ \typ ->
+    FFI.constInt typ (fromIntegral i) (FFI.consBool $ isSigned $ LP.fromValue i)
+
+constF :: (IsFloating a, Real a) => a -> ConstValue a
+constF i =
+    unsafeWithConstValue $ \typ -> FFI.constReal typ (realToFrac i)
+
+valueOf :: (IsConst a) => a -> Value a
+valueOf = value . constOf
+
+value :: ConstValue a -> Value a
+value (ConstValue a) = Value a
+
+zero :: forall a . (IsType a) => ConstValue a
+zero = unsafeWithConstValue FFI.constNull
+
+allOnes :: forall a . (IsInteger a) => ConstValue a
+allOnes = unsafeWithConstValue FFI.constAllOnes
+
+undef :: forall a . (IsType a) => ConstValue a
+undef = unsafeWithConstValue FFI.getUndef
+
+{-
+createString :: String -> ConstValue (DynamicArray Word8)
+createString = ConstValue . U.constString
+
+constStringNul :: String -> ConstValue (DynamicArray Word8)
+constStringNul = ConstValue . U.constStringNul
+-}
+
+--------------------------------------
+
+
+-- |A function is simply a pointer to the function.
+type Function a = Value (FunPtr a)
+
+-- | Create a new named function.
+newNamedFunction :: forall a . (IsFunction a)
+                 => Linkage
+                 -> String   -- ^ Function name
+                 -> CodeGenModule (Function a)
+newNamedFunction linkage name = do
+    modul <- getModule
+    typ <- liftIO $ typeRef (LP.Proxy :: LP.Proxy a)
+    liftIO $ liftM Value $ U.addFunction modul linkage name typ
+
+-- | Create a new function.  Use 'newNamedFunction' to create a function with external linkage, since
+-- it needs a known name.
+newFunction :: forall a . (IsFunction a)
+            => Linkage
+            -> CodeGenModule (Function a)
+newFunction linkage = genMSym "fun" >>= newNamedFunction linkage
+
+-- | Define a function body.  The basic block returned by the function is the function entry point.
+defineFunction :: forall f . (FunctionArgs f)
+               => Function f        -- ^ Function to define (created by 'newFunction').
+               -> FunctionCodeGen f -- ^ Function body.
+               -> CodeGenModule ()
+defineFunction fn body = do
+    bld <- liftIO $ U.createBuilder
+    let body' = do
+            newBasicBlock >>= defineBasicBlock
+            paramFunc (unValue fn) (proxyFromFunction fn) body 0
+    runCodeGenFunction bld (unValue fn) body'
+
+proxyFromFunction :: Function f -> LP.Proxy f
+proxyFromFunction _ = LP.Proxy
+
+-- | Create a new function with the given body.
+createFunction :: (FunctionArgs f)
+               => Linkage
+               -> FunctionCodeGen f  -- ^ Function body.
+               -> CodeGenModule (Function f)
+createFunction linkage body = do
+    f <- newFunction linkage
+    defineFunction f body
+    return f
+
+-- | Create a new function with the given body.
+createNamedFunction :: (FunctionArgs f)
+               => Linkage
+               -> String
+               -> FunctionCodeGen f  -- ^ Function body.
+               -> CodeGenModule (Function f)
+createNamedFunction linkage name body = do
+    f <- newNamedFunction linkage name
+    defineFunction f body
+    return f
+
+-- | Set the calling convention of a function. By default it is the
+-- C calling convention.
+setFuncCallConv :: Function a
+                -> FFI.CallingConvention
+                -> CodeGenModule ()
+setFuncCallConv (Value f) cc = do
+  liftIO $ FFI.setFunctionCallConv f (FFI.fromCallingConvention cc)
+
+data Attribute = Attribute Attr.Name Word64
+
+-- | Add attributes to a value.  Beware, what attributes are allowed depends on
+-- what kind of value it is.
+addAttributes ::
+    Value a -> FFI.AttributeIndex -> [Attribute] -> CodeGenFunction r ()
+addAttributes (Value f) i as =
+    liftIO $ do
+        context <- FFI.getGlobalContext
+        Fold.forM_ as $ \(Attribute (Attr.Name name) val) -> do
+            attrKind <-
+                withCStringLen name $
+                    uncurry FFI.getEnumAttributeKindForName .
+                    mapSnd fromIntegral
+            FFI.addCallSiteAttribute f i =<<
+                FFI.createEnumAttribute context attrKind val
+
+{- |
+Convert a function @f@ of type @t1->t2->...-> IO r@ to
+@Value t1 -> Value t2 -> ... CodeGenFunction r ()@.
+-}
+class IsFunction f => FunctionArgs f where
+    type FunctionCodeGen f :: *
+    type FunctionResult  f :: *
+    paramFunc ::
+        FFI.ValueRef -> LP.Proxy f -> FunctionCodeGen f ->
+        Int -> CodeGenFunction (FunctionResult f) ()
+
+instance (FunctionArgs b, IsFirstClass a) => FunctionArgs (a -> b) where
+    type FunctionCodeGen (a -> b) = Value a -> FunctionCodeGen b
+    type FunctionResult  (a -> b) = FunctionResult b
+    paramFunc f proxy g n =
+        paramFunc f (proxy<*>LP.Proxy) (g $ Value $ U.getParam f n) (n+1)
+
+instance IsFirstClass a => FunctionArgs (IO a) where
+    type FunctionCodeGen (IO a) = CodeGenFunction a ()
+    type FunctionResult (IO a) = a
+    paramFunc _ LP.Proxy code = const code
+
+
+type family UnaryParameter f i
+type instance UnaryParameter (a -> b) Un.Zero = a
+type instance UnaryParameter (a -> b) (Un.Succ i) = UnaryParameter b i
+
+type FunctionParameter f i = UnaryParameter f (Dec.ToUnary i)
+
+{- |
+Preferably you use the parameter values provided by
+'createFunction' or 'defineFunction',
+but sometimes you need to access a parameter
+after 'newFunction' and before 'defineFunction'.
+In this case you can obtain a function parameter using this accessor.
+-}
+functionParameter ::
+    (Dec.Natural i) => Function f -> Proxy i -> Value (FunctionParameter f i)
+functionParameter (Value f) n =
+    Value $ U.getParam f $ Dec.integralFromProxy n
+
+
+type family UnValue a
+type instance UnValue (Value a) = a
+
+type family CodeValue code
+type instance CodeValue (CodeGenFunction r a) = a
+type instance CodeValue (a -> b) = CodeValue b
+
+type family CodeResult code
+type instance CodeResult (CodeGenFunction r a) = r
+type instance CodeResult (a -> b) = CodeResult b
+
+
+--------------------------------------
+
+-- |A basic block is a sequence of non-branching instructions, terminated by a control flow instruction.
+newtype BasicBlock = BasicBlock FFI.BasicBlockRef
+    deriving (Show, Typeable)
+
+createBasicBlock :: CodeGenFunction r BasicBlock
+createBasicBlock = do
+    b <- newBasicBlock
+    defineBasicBlock b
+    return b
+
+newBasicBlock :: CodeGenFunction r BasicBlock
+newBasicBlock = genFSym >>= newNamedBasicBlock
+
+newNamedBasicBlock :: String -> CodeGenFunction r BasicBlock
+newNamedBasicBlock name = do
+    fn <- getFunction
+    liftIO $ liftM BasicBlock $ U.appendBasicBlock fn name
+
+defineBasicBlock :: BasicBlock -> CodeGenFunction r ()
+defineBasicBlock (BasicBlock l) = do
+    bld <- getBuilder
+    liftIO $ U.positionAtEnd bld l
+
+getCurrentBasicBlock :: CodeGenFunction r BasicBlock
+getCurrentBasicBlock = do
+    bld <- getBuilder
+    liftIO $ liftM BasicBlock $ U.getInsertBlock bld
+
+toLabel :: BasicBlock -> Value Label
+toLabel (BasicBlock ptr) =
+    Value (unsafePerformIO $ FFI.basicBlockAsValue ptr)
+
+fromLabel :: Value Label -> BasicBlock
+fromLabel (Value ptr) =
+    BasicBlock (unsafePerformIO $ FFI.valueAsBasicBlock ptr)
+
+--------------------------------------
+
+--- XXX: the functions in this section (and addGlobalMapping) don't actually use any
+-- Function state so should really be in the CodeGenModule monad
+
+{- |
+Create a reference to an external function while code generating for a function.
+Functions are not redefined, that is,
+all functions with the same name must have the same type.
+If LLVM cannot resolve the function name, then you may try 'staticFunction'.
+-}
+externFunction :: forall a r.
+    (IsFunction a) => String -> CodeGenFunction r (Function a)
+externFunction name =
+    externCore name $
+        fmap (unValue :: Function a -> FFI.ValueRef) .
+        newNamedFunction ExternalLinkage
+
+-- | As 'externFunction', but for 'Global's rather than 'Function's
+externGlobal :: forall a r . (IsType a) => Bool -> String -> CodeGenFunction r (Global a)
+externGlobal isConst name =
+    externCore name $
+        fmap (unValue :: Global a -> FFI.ValueRef) .
+        newNamedGlobal isConst ExternalLinkage
+
+externCore ::
+    String -> (String -> CodeGenModule FFI.ValueRef) ->
+    CodeGenFunction r (Value ptr)
+externCore name act = do
+    es <- getExterns
+    case lookup name es of
+        Just f -> return $ Value f
+        Nothing -> do
+            f <- liftCodeGenModule $ act name
+            putExterns ((name, f) : es)
+            return $ Value f
+
+{- |
+Make an external C function with a fixed address callable from LLVM code.
+This callback function can also be a Haskell function,
+that was imported like
+
+> foreign import ccall "&nextElement"
+>    nextElementFunPtr :: FunPtr (StablePtr (IORef [Word32]) -> IO Word32)
+
+See @examples\/List.hs@.
+
+When you only use 'externFunction', then LLVM cannot resolve the name.
+(However, I do not know why.)
+Thus 'staticFunction' manages a list of static functions.
+This list is automatically installed by 'ExecutionEngine.simpleFunction'
+and can be manually obtained by 'getGlobalMappings'
+and installed by 'ExecutionEngine.addGlobalMappings'.
+\"Installing\" means calling LLVM's @addGlobalMapping@ according to
+<http://old.nabble.com/jit-with-external-functions-td7769793.html>.
+-}
+staticFunction :: forall f r.
+    (IsFunction f) => FunPtr f -> CodeGenFunction r (Function f)
+staticFunction = staticNamedFunction ""
+
+{- |
+Due to <https://llvm.org/bugs/show_bug.cgi?id=20656>
+this will fail with MCJIT of LLVM-3.6.
+-}
+staticNamedFunction :: forall f r.
+    (IsFunction f) => String -> FunPtr f -> CodeGenFunction r (Function f)
+staticNamedFunction name func = liftCodeGenModule $ do
+    val <- newNamedFunction ExternalLinkage name
+    addFunctionMapping (unValue (val :: Function f)) func
+    return val
+
+-- | As 'staticFunction', but for 'Global's rather than 'Function's
+staticGlobal :: forall a r.
+    (IsType a) => Bool -> Data.Ptr a -> CodeGenFunction r (Global a)
+staticGlobal isConst gbl = liftCodeGenModule $ do
+    val <- newNamedGlobal isConst ExternalLinkage ""
+    addGlobalMapping (unValue (val :: Global a)) gbl
+    return val
+
+--------------------------------------
+
+withCurrentBuilder :: (FFI.BuilderRef -> IO a) -> CodeGenFunction r a
+withCurrentBuilder body = do
+    bld <- getBuilder
+    liftIO $ U.withBuilder bld body
+
+--------------------------------------
+
+-- Mark all block terminating instructions.  Not used yet.
+--data Terminate = Terminate
+
+--------------------------------------
+
+type Global a = Value (Data.Ptr a)
+
+-- | Create a new named global variable.
+newNamedGlobal :: forall a . (IsType a)
+               => Bool         -- ^Constant?
+               -> Linkage      -- ^Visibility
+               -> String       -- ^Name
+               -> TGlobal a
+newNamedGlobal isConst linkage name = do
+    modul <- getModule
+    typ <- liftIO $ typeRef (LP.Proxy :: LP.Proxy a)
+    liftIO $ liftM Value $ do
+        g <- U.addGlobal modul linkage name typ
+        when isConst $ FFI.setGlobalConstant g FFI.true
+        return g
+
+-- | Create a new global variable.
+newGlobal :: forall a . (IsType a) => Bool -> Linkage -> TGlobal a
+newGlobal isConst linkage = genMSym "glb" >>= newNamedGlobal isConst linkage
+
+-- | Give a global variable a (constant) value.
+defineGlobal :: Global a -> ConstValue a -> CodeGenModule ()
+defineGlobal (Value g) (ConstValue v) =
+    liftIO $ FFI.setInitializer g v
+
+-- | Create and define a global variable.
+createGlobal :: (IsType a) => Bool -> Linkage -> ConstValue a -> TGlobal a
+createGlobal isConst linkage con = do
+    g <- newGlobal isConst linkage
+    defineGlobal g con
+    return g
+
+-- | Create and define a named global variable.
+createNamedGlobal :: (IsType a) => Bool -> Linkage -> String -> ConstValue a -> TGlobal a
+createNamedGlobal isConst linkage name con = do
+    g <- newNamedGlobal isConst linkage name
+    defineGlobal g con
+    return g
+
+type TFunction a = CodeGenModule (Function a)
+type TGlobal a = CodeGenModule (Global a)
+
+-- Special string creators
+{-# DEPRECATED createString "use withString instead" #-}
+createString :: String -> TGlobal (Array n Word8)
+createString s = string (length s) (U.constString s)
+
+{-# DEPRECATED createStringNul "use withStringNul instead" #-}
+createStringNul :: String -> TGlobal (Array n Word8)
+createStringNul s = string (length s + 1) (U.constStringNul s)
+
+withString ::
+    String ->
+    (forall n. (Dec.Natural n) => Global (Array n Word8) -> CodeGenModule a) ->
+    CodeGenModule a
+withString s act =
+    let n = length s
+    in  fromMaybe (error "withString: length must always be non-negative") $
+        Dec.reifyNatural (fromIntegral n) (\tn -> do
+            arr <- string n (U.constString s)
+            act (fixArraySize tn arr))
+
+withStringNul ::
+    String ->
+    (forall n. (Dec.Natural n) => Global (Array n Word8) -> CodeGenModule a) ->
+    CodeGenModule a
+withStringNul s act =
+    let n = length s + 1
+    in  fromMaybe (error "withStringNul: length must always be non-negative") $
+        Dec.reifyNatural (fromIntegral n) (\tn -> do
+            arr <- string n (U.constStringNul s)
+            act (fixArraySize tn arr))
+
+fixArraySize :: Proxy n -> Global (Array n a) -> Global (Array n a)
+fixArraySize _ = id
+
+string :: Int -> FFI.ValueRef -> TGlobal (Array n Word8)
+string n s = do
+    modul <- getModule
+    name <- genMSym "str"
+    elemTyp <- liftIO $ typeRef (LP.Proxy :: LP.Proxy Word8)
+    typ <- liftIO $ FFI.arrayType elemTyp (fromIntegral n)
+    liftIO $ liftM Value $ do g <- U.addGlobal modul InternalLinkage name typ
+                              FFI.setGlobalConstant g FFI.true
+                              FFI.setInitializer g s
+                              return g
+
+--------------------------------------
+
+-- |Make a constant vector.
+constVector ::
+    forall a n u.
+    (Dec.Positive n, Dec.ToUnary n ~ u,
+     UnaryVector.Length (FixedList u) ~ u) =>
+    UnaryVector.FixedList u (ConstValue a) ->
+    ConstValue (Vector n a)
+constVector =
+    constVectorGen id
+
+constVectorGen ::
+    forall a b n u.
+    (Dec.Positive n, Dec.ToUnary n ~ u) =>
+    (b -> ConstValue a) ->
+    UnaryVector.FixedList u b ->
+    ConstValue (Vector n a)
+constVectorGen f xs =
+    unsafeConstValue $
+    U.constVector
+        (case DecProof.unaryNat :: DecProof.UnaryNat n of
+             DecProof.UnaryNat ->
+                 map (unConstValue . f) $
+                 Fold.toList
+                     (UnaryVector.fromFixedList xs :: UnaryVector.T u b))
+
+{- |
+Make a constant vector.
+Replicates or truncates the list to get length @n@.
+-}
+constCyclicVector ::
+    forall a n.
+    (Dec.Positive n) =>
+    NonEmpty.T [] (ConstValue a) ->
+    ConstValue (Vector n a)
+constCyclicVector xs =
+    unsafeConstValue $
+    U.constVector
+        (take (Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n)) $
+         map unConstValue $ NonEmpty.flatten $ NonEmpty.cycle xs)
+
+
+constArray ::
+    forall a n . (IsSized a, Dec.Natural n) =>
+    [ConstValue a] -> ConstValue (Array n a)
+constArray xs = unsafeConstValue $ do
+    let m = length xs
+        n = Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n)
+    when (m /= n) $
+        error $
+            printf "LLVM.constArray: number of array elements (%d) mismatches typed array length (%d)"
+                m n
+    typ <- typeRef (LP.Proxy :: LP.Proxy a)
+    U.constArray typ $ map unConstValue xs
+
+{- |
+Make a constant array.
+Replicates or truncates the list to get length @n@.
+-}
+constCyclicArray ::
+    forall a n.
+    (IsSized a, Dec.Natural n) =>
+    NonEmpty.T [] (ConstValue a) ->
+    ConstValue (Vector n a)
+constCyclicArray xs = unsafeConstValue $ do
+    typ <- typeRef (LP.Proxy :: LP.Proxy a)
+    U.constArray typ
+        (take (Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n)) $
+         map unConstValue $ NonEmpty.flatten $ NonEmpty.cycle xs)
+
+-- |Make a constant struct.
+constStruct ::
+    (IsConstStruct c) => c -> ConstValue (Struct (ConstStructOf c))
+constStruct struct =
+    unsafeConstValue $ U.constStruct (constValueFieldsOf struct) False
+
+-- |Make a constant packed struct.
+constPackedStruct ::
+    (IsConstStruct c) => c -> ConstValue (PackedStruct (ConstStructOf c))
+constPackedStruct struct =
+    unsafeConstValue $ U.constStruct (constValueFieldsOf struct) True
+
+class IsConstStruct c where
+    type ConstStructOf c :: *
+    constValueFieldsOf :: c -> [FFI.ValueRef]
+
+instance (IsConst a, IsConstStruct cs) => IsConstStruct (ConstValue a, cs) where
+    type ConstStructOf (ConstValue a, cs) = (a, ConstStructOf cs)
+    constValueFieldsOf (a, as) = unConstValue a : constValueFieldsOf as
+instance IsConstStruct () where
+    type ConstStructOf () = ()
+    constValueFieldsOf _ = []
diff --git a/private/LLVM/Core/CodeGenMonad.hs b/private/LLVM/Core/CodeGenMonad.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/Core/CodeGenMonad.hs
@@ -0,0 +1,181 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+module LLVM.Core.CodeGenMonad(
+    -- * Module code generation
+    CodeGenModule, runCodeGenModule, genMSym, getModule,
+    GlobalMappings(..), addGlobalMapping, getGlobalMappings,
+    addFunctionMapping,
+    -- * Function code generation
+    CodeGenFunction, runCodeGenFunction, liftCodeGenModule, genFSym, getFunction, getBuilder, getFunctionModule, getExterns, putExterns,
+    ) where
+
+import qualified LLVM.Core.Data as Data
+import qualified LLVM.Core.Type as Type
+import LLVM.Core.Util (Module, Builder, Function, getValueNameU, withModule, )
+
+import qualified LLVM.FFI.Core as FFI
+import qualified LLVM.FFI.ExecutionEngine as EE
+
+import Foreign.C.String (withCString, )
+import Foreign.Ptr (FunPtr, nullPtr, )
+
+import Control.Monad.Trans.State (StateT, runStateT, evalStateT, get, gets, put, modify, )
+import Control.Monad.IO.Class (MonadIO, liftIO, )
+import Control.Monad (when, )
+import Control.Applicative (Applicative, )
+import Data.Monoid (Monoid, mempty, mappend, )
+import Data.Semigroup (Semigroup, (<>), )
+
+import Data.Typeable (Typeable)
+
+--------------------------------------
+
+data CGMState = CGMState {
+    cgm_module :: Module,
+    cgm_externs :: [(String, Function)],
+    cgm_global_mappings :: GlobalMappings,
+    cgm_next :: !Int
+    }
+    deriving (Show, Typeable)
+newtype CodeGenModule a = CGM (StateT CGMState IO a)
+    deriving (Functor, Applicative, Monad, MonadIO, Typeable)
+
+genMSym :: String -> CodeGenModule String
+genMSym prefix = do
+    s <- CGM get
+    let n = cgm_next s
+    CGM $ put (s { cgm_next = n + 1 })
+    return $ "_" ++ prefix ++ show n
+
+getModule :: CodeGenModule Module
+getModule = CGM $ gets cgm_module
+
+runCodeGenModule :: Module -> CodeGenModule a -> IO a
+runCodeGenModule m (CGM body) =
+    evalStateT body $
+    CGMState {
+        cgm_module = m, cgm_next = 1,
+        cgm_externs = [], cgm_global_mappings = mempty
+    }
+
+--------------------------------------
+
+data CGFState r = CGFState {
+    cgf_module :: CGMState,
+    cgf_builder :: Builder,
+    cgf_function :: Function,
+    cgf_next :: !Int
+    }
+    deriving (Show, Typeable)
+newtype CodeGenFunction r a = CGF (StateT (CGFState r) IO a)
+    deriving (Functor, Applicative, Monad, MonadIO, Typeable)
+
+genFSym :: CodeGenFunction a String
+genFSym = do
+    s <- CGF get
+    let n = cgf_next s
+    CGF $ put (s { cgf_next = n + 1 })
+    return $ "_L" ++ show n
+
+getFunction :: CodeGenFunction a Function
+getFunction = CGF $ gets cgf_function
+
+getBuilder :: CodeGenFunction a Builder
+getBuilder = CGF $ gets cgf_builder
+
+getFunctionModule :: CodeGenFunction a Module
+getFunctionModule = CGF $ gets (cgm_module . cgf_module)
+
+getExterns :: CodeGenFunction a [(String, Function)]
+getExterns = CGF $ gets (cgm_externs . cgf_module)
+
+putExterns :: [(String, Function)] -> CodeGenFunction a ()
+putExterns es = do
+    cgf <- CGF get
+    let cgm' = (cgf_module cgf) { cgm_externs = es }
+    CGF $ put (cgf { cgf_module = cgm' })
+
+
+type Value = FFI.ValueRef
+
+addGlobalMapping :: (Type.IsType a) => Value -> Data.Ptr a -> CodeGenModule ()
+addGlobalMapping value ptr = CGM $
+    addMappingToState $
+        GlobalMappings (\ee ->
+            EE.addGlobalMapping ee value $ Data.uncheckedToPtr ptr)
+
+addFunctionMapping :: Function -> FunPtr f -> CodeGenModule ()
+addFunctionMapping value func = CGM $ do
+    {-
+    We need to fetch the name from the value
+    since it might have been disambiguized after adding.
+    -}
+    name <- liftIO $ getValueNameU value
+    modul <- gets cgm_module
+    addMappingToState $
+        GlobalMappings $ \ee -> do
+            {-
+            Between adding and application
+            the program may have been restructured by optimization passes.
+            I have not seen that the optimizer alters a Function Value pointer,
+            but the optimizer can remove an unused function.
+            That would render the original value invalid.
+            -}
+            currentValue <-
+                liftIO $
+                    withCString name $ \cname ->
+                    withModule modul $ \cmodule ->
+                        FFI.getNamedFunction cmodule cname
+            -- the optimizer could have removed the function
+            when (currentValue/=nullPtr) $
+                EE.addFunctionMapping ee currentValue func
+
+addMappingToState :: GlobalMappings -> StateT CGMState IO ()
+addMappingToState gm =
+    modify $ \cgm ->
+        cgm { cgm_global_mappings = cgm_global_mappings cgm <> gm }
+
+newtype GlobalMappings =
+    GlobalMappings (EE.ExecutionEngineRef -> IO ())
+
+instance Show GlobalMappings where
+    show _ = "GlobalMappings"
+
+instance Semigroup GlobalMappings where
+    GlobalMappings x <> GlobalMappings y =
+        GlobalMappings (\ee -> x ee >> y ee)
+
+instance Monoid GlobalMappings where
+    mempty = GlobalMappings $ const $ return ()
+    mappend = (<>)
+
+
+{- |
+Get a list created by calls to 'staticFunction'
+that must be passed to the execution engine
+via 'LLVM.ExecutionEngine.addGlobalMappings'.
+-}
+getGlobalMappings :: CodeGenModule GlobalMappings
+getGlobalMappings = CGM $ gets cgm_global_mappings
+
+runCodeGenFunction ::
+    Builder -> Function -> CodeGenFunction r a -> CodeGenModule a
+runCodeGenFunction bld fn (CGF body) = do
+    cgm <- CGM get
+    let cgf = CGFState { cgf_module = cgm,
+                         cgf_builder = bld,
+                         cgf_function = fn,
+                         cgf_next = 1 }
+    (a, cgf') <- liftIO $ runStateT body cgf
+    CGM $ put (cgf_module cgf')
+    return a
+
+--------------------------------------
+
+-- | Allows you to define part of a module while in the middle of defining a function.
+liftCodeGenModule :: CodeGenModule a -> CodeGenFunction r a
+liftCodeGenModule (CGM act) = do
+    cgf <- CGF get
+    (a, cgm') <- liftIO $ runStateT act (cgf_module cgf)
+    CGF $ put (cgf { cgf_module = cgm' })
+    return a
diff --git a/private/LLVM/Core/Data.hs b/private/LLVM/Core/Data.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/Core/Data.hs
@@ -0,0 +1,134 @@
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module LLVM.Core.Data (
+    Ptr(..), uncheckedFromPtr, uncheckedToPtr,
+    IntN(..), WordN(..), FP128(..),
+    Array(..), Vector(..), Label, Struct(..), PackedStruct(..),
+    FixedList,
+    ) where
+
+import qualified LLVM.Core.UnaryVector as UnaryVector
+import LLVM.Core.UnaryVector (FixedList)
+
+import qualified Type.Data.Num.Decimal.Proof as DecProof
+import qualified Type.Data.Num.Decimal.Number as Dec
+import Type.Base.Proxy (Proxy(Proxy))
+
+import qualified Foreign
+
+import qualified Data.Foldable as Fold
+import qualified Data.Bits as Bits
+
+import Data.Typeable (Typeable)
+
+import qualified Test.QuickCheck as QC
+
+
+{- |
+We export the constructor such that you can use 'Ptr' in foreign imports.
+However, we recommend that you call 'uncheckedFromPtr' instead.
+-}
+newtype Ptr a = Ptr (Foreign.Ptr a)
+    deriving (Show, Eq, Ord, Typeable)
+
+uncheckedFromPtr :: Foreign.Ptr a -> Ptr a
+uncheckedFromPtr = Ptr
+
+uncheckedToPtr :: Ptr a -> Foreign.Ptr a
+uncheckedToPtr (Ptr ptr) = ptr
+
+instance Foreign.Storable (Ptr a) where
+    sizeOf = Foreign.sizeOf . uncheckedToPtr
+    alignment = Foreign.alignment . uncheckedToPtr
+    poke p = Foreign.pokeByteOff p 0 . uncheckedToPtr
+    peek p = fmap uncheckedFromPtr $ Foreign.peekByteOff p 0
+
+
+-- TODO:
+-- Make instances IntN, WordN to actually do the right thing.
+-- Make FP128 do the right thing
+-- Make Array functions.
+
+-- |Variable sized signed integer.
+-- The /n/ parameter should belong to @PosI@.
+newtype IntN n = IntN Integer
+    deriving (Show, Eq, Ord, Typeable)
+
+instance (Dec.Positive n) => QC.Arbitrary (IntN n) where
+    arbitrary = arbitraryInt IntN (\(IntN a) -> a)
+
+instance (Dec.Positive n) => Bounded (IntN n) where
+    minBound =
+        withBitSize $
+        IntN . negate . Bits.shiftL 1 . subtract 1 . Dec.integralFromProxy
+    maxBound =
+        withBitSize $
+        IntN . subtract 1 . Bits.shiftL 1 . subtract 1 . Dec.integralFromProxy
+
+-- |Variable sized unsigned integer.
+-- The /n/ parameter should belong to @PosI@.
+newtype WordN n = WordN Integer
+    deriving (Show, Eq, Ord, Typeable)
+
+instance (Dec.Positive n) => QC.Arbitrary (WordN n) where
+    arbitrary = arbitraryInt WordN (\(WordN a) -> a)
+
+instance (Dec.Positive n) => Bounded (WordN n) where
+    minBound = WordN 0
+    maxBound =
+        withBitSize $ WordN . subtract 1 . Bits.shiftL 1 . Dec.integralFromProxy
+
+arbitraryInt :: (Bounded a) => (Integer -> a) -> (a -> Integer) -> QC.Gen a
+arbitraryInt wrap unwrap =
+    case (minBound, maxBound) of
+        (a,b) -> do
+            x <- QC.choose (unwrap a, unwrap b)
+            return $ wrap x `asTypeOf` a `asTypeOf` b
+
+withBitSize :: (Proxy n -> f n) -> f n
+withBitSize f = f Proxy
+
+-- |128 bit floating point.
+newtype FP128 = FP128 Rational
+    deriving (Show, Typeable)
+
+
+-- |Fixed sized arrays, the array size is encoded in the /n/ parameter.
+newtype Array n a = Array [a]
+    deriving (Eq, Show, Typeable)
+
+instance (Dec.Integer n) => Fold.Foldable (Array n) where
+    foldMap f (Array xs) = Fold.foldMap f xs
+
+instance (Dec.Integer n, QC.Arbitrary a) => QC.Arbitrary (Array n a) where
+    arbitrary = withArraySize $ fmap Array . QC.vector . Dec.integralFromProxy
+
+withArraySize :: (Proxy n -> gen (Array n a)) -> gen (Array n a)
+withArraySize f = f Proxy
+
+-- |Fixed sized vector, the array size is encoded in the /n/ parameter.
+newtype Vector n a = Vector (FixedList (Dec.ToUnary n) a)
+
+instance (Dec.Natural n, Show a) => Show (Vector n a) where
+    showsPrec p (Vector xs) =
+        case DecProof.unaryNat :: DecProof.UnaryNat n of
+            DecProof.UnaryNat ->
+                showParen (p>10) $
+                    showString "Vector " .
+                    showList (Fold.toList
+                        (UnaryVector.fromFixedList xs
+                            :: UnaryVector.T (Dec.ToUnary n) a))
+
+-- |Label type, produced by a basic block.
+data Label
+    deriving (Typeable)
+
+-- |Struct types; a list (nested tuple) of component types.
+newtype Struct a = Struct a
+    deriving (Eq, Show, Typeable)
+newtype PackedStruct a = PackedStruct a
+    deriving (Eq, Show, Typeable)
+
+instance (QC.Arbitrary a) => QC.Arbitrary (Struct a) where
+    arbitrary = fmap Struct QC.arbitrary
diff --git a/private/LLVM/Core/Instructions.hs b/private/LLVM/Core/Instructions.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/Core/Instructions.hs
@@ -0,0 +1,1257 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+module LLVM.Core.Instructions(
+    -- * ADT representation of IR
+    BinOpDesc(..), InstrDesc(..), ArgDesc(..), getInstrDesc,
+    -- * Terminator instructions
+    ret,
+    condBr,
+    br,
+    switch,
+    invoke, invokeWithConv,
+    invokeFromFunction, invokeWithConvFromFunction,
+    unreachable,
+    -- * Arithmetic binary operations
+    -- | Arithmetic operations with the normal semantics.
+    -- The u instructions are unsigned, the s instructions are signed.
+    add, sub, mul, neg,
+    iadd, isub, imul, ineg,
+    iaddNoWrap, isubNoWrap, imulNoWrap, inegNoWrap,
+    fadd, fsub, fmul, fneg,
+    idiv, irem,
+    udiv, sdiv, fdiv, urem, srem, frem,
+    -- * Logical binary operations
+    -- |Logical instructions with the normal semantics.
+    shl, shr, lshr, ashr, and, or, xor, inv,
+    -- * Vector operations
+    extractelement,
+    insertelement,
+    shufflevector,
+    -- * Aggregate operation
+    extractvalue,
+    insertvalue,
+    -- * Memory access
+    malloc, arrayMalloc,
+    alloca, arrayAlloca,
+    free,
+    load,
+    store,
+    getElementPtr, getElementPtr0,
+    -- * Conversions
+    ValueCons,
+    trunc, zext, sext, ext, zadapt, sadapt, adapt,
+    fptrunc, fpext,
+    fptoui, fptosi, fptoint,
+    uitofp, sitofp, inttofp,
+    ptrtoint, inttoptr,
+    bitcast,
+    -- * Comparison
+    CmpPredicate(..), IntPredicate(..), FPPredicate(..),
+    CmpRet, CmpResult, CmpValueResult,
+    cmp, pcmp, icmp, fcmp,
+    select,
+    -- * Fast math
+    setHasNoNaNs,
+    setHasNoInfs,
+    setHasNoSignedZeros,
+    setHasAllowReciprocal,
+    setFastMath,
+    -- * Other
+    phi, addPhiInputs,
+    call, callWithConv,
+    callFromFunction, callWithConvFromFunction,
+    Call, applyCall, runCall,
+
+    -- * Classes and types
+    ValueCons2, BinOpValue,
+    Terminate, Ret, Result, CallArgs,
+    CodeGen.FunctionArgs, CodeGen.FunctionCodeGen, CodeGen.FunctionResult,
+    AllocArg,
+    GetElementPtr, ElementPtrType, IsIndexArg, IsIndexType,
+    GetValue, ValueType,
+    GetField, FieldType,
+    ) where
+
+import qualified LLVM.Core.Util as U
+import qualified LLVM.Core.Proxy as LP
+import qualified LLVM.Core.CodeGen as CodeGen
+import LLVM.Core.Instructions.Private
+            (ValueCons, unValue, convert, unop,
+             FFIBinOp, FFIConstBinOp,
+             GetField, FieldType, GetElementPtr, ElementPtrType,
+             IsIndexArg, IsIndexType, getIxList, getArg,
+             CmpPredicate(..),
+             uintFromCmpPredicate, sintFromCmpPredicate, fpFromCmpPredicate)
+import LLVM.Core.Data
+import LLVM.Core.Type
+import LLVM.Core.CodeGenMonad
+import LLVM.Core.CodeGen
+            (BasicBlock(BasicBlock), Function, withCurrentBuilder,
+             ConstValue(ConstValue), zero,
+             Value(Value), value, valueOf, UnValue, CodeResult)
+
+import qualified LLVM.FFI.Core as FFI
+import LLVM.FFI.Core (IntPredicate(..), FPPredicate(..))
+
+import qualified Type.Data.Num.Decimal.Number as Dec
+import Type.Data.Num.Decimal.Literal (d1)
+import Type.Data.Num.Decimal.Number ((:<:), (:>:))
+import Type.Base.Proxy (Proxy)
+
+import qualified Foreign
+import Foreign.Ptr (FunPtr)
+import Foreign.C (CUInt, CInt)
+
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad (liftM)
+
+import qualified Data.Map as Map
+import Data.Map (Map)
+import Data.Int (Int8, Int16, Int32, Int64)
+import Data.Word (Word8, Word16, Word32, Word64, Word)
+
+import Prelude hiding (and, or)
+
+
+-- TODO:
+-- Add vector version of arithmetic
+-- Add rest of instructions
+-- Use Terminate to ensure bb termination (how?)
+-- more intrinsics are needed to, e.g., create an empty vector
+
+data ArgDesc = AV String | AI Int | AL String | AE
+
+instance Show ArgDesc where
+    -- show (AV s) = "V_" ++ s
+    -- show (AI i) = "I_" ++ show i
+    -- show (AL l) = "L_" ++ l
+    show (AV s) = s
+    show (AI i) = show i
+    show (AL l) = l
+    show AE = "voidarg?"
+
+data BinOpDesc = BOAdd | BOAddNuw | BOAddNsw | BOAddNuwNsw | BOFAdd
+               | BOSub | BOSubNuw | BOSubNsw | BOSubNuwNsw | BOFSub
+               | BOMul | BOMulNuw | BOMulNsw | BOMulNuwNsw | BOFMul
+               | BOUDiv | BOSDiv | BOSDivExact | BOFDiv | BOURem | BOSRem | BOFRem
+               | BOShL | BOLShR | BOAShR | BOAnd | BOOr | BOXor
+    deriving Show
+
+-- FIXME: complete definitions for unimplemented instructions
+data InstrDesc =
+    -- terminators
+    IDRet TypeDesc ArgDesc | IDRetVoid
+  | IDBrCond ArgDesc ArgDesc ArgDesc | IDBrUncond ArgDesc
+  | IDSwitch [(ArgDesc, ArgDesc)]
+  | IDIndirectBr
+  | IDInvoke
+  | IDUnwind
+  | IDUnreachable
+    -- binary operators (including bitwise)
+  | IDBinOp BinOpDesc TypeDesc ArgDesc ArgDesc
+    -- memory access and addressing
+  | IDAlloca TypeDesc Int Int | IDLoad TypeDesc ArgDesc | IDStore TypeDesc ArgDesc ArgDesc
+  | IDGetElementPtr TypeDesc [ArgDesc]
+    -- conversion
+  | IDTrunc TypeDesc TypeDesc ArgDesc | IDZExt TypeDesc TypeDesc ArgDesc
+  | IDSExt TypeDesc TypeDesc ArgDesc | IDFPtoUI TypeDesc TypeDesc ArgDesc
+  | IDFPtoSI TypeDesc TypeDesc ArgDesc | IDUItoFP TypeDesc TypeDesc ArgDesc
+  | IDSItoFP TypeDesc TypeDesc ArgDesc
+  | IDFPTrunc TypeDesc TypeDesc ArgDesc | IDFPExt TypeDesc TypeDesc ArgDesc
+  | IDPtrToInt TypeDesc TypeDesc ArgDesc | IDIntToPtr TypeDesc TypeDesc ArgDesc
+  | IDBitcast TypeDesc TypeDesc ArgDesc
+    -- other
+  | IDICmp IntPredicate ArgDesc ArgDesc | IDFCmp FPPredicate ArgDesc ArgDesc
+  | IDPhi TypeDesc [(ArgDesc, ArgDesc)] | IDCall TypeDesc ArgDesc [ArgDesc]
+  | IDSelect TypeDesc ArgDesc ArgDesc | IDUserOp1 | IDUserOp2 | IDVAArg
+    -- vector operators
+  | IDExtractElement | IDInsertElement | IDShuffleVector
+    -- aggregate operators
+  | IDExtractValue | IDInsertValue
+    -- invalid
+  | IDInvalidOp
+    deriving Show
+
+-- TODO: overflow support for binary operations (add/sub/mul)
+getInstrDesc :: FFI.ValueRef -> IO (String, InstrDesc)
+getInstrDesc v = do
+    valueName <- U.getValueNameU v
+    opcode <- FFI.instGetOpcode v
+    t <- FFI.typeOf v >>= typeDesc2
+    -- FIXME: sizeof() does not work for types!
+    --tsize <- FFI.typeOf v -- >>= FFI.sizeOf -- >>= FFI.constIntGetZExtValue >>= return . fromIntegral
+    tsize <- return 1
+    ovs <- U.getOperands v
+    os <- mapM getArgDesc ovs
+    os0 <- return $ case os of {o:_   -> o; _ -> AE}
+    os1 <- return $ case os of {_:o:_ -> o; _ -> AE}
+    instr <-
+        case Map.lookup opcode binOpMap of -- binary arithmetic
+          Just op -> return $ IDBinOp op t os0 os1
+          Nothing ->
+            case Map.lookup opcode convOpMap of
+              Just op -> do
+                t2 <-
+                    case ovs of
+                        (_name,ov):_ -> FFI.typeOf ov >>= typeDesc2
+                        _ -> return TDVoid
+                return $ op t2 t os0
+              Nothing ->
+                case opcode of
+                  1 -> return $ if null os then IDRetVoid else IDRet t os0
+                  2 -> return $ if length os == 1 then IDBrUncond os0 else IDBrCond os0 (os !! 2) os1
+                  3 -> return $ IDSwitch $ toPairs os
+                  -- TODO (can skip for now)
+                  -- 4 -> return IndirectBr ; 5 -> return Invoke
+                  6 -> return IDUnwind; 7 -> return IDUnreachable
+                  26 -> return $ IDAlloca (getPtrType t) tsize (getImmInt os0)
+                  27 -> return $ IDLoad t os0; 28 -> return $ IDStore t os0 os1
+                  29 -> return $ IDGetElementPtr t os
+                  42 -> do
+                      pInt <- FFI.cmpInstGetIntPredicate v
+                      return $ IDICmp (FFI.toIntPredicate pInt) os0 os1
+                  43 -> do
+                      pFloat <- FFI.cmpInstGetRealPredicate v
+                      return $ IDFCmp (FFI.toRealPredicate pFloat) os0 os1
+                  44 -> return $ IDPhi t $ toPairs os
+                  -- FIXME: getelementptr arguments are not handled
+                  45 -> return $ IDCall t (last os) (init os)
+                  46 -> return $ IDSelect t os0 os1
+                  -- TODO (can skip for now)
+                  -- 47 -> return UserOp1 ; 48 -> return UserOp2 ; 49 -> return VAArg
+                  -- 50 -> return ExtractElement ; 51 -> return InsertElement ; 52 -> return ShuffleVector
+                  -- 53 -> return ExtractValue ; 54 -> return InsertValue
+                  _ -> return IDInvalidOp
+    return (valueName, instr)
+    --if instr /= InvalidOp then return instr else fail $ "Invalid opcode: " ++ show opcode
+        where toPairs xs = zip (stride 2 xs) (stride 2 (drop 1 xs))
+              stride _ [] = []
+              stride n (x:xs) = x : stride n (drop (n-1) xs)
+              getPtrType (TDPtr t) = t
+              getPtrType _ = TDVoid
+              getImmInt (AI i) = i
+              getImmInt _ = 0
+
+binOpMap :: Map CInt BinOpDesc
+binOpMap =
+    Map.fromList
+        [(8, BOAdd), (9, BOFAdd), (10, BOSub), (11, BOFSub),
+         (12, BOMul), (13, BOFMul), (14, BOUDiv), (15, BOSDiv),
+         (16, BOFDiv), (17, BOURem), (18, BOSRem), (19, BOFRem),
+         (20, BOShL), (21, BOLShR), (22, BOAShR), (23, BOAnd),
+         (24, BOOr), (25, BOXor)]
+
+convOpMap :: Map CInt (TypeDesc -> TypeDesc -> ArgDesc -> InstrDesc)
+convOpMap =
+    Map.fromList
+        [(30, IDTrunc), (31, IDZExt), (32, IDSExt), (33, IDFPtoUI),
+         (34, IDFPtoSI), (35, IDUItoFP), (36, IDSItoFP), (37, IDFPTrunc),
+         (38, IDFPExt), (39, IDPtrToInt), (40, IDIntToPtr), (41, IDBitcast)]
+
+-- TODO: fix for non-int constants
+getArgDesc :: (String, FFI.ValueRef) -> IO ArgDesc
+getArgDesc (vname, v) = do
+    isC <- U.isConstant v
+    t <- FFI.typeOf v >>= typeDesc2
+    if isC
+      then case t of
+             TDInt _ _ -> do
+                          cV <- FFI.constIntGetSExtValue v
+                          return $ AI $ fromIntegral cV
+             _ -> return AE
+      else case t of
+             TDLabel -> return $ AL vname
+             _ -> return $ AV vname
+
+--------------------------------------
+
+type Terminate = ()
+terminate :: Terminate
+terminate = ()
+
+--------------------------------------
+
+-- |Acceptable arguments to the 'ret' instruction.
+class Ret a where
+    type Result a
+    ret' :: a -> CodeGenFunction (Result a) Terminate
+
+-- | Return from the current function with the given value.  Use () as the return value for what would be a void function in C.
+ret :: (Ret a) => a -> CodeGenFunction (Result a) Terminate
+ret = ret'
+
+-- overlaps with Ret () ()!
+{-
+instance (IsFirstClass a, IsConst a) => Ret a a where
+    ret' = ret . valueOf
+-}
+
+instance Ret (Value a) where
+    type Result (Value a) = a
+    ret' (Value a) = do
+        withCurrentBuilder_ $ \ bldPtr -> FFI.buildRet bldPtr a
+        return terminate
+
+instance Ret () where
+    type Result () = ()
+    ret' _ = do
+        withCurrentBuilder_ $ FFI.buildRetVoid
+        return terminate
+
+withCurrentBuilder_ :: (FFI.BuilderRef -> IO a) -> CodeGenFunction r ()
+withCurrentBuilder_ p = withCurrentBuilder p >> return ()
+
+--------------------------------------
+
+-- | Branch to the first basic block if the boolean is true, otherwise to the second basic block.
+condBr :: Value Bool -- ^ Boolean to branch upon.
+       -> BasicBlock -- ^ Target for true.
+       -> BasicBlock -- ^ Target for false.
+       -> CodeGenFunction r Terminate
+condBr (Value b) (BasicBlock t1) (BasicBlock t2) = do
+    withCurrentBuilder_ $ \ bldPtr -> FFI.buildCondBr bldPtr b t1 t2
+    return terminate
+
+--------------------------------------
+
+-- | Unconditionally branch to the given basic block.
+br :: BasicBlock  -- ^ Branch target.
+   -> CodeGenFunction r Terminate
+br (BasicBlock t) = do
+    withCurrentBuilder_ $ \ bldPtr -> FFI.buildBr bldPtr t
+    return terminate
+
+--------------------------------------
+
+-- | Branch table instruction.
+switch :: (IsInteger a)
+       => Value a                        -- ^ Value to branch upon.
+       -> BasicBlock                     -- ^ Default branch target.
+       -> [(ConstValue a, BasicBlock)]   -- ^ Labels and corresponding branch targets.
+       -> CodeGenFunction r Terminate
+switch (Value val) (BasicBlock dflt) arms = do
+    withCurrentBuilder_ $ \ bldPtr -> do
+        inst <- FFI.buildSwitch bldPtr val dflt (fromIntegral $ length arms)
+        sequence_ [ FFI.addCase inst c b | (ConstValue c, BasicBlock b) <- arms ]
+    return terminate
+
+--------------------------------------
+
+-- |Inform the code generator that this code can never be reached.
+unreachable :: CodeGenFunction r Terminate
+unreachable = do
+    withCurrentBuilder_ FFI.buildUnreachable
+    return terminate
+
+--------------------------------------
+
+
+withArithmeticType ::
+    (IsArithmetic c) =>
+    (ArithmeticType c -> a -> CodeGenFunction r (v c)) ->
+    (a -> CodeGenFunction r (v c))
+withArithmeticType f = f arithmeticType
+
+
+class (ValueCons value0, ValueCons value1) => ValueCons2 value0 value1 where
+    type BinOpValue (value0 :: * -> *) (value1 :: * -> *) :: * -> *
+    binop ::
+        FFIConstBinOp -> FFIBinOp ->
+        value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 b)
+
+instance ValueCons2 Value Value where
+    type BinOpValue Value Value = Value
+    binop _ op (Value a1) (Value a2) = buildBinOp op a1 a2
+
+instance ValueCons2 Value ConstValue where
+    type BinOpValue Value ConstValue = Value
+    binop _ op (Value a1) (ConstValue a2) = buildBinOp op a1 a2
+
+instance ValueCons2 ConstValue Value where
+    type BinOpValue ConstValue Value = Value
+    binop _ op (ConstValue a1) (Value a2) = buildBinOp op a1 a2
+
+instance ValueCons2 ConstValue ConstValue where
+    type BinOpValue ConstValue ConstValue = ConstValue
+    binop cop _ (ConstValue a1) (ConstValue a2) =
+        liftIO $ fmap ConstValue $ cop a1 a2
+
+
+add, sub, mul ::
+    (ValueCons2 value0 value1, IsArithmetic a) =>
+    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
+add =
+    curry $ withArithmeticType $ \typ -> uncurry $ case typ of
+      IntegerType  -> binop FFI.constAdd  FFI.buildAdd
+      FloatingType -> binop FFI.constFAdd FFI.buildFAdd
+
+sub =
+    curry $ withArithmeticType $ \typ -> uncurry $ case typ of
+      IntegerType  -> binop FFI.constSub  FFI.buildSub
+      FloatingType -> binop FFI.constFSub FFI.buildFSub
+
+mul =
+    curry $ withArithmeticType $ \typ -> uncurry $ case typ of
+      IntegerType  -> binop FFI.constMul  FFI.buildMul
+      FloatingType -> binop FFI.constFMul FFI.buildFMul
+
+iadd, isub, imul ::
+    (ValueCons2 value0 value1, IsInteger a) =>
+    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
+iadd = binop FFI.constAdd FFI.buildAdd
+isub = binop FFI.constSub FFI.buildSub
+imul = binop FFI.constMul FFI.buildMul
+
+iaddNoWrap, isubNoWrap, imulNoWrap ::
+    (ValueCons2 value0 value1, IsInteger a) =>
+    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
+iaddNoWrap =
+    sbinop FFI.constNSWAdd FFI.buildNSWAdd FFI.constNUWAdd FFI.buildNUWAdd
+isubNoWrap =
+    sbinop FFI.constNSWSub FFI.buildNSWSub FFI.constNUWSub FFI.buildNUWSub
+imulNoWrap =
+    sbinop FFI.constNSWMul FFI.buildNSWMul FFI.constNUWMul FFI.buildNUWMul
+
+-- | signed or unsigned integer division depending on the type
+idiv ::
+    (ValueCons2 value0 value1, IsInteger a) =>
+    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
+idiv = sbinop FFI.constSDiv FFI.buildSDiv FFI.constUDiv FFI.buildUDiv
+-- | signed or unsigned remainder depending on the type
+irem ::
+    (ValueCons2 value0 value1, IsInteger a) =>
+    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
+irem = sbinop FFI.constSRem FFI.buildSRem FFI.constURem FFI.buildURem
+
+{-# DEPRECATED udiv "use idiv instead" #-}
+{-# DEPRECATED sdiv "use idiv instead" #-}
+{-# DEPRECATED urem "use irem instead" #-}
+{-# DEPRECATED srem "use irem instead" #-}
+udiv, sdiv, urem, srem ::
+    (ValueCons2 value0 value1, IsInteger a) =>
+    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
+udiv = binop FFI.constUDiv FFI.buildUDiv
+sdiv = binop FFI.constSDiv FFI.buildSDiv
+urem = binop FFI.constURem FFI.buildURem
+srem = binop FFI.constSRem FFI.buildSRem
+
+fadd, fsub, fmul ::
+    (ValueCons2 value0 value1, IsFloating a) =>
+    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
+fadd = binop FFI.constFAdd FFI.buildFAdd
+fsub = binop FFI.constFSub FFI.buildFSub
+fmul = binop FFI.constFMul FFI.buildFMul
+
+-- | Floating point division.
+fdiv ::
+    (ValueCons2 value0 value1, IsFloating a) =>
+    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
+fdiv = binop FFI.constFDiv FFI.buildFDiv
+-- | Floating point remainder.
+frem ::
+    (ValueCons2 value0 value1, IsFloating a) =>
+    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
+frem = binop FFI.constFRem FFI.buildFRem
+
+shl, lshr, ashr, and, or, xor ::
+    (ValueCons2 value0 value1, IsInteger a) =>
+    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
+shl  = binop FFI.constShl  FFI.buildShl
+lshr = binop FFI.constLShr FFI.buildLShr
+ashr = binop FFI.constAShr FFI.buildAShr
+and  = binop FFI.constAnd  FFI.buildAnd
+or   = binop FFI.constOr   FFI.buildOr
+xor  = binop FFI.constXor  FFI.buildXor
+
+shr ::
+    (ValueCons2 value0 value1, IsInteger a) =>
+    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
+shr = sbinop FFI.constAShr FFI.buildAShr FFI.constLShr FFI.buildLShr
+
+sbinop ::
+    forall value0 value1 a b r.
+    (ValueCons2 value0 value1, IsInteger a) =>
+    FFIConstBinOp -> FFIBinOp ->
+    FFIConstBinOp -> FFIBinOp ->
+    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 b)
+sbinop scop sop ucop uop =
+    if isSigned (LP.Proxy :: LP.Proxy a)
+        then binop scop sop
+        else binop ucop uop
+
+
+buildBinOp ::
+    FFIBinOp -> FFI.ValueRef -> FFI.ValueRef -> CodeGenFunction r (Value a)
+buildBinOp op a1 a2 =
+    liftM Value $
+    withCurrentBuilder $ \ bld ->
+      U.withEmptyCString $ op bld a1 a2
+
+neg ::
+    (ValueCons value, IsArithmetic a) =>
+    value a -> CodeGenFunction r (value a)
+neg =
+    withArithmeticType $ \typ -> case typ of
+      IntegerType  -> unop FFI.constNeg FFI.buildNeg
+      FloatingType -> unop FFI.constFNeg FFI.buildFNeg
+
+ineg ::
+    (ValueCons value, IsInteger a) =>
+    value a -> CodeGenFunction r (value a)
+ineg = unop FFI.constNeg FFI.buildNeg
+
+inegNoWrap ::
+    forall value a r.
+    (ValueCons value, IsInteger a) =>
+    value a -> CodeGenFunction r (value a)
+inegNoWrap =
+   if isSigned (LP.Proxy :: LP.Proxy a)
+     then unop FFI.constNSWNeg FFI.buildNSWNeg
+     else unop FFI.constNUWNeg FFI.buildNUWNeg
+
+fneg ::
+    (ValueCons value, IsFloating a) =>
+    value a -> CodeGenFunction r (value a)
+fneg = unop FFI.constFNeg FFI.buildFNeg
+
+inv ::
+    (ValueCons value, IsInteger a) =>
+    value a -> CodeGenFunction r (value a)
+inv = unop FFI.constNot FFI.buildNot
+
+--------------------------------------
+
+-- | Get a value from a vector.
+extractelement :: (Dec.Positive n, IsPrimitive a)
+               => Value (Vector n a)               -- ^ Vector
+               -> Value Word32                     -- ^ Index into the vector
+               -> CodeGenFunction r (Value a)
+extractelement (Value vec) (Value i) =
+    liftM Value $
+    withCurrentBuilder $ \ bldPtr ->
+      U.withEmptyCString $ FFI.buildExtractElement bldPtr vec i
+
+-- | Insert a value into a vector, nondestructive.
+insertelement :: (Dec.Positive n, IsPrimitive a)
+              => Value (Vector n a)                -- ^ Vector
+              -> Value a                           -- ^ Value to insert
+              -> Value Word32                      -- ^ Index into the vector
+              -> CodeGenFunction r (Value (Vector n a))
+insertelement (Value vec) (Value e) (Value i) =
+    liftM Value $
+    withCurrentBuilder $ \ bldPtr ->
+      U.withEmptyCString $ FFI.buildInsertElement bldPtr vec e i
+
+-- | Permute vector.
+shufflevector :: (Dec.Positive n, Dec.Positive m, IsPrimitive a)
+              => Value (Vector n a)
+              -> Value (Vector n a)
+              -> ConstValue (Vector m Word32)
+              -> CodeGenFunction r (Value (Vector m a))
+shufflevector (Value a) (Value b) (ConstValue mask) =
+    liftM Value $
+    withCurrentBuilder $ \ bldPtr ->
+      U.withEmptyCString $ FFI.buildShuffleVector bldPtr a b mask
+
+
+-- |Acceptable arguments to 'extractvalue' and 'insertvalue'.
+class GetValue agg ix where
+    type ValueType agg ix :: *
+    getIx :: LP.Proxy agg -> ix -> CUInt
+
+instance (GetField as i, Dec.Natural i) => GetValue (Struct as) (Proxy i) where
+    type ValueType (Struct as) (Proxy i) = FieldType as i
+    getIx _ n = Dec.integralFromProxy n
+
+instance (IsFirstClass a, Dec.Natural n) => GetValue (Array n a) Word where
+    type ValueType (Array n a) Word = a
+    getIx _ n = fromIntegral n
+
+instance (IsFirstClass a, Dec.Natural n) => GetValue (Array n a) Word32 where
+    type ValueType (Array n a) Word32 = a
+    getIx _ n = fromIntegral n
+
+instance (IsFirstClass a, Dec.Natural n) => GetValue (Array n a) Word64 where
+    type ValueType (Array n a) Word64 = a
+    getIx _ n = fromIntegral n
+
+
+instance (IsFirstClass a, Dec.Natural n, Dec.Natural i, i :<: n) => GetValue (Array n a) (Proxy i) where
+    type ValueType (Array n a) (Proxy i) = a
+    getIx _ n = Dec.integralFromProxy n
+
+
+-- | Get a value from an aggregate.
+extractvalue :: forall r agg i.
+                GetValue agg i
+             => Value agg                   -- ^ Aggregate
+             -> i                           -- ^ Index into the aggregate
+             -> CodeGenFunction r (Value (ValueType agg i))
+extractvalue (Value agg) i =
+    liftM Value $
+    withCurrentBuilder $ \ bldPtr ->
+      U.withEmptyCString $
+        FFI.buildExtractValue bldPtr agg (getIx (LP.Proxy :: LP.Proxy agg) i)
+
+-- | Insert a value into an aggregate, nondestructive.
+insertvalue :: forall r agg i.
+               GetValue agg i
+            => Value agg                   -- ^ Aggregate
+            -> Value (ValueType agg i)     -- ^ Value to insert
+            -> i                           -- ^ Index into the aggregate
+            -> CodeGenFunction r (Value agg)
+insertvalue (Value agg) (Value e) i =
+    liftM Value $
+    withCurrentBuilder $ \ bldPtr ->
+      U.withEmptyCString $
+        FFI.buildInsertValue bldPtr agg e (getIx (LP.Proxy :: LP.Proxy agg) i)
+
+
+--------------------------------------
+
+-- | Truncate a value to a shorter bit width.
+trunc :: (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :>: SizeOf b)
+      => value a -> CodeGenFunction r (value b)
+trunc = convert FFI.constTrunc FFI.buildTrunc
+
+-- | Zero extend a value to a wider width.
+-- If possible, use 'ext' that chooses the right padding according to the types
+zext :: (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)
+     => value a -> CodeGenFunction r (value b)
+zext = convert FFI.constZExt FFI.buildZExt
+
+-- | Sign extend a value to wider width.
+-- If possible, use 'ext' that chooses the right padding according to the types
+sext :: (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)
+     => value a -> CodeGenFunction r (value b)
+sext = convert FFI.constSExt FFI.buildSExt
+
+-- | Extend a value to wider width.
+-- If the target type is signed, then preserve the sign,
+-- If the target type is unsigned, then extended by zeros.
+ext :: forall value a b r. (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, Signed a ~ Signed b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)
+     => value a -> CodeGenFunction r (value b)
+ext =
+   if isSigned (LP.Proxy :: LP.Proxy b)
+     then convert FFI.constSExt FFI.buildSExt
+     else convert FFI.constZExt FFI.buildZExt
+
+-- | It is 'zext', 'trunc' or nop depending on the relation of the sizes.
+zadapt :: forall value a b r. (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b)
+     => value a -> CodeGenFunction r (value b)
+zadapt =
+   case compare (sizeOf (typeDesc (LP.Proxy :: LP.Proxy a)))
+                (sizeOf (typeDesc (LP.Proxy :: LP.Proxy b))) of
+      LT -> convert FFI.constZExt FFI.buildZExt
+      EQ -> convert FFI.constBitCast FFI.buildBitCast
+      GT -> convert FFI.constTrunc FFI.buildTrunc
+
+-- | It is 'sext', 'trunc' or nop depending on the relation of the sizes.
+sadapt :: forall value a b r. (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b)
+     => value a -> CodeGenFunction r (value b)
+sadapt =
+   case compare (sizeOf (typeDesc (LP.Proxy :: LP.Proxy a)))
+                (sizeOf (typeDesc (LP.Proxy :: LP.Proxy b))) of
+      LT -> convert FFI.constSExt FFI.buildSExt
+      EQ -> convert FFI.constBitCast FFI.buildBitCast
+      GT -> convert FFI.constTrunc FFI.buildTrunc
+
+-- | It is 'sadapt' or 'zadapt' depending on the sign mode.
+adapt :: forall value a b r. (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, Signed a ~ Signed b)
+     => value a -> CodeGenFunction r (value b)
+adapt =
+   case compare (sizeOf (typeDesc (LP.Proxy :: LP.Proxy a)))
+                (sizeOf (typeDesc (LP.Proxy :: LP.Proxy b))) of
+      LT ->
+         if isSigned (LP.Proxy :: LP.Proxy b)
+           then convert FFI.constSExt FFI.buildSExt
+           else convert FFI.constZExt FFI.buildZExt
+      EQ -> convert FFI.constBitCast FFI.buildBitCast
+      GT -> convert FFI.constTrunc FFI.buildTrunc
+
+-- | Truncate a floating point value.
+fptrunc :: (ValueCons value, IsFloating a, IsFloating b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :>: SizeOf b)
+        => value a -> CodeGenFunction r (value b)
+fptrunc = convert FFI.constFPTrunc FFI.buildFPTrunc
+
+-- | Extend a floating point value.
+fpext :: (ValueCons value, IsFloating a, IsFloating b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)
+      => value a -> CodeGenFunction r (value b)
+fpext = convert FFI.constFPExt FFI.buildFPExt
+
+{-# DEPRECATED fptoui "use fptoint since it is type-safe with respect to signs" #-}
+-- | Convert a floating point value to an unsigned integer.
+fptoui :: (ValueCons value, IsFloating a, IsInteger b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)
+fptoui = convert FFI.constFPToUI FFI.buildFPToUI
+
+{-# DEPRECATED fptosi "use fptoint since it is type-safe with respect to signs" #-}
+-- | Convert a floating point value to a signed integer.
+fptosi :: (ValueCons value, IsFloating a, IsInteger b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)
+fptosi = convert FFI.constFPToSI FFI.buildFPToSI
+
+-- | Convert a floating point value to an integer.
+-- It is mapped to @fptosi@ or @fptoui@ depending on the type @a@.
+fptoint :: forall value a b r. (ValueCons value, IsFloating a, IsInteger b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)
+fptoint =
+   if isSigned (LP.Proxy :: LP.Proxy b)
+     then convert FFI.constFPToSI FFI.buildFPToSI
+     else convert FFI.constFPToUI FFI.buildFPToUI
+
+
+{- DEPRECATED uitofp "use inttofp since it is type-safe with respect to signs" -}
+-- | Convert an unsigned integer to a floating point value.
+-- Although 'inttofp' should be prefered, this function may be useful for conversion from Bool.
+uitofp :: (ValueCons value, IsInteger a, IsFloating b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)
+uitofp = convert FFI.constUIToFP FFI.buildUIToFP
+
+{- DEPRECATED sitofp "use inttofp since it is type-safe with respect to signs" -}
+-- | Convert a signed integer to a floating point value.
+-- Although 'inttofp' should be prefered, this function may be useful for conversion from Bool.
+sitofp :: (ValueCons value, IsInteger a, IsFloating b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)
+sitofp = convert FFI.constSIToFP FFI.buildSIToFP
+
+-- | Convert an integer to a floating point value.
+-- It is mapped to @sitofp@ or @uitofp@ depending on the type @a@.
+inttofp :: forall value a b r. (ValueCons value, IsInteger a, IsFloating b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)
+inttofp =
+   if isSigned (LP.Proxy :: LP.Proxy a)
+     then convert FFI.constSIToFP FFI.buildSIToFP
+     else convert FFI.constUIToFP FFI.buildUIToFP
+
+
+-- | Convert a pointer to an integer.
+ptrtoint :: (ValueCons value, IsInteger b, IsPrimitive b) => value (Ptr a) -> CodeGenFunction r (value b)
+ptrtoint = convert FFI.constPtrToInt FFI.buildPtrToInt
+
+-- | Convert an integer to a pointer.
+inttoptr :: (ValueCons value, IsInteger a, IsType b) => value a -> CodeGenFunction r (value (Ptr b))
+inttoptr = convert FFI.constIntToPtr FFI.buildIntToPtr
+
+-- | Convert between to values of the same size by just copying the bit pattern.
+bitcast :: (ValueCons value, IsFirstClass a, IsFirstClass b, IsSized a, IsSized b, SizeOf a ~ SizeOf b)
+        => value a -> CodeGenFunction r (value b)
+bitcast = convert FFI.constBitCast FFI.buildBitCast
+
+
+--------------------------------------
+
+type CmpValueResult value0 value1 a = BinOpValue value0 value1 (CmpResult a)
+
+type CmpResult c = ShapedType (ShapeOf c) Bool
+
+class (IsFirstClass c) => CmpRet c where
+    cmpBld :: LP.Proxy c -> CmpPredicate -> FFIBinOp
+    cmpCnst :: LP.Proxy c -> CmpPredicate -> FFIConstBinOp
+
+instance CmpRet Float   where cmpBld _ = fcmpBld ; cmpCnst _ = fcmpCnst
+instance CmpRet Double  where cmpBld _ = fcmpBld ; cmpCnst _ = fcmpCnst
+instance CmpRet FP128   where cmpBld _ = fcmpBld ; cmpCnst _ = fcmpCnst
+instance CmpRet Bool    where cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
+instance CmpRet Word    where cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
+instance CmpRet Word8   where cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
+instance CmpRet Word16  where cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
+instance CmpRet Word32  where cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
+instance CmpRet Word64  where cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
+instance CmpRet Int     where cmpBld _ = scmpBld ; cmpCnst _ = scmpCnst
+instance CmpRet Int8    where cmpBld _ = scmpBld ; cmpCnst _ = scmpCnst
+instance CmpRet Int16   where cmpBld _ = scmpBld ; cmpCnst _ = scmpCnst
+instance CmpRet Int32   where cmpBld _ = scmpBld ; cmpCnst _ = scmpCnst
+instance CmpRet Int64   where cmpBld _ = scmpBld ; cmpCnst _ = scmpCnst
+instance CmpRet (Foreign.Ptr a)
+                        where cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
+instance (IsType a) =>
+         CmpRet (Ptr a) where cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
+
+instance (Dec.Positive n) => CmpRet (WordN n) where
+    cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
+instance (Dec.Positive n) => CmpRet (IntN n) where
+    cmpBld _ = scmpBld ; cmpCnst _ = scmpCnst
+
+instance (CmpRet a, IsPrimitive a, Dec.Positive n) => CmpRet (Vector n a) where
+    cmpBld _ = cmpBld (LP.Proxy :: LP.Proxy a)
+    cmpCnst _ = cmpCnst (LP.Proxy :: LP.Proxy a)
+
+
+{- |
+Compare values of ordered types
+and choose predicates according to the compared types.
+Floating point numbers are compared in \"ordered\" mode,
+that is @NaN@ operands yields 'False' as result.
+Pointers are compared unsigned.
+These choices are consistent with comparison in plain Haskell.
+-}
+cmp :: forall value0 value1 a r.
+   (ValueCons2 value0 value1, CmpRet a) =>
+   CmpPredicate -> value0 a -> value1 a ->
+   CodeGenFunction r (CmpValueResult value0 value1 a)
+cmp p =
+    binop
+        (cmpCnst (LP.Proxy :: LP.Proxy a) p)
+        (cmpBld (LP.Proxy :: LP.Proxy a) p)
+
+ucmpBld :: CmpPredicate -> FFIBinOp
+ucmpBld p = flip FFI.buildICmp (FFI.fromIntPredicate (uintFromCmpPredicate p))
+
+scmpBld :: CmpPredicate -> FFIBinOp
+scmpBld p = flip FFI.buildICmp (FFI.fromIntPredicate (sintFromCmpPredicate p))
+
+fcmpBld :: CmpPredicate -> FFIBinOp
+fcmpBld p = flip FFI.buildFCmp (FFI.fromRealPredicate (fpFromCmpPredicate p))
+
+
+ucmpCnst :: CmpPredicate -> FFIConstBinOp
+ucmpCnst p = FFI.constICmp (FFI.fromIntPredicate (uintFromCmpPredicate p))
+
+scmpCnst :: CmpPredicate -> FFIConstBinOp
+scmpCnst p = FFI.constICmp (FFI.fromIntPredicate (sintFromCmpPredicate p))
+
+fcmpCnst :: CmpPredicate -> FFIConstBinOp
+fcmpCnst p = FFI.constFCmp (FFI.fromRealPredicate (fpFromCmpPredicate p))
+
+
+_ucmp ::
+    (ValueCons2 value0 value1, CmpRet a, IsInteger a) =>
+    CmpPredicate -> value0 a -> value1 a ->
+    CodeGenFunction r (CmpValueResult value0 value1 a)
+_ucmp p = binop (ucmpCnst p) (ucmpBld p)
+
+_scmp ::
+    (ValueCons2 value0 value1, CmpRet a, IsInteger a) =>
+    CmpPredicate -> value0 a -> value1 a ->
+    CodeGenFunction r (CmpValueResult value0 value1 a)
+_scmp p = binop (scmpCnst p) (scmpBld p)
+
+pcmp ::
+    (ValueCons2 value0 value1, IsType a) =>
+    IntPredicate -> value0 (Ptr a) -> value1 (Ptr a) ->
+    CodeGenFunction r (BinOpValue value0 value1 (Ptr a))
+pcmp p =
+    binop
+        (FFI.constICmp (FFI.fromIntPredicate p))
+        (flip FFI.buildICmp (FFI.fromIntPredicate p))
+
+
+{-# DEPRECATED icmp "use cmp or pcmp instead" #-}
+-- | Compare integers.
+icmp ::
+    (ValueCons2 value0 value1, CmpRet a, IsIntegerOrPointer a) =>
+    IntPredicate -> value0 a -> value1 a ->
+    CodeGenFunction r (CmpValueResult value0 value1 a)
+icmp p =
+    binop
+        (FFI.constICmp (FFI.fromIntPredicate p))
+        (flip FFI.buildICmp (FFI.fromIntPredicate p))
+
+-- | Compare floating point values.
+fcmp ::
+    (ValueCons2 value0 value1, CmpRet a, IsFloating a) =>
+    FPPredicate -> value0 a -> value1 a ->
+    CodeGenFunction r (CmpValueResult value0 value1 a)
+fcmp p =
+    binop
+        (FFI.constFCmp (FFI.fromRealPredicate p))
+        (flip FFI.buildFCmp (FFI.fromRealPredicate p))
+
+--------------------------------------
+
+setHasNoNaNs, setHasNoInfs, setHasNoSignedZeros, setHasAllowReciprocal,
+    setFastMath :: (IsFloating a) => Bool -> Value a -> CodeGenFunction r ()
+setHasNoNaNs          = fastMath FFI.setHasNoNaNs
+setHasNoInfs          = fastMath FFI.setHasNoInfs
+setHasNoSignedZeros   = fastMath FFI.setHasNoSignedZeros
+setHasAllowReciprocal = fastMath FFI.setHasAllowReciprocal
+setFastMath           = fastMath FFI.setHasUnsafeAlgebra
+
+fastMath ::
+    (IsFloating a) =>
+    (FFI.ValueRef -> FFI.Bool -> IO ()) ->
+    Bool -> Value a -> CodeGenFunction r ()
+fastMath setter b (Value v) = liftIO $ setter v $ FFI.consBool b
+
+
+--------------------------------------
+
+-- XXX could do const song and dance
+-- | Select between two values depending on a boolean.
+select :: (CmpRet a) => Value (CmpResult a) -> Value a -> Value a -> CodeGenFunction r (Value a)
+select (Value cnd) (Value thn) (Value els) =
+    liftM Value $
+      withCurrentBuilder $ \ bldPtr ->
+        U.withEmptyCString $
+          FFI.buildSelect bldPtr cnd thn els
+
+--------------------------------------
+
+type Caller = FFI.BuilderRef -> [FFI.ValueRef] -> IO FFI.ValueRef
+
+{-
+Function (a -> b -> IO c)
+Value a -> Value b -> CodeGenFunction r c
+-}
+
+-- |Acceptable arguments to 'call'.
+class (f ~ CalledFunction g, r ~ CodeResult g, g ~ CallerFunction r f) =>
+         CallArgs r f g where
+    type CalledFunction g :: *
+    type CallerFunction r f :: *
+    doCall :: Call f -> g
+
+instance (Value a ~ a', CallArgs r b b') => CallArgs r (a -> b) (a' -> b') where
+    type CalledFunction (a' -> b') = UnValue a' -> CalledFunction b'
+    type CallerFunction r (a -> b) = Value a -> CallerFunction r b
+    doCall f a = doCall (applyCall f a)
+
+instance
+    (r ~ r', Value a ~ a') =>
+        CallArgs r (IO a) (CodeGenFunction r' a') where
+    type CalledFunction (CodeGenFunction r' a') = IO (UnValue a')
+    type CallerFunction r (IO a) = CodeGenFunction r (Value a)
+    doCall = runCall
+
+doCallDef :: Caller -> [FFI.ValueRef] -> b -> CodeGenFunction r (Value a)
+doCallDef mkCall args _ =
+    withCurrentBuilder $ \ bld ->
+      liftM Value $ mkCall bld (reverse args)
+
+-- | Call a function with the given arguments.  The 'call' instruction is variadic, i.e., the number of arguments
+-- it takes depends on the type of /f/.
+call :: (CallArgs r f g) => Function f -> g
+call = doCall . callFromFunction
+
+data Call a = Call Caller [FFI.ValueRef]
+
+callFromFunction :: Function a -> Call a
+callFromFunction (Value f) = Call (U.makeCall f) []
+
+-- like Applicative.<*>
+infixl 4 `applyCall`
+
+applyCall :: Call (a -> b) -> Value a -> Call b
+applyCall (Call mkCall args) (Value arg) = Call mkCall (arg:args)
+
+runCall :: Call (IO a) -> CodeGenFunction r (Value a)
+runCall (Call mkCall args) = doCallDef mkCall args ()
+
+
+invokeFromFunction ::
+          BasicBlock         -- ^Normal return point.
+       -> BasicBlock         -- ^Exception return point.
+       -> Function f         -- ^Function to call.
+       -> Call f
+invokeFromFunction (BasicBlock norm) (BasicBlock expt) (Value f) =
+    Call (U.makeInvoke norm expt f) []
+
+-- | Call a function with exception handling.
+invoke :: (CallArgs r f g)
+       => BasicBlock         -- ^Normal return point.
+       -> BasicBlock         -- ^Exception return point.
+       -> Function f         -- ^Function to call.
+       -> g
+invoke norm expt f = doCall $ invokeFromFunction norm expt f
+
+callWithConvFromFunction :: FFI.CallingConvention -> Function f -> Call f
+callWithConvFromFunction cc (Value f) =
+    Call (U.makeCallWithCc cc f) []
+
+-- | Call a function with the given arguments.  The 'call' instruction
+-- is variadic, i.e., the number of arguments it takes depends on the
+-- type of /f/.
+-- This also sets the calling convention of the call to the function.
+-- As LLVM itself defines, if the calling conventions of the calling
+-- /instruction/ and the function being /called/ are different, undefined
+-- behavior results.
+callWithConv :: (CallArgs r f g) => FFI.CallingConvention -> Function f -> g
+callWithConv cc f = doCall $ callWithConvFromFunction cc f
+
+invokeWithConvFromFunction ::
+          FFI.CallingConvention -- ^Calling convention
+       -> BasicBlock         -- ^Normal return point.
+       -> BasicBlock         -- ^Exception return point.
+       -> Function f         -- ^Function to call.
+       -> Call f
+invokeWithConvFromFunction cc (BasicBlock norm) (BasicBlock expt) (Value f) =
+    Call (U.makeInvokeWithCc cc norm expt f) []
+
+-- | Call a function with exception handling.
+-- This also sets the calling convention of the call to the function.
+-- As LLVM itself defines, if the calling conventions of the calling
+-- /instruction/ and the function being /called/ are different, undefined
+-- behavior results.
+invokeWithConv :: (CallArgs r f g)
+               => FFI.CallingConvention -- ^Calling convention
+               -> BasicBlock         -- ^Normal return point.
+               -> BasicBlock         -- ^Exception return point.
+               -> Function f         -- ^Function to call.
+               -> g
+invokeWithConv cc norm expt f =
+    doCall $ invokeWithConvFromFunction cc norm expt f
+
+--------------------------------------
+
+-- XXX could do const song and dance
+-- |Join several variables (virtual registers) from different basic blocks into one.
+-- All of the variables in the list are joined.  See also 'addPhiInputs'.
+phi :: forall a r . (IsFirstClass a) => [(Value a, BasicBlock)] -> CodeGenFunction r (Value a)
+phi incoming =
+    liftM Value $
+      withCurrentBuilder $ \ bldPtr -> do
+        inst <- U.buildEmptyPhi bldPtr =<< typeRef (LP.Proxy :: LP.Proxy a)
+        U.addPhiIns inst [ (v, b) | (Value v, BasicBlock b) <- incoming ]
+        return inst
+
+-- |Add additional inputs to an existing phi node.
+-- The reason for this instruction is that sometimes the structure of the code
+-- makes it impossible to have all variables in scope at the point where you need the phi node.
+addPhiInputs :: forall a r . (IsFirstClass a)
+             => Value a                      -- ^Must be a variable from a call to 'phi'.
+             -> [(Value a, BasicBlock)]      -- ^Variables to add.
+             -> CodeGenFunction r ()
+addPhiInputs (Value inst) incoming =
+    liftIO $ U.addPhiIns inst [ (v, b) | (Value v, BasicBlock b) <- incoming ]
+
+
+--------------------------------------
+
+-- | Acceptable argument to array memory allocation.
+class AllocArg a where
+    getAllocArg :: a -> Value Word
+instance (i ~ Word) => AllocArg (Value i) where
+    getAllocArg = id
+instance (i ~ Word) => AllocArg (ConstValue i) where
+    getAllocArg = value
+instance AllocArg Word where
+    getAllocArg = valueOf
+
+-- could be moved to Util.Memory
+-- FFI.buildMalloc deprecated since LLVM-2.7
+-- XXX What's the type returned by malloc
+-- | Allocate heap memory.
+malloc :: forall a r . (IsSized a) => CodeGenFunction r (Value (Ptr a))
+malloc = arrayMalloc (1::Word)
+
+type BytePtr = Ptr Word8
+
+{-
+I use a pointer type as size parameter of 'malloc'.
+This way I hope that the parameter has always the correct size (32 or 64 bit).
+A side effect is that we can convert the result of 'getelementptr' using 'bitcast',
+that does not suffer from the slow assembly problem. (bug #8281)
+-}
+foreign import ccall "&aligned_malloc_sizeptr"
+   alignedMalloc :: FunPtr (BytePtr -> BytePtr -> IO BytePtr)
+
+foreign import ccall "&aligned_free"
+   alignedFree :: FunPtr (BytePtr -> IO ())
+
+
+{-
+There is a bug in LLVM-2.7 and LLVM-2.8
+(http://llvm.org/bugs/show_bug.cgi?id=8281)
+that causes huge assembly times for expressions like
+ptrtoint(getelementptr(zero,..)).
+If you break those expressions into two statements
+at separate lines, everything is fine.
+But the C interface is too clever,
+and rewrites two separate statements into a functional expression on a single line.
+Such code is generated whenever you call
+buildMalloc, buildArrayMalloc, sizeOf (called by buildMalloc), or alignOf.
+One possible way is to write a getelementptr expression
+containing a nullptr in a way
+that hides the constant nature of nullptr.
+
+    ptr <- alloca
+    store (value zero) ptr
+    z <- load ptr
+    size <- bitcast =<<
+       getElementPtr (z :: Value (Ptr a)) (getAllocArg s, ())
+
+However, I found that bitcast on pointers causes no problems.
+Thus I switched to using pointers for size quantities.
+This still allows for optimizations involving pointers.
+-}
+
+-- XXX What's the type returned by arrayMalloc?
+-- | Allocate heap (array) memory.
+arrayMalloc :: forall a r s . (IsSized a, AllocArg s) =>
+               s -> CodeGenFunction r (Value (Ptr a)) -- XXX
+arrayMalloc s = do
+    func <- CodeGen.staticNamedFunction "alignedMalloc" alignedMalloc
+--    func <- externFunction "malloc"
+
+    size <- sizeOfArray (LP.Proxy :: LP.Proxy a) (getAllocArg s)
+    alignment <- alignOf (LP.Proxy :: LP.Proxy a)
+    bitcast =<< call func size alignment
+
+-- XXX What's the type returned by malloc
+-- | Allocate stack memory.
+alloca :: forall a r . (IsSized a) => CodeGenFunction r (Value (Ptr a))
+alloca =
+    liftM Value $
+    withCurrentBuilder $ \ bldPtr -> do
+      typ <- typeRef (LP.Proxy :: LP.Proxy a)
+      U.withEmptyCString $ FFI.buildAlloca bldPtr typ
+
+-- XXX What's the type returned by arrayAlloca?
+-- | Allocate stack (array) memory.
+arrayAlloca :: forall a r s . (IsSized a, AllocArg s) =>
+               s -> CodeGenFunction r (Value (Ptr a))
+arrayAlloca s =
+    liftM Value $
+    withCurrentBuilder $ \ bldPtr -> do
+      typ <- typeRef (LP.Proxy :: LP.Proxy a)
+      U.withEmptyCString $
+        FFI.buildArrayAlloca bldPtr typ (case getAllocArg s of Value v -> v)
+
+-- FFI.buildFree deprecated since LLVM-2.7
+-- XXX What's the type of free?
+-- | Free heap memory.
+free :: (IsType a) => Value (Ptr a) -> CodeGenFunction r ()
+free ptr = do
+    func <- CodeGen.staticNamedFunction "alignedFree" alignedFree
+--    func <- externFunction "free"
+    _ <- call func =<< bitcast ptr
+    return ()
+
+
+-- | If we want to export that, then we should have a Size type
+-- This is the official implementation,
+-- but it suffers from the ptrtoint(gep) bug.
+_sizeOf ::
+    forall a r.
+    (IsSized a) => LP.Proxy a -> CodeGenFunction r (Value Word)
+_sizeOf a =
+    liftIO $ liftM Value $
+    FFI.sizeOf =<< typeRef a
+
+_alignOf ::
+    forall a r.
+    (IsSized a) => LP.Proxy a -> CodeGenFunction r (Value Word)
+_alignOf a =
+    liftIO $ liftM Value $
+    FFI.alignOf =<< typeRef a
+
+
+-- Here are reimplementation from Constants.cpp that avoid the ptrtoint(gep) bug #8281.
+-- see ConstantExpr::getSizeOf
+sizeOfArray ::
+    forall a r . (IsSized a) =>
+    LP.Proxy a -> Value Word -> CodeGenFunction r (Value BytePtr)
+sizeOfArray _ len =
+    bitcast =<<
+       getElementPtr (value zero :: Value (Ptr a)) (len, ())
+
+-- see ConstantExpr::getAlignOf
+alignOf ::
+    forall a r . (IsSized a) =>
+    LP.Proxy a -> CodeGenFunction r (Value BytePtr)
+alignOf _ =
+    bitcast =<<
+       getElementPtr0 (value zero :: Value (Ptr (Struct (Bool, (a, ()))))) (d1, ())
+
+
+-- | Load a value from memory.
+load :: Value (Ptr a)                   -- ^ Address to load from.
+     -> CodeGenFunction r (Value a)
+load (Value p) =
+    liftM Value $
+    withCurrentBuilder $ \ bldPtr ->
+      U.withEmptyCString $ FFI.buildLoad bldPtr p
+
+-- | Store a value in memory
+store :: Value a                        -- ^ Value to store.
+      -> Value (Ptr a)                  -- ^ Address to store to.
+      -> CodeGenFunction r ()
+store (Value v) (Value p) = do
+    withCurrentBuilder_ $ \ bldPtr ->
+      FFI.buildStore bldPtr v p
+    return ()
+
+-- | Address arithmetic.  See LLVM description.
+-- (The type isn't as accurate as it should be.)
+_getElementPtrDynamic :: (IsInteger i) =>
+    Value (Ptr a) -> [Value i] -> CodeGenFunction r (Value (Ptr b))
+_getElementPtrDynamic (Value ptr) ixs =
+    liftM Value $
+    withCurrentBuilder $ \ bldPtr ->
+      U.withArrayLen [ v | Value v <- ixs ] $ \ idxLen idxPtr ->
+        U.withEmptyCString $
+          FFI.buildGEP bldPtr ptr idxPtr (fromIntegral idxLen)
+
+-- | Address arithmetic.  See LLVM description.
+-- The index is a nested tuple of the form @(i1,(i2,( ... ())))@.
+-- (This is without a doubt the most confusing LLVM instruction, but the types help.)
+getElementPtr :: forall a o i r . (GetElementPtr o i, IsIndexArg a) =>
+                 Value (Ptr o) -> (a, i) -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
+getElementPtr (Value ptr) (a, ixs) =
+    let ixl = getArg a : getIxList (LP.Proxy :: LP.Proxy o) ixs in
+    liftM Value $
+    withCurrentBuilder $ \ bldPtr ->
+      U.withArrayLen ixl $ \ idxLen idxPtr ->
+        U.withEmptyCString $
+          FFI.buildGEP bldPtr ptr idxPtr (fromIntegral idxLen)
+
+-- | Like getElementPtr, but with an initial index that is 0.
+-- This is useful since any pointer first need to be indexed off the pointer, and then into
+-- its actual value.  This first indexing is often with 0.
+getElementPtr0 :: (GetElementPtr o i) =>
+                  Value (Ptr o) -> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
+getElementPtr0 p i = getElementPtr p (0::Word32, i)
+
+_getElementPtr :: forall value o i i0 r.
+    (ValueCons value, GetElementPtr o i, IsIndexType i0) =>
+    value (Ptr o) -> (value i0, i) ->
+    CodeGenFunction r (value (Ptr (ElementPtrType o i)))
+_getElementPtr vptr (a, ixs) =
+    let withArgs act =
+            U.withArrayLen
+                (unValue a : getIxList (LP.Proxy :: LP.Proxy o) ixs) $
+            \ idxLen idxPtr ->
+                act idxPtr (fromIntegral idxLen)
+    in  unop
+            (\ptr -> withArgs $ FFI.constGEP ptr)
+            (\bldPtr ptr cstr ->
+                withArgs $ \idxPtr idxLen ->
+                    FFI.buildGEP bldPtr ptr idxPtr idxLen cstr)
+            vptr
+
+--------------------------------------
+{-
+instance (IsConst a) => Show (ConstValue a) -- XXX
+instance (IsConst a) => Eq (ConstValue a)
+
+{-
+instance (IsConst a) => Eq (ConstValue a) where
+    ConstValue x == ConstValue y  =
+        if isFloating x then ConstValue (FFI.constFCmp (FFI.fromRealPredicate  FPOEQ) x y)
+                        else ConstValue (FFI.constICmp (FFI.fromIntPredicate IntEQ) x y)
+    ConstValue x /= ConstValue y  =
+        if isFloating x then ConstValue (FFI.constFCmp (FFI.fromRealPredicate  FPONE) x y)
+                        else ConstValue (FFI.constICmp (FFI.fromIntPredicate IntNE) x y)
+
+instance (IsConst a) => Ord (ConstValue a) where
+    ConstValue x <  ConstValue y  =
+        if isFloating x then ConstValue (FFI.constFCmp (FFI.fromRealPredicate  FPOLT) x y)
+                        else ConstValue (FFI.constICmp (FFI.fromIntPredicate IntLT) x y)
+    ConstValue x <= ConstValue y  =
+        if isFloating x then ConstValue (FFI.constFCmp (FFI.fromRealPredicate  FPOLE) x y)
+                        else ConstValue (FFI.constICmp (FFI.fromIntPredicate IntLE) x y)
+    ConstValue x >  ConstValue y  =
+        if isFloating x then ConstValue (FFI.constFCmp (FFI.fromRealPredicate  FPOGT) x y)
+                        else ConstValue (FFI.constICmp (FFI.fromIntPredicate IntGT) x y)
+    ConstValue x >= ConstValue y  =
+        if isFloating x then ConstValue (FFI.constFCmp (FFI.fromRealPredicate  FPOGE) x y)
+                        else ConstValue (FFI.constICmp (FFI.fromIntPredicate IntGE) x y)
+-}
+
+instance (Num a, IsConst a) => Num (ConstValue a) where
+    ConstValue x + ConstValue y  =  ConstValue (FFI.constAdd x y)
+    ConstValue x - ConstValue y  =  ConstValue (FFI.constSub x y)
+    ConstValue x * ConstValue y  =  ConstValue (FFI.constMul x y)
+    negate (ConstValue x)        =  ConstValue (FFI.constNeg x)
+    fromInteger x                =  constOf (fromInteger x :: a)
+-}
diff --git a/private/LLVM/Core/Instructions/Guided.hs b/private/LLVM/Core/Instructions/Guided.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/Core/Instructions/Guided.hs
@@ -0,0 +1,355 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{- |
+This module provides some functions from the "LLVM.Core.Instructions" module
+in a way that enables easier type handling.
+E.g. 'trunc' on vectors requires you to prove
+that reducing the bitsize of the elements
+reduces the bitsize of the whole vector.
+We solve the problem by adding a 'Guide' parameter.
+It can be either 'scalar' or 'vector'.
+We impose the bitsize constraint only on the element type,
+but not on the size of the whole value (scalar or vector).
+
+Another example:
+If you call 'trunc' on a Vector input,
+GHC cannot infer that the result must be a 'Data.Vector' of the same size.
+Using the guide, it can.
+However, in practice this is not as useful as I thought initially.
+-}
+module LLVM.Core.Instructions.Guided (
+    Guide,
+    scalar,
+    vector,
+    getElementPtr,
+    getElementPtr0,
+    trunc,
+    ext,
+    extBool,
+    zadapt,
+    sadapt,
+    adapt,
+    fptrunc,
+    fpext,
+    fptoint,
+    inttofp,
+    ptrtoint,
+    inttoptr,
+    bitcast,
+    select,
+    cmp,
+    icmp,
+    pcmp,
+    fcmp,
+    ) where
+
+import qualified LLVM.Core.Instructions.Private as Priv
+import qualified LLVM.Core.Type as Type
+import qualified LLVM.Core.Util as U
+import qualified LLVM.Core.Proxy as LP
+import LLVM.Core.Instructions.Private (ValueCons)
+import LLVM.Core.CodeGenMonad (CodeGenFunction)
+import LLVM.Core.CodeGen (ConstValue, zero)
+import LLVM.Core.Type
+         (IsArithmetic, IsInteger, IsIntegerOrPointer, IsFloating,
+          IsFirstClass, IsPrimitive,
+          Signed, Positive, IsType, IsSized, SizeOf,
+          isFloating, sizeOf, typeDesc)
+
+import qualified LLVM.FFI.Core as FFI
+
+import Type.Data.Num.Decimal.Number ((:<:), (:>:))
+
+import Foreign.Ptr (Ptr)
+
+import qualified Control.Functor.HT as FuncHT
+
+import Data.Word (Word32)
+
+
+data Guide shape elem = Guide
+
+instance Functor (Guide shape) where
+    fmap _ Guide = Guide
+
+scalar :: Guide Type.ScalarShape a
+scalar = Guide
+
+vector :: (Positive n) => Guide (Type.VectorShape n) a
+vector = Guide
+
+proxyFromGuide :: Guide shape elem -> LP.Proxy elem
+proxyFromGuide Guide = LP.Proxy
+
+
+type Type shape a = Type.ShapedType shape a
+type VT value shape a = value (Type shape a)
+
+getElementPtr ::
+    (ValueCons value, Priv.GetElementPtr o i, Priv.IsIndexType i0) =>
+    Guide shape (Ptr o, i0) ->
+    VT value shape (Ptr o) ->
+    (VT value shape i0, i) ->
+    CodeGenFunction r (VT value shape (Ptr (Priv.ElementPtrType o i)))
+getElementPtr guide vptr (a, ixs) =
+    getElementPtrGen (fmap fst guide) vptr (Priv.unValue a, ixs)
+
+getElementPtr0 ::
+    (ValueCons value, Priv.GetElementPtr o i) =>
+    Guide shape (Ptr o) ->
+    VT value shape (Ptr o) -> i ->
+    CodeGenFunction r (VT value shape (Ptr (Priv.ElementPtrType o i)))
+getElementPtr0 guide vptr ixs =
+    getElementPtrGen guide vptr
+        (Priv.unConst (zero :: ConstValue Word32), ixs)
+
+getElementPtrGen ::
+    (ValueCons value, Priv.GetElementPtr o i) =>
+    Guide shape (Ptr o) ->
+    VT value shape (Ptr o) -> (FFI.ValueRef, i) ->
+    CodeGenFunction r (VT value shape (Ptr (Priv.ElementPtrType o i)))
+getElementPtrGen guide vptr (i0val,ixs) =
+    let withArgs act =
+            U.withArrayLen
+                (i0val : Priv.getIxList (LP.element (proxyFromGuide guide)) ixs) $
+            \ idxLen idxPtr ->
+                act idxPtr (fromIntegral idxLen)
+    in  Priv.unop
+            (\ptr -> withArgs $ FFI.constGEP ptr)
+            (\bldPtr ptr cstr ->
+                withArgs $ \idxPtr idxLen ->
+                    FFI.buildGEP bldPtr ptr idxPtr idxLen cstr)
+            vptr
+
+
+-- | Truncate a value to a shorter bit width.
+trunc ::
+    (ValueCons value, IsInteger av, IsInteger bv,
+     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv,
+     IsSized a, IsSized b, SizeOf a :>: SizeOf b) =>
+    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
+trunc = convert FFI.constTrunc FFI.buildTrunc
+
+isSigned :: (IsArithmetic a) => Guide shape a -> Bool
+isSigned = Type.isSigned . proxyFromGuide
+
+-- | Extend a value to wider width.
+-- If the target type is signed, then preserve the sign,
+-- If the target type is unsigned, then extended by zeros.
+ext ::
+    (ValueCons value, IsInteger a, IsInteger b, IsType bv, Signed a ~ Signed b,
+     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv,
+     IsSized a, IsSized b, SizeOf a :<: SizeOf b) =>
+    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
+ext guide =
+   if isSigned (fmap snd guide)
+     then convert FFI.constSExt FFI.buildSExt guide
+     else convert FFI.constZExt FFI.buildZExt guide
+
+extBool ::
+    (ValueCons value, IsInteger b, IsType bv,
+     IsPrimitive b, Type shape Bool ~ av, Type shape b ~ bv) =>
+    Guide shape (Bool,b) -> value av -> CodeGenFunction r (value bv)
+extBool guide =
+   if isSigned (fmap snd guide)
+     then convert FFI.constSExt FFI.buildSExt guide
+     else convert FFI.constZExt FFI.buildZExt guide
+
+
+compareGuideSizes :: (IsType a, IsType b) => Guide shape (a,b) -> Ordering
+compareGuideSizes guide =
+   case FuncHT.unzip $ proxyFromGuide guide of
+      (a,b) -> compare (sizeOf (typeDesc a)) (sizeOf (typeDesc b))
+
+-- | It is 'zext', 'trunc' or nop depending on the relation of the sizes.
+zadapt ::
+    (ValueCons value, IsInteger a, IsInteger b, IsType bv,
+     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv) =>
+    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
+zadapt guide =
+   case compareGuideSizes guide of
+      LT -> convert FFI.constZExt FFI.buildZExt guide
+      EQ -> convert FFI.constBitCast FFI.buildBitCast guide
+      GT -> convert FFI.constTrunc FFI.buildTrunc guide
+
+-- | It is 'sext', 'trunc' or nop depending on the relation of the sizes.
+sadapt ::
+    (ValueCons value, IsInteger a, IsInteger b, IsType bv,
+     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv) =>
+    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
+sadapt guide =
+   case compareGuideSizes guide of
+      LT -> convert FFI.constSExt FFI.buildSExt guide
+      EQ -> convert FFI.constBitCast FFI.buildBitCast guide
+      GT -> convert FFI.constTrunc FFI.buildTrunc guide
+
+-- | It is 'sadapt' or 'zadapt' depending on the sign mode.
+adapt ::
+    (ValueCons value, IsInteger a, IsInteger b, IsType bv,
+     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv,
+     Signed a ~ Signed b) =>
+    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
+adapt guide =
+   case compareGuideSizes guide of
+      LT ->
+         if isSigned (fmap snd guide)
+           then convert FFI.constSExt FFI.buildSExt guide
+           else convert FFI.constZExt FFI.buildZExt guide
+      EQ -> convert FFI.constBitCast FFI.buildBitCast guide
+      GT -> convert FFI.constTrunc FFI.buildTrunc guide
+
+-- | Truncate a floating point value.
+fptrunc ::
+    (ValueCons value, IsFloating av, IsFloating bv,
+     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv,
+     IsSized a, IsSized b, SizeOf a :>: SizeOf b) =>
+    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
+fptrunc = convert FFI.constFPTrunc FFI.buildFPTrunc
+
+-- | Extend a floating point value.
+fpext ::
+    (ValueCons value, IsFloating av, IsFloating bv,
+     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv,
+     IsSized a, IsSized b, SizeOf a :<: SizeOf b) =>
+    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
+fpext = convert FFI.constFPExt FFI.buildFPExt
+
+-- | Convert a floating point value to an integer.
+-- It is mapped to @fptosi@ or @fptoui@ depending on the type @a@.
+fptoint ::
+    (ValueCons value, IsFloating a, IsInteger b, IsType bv,
+     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv) =>
+    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
+fptoint guide =
+   if isSigned (fmap snd guide)
+     then convert FFI.constFPToSI FFI.buildFPToSI guide
+     else convert FFI.constFPToUI FFI.buildFPToUI guide
+
+
+-- | Convert an integer to a floating point value.
+-- It is mapped to @sitofp@ or @uitofp@ depending on the type @a@.
+inttofp ::
+    (ValueCons value, IsInteger a, IsFloating b, IsType bv,
+     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv) =>
+    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
+inttofp guide =
+   if isSigned (fmap fst guide)
+     then convert FFI.constSIToFP FFI.buildSIToFP guide
+     else convert FFI.constUIToFP FFI.buildUIToFP guide
+
+
+-- | Convert a pointer to an integer.
+ptrtoint ::
+    (ValueCons value, IsType a, IsInteger b, IsType bv,
+     IsPrimitive b, Type shape (Ptr a) ~ av, Type shape b ~ bv) =>
+    Guide shape (Ptr a, b) -> value av -> CodeGenFunction r (value bv)
+ptrtoint = convert FFI.constPtrToInt FFI.buildPtrToInt
+
+-- | Convert an integer to a pointer.
+inttoptr ::
+    (ValueCons value, IsInteger a, IsType b, IsType bv,
+     IsPrimitive a, Type shape a ~ av, Type shape (Ptr b) ~ bv) =>
+    Guide shape (a, Ptr b) -> value av -> CodeGenFunction r (value bv)
+inttoptr = convert FFI.constIntToPtr FFI.buildIntToPtr
+
+-- | Convert between to values of the same size by just copying the bit pattern.
+bitcast ::
+    (ValueCons value, IsFirstClass a, IsFirstClass bv,
+     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv,
+     IsSized a, IsSized b, SizeOf a ~ SizeOf b) =>
+    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
+bitcast = convert FFI.constBitCast FFI.buildBitCast
+
+
+convert ::
+    (ValueCons value, IsType bv,
+     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv) =>
+    Priv.FFIConstConvert -> Priv.FFIConvert -> Guide shape (a,b) ->
+    value av -> CodeGenFunction r (value bv)
+convert cnvConst cnv Guide = Priv.convert cnvConst cnv
+
+
+
+select ::
+    (ValueCons value, IsPrimitive a,
+     Type shape a ~ av, Type shape Bool ~ bv) =>
+    Guide shape a ->
+    value bv -> value av -> value av -> CodeGenFunction r (value av)
+select Guide = Priv.trinop FFI.constSelect FFI.buildSelect
+
+
+cmp ::
+    (ValueCons value, IsArithmetic a, IsPrimitive a,
+     Type shape a ~ av, Type shape Bool ~ bv) =>
+    Guide shape a ->
+    Priv.CmpPredicate -> value av -> value av -> CodeGenFunction r (value bv)
+cmp guide@Guide p =
+    let cmpop constCmp buildCmp predi =
+            Priv.binop (constCmp predi) (flip buildCmp predi)
+    in  if isFloating (proxyFromGuide guide)
+          then
+            cmpop FFI.constFCmp FFI.buildFCmp $
+            FFI.fromRealPredicate $ Priv.fpFromCmpPredicate p
+          else
+            cmpop FFI.constICmp FFI.buildICmp $
+            FFI.fromIntPredicate $
+            if isSigned guide
+              then Priv.sintFromCmpPredicate p
+              else Priv.uintFromCmpPredicate p
+
+_cmp ::
+    (ValueCons value, IsArithmetic a, IsPrimitive a,
+     Type shape a ~ av, Type shape Bool ~ bv) =>
+    Guide shape a ->
+    Priv.CmpPredicate -> value av -> value av -> CodeGenFunction r (value bv)
+_cmp guide@Guide p =
+    if isFloating (proxyFromGuide guide)
+      then
+        let predi = FFI.fromRealPredicate $ Priv.fpFromCmpPredicate p
+        in  Priv.binop
+                (FFI.constFCmp predi)
+                (flip FFI.buildFCmp predi)
+      else
+        let predi =
+              FFI.fromIntPredicate $
+              if isSigned guide
+                then Priv.sintFromCmpPredicate p
+                else Priv.uintFromCmpPredicate p
+        in  Priv.binop
+                (FFI.constICmp predi)
+                (flip FFI.buildICmp predi)
+
+{-# DEPRECATED icmp "use cmp or pcmp instead" #-}
+-- | Compare integers.
+icmp ::
+    (ValueCons value, IsIntegerOrPointer a, IsPrimitive a,
+     Type shape a ~ av, Type shape Bool ~ bv) =>
+    Guide shape a ->
+    FFI.IntPredicate -> value av -> value av -> CodeGenFunction r (value bv)
+icmp Guide p =
+    Priv.binop
+        (FFI.constICmp (FFI.fromIntPredicate p))
+        (flip FFI.buildICmp (FFI.fromIntPredicate p))
+
+-- | Compare pointers.
+pcmp :: (ValueCons value, Type shape (Ptr a) ~ av, Type shape Bool ~ bv) =>
+    Guide shape (Ptr a) ->
+    FFI.IntPredicate -> value av -> value av -> CodeGenFunction r (value bv)
+pcmp Guide p =
+    Priv.binop
+        (FFI.constICmp (FFI.fromIntPredicate p))
+        (flip FFI.buildICmp (FFI.fromIntPredicate p))
+
+-- | Compare floating point values.
+fcmp ::
+    (ValueCons value, IsFloating a, IsPrimitive a,
+     Type shape a ~ av, Type shape Bool ~ bv) =>
+    Guide shape a ->
+    FFI.FPPredicate -> value av -> value av -> CodeGenFunction r (value bv)
+fcmp Guide p =
+    Priv.binop
+        (FFI.constFCmp (FFI.fromRealPredicate p))
+        (flip FFI.buildFCmp (FFI.fromRealPredicate p))
diff --git a/private/LLVM/Core/Instructions/Private.hs b/private/LLVM/Core/Instructions/Private.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/Core/Instructions/Private.hs
@@ -0,0 +1,303 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+module LLVM.Core.Instructions.Private where
+
+import qualified LLVM.Core.Util as U
+import qualified LLVM.Core.Proxy as LP
+import LLVM.Core.Type (IsType, IsPrimitive, typeRef)
+import LLVM.Core.Data (Vector, Array, Struct, PackedStruct)
+import LLVM.Core.CodeGenMonad (CodeGenFunction)
+import LLVM.Core.CodeGen
+            (ConstValue(ConstValue), constOf, Value(Value), withCurrentBuilder)
+
+import qualified LLVM.FFI.Core as FFI
+import LLVM.FFI.Core (IntPredicate(..), FPPredicate(..))
+
+import qualified Type.Data.Num.Decimal.Number as Dec
+import Type.Data.Num.Decimal.Number (Pred)
+import Type.Base.Proxy (Proxy)
+
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad (liftM)
+
+import Data.Typeable (Typeable)
+import Data.Int (Int32, Int64)
+import Data.Word (Word32, Word64, Word)
+
+
+
+type FFIConstConvert = FFI.ValueRef -> FFI.TypeRef -> IO FFI.ValueRef
+type FFIConvert =
+        FFI.BuilderRef -> FFI.ValueRef -> FFI.TypeRef ->
+        U.CString -> IO FFI.ValueRef
+
+type FFIConstUnOp = FFI.ValueRef -> IO FFI.ValueRef
+type FFIUnOp = FFI.BuilderRef -> FFI.ValueRef -> U.CString -> IO FFI.ValueRef
+
+type FFIConstBinOp = FFI.ValueRef -> FFI.ValueRef -> IO FFI.ValueRef
+type FFIBinOp =
+        FFI.BuilderRef -> FFI.ValueRef -> FFI.ValueRef ->
+        U.CString -> IO FFI.ValueRef
+
+type FFIConstTrinOp =
+        FFI.ValueRef -> FFI.ValueRef -> FFI.ValueRef -> IO FFI.ValueRef
+type FFITrinOp =
+        FFI.BuilderRef -> FFI.ValueRef -> FFI.ValueRef -> FFI.ValueRef ->
+        U.CString -> IO FFI.ValueRef
+
+
+class ValueCons value where
+    switchValueCons :: f ConstValue -> f Value -> f value
+
+instance ValueCons ConstValue where
+    switchValueCons f _ = f
+
+instance ValueCons Value where
+    switchValueCons _ f = f
+
+
+convert :: (ValueCons value, IsType b) =>
+    FFIConstConvert -> FFIConvert -> value a -> CodeGenFunction r (value b)
+convert cop op =
+    getUnOp $
+    switchValueCons
+        (UnOp $ convertConstValue LP.Proxy cop)
+        (UnOp $ convertValue LP.Proxy op)
+
+convertConstValue ::
+    (IsType b) =>
+    LP.Proxy b -> FFIConstConvert ->
+    ConstValue a -> CodeGenFunction r (ConstValue b)
+convertConstValue proxy conv (ConstValue a) =
+    liftM ConstValue $ liftIO $ conv a =<< typeRef proxy
+
+convertValue ::
+    (IsType b) =>
+    LP.Proxy b -> FFIConvert -> Value a -> CodeGenFunction r (Value b)
+convertValue proxy conv (Value a) =
+    liftM Value $
+    withCurrentBuilder $ \ bldPtr -> do
+      typ <- typeRef proxy
+      U.withEmptyCString $ conv bldPtr a typ
+
+
+newtype UnValue a value = UnValue {getUnValue :: value a -> FFI.ValueRef}
+
+unValue :: (ValueCons value) => value a -> FFI.ValueRef
+unValue =
+    getUnValue $
+    switchValueCons
+        (UnValue $ \(ConstValue a) -> a)
+        (UnValue $ \(Value a) -> a)
+
+newtype UnOp a b r value =
+    UnOp {getUnOp :: value a -> CodeGenFunction r (value b)}
+
+unop ::
+    (ValueCons value) =>
+    FFIConstUnOp -> FFIUnOp -> value a -> CodeGenFunction r (value b)
+unop cop op =
+    getUnOp $
+    switchValueCons
+        (UnOp $ \(ConstValue a) -> liftIO $ fmap ConstValue $ cop a)
+        (UnOp $ \(Value a) ->
+            liftM Value $
+            withCurrentBuilder $ \ bld ->
+                U.withEmptyCString $ op bld a)
+
+newtype BinOp a b c r value =
+    BinOp {getBinOp :: value a -> value b -> CodeGenFunction r (value c)}
+
+binop ::
+    (ValueCons value) =>
+    FFIConstBinOp -> FFIBinOp ->
+    value a -> value b -> CodeGenFunction r (value c)
+binop cop op =
+    getBinOp $
+    switchValueCons
+        (BinOp $ \(ConstValue a) (ConstValue b) ->
+            liftIO $ fmap ConstValue $ cop a b)
+        (BinOp $ \(Value a) (Value b) ->
+            liftM Value $
+            withCurrentBuilder $ \ bld ->
+                U.withEmptyCString $ op bld a b)
+
+newtype TrinOp a b c d r value =
+    TrinOp {
+        getTrinOp ::
+            value a -> value b -> value c -> CodeGenFunction r (value d)
+    }
+
+trinop ::
+    (ValueCons value) =>
+    FFIConstTrinOp -> FFITrinOp ->
+    value a -> value b -> value c -> CodeGenFunction r (value d)
+trinop cop op =
+    getTrinOp $
+    switchValueCons
+        (TrinOp $ \(ConstValue a) (ConstValue b) (ConstValue c) ->
+            liftIO $ fmap ConstValue $ cop a b c)
+        (TrinOp $ \(Value a) (Value b) (Value c) ->
+            liftM Value $
+            withCurrentBuilder $ \ bld ->
+                U.withEmptyCString $ op bld a b c)
+
+
+
+-- | Acceptable arguments to 'getElementPointer'.
+class GetElementPtr optr ixs where
+    type ElementPtrType optr ixs :: *
+    getIxList :: LP.Proxy optr -> ixs -> [FFI.ValueRef]
+
+-- | Acceptable single index to 'getElementPointer'.
+class IsIndexArg a where
+    getArg :: a -> FFI.ValueRef
+
+{- |
+In principle we do not need the getValueArg method,
+because we could just use 'unValue'.
+However, we want to prevent users
+from defining their own (disfunctional) IsIndexType instances.
+-}
+class (IsPrimitive i) => IsIndexType i where
+    getValueArg :: (ValueCons value) => value i -> FFI.ValueRef
+
+instance IsIndexType Word where
+    getValueArg = unValue
+
+instance IsIndexType Word32 where
+    getValueArg = unValue
+
+instance IsIndexType Word64 where
+    getValueArg = unValue
+
+instance IsIndexType Int where
+    getValueArg = unValue
+
+instance IsIndexType Int32 where
+    getValueArg = unValue
+
+instance IsIndexType Int64 where
+    getValueArg = unValue
+
+instance IsIndexType i => IsIndexArg (ConstValue i) where
+    getArg = getValueArg
+
+instance IsIndexType i => IsIndexArg (Value i) where
+    getArg = getValueArg
+
+instance IsIndexArg Word where
+    getArg = unConst . constOf
+
+instance IsIndexArg Word32 where
+    getArg = unConst . constOf
+
+instance IsIndexArg Word64 where
+    getArg = unConst . constOf
+
+instance IsIndexArg Int where
+    getArg = unConst . constOf
+
+instance IsIndexArg Int32 where
+    getArg = unConst . constOf
+
+instance IsIndexArg Int64 where
+    getArg = unConst . constOf
+
+unConst :: ConstValue a -> FFI.ValueRef
+unConst (ConstValue v) = v
+
+-- End of indexing
+instance GetElementPtr a () where
+    type ElementPtrType a () = a
+    getIxList LP.Proxy () = []
+
+-- Index in Array
+instance
+    (GetElementPtr o i, IsIndexArg a, Dec.Natural k) =>
+        GetElementPtr (Array k o) (a, i) where
+    type ElementPtrType (Array k o) (a, i) = ElementPtrType o i
+    getIxList proxy (v, i) = getArg v : getIxList (LP.element proxy) i
+
+-- Index in Vector
+instance
+    (GetElementPtr o i, IsIndexArg a, Dec.Positive k) =>
+        GetElementPtr (Vector k o) (a, i) where
+    type ElementPtrType (Vector k o) (a, i) = ElementPtrType o i
+    getIxList proxy (v, i) = getArg v : getIxList (LP.element proxy) i
+
+fieldProxy :: LP.Proxy (struct fs) -> Proxy a -> LP.Proxy (FieldType fs a)
+fieldProxy LP.Proxy _proxy = LP.Proxy
+
+-- Index in Struct and PackedStruct.
+-- The index has to be a type level integer to statically determine the record field type
+instance
+    (GetElementPtr (FieldType fs a) i, Dec.Natural a) =>
+        GetElementPtr (Struct fs) (Proxy a, i) where
+    type ElementPtrType (Struct fs) (Proxy a, i) =
+            ElementPtrType (FieldType fs a) i
+    getIxList proxy (a, i) =
+        unConst (constOf (Dec.integralFromProxy a :: Word32)) :
+        getIxList (fieldProxy proxy a) i
+instance
+    (GetElementPtr (FieldType fs a) i, Dec.Natural a) =>
+        GetElementPtr (PackedStruct fs) (Proxy a, i) where
+    type ElementPtrType (PackedStruct fs) (Proxy a, i) =
+            ElementPtrType (FieldType fs a) i
+    getIxList proxy (a, i) =
+        unConst (constOf (Dec.integralFromProxy a :: Word32)) :
+        getIxList (fieldProxy proxy a) i
+
+class GetField as i where type FieldType as i :: *
+instance GetField (a, as) Dec.Zero where
+    type FieldType (a, as) Dec.Zero = a
+instance
+    (GetField as (Pred (Dec.Pos i0 i1))) =>
+        GetField (a, as) (Dec.Pos i0 i1) where
+    type FieldType (a,as) (Dec.Pos i0 i1) = FieldType as (Pred (Dec.Pos i0 i1))
+
+
+
+data CmpPredicate =
+    CmpEQ                       -- ^ equal
+  | CmpNE                       -- ^ not equal
+  | CmpGT                       -- ^ greater than
+  | CmpGE                       -- ^ greater or equal
+  | CmpLT                       -- ^ less than
+  | CmpLE                       -- ^ less or equal
+    deriving (Eq, Ord, Enum, Show, Typeable)
+
+uintFromCmpPredicate :: CmpPredicate -> IntPredicate
+uintFromCmpPredicate p =
+   case p of
+      CmpEQ -> IntEQ
+      CmpNE -> IntNE
+      CmpGT -> IntUGT
+      CmpGE -> IntUGE
+      CmpLT -> IntULT
+      CmpLE -> IntULE
+
+sintFromCmpPredicate :: CmpPredicate -> IntPredicate
+sintFromCmpPredicate p =
+   case p of
+      CmpEQ -> IntEQ
+      CmpNE -> IntNE
+      CmpGT -> IntSGT
+      CmpGE -> IntSGE
+      CmpLT -> IntSLT
+      CmpLE -> IntSLE
+
+fpFromCmpPredicate :: CmpPredicate -> FPPredicate
+fpFromCmpPredicate p =
+   case p of
+      CmpEQ -> FPOEQ
+      CmpNE -> FPONE
+      CmpGT -> FPOGT
+      CmpGE -> FPOGE
+      CmpLT -> FPOLT
+      CmpLE -> FPOLE
diff --git a/private/LLVM/Core/Proxy.hs b/private/LLVM/Core/Proxy.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/Core/Proxy.hs
@@ -0,0 +1,19 @@
+module LLVM.Core.Proxy where
+
+import Control.Applicative (Applicative, pure, (<*>), )
+
+data Proxy a = Proxy
+
+instance Functor Proxy where
+   fmap _f Proxy = Proxy
+
+instance Applicative Proxy where
+   pure _ = Proxy
+   Proxy <*> Proxy = Proxy
+
+
+fromValue :: a -> Proxy a
+fromValue _ = Proxy
+
+element :: Proxy (f a) -> Proxy a
+element Proxy = Proxy
diff --git a/private/LLVM/Core/Type.hs b/private/LLVM/Core/Type.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/Core/Type.hs
@@ -0,0 +1,698 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+-- |The LLVM type system is captured with a number of Haskell type classes.
+-- In general, an LLVM type @T@ is represented as @Value T@, where @T@ is some Haskell type.
+-- The various types @T@ are classified by various type classes, e.g., 'IsFirstClass' for
+-- those types that are LLVM first class types (passable as arguments etc).
+-- All valid LLVM types belong to the 'IsType' class.
+module LLVM.Core.Type(
+    -- * Type classifier
+    IsType(..),
+    -- ** Special type classifiers
+    Dec.Natural,
+    Dec.Positive,
+    IsArithmetic(arithmeticType),
+    ArithmeticType(IntegerType,FloatingType),
+    IsInteger, Signed,
+    IsIntegerOrPointer,
+    IsFloating,
+    IsPrimitive,
+    IsFirstClass,
+    IsSized, SizeOf, sizeOf,
+    IsFunction,
+    Storable, fromPtr, toPtr,
+    -- ** Others
+    IsScalarOrVector,
+    ShapeOf, ScalarShape, VectorShape,
+    Shape, ShapedType,
+    StructFields,
+    PtrSize, IntSize,
+    UnknownSize, -- needed for arrays of structs
+    -- ** Structs
+    ConsStruct(..), consStruct,
+    CurryStruct, Curried, curryStruct, uncurryStruct,
+    (:&), (&),
+    -- ** Type tests
+    TypeDesc(..),
+    isFloating,
+    isSigned,
+    typeRef,
+    unsafeTypeRef,
+    typeName,
+    intrinsicTypeName,
+    typeDesc2,
+    VarArgs, CastVarArgs,
+    ) where
+
+import qualified LLVM.FFI.Core as FFI
+
+import qualified LLVM.Core.Data as Data
+import LLVM.Core.Util (functionType, structType)
+import LLVM.Core.Data
+        (IntN, WordN, Vector, Array, FP128,
+         Struct(Struct), PackedStruct(PackedStruct), Label)
+import LLVM.Core.Proxy (Proxy(Proxy))
+
+import qualified Type.Data.Num.Decimal.Number as Dec
+import Type.Data.Num.Decimal.Number ((:*:))
+import Type.Data.Num.Decimal.Literal (D1, D8, D16, D32, D64, D128, D99)
+import Type.Data.Bool (True, False)
+
+import qualified Foreign
+import Foreign.StablePtr (StablePtr, )
+import Foreign.Ptr (FunPtr)
+import System.IO.Unsafe (unsafePerformIO)
+
+import Data.Typeable (Typeable)
+import Data.List (intercalate)
+import Data.Bits (bitSize)
+import Data.Int (Int8, Int16, Int32, Int64)
+import Data.Word (Word8, Word16, Word32, Word64, Word)
+
+
+#include "MachDeps.h"
+
+-- TODO:
+-- Move IntN, WordN to a special module that implements those types
+--   properly in Haskell.
+-- Also move Array and Vector to a Haskell module to implement them.
+-- Add Label?
+-- Add structures (using tuples, maybe nested).
+
+-- |The 'IsType' class classifies all types that have an LLVM representation.
+class IsType a where
+    typeDesc :: Proxy a -> TypeDesc
+
+typeRef :: (IsType a) => Proxy a -> IO FFI.TypeRef
+typeRef = code . typeDesc
+  where code TDFloat  = FFI.floatType
+        code TDDouble = FFI.doubleType
+        code TDFP128  = FFI.fp128Type
+        code TDVoid   = FFI.voidType
+        code (TDInt _ n)  = FFI.integerType (fromInteger n)
+        code (TDArray n a) = withCode FFI.arrayType (code a) (fromInteger n)
+        code (TDVector n a) = withCode FFI.vectorType (code a) (fromInteger n)
+        code (TDPtr a) = withCode FFI.pointerType (code a) 0
+        code (TDFunction va as b) = do
+            bt <- code b
+            ast <- mapM code as
+            functionType va bt ast
+        code TDLabel = FFI.labelType
+        code (TDStruct ts packed) = withCode structType (mapM code ts) packed
+        code TDInvalidType = error "typeRef TDInvalidType"
+
+unsafeTypeRef :: (IsType a) => Proxy a -> FFI.TypeRef
+unsafeTypeRef = unsafePerformIO . typeRef
+
+
+withCode ::
+    Monad m =>
+    (a -> b -> m c) ->
+    m a -> b -> m c
+withCode f mx y =
+    mx >>= \x -> f x y
+
+
+typeName :: (IsType a) => Proxy a -> String
+typeName = code . typeDesc
+  where code TDFloat  = "f32"
+        code TDDouble = "f64"
+        code TDFP128  = "f128"
+        code TDVoid   = "void"
+        code (TDInt _ n)  = "i" ++ show n
+        code (TDArray n a) = "[" ++ show n ++ " x " ++ code a ++ "]"
+        code (TDVector n a) = "<" ++ show n ++ " x " ++ code a ++ ">"
+        code (TDPtr a) = code a ++ "*"
+        code (TDFunction _ as b) = code b ++ "(" ++ intercalate "," (map code as) ++ ")"
+        code TDLabel = "label"
+        code (TDStruct as packed) = (if packed then "<{" else "{") ++
+                                    intercalate "," (map code as) ++
+                                    (if packed then "}>" else "}")
+        code TDInvalidType = error "typeName TDInvalidType"
+
+intrinsicTypeName :: (IsType a) => Proxy a -> String
+intrinsicTypeName = code . typeDesc
+  where code TDFloat  = "f32"
+        code TDDouble = "f64"
+        code TDFP128  = "f128"
+        code (TDInt _ n)  = "i" ++ show n
+        code (TDVector n a) = "v" ++ show n ++ code a
+        code _ = error "intrinsicTypeName: type not supported in intrinsics"
+
+typeDesc2 :: FFI.TypeRef -> IO TypeDesc
+typeDesc2 t = do
+    tk <- FFI.getTypeKind t
+    case tk of
+      FFI.VoidTypeKind -> return TDVoid
+      FFI.FloatTypeKind -> return TDFloat
+      FFI.DoubleTypeKind -> return TDDouble
+      -- FIXME: FFI.X86_FP80TypeKind -> return "X86_FP80"
+      FFI.FP128TypeKind -> return TDFP128
+      -- FIXME: FFI.PPC_FP128TypeKind -> return "PPC_FP128"
+      FFI.LabelTypeKind -> return TDLabel
+      FFI.IntegerTypeKind -> do
+                n <- FFI.getIntTypeWidth t
+                return $ TDInt False (fromIntegral n)
+      -- FIXME: FFI.FunctionTypeKind
+      -- FIXME: FFI.StructTypeKind -> return "(Struct ...)"
+      FFI.ArrayTypeKind -> do
+                n <- FFI.getArrayLength t
+                et <- FFI.getElementType t
+                etd <- typeDesc2 et
+                return $ TDArray (fromIntegral n) etd
+      FFI.PointerTypeKind -> do
+                et <- FFI.getElementType t
+                etd <- typeDesc2 et
+                return $ TDPtr etd
+      -- FIXME: FFI.OpaqueTypeKind -> return "Opaque"
+      FFI.VectorTypeKind -> do
+                n <- FFI.getVectorSize t
+                et <- FFI.getElementType t
+                etd <- typeDesc2 et
+                return $ TDVector (fromIntegral n) etd
+      -- FIXME: LLVMMetadataTypeKind,    /**< Metadata */
+      -- FIXME: LLVMX86_MMXTypeKind      /**< X86 MMX */
+      _ -> return TDInvalidType
+
+-- |Type descriptor, used to convey type information through the LLVM API.
+data TypeDesc = TDFloat | TDDouble | TDFP128 | TDVoid | TDInt Bool Integer
+              | TDArray Integer TypeDesc | TDVector Integer TypeDesc
+              | TDPtr TypeDesc | TDFunction Bool [TypeDesc] TypeDesc | TDLabel
+              | TDStruct [TypeDesc] Bool | TDInvalidType
+    deriving (Eq, Ord, Show, Typeable)
+
+-- XXX isFloating and typeName could be extracted from typeRef
+-- Usage:
+--   superclass of IsConst
+--   add, sub, mul, neg context
+--   used to get type name to call intrinsic
+-- |Arithmetic types, i.e., integral and floating types.
+class IsFirstClass a => IsArithmetic a where
+    arithmeticType :: ArithmeticType a
+
+data ArithmeticType a = IntegerType | FloatingType
+
+instance Functor ArithmeticType where
+    fmap _ IntegerType  = IntegerType
+    fmap _ FloatingType = FloatingType
+
+vectorArithmeticType :: ArithmeticType a -> ArithmeticType (Vector n a)
+vectorArithmeticType t =
+    case t of
+        IntegerType  -> IntegerType
+        FloatingType -> FloatingType
+
+
+-- Usage:
+--  constI, allOnes
+--  many instructions.  XXX some need vector
+--  used to find signedness in Arithmetic
+-- |Integral types.
+class (IsArithmetic a, IsIntegerOrPointer a) => IsInteger a where
+   type Signed a :: *
+
+-- Usage:
+--  icmp
+-- |Integral or pointer type.
+class IsIntegerOrPointer a
+
+isSigned :: (IsArithmetic a) => Proxy a -> Bool
+isSigned = is . typeDesc
+  where is (TDInt s _) = s
+        is (TDVector _ a) = is a
+        is TDFloat = True
+        is TDDouble = True
+        is TDFP128 = True
+        is _ = error "isSigned got impossible input"
+
+-- Usage:
+--  constF
+--  many instructions
+-- |Floating types.
+class IsArithmetic a => IsFloating a
+
+isFloating :: (IsArithmetic a) => Proxy a -> Bool
+isFloating = is . typeDesc
+  where is TDFloat = True
+        is TDDouble = True
+        is TDFP128 = True
+        is (TDVector _ a) = is a
+        is _ = False
+
+-- Usage:
+--  Precondition for Vector
+-- |Primitive types.
+-- class (IsType a) => IsPrimitive a
+class (IsScalarOrVector a, ShapeOf a ~ ScalarShape) => IsPrimitive a
+
+data ScalarShape
+data VectorShape n
+
+class Shape shape where
+    type ShapedType shape a :: *
+
+instance Shape ScalarShape where
+    type ShapedType ScalarShape a = a
+
+instance Shape (VectorShape n) where
+    type ShapedType (VectorShape n) a = Vector n a
+
+-- |Number of elements for instructions that handle both primitive and vector types
+class (IsFirstClass a) => IsScalarOrVector a where
+    type ShapeOf a :: *
+
+
+-- Usage:
+--  Precondition for function args and result.
+--  Used by some instructions, like ret and phi.
+--  XXX IsSized as precondition?
+-- |First class types, i.e., the types that can be passed as arguments, etc.
+class IsType a => IsFirstClass a
+
+-- Usage:
+--  Context for Array being a type
+--  thus, allocation instructions
+-- |Types with a fixed size.
+class (IsType a, Dec.Natural (SizeOf a)) => IsSized a where
+    type SizeOf a :: *
+
+sizeOf :: TypeDesc -> Integer
+sizeOf TDFloat  = 32
+sizeOf TDDouble = 64
+sizeOf TDFP128  = 128
+sizeOf (TDInt _ bits) = bits
+sizeOf (TDArray n typ) = n * sizeOf typ
+sizeOf (TDVector n typ) = n * sizeOf typ
+sizeOf (TDStruct ts _packed) = sum (map sizeOf ts)
+sizeOf _ = error "type has no size"
+
+-- |Function type.
+class (IsType a) => IsFunction a where
+    funcType :: [TypeDesc] -> Proxy a -> TypeDesc
+
+-- Only make instances for types that make sense in Haskell
+-- (i.e., some floating types are excluded).
+
+-- Floating point types.
+instance IsType Float  where typeDesc _ = TDFloat
+instance IsType Double where typeDesc _ = TDDouble
+instance IsType FP128  where typeDesc _ = TDFP128
+
+-- Void type
+instance IsType ()     where typeDesc _ = TDVoid
+
+-- Label type
+instance IsType Label  where typeDesc _ = TDLabel
+
+-- Variable size integer types
+instance (Dec.Positive n) => IsType (IntN n)
+    where typeDesc _ =
+             TDInt True
+                (Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n))
+
+instance (Dec.Positive n) => IsType (WordN n)
+    where typeDesc _ =
+             TDInt False
+                (Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n))
+
+-- Fixed size integer types.
+instance IsType Bool   where typeDesc _ = TDInt False  1
+instance IsType Word8  where typeDesc _ = TDInt False  8
+instance IsType Word16 where typeDesc _ = TDInt False 16
+instance IsType Word32 where typeDesc _ = TDInt False 32
+instance IsType Word64 where typeDesc _ = TDInt False 64
+instance IsType Word   where
+   typeDesc _ = TDInt False (toInteger$bitSize(0::Word))
+instance IsType Int8   where typeDesc _ = TDInt True   8
+instance IsType Int16  where typeDesc _ = TDInt True  16
+instance IsType Int32  where typeDesc _ = TDInt True  32
+instance IsType Int64  where typeDesc _ = TDInt True  64
+instance IsType Int    where
+   typeDesc _ = TDInt True  (toInteger$bitSize(0::Int))
+
+-- Sequence types
+instance (Dec.Natural n, IsSized a) => IsType (Array n a)
+    where typeDesc _ =
+             TDArray
+                (Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n))
+                (typeDesc (Proxy :: Proxy a))
+instance (Dec.Positive n, IsPrimitive a) => IsType (Vector n a)
+    where typeDesc _ =
+             TDVector
+                (Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n))
+                (typeDesc (Proxy :: Proxy a))
+
+-- Pointer type.
+instance IsType (Foreign.Ptr a) where
+    typeDesc _ = TDPtr (typeDesc (Proxy :: Proxy (Struct ())))
+
+instance (IsType a) => IsType (Data.Ptr a) where
+    typeDesc _ = TDPtr (typeDesc (Proxy :: Proxy a))
+
+instance (IsFunction f) => IsType (FunPtr f) where
+    typeDesc _ = TDPtr (typeDesc (Proxy :: Proxy f))
+
+instance IsType (StablePtr a) where
+    typeDesc _ = TDPtr (typeDesc (Proxy :: Proxy (Struct ())))
+{-
+    typeDesc _ = TDPtr TDVoid
+
+List: Type.cpp:1311: static llvm::PointerType* llvm::PointerType::get(const llvm::Type*, unsigned int): Assertion `ValueType != Type::VoidTy && "Pointer to void is not valid, use sbyte* instead!"' failed.
+-}
+
+
+-- Functions.
+instance (IsFirstClass a, IsFunction b) => IsType (a->b) where
+    typeDesc = funcType []
+
+-- Function base type, always IO.
+instance (IsFirstClass a) => IsType (IO a) where
+    typeDesc = funcType []
+
+-- Struct types, basically a list of component types.
+instance (StructFields a) => IsType (Struct a) where
+    typeDesc p = TDStruct (fieldTypes $ fmap (\(Struct a) -> a) p) False
+
+instance (StructFields a) => IsType (PackedStruct a) where
+    typeDesc p = TDStruct (fieldTypes $ fmap (\(PackedStruct a) -> a) p) True
+
+-- Use a nested tuples for struct fields.
+class StructFields as where
+    fieldTypes :: Proxy as -> [TypeDesc]
+
+instance (IsSized a, StructFields as) => StructFields (a :& as) where
+    fieldTypes p = typeDesc (fmap fst p) : fieldTypes (fmap snd p)
+instance StructFields () where
+    fieldTypes Proxy = []
+
+
+-- Simplifies construction, pattern matching and conversion to and from records
+class ConsStruct f where
+    type PartialStruct f
+    type ConsResult f
+    curryConsStruct :: (PartialStruct f -> Struct (ConsResult f)) -> f
+
+instance ConsStruct (Struct a) where
+    type PartialStruct (Struct a) = ()
+    type ConsResult (Struct a) = a
+    curryConsStruct g = g ()
+
+instance (ConsStruct f) => ConsStruct (a->f) where
+    type PartialStruct (a->f) = (a, PartialStruct f)
+    type ConsResult (a->f) = ConsResult f
+    curryConsStruct g a = curryConsStruct (\r -> g (a,r))
+
+consStruct :: (ConsStruct f, ConsResult f ~ PartialStruct f) => f
+consStruct = curryConsStruct Struct
+
+class CurryStruct a where
+    type Curried a b
+    curryStruct' :: (a -> b) -> Curried a b
+    uncurryStruct' :: Curried a b -> a -> b
+
+instance CurryStruct () where
+    type Curried () b = b
+    curryStruct' f = f ()
+    uncurryStruct' f () = f
+
+instance (CurryStruct r) => CurryStruct (a,r) where
+    type Curried (a,r) b = a -> Curried r b
+    curryStruct' f a = curryStruct' (\r -> f (a,r))
+    uncurryStruct' f (a,r) = uncurryStruct' (f a) r
+
+curryStruct :: (CurryStruct a) => (Struct a -> b) -> Curried a b
+curryStruct f = curryStruct' (f . Struct)
+
+uncurryStruct :: (CurryStruct a) => Curried a b -> (Struct a -> b)
+uncurryStruct f (Struct a) = uncurryStruct' f a
+
+
+-- An alias for pairs to make structs look nicer
+infixr :&
+type (:&) a as = (a, as)
+infixr &
+(&) :: a -> as -> a :& as
+a & as = (a, as)
+
+
+--- Instances to classify types
+instance IsArithmetic Float  where arithmeticType = FloatingType
+instance IsArithmetic Double where arithmeticType = FloatingType
+instance IsArithmetic FP128  where arithmeticType = FloatingType
+instance (Dec.Positive n) => IsArithmetic (IntN n)  where arithmeticType = IntegerType
+instance (Dec.Positive n) => IsArithmetic (WordN n) where arithmeticType = IntegerType
+{-
+This instance is more dangerous than useful.
+E.g. 'inv' can be mixed up with 'neg'.
+For arithmetic on i1 you might better use @IntN D1@ or @WordN D1@.
+-}
+instance IsArithmetic Bool   where arithmeticType = IntegerType
+instance IsArithmetic Int8   where arithmeticType = IntegerType
+instance IsArithmetic Int16  where arithmeticType = IntegerType
+instance IsArithmetic Int32  where arithmeticType = IntegerType
+instance IsArithmetic Int64  where arithmeticType = IntegerType
+instance IsArithmetic Int    where arithmeticType = IntegerType
+instance IsArithmetic Word8  where arithmeticType = IntegerType
+instance IsArithmetic Word16 where arithmeticType = IntegerType
+instance IsArithmetic Word32 where arithmeticType = IntegerType
+instance IsArithmetic Word64 where arithmeticType = IntegerType
+instance IsArithmetic Word   where arithmeticType = IntegerType
+instance (Dec.Positive n, IsPrimitive a, IsArithmetic a) =>
+         IsArithmetic (Vector n a) where
+   arithmeticType = vectorArithmeticType arithmeticType
+--   arithmeticType = fmap (pure :: a -> Vector n a) arithmeticType
+
+instance IsFloating Float
+instance IsFloating Double
+instance IsFloating FP128
+instance (Dec.Positive n, IsPrimitive a, IsFloating a) => IsFloating (Vector n a)
+
+data Indecisive
+
+instance (Dec.Positive n) => IsInteger (IntN  n) where type Signed (IntN  n) = True
+instance (Dec.Positive n) => IsInteger (WordN n) where type Signed (WordN n) = False
+instance IsInteger Bool   where type Signed Bool = Indecisive
+instance IsInteger Int8   where type Signed Int8 = True
+instance IsInteger Int16  where type Signed Int16 = True
+instance IsInteger Int32  where type Signed Int32 = True
+instance IsInteger Int64  where type Signed Int64 = True
+instance IsInteger Int    where type Signed Int   = True
+instance IsInteger Word8  where type Signed Word8 = False
+instance IsInteger Word16 where type Signed Word16 = False
+instance IsInteger Word32 where type Signed Word32 = False
+instance IsInteger Word64 where type Signed Word64 = False
+instance IsInteger Word   where type Signed Word   = False
+instance (Dec.Positive n, IsPrimitive a, IsInteger a) => IsInteger (Vector n a)
+                          where type Signed (Vector n a) = Signed a
+
+instance (Dec.Positive n) => IsIntegerOrPointer (IntN n)
+instance (Dec.Positive n) => IsIntegerOrPointer (WordN n)
+instance IsIntegerOrPointer Bool
+instance IsIntegerOrPointer Int8
+instance IsIntegerOrPointer Int16
+instance IsIntegerOrPointer Int32
+instance IsIntegerOrPointer Int64
+instance IsIntegerOrPointer Int
+instance IsIntegerOrPointer Word8
+instance IsIntegerOrPointer Word16
+instance IsIntegerOrPointer Word32
+instance IsIntegerOrPointer Word64
+instance IsIntegerOrPointer Word
+instance (Dec.Positive n, IsPrimitive a, IsInteger a) => IsIntegerOrPointer (Vector n a)
+instance IsIntegerOrPointer (Foreign.Ptr a)
+instance (IsType a) => IsIntegerOrPointer (Data.Ptr a)
+
+instance IsFirstClass Float
+instance IsFirstClass Double
+instance IsFirstClass FP128
+instance (Dec.Positive n) => IsFirstClass (IntN n)
+instance (Dec.Positive n) => IsFirstClass (WordN n)
+instance IsFirstClass Bool
+instance IsFirstClass Int
+instance IsFirstClass Int8
+instance IsFirstClass Int16
+instance IsFirstClass Int32
+instance IsFirstClass Int64
+instance IsFirstClass Word
+instance IsFirstClass Word8
+instance IsFirstClass Word16
+instance IsFirstClass Word32
+instance IsFirstClass Word64
+instance (Dec.Positive n, IsPrimitive a) => IsFirstClass (Vector n a)
+instance (Dec.Natural n, IsSized a) => IsFirstClass (Array n a)
+instance IsFirstClass (Foreign.Ptr a)
+instance (IsType a) => IsFirstClass (Data.Ptr a)
+instance (IsFunction a) => IsFirstClass (FunPtr a)
+instance IsFirstClass (StablePtr a)
+instance IsFirstClass Label
+instance IsFirstClass () -- XXX This isn't right, but () can be returned
+instance (StructFields as) => IsFirstClass (Struct as)
+
+
+{- |
+Types where LLVM and 'Foreign.Storable' memory layout are compatible.
+-}
+class (Foreign.Storable a, IsFirstClass a, IsSized a) => Storable a
+instance Storable Float
+instance Storable Double
+instance Storable Int
+instance Storable Int8
+instance Storable Int16
+instance Storable Int32
+instance Storable Int64
+instance Storable Word
+instance Storable Word8
+instance Storable Word16
+instance Storable Word32
+instance Storable Word64
+instance (Foreign.Storable a) => Storable (Foreign.Ptr a)
+instance (IsType a) => Storable (Data.Ptr a)
+instance (IsFunction a) => Storable (FunPtr a)
+instance Storable (StablePtr a) where
+
+fromPtr :: (Storable a) => Foreign.Ptr a -> Data.Ptr a
+fromPtr = Data.uncheckedFromPtr
+
+toPtr :: (Storable a) => Data.Ptr a -> Foreign.Ptr a
+toPtr = Data.uncheckedToPtr
+
+
+instance (Dec.Positive n) => IsSized (IntN n)  where type SizeOf (IntN  n) = n
+instance (Dec.Positive n) => IsSized (WordN n) where type SizeOf (WordN n) = n
+instance IsSized Float  where type SizeOf Float  = D32
+instance IsSized Double where type SizeOf Double = D64
+instance IsSized FP128  where type SizeOf FP128  = D128
+instance IsSized Bool   where type SizeOf Bool   = D1
+instance IsSized Int8   where type SizeOf Int8   = D8
+instance IsSized Int16  where type SizeOf Int16  = D16
+instance IsSized Int32  where type SizeOf Int32  = D32
+instance IsSized Int64  where type SizeOf Int64  = D64
+instance IsSized Int    where type SizeOf Int    = IntSize
+instance IsSized Word8  where type SizeOf Word8  = D8
+instance IsSized Word16 where type SizeOf Word16 = D16
+instance IsSized Word32 where type SizeOf Word32 = D32
+instance IsSized Word64 where type SizeOf Word64 = D64
+instance IsSized Word   where type SizeOf Word   = IntSize
+{-
+Can we derive Dec.Natural (n :*: SizeOf a)
+from (Dec.Natural n, Dec.Natural (n :*: SizeOf a))?
+-}
+instance
+    (Dec.Natural n, IsSized a, Dec.Natural (n :*: SizeOf a)) =>
+        IsSized (Array n a) where
+    type SizeOf (Array n a) = n :*: SizeOf a
+instance
+    (Dec.Positive n, IsPrimitive a, IsSized a, Dec.Natural (n :*: SizeOf a)) =>
+        IsSized (Vector n a) where
+    type SizeOf (Vector n a) = n :*: SizeOf a
+instance IsSized (Foreign.Ptr a) where type SizeOf (Foreign.Ptr a) = PtrSize
+instance (IsType a) => IsSized (Data.Ptr a) where
+    type SizeOf (Data.Ptr a) = PtrSize
+instance (IsFunction a) => IsSized (FunPtr a) where
+    type SizeOf (FunPtr a) =  PtrSize
+instance IsSized (StablePtr a) where type SizeOf (StablePtr a) =  PtrSize
+-- instance IsSized Label PtrSize -- labels are not quite first classed
+-- We cannot compute the sizes statically :(
+instance (StructFields as) => IsSized (Struct as) where
+    type SizeOf (Struct as) = UnknownSize
+instance (StructFields as) => IsSized (PackedStruct as) where
+    type SizeOf (PackedStruct as) = UnknownSize
+
+type UnknownSize = D99   -- XXX this is wrong!
+
+type IntSize = PtrSize
+#if WORD_SIZE_IN_BITS == 32
+type PtrSize = D32
+#elif WORD_SIZE_IN_BITS == 64
+type PtrSize = D64
+#else
+#error cannot determine type of PtrSize
+#endif
+
+instance IsPrimitive Float
+instance IsPrimitive Double
+instance IsPrimitive FP128
+instance (Dec.Positive n) => IsPrimitive (IntN n)
+instance (Dec.Positive n) => IsPrimitive (WordN n)
+instance IsPrimitive Bool
+instance IsPrimitive Int8
+instance IsPrimitive Int16
+instance IsPrimitive Int32
+instance IsPrimitive Int64
+instance IsPrimitive Int
+instance IsPrimitive Word8
+instance IsPrimitive Word16
+instance IsPrimitive Word32
+instance IsPrimitive Word64
+instance IsPrimitive Word
+instance IsPrimitive Label
+instance IsPrimitive ()
+instance IsPrimitive (Foreign.Ptr a)
+instance (IsType a) => IsPrimitive (Data.Ptr a)
+
+
+instance (Dec.Positive n) =>
+         IsScalarOrVector (IntN n)  where type ShapeOf (IntN n)  = ScalarShape
+instance (Dec.Positive n) =>
+         IsScalarOrVector (WordN n) where type ShapeOf (WordN n) = ScalarShape
+instance IsScalarOrVector Float  where type ShapeOf Float  = ScalarShape
+instance IsScalarOrVector Double where type ShapeOf Double = ScalarShape
+instance IsScalarOrVector FP128  where type ShapeOf FP128  = ScalarShape
+instance IsScalarOrVector Bool   where type ShapeOf Bool   = ScalarShape
+instance IsScalarOrVector Int8   where type ShapeOf Int8   = ScalarShape
+instance IsScalarOrVector Int16  where type ShapeOf Int16  = ScalarShape
+instance IsScalarOrVector Int32  where type ShapeOf Int32  = ScalarShape
+instance IsScalarOrVector Int64  where type ShapeOf Int64  = ScalarShape
+instance IsScalarOrVector Int    where type ShapeOf Int    = ScalarShape
+instance IsScalarOrVector Word8  where type ShapeOf Word8  = ScalarShape
+instance IsScalarOrVector Word16 where type ShapeOf Word16 = ScalarShape
+instance IsScalarOrVector Word32 where type ShapeOf Word32 = ScalarShape
+instance IsScalarOrVector Word64 where type ShapeOf Word64 = ScalarShape
+instance IsScalarOrVector Word   where type ShapeOf Word   = ScalarShape
+instance IsScalarOrVector Label  where type ShapeOf Label  = ScalarShape
+instance IsScalarOrVector ()     where type ShapeOf ()     = ScalarShape
+instance IsScalarOrVector (Foreign.Ptr a) where
+    type ShapeOf (Foreign.Ptr a) = ScalarShape
+instance (IsType a) => IsScalarOrVector (Data.Ptr a) where
+    type ShapeOf (Data.Ptr a) = ScalarShape
+
+instance (Dec.Positive n, IsPrimitive a) =>
+         IsScalarOrVector (Vector n a) where
+    type ShapeOf (Vector n a) = VectorShape n
+
+
+-- Functions.
+instance (IsFirstClass a, IsFunction b) => IsFunction (a->b) where
+    funcType ts _ = funcType (typeDesc (Proxy :: Proxy a) : ts) (Proxy :: Proxy b)
+instance (IsFirstClass a) => IsFunction (IO a) where
+    funcType ts _ = TDFunction False (reverse ts) (typeDesc (Proxy :: Proxy a))
+instance (IsFirstClass a) => IsFunction (VarArgs a) where
+    funcType ts _ = TDFunction True  (reverse ts) (typeDesc (Proxy :: Proxy a))
+
+-- |The 'VarArgs' type is a placeholder for the real 'IO' type that
+-- can be obtained with 'castVarArgs'.
+data VarArgs a
+    deriving (Typeable)
+instance IsType (VarArgs a) where
+    typeDesc _ = error "typeDesc: Dummy type VarArgs used incorrectly"
+
+-- |Define what vararg types are permissible.
+class CastVarArgs a b
+instance (x~y, CastVarArgs a b) => CastVarArgs (x -> a) (y -> b)
+instance (x~y) => CastVarArgs (VarArgs x) (IO y)
+instance (IsFirstClass x, CastVarArgs (VarArgs a) b) =>
+            CastVarArgs (VarArgs a) (x -> b)
+
+
+
+
+-- XXX Structures not implemented.  Tuples is probably an easy way.
+
diff --git a/private/LLVM/Core/UnaryVector.hs b/private/LLVM/Core/UnaryVector.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/Core/UnaryVector.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE TypeFamilies #-}
+module LLVM.Core.UnaryVector (
+   T, vector, cyclicVector,
+   FixedLength.fromFixedList, FixedLength.toFixedList, FixedLength.head,
+   FixedList, Length,
+   FixedLength.Curried, FixedLength.uncurry, FixedLength.curry,
+   ) where
+
+import qualified Type.Data.Num.Unary as Unary
+
+import qualified Data.FixedLength as FixedLength
+import Data.FixedLength (T, List, Length, end, (!:))
+
+import qualified Data.NonEmpty as NonEmpty
+
+import Prelude hiding (head)
+
+
+type FixedList n = List n
+
+
+vector :: (Unary.Natural n, n ~ Length (List n)) => List n a -> T n a
+vector = FixedLength.fromFixedList
+
+cyclicVector :: (Unary.Natural n) => NonEmpty.T [] a -> T n a
+cyclicVector xt@(NonEmpty.Cons x xs) =
+   runOp0 $
+   Unary.switchNat
+      (Op0 end)
+      (Op0 $ x !: cyclicVectorAppend xt xs)
+
+cyclicVectorAppend :: (Unary.Natural n) => NonEmpty.T [] a -> [a] -> T n a
+cyclicVectorAppend ys xt =
+   runOp0 $
+   Unary.switchNat
+      (Op0 end)
+      (Op0 $
+       case xt of
+          [] -> cyclicVector ys
+          x:xs -> x !: cyclicVectorAppend ys xs)
+
+newtype Op0 a n = Op0 {runOp0 :: T n a}
diff --git a/private/LLVM/Core/Util.hs b/private/LLVM/Core/Util.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/Core/Util.hs
@@ -0,0 +1,480 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+module LLVM.Core.Util(
+    -- * Module handling
+    Module(..), withModule, createModule, destroyModule, writeBitcodeToFile, readBitcodeFromFile,
+    getModuleValues, getFunctions, getGlobalVariables, valueHasType,
+    -- * Pass manager handling
+    PassManager(..), withPassManager, createPassManager, createFunctionPassManager,
+    runFunctionPassManager, initializeFunctionPassManager, finalizeFunctionPassManager,
+    -- * Instruction builder
+    Builder(..), withBuilder, createBuilder, positionAtEnd, getInsertBlock,
+    -- * Basic blocks
+    BasicBlock,
+    appendBasicBlock, getBasicBlocks,
+    -- * Functions
+    Function,
+    addFunction, getParam, getParams,
+    -- * Structs
+    structType,
+    -- * Globals
+    addGlobal,
+    constString, constStringNul, constVector, constArray, constStruct,
+    -- * Instructions
+    makeCall, makeInvoke,
+    makeCallWithCc, makeInvokeWithCc,
+    withValue, getInstructions, getOperands,
+    -- * Uses and Users
+    hasUsers, getUsers, getUses, getUser, isChildOf, getDep,
+    -- * Misc
+    CString, withArrayLen,
+    withEmptyCString,
+    functionType, buildEmptyPhi, addPhiIns,
+    showTypeOf, getValueNameU, getObjList, annotateValueList,
+    isConstant, isIntrinsic,
+    -- * Transformation passes
+    addCFGSimplificationPass, addConstantPropagationPass, addDemoteMemoryToRegisterPass,
+    addGVNPass, addInstructionCombiningPass, addPromoteMemoryToRegisterPass, addReassociatePass,
+    ) where
+
+import qualified LLVM.FFI.Core as FFI
+import qualified LLVM.FFI.BitWriter as FFI
+import qualified LLVM.FFI.BitReader as FFI
+import qualified LLVM.FFI.Transforms.Scalar as FFI
+
+import Foreign.C.String (withCString, withCStringLen, CString, peekCString)
+import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr)
+import Foreign.Ptr (Ptr, nullPtr)
+import Foreign.Marshal.Array (withArrayLen, withArray, allocaArray, peekArray)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Storable (Storable(..))
+import System.IO.Unsafe (unsafePerformIO)
+
+import Data.Typeable (Typeable)
+import Data.List (intercalate)
+import Control.Monad (liftM, when)
+
+
+type Type = FFI.TypeRef
+
+functionType :: Bool -> Type -> [Type] -> IO Type
+functionType varargs retType paramTypes =
+    withArrayLen paramTypes $ \ len ptr ->
+        FFI.functionType retType ptr (fromIntegral len) (FFI.consBool varargs)
+
+structType :: [Type] -> Bool -> IO Type
+structType types packed =
+    withArrayLen types $ \ len ptr ->
+        FFI.structType ptr (fromIntegral len) (FFI.consBool packed)
+
+--------------------------------------
+-- Handle modules
+
+-- Don't use a finalizer for the module, but instead provide an
+-- explicit destructor.  This is because handing a module to
+-- a module provider changes ownership of the module to the provider,
+-- and we don't want to free it by mistake.
+
+-- | Type of top level modules.
+newtype Module = Module {
+      fromModule :: FFI.ModuleRef
+    }
+    deriving (Show, Typeable)
+
+withModule :: Module -> (FFI.ModuleRef -> IO a) -> IO a
+withModule modul f = f (fromModule modul)
+
+createModule :: String -> IO Module
+createModule name =
+    withCString name $ \ namePtr -> do
+      liftM Module $ FFI.moduleCreateWithName namePtr
+
+-- | Free all storage related to a module.  *Note*, this is a dangerous call, since referring
+-- to the module after this call is an error.  The reason for the explicit call to free
+-- the module instead of an automatic lifetime management is that modules have a
+-- somewhat complicated ownership.  Handing a module to a module provider changes
+-- the ownership of the module, and the module provider will free the module when necessary.
+destroyModule :: Module -> IO ()
+destroyModule = FFI.disposeModule . fromModule
+
+-- |Write a module to a file.
+writeBitcodeToFile :: String -> Module -> IO ()
+writeBitcodeToFile name mdl =
+    withCString name $ \ namePtr ->
+      withModule mdl $ \ mdlPtr -> do
+        rc <- FFI.writeBitcodeToFile mdlPtr namePtr
+        when (rc /= 0) $
+          ioError $ userError $ "writeBitcodeToFile: return code " ++ show rc
+
+-- |Read a module from a file.
+readBitcodeFromFile :: String -> IO Module
+readBitcodeFromFile name =
+    withCString name $ \ namePtr ->
+      alloca $ \ bufPtr ->
+      alloca $ \ modPtr ->
+      alloca $ \ errStr -> do
+        rrc <- FFI.createMemoryBufferWithContentsOfFile namePtr bufPtr errStr
+        if FFI.deconsBool rrc then do
+            msg <- peek errStr >>= peekCString
+            ioError $ userError $ "readBitcodeFromFile: read return code " ++ show rrc ++ ", " ++ msg
+         else do
+            buf <- peek bufPtr
+            prc <- FFI.parseBitcode buf modPtr errStr
+            if FFI.deconsBool prc then do
+                msg <- peek errStr >>= peekCString
+                ioError $ userError $ "readBitcodeFromFile: parse return code " ++ show prc ++ ", " ++ msg
+             else do
+                ptr <- peek modPtr
+                return $ Module ptr
+{-
+                liftM Module $ newForeignPtr FFI.ptrDisposeModule ptr
+-}
+
+getModuleValues :: Module -> IO [(String, Value)]
+getModuleValues mdl = do
+  fs <- getFunctions mdl
+  gs <- getGlobalVariables mdl
+  return (fs ++ gs)
+
+getFunctions :: Module -> IO [(String, Value)]
+getFunctions mdl =
+    getObjList withModule FFI.getFirstFunction FFI.getNextFunction mdl
+      >>= annotateValueList
+
+getGlobalVariables :: Module -> IO [(String, Value)]
+getGlobalVariables mdl =
+    getObjList withModule FFI.getFirstGlobal FFI.getNextGlobal mdl
+      >>= annotateValueList
+
+-- This is safe because we just ask for the type of a value.
+valueHasType :: Value -> Type -> Bool
+valueHasType v t = unsafePerformIO $ do
+    vt <- FFI.typeOf v
+    return $ vt == t  -- LLVM uses hash consing for types, so pointer equality works.
+
+showTypeOf :: Value -> IO String
+showTypeOf v = FFI.typeOf v >>= showType'
+
+showType' :: Type -> IO String
+showType' p = do
+    pk <- FFI.getTypeKind p
+    case pk of
+        FFI.VoidTypeKind -> return "()"
+        FFI.FloatTypeKind -> return "Float"
+        FFI.DoubleTypeKind -> return "Double"
+        FFI.X86_FP80TypeKind -> return "X86_FP80"
+        FFI.FP128TypeKind -> return "FP128"
+        FFI.PPC_FP128TypeKind -> return "PPC_FP128"
+        FFI.LabelTypeKind -> return "Label"
+        FFI.IntegerTypeKind -> do w <- FFI.getIntTypeWidth p; return $ "(IntN " ++ show w ++ ")"
+        FFI.FunctionTypeKind -> do
+            r <- FFI.getReturnType p
+            c <- FFI.countParamTypes p
+            let n = fromIntegral c
+            as <- allocaArray n $ \ args -> do
+                     FFI.getParamTypes p args
+                     peekArray n args
+            ts <- mapM showType' (as ++ [r])
+            return $ "(" ++ intercalate " -> " ts ++ ")"
+        FFI.StructTypeKind -> return "(Struct ...)"
+        FFI.ArrayTypeKind -> do n <- FFI.getArrayLength p; t <- FFI.getElementType p >>= showType'; return $ "(Array " ++ show n ++ " " ++ t ++ ")"
+        FFI.PointerTypeKind -> do t <- FFI.getElementType p >>= showType'; return $ "(Ptr " ++ t ++ ")"
+        FFI.OpaqueTypeKind -> return "Opaque"
+        FFI.VectorTypeKind -> do n <- FFI.getVectorSize p; t <- FFI.getElementType p >>= showType'; return $ "(Vector " ++ show n ++ " " ++ t ++ ")"
+
+--------------------------------------
+-- Handle instruction builders
+
+newtype Builder = Builder {
+      fromBuilder :: ForeignPtr FFI.Builder
+    }
+    deriving (Show, Typeable)
+
+withBuilder :: Builder -> (FFI.BuilderRef -> IO a) -> IO a
+withBuilder = withForeignPtr . fromBuilder
+
+createBuilder :: IO Builder
+createBuilder = do
+    ptr <- FFI.createBuilder
+    liftM Builder $ newForeignPtr FFI.ptrDisposeBuilder ptr
+
+positionAtEnd :: Builder -> FFI.BasicBlockRef -> IO ()
+positionAtEnd bld bblk =
+    withBuilder bld $ \ bldPtr ->
+      FFI.positionAtEnd bldPtr bblk
+
+getInsertBlock :: Builder -> IO FFI.BasicBlockRef
+getInsertBlock bld =
+    withBuilder bld $ \ bldPtr ->
+      FFI.getInsertBlock bldPtr
+
+--------------------------------------
+
+type BasicBlock = FFI.BasicBlockRef
+
+appendBasicBlock :: Function -> String -> IO BasicBlock
+appendBasicBlock func name =
+    withCString name $ \ namePtr ->
+      FFI.appendBasicBlock func namePtr
+
+getBasicBlocks :: Value -> IO [(String, BasicBlock)]
+getBasicBlocks v =
+    getObjList withValue FFI.getFirstBasicBlock FFI.getNextBasicBlock v
+      >>= annotateBasicBlockList
+
+--------------------------------------
+
+type Function = FFI.ValueRef
+
+addFunction :: Module -> FFI.Linkage -> String -> Type -> IO Function
+addFunction modul linkage name typ =
+    withModule modul $ \ modulPtr ->
+      withCString name $ \ namePtr -> do
+        f <- FFI.addFunction modulPtr namePtr typ
+        FFI.setLinkage f (FFI.fromLinkage linkage)
+        return f
+
+getParam :: Function -> Int -> Value
+getParam f = unsafePerformIO . FFI.getParam f . fromIntegral
+
+getParams :: Value -> IO [(String, Value)]
+getParams v =
+    getObjList withValue FFI.getFirstParam FFI.getNextParam v
+      >>= annotateValueList
+
+--------------------------------------
+
+addGlobal :: Module -> FFI.Linkage -> String -> Type -> IO Value
+addGlobal modul linkage name typ =
+    withModule modul $ \ modulPtr ->
+      withCString name $ \ namePtr -> do
+        v <- FFI.addGlobal modulPtr typ namePtr
+        FFI.setLinkage v (FFI.fromLinkage linkage)
+        return v
+
+-- unsafePerformIO is safe because it's only used for the withCStringLen conversion
+constStringInternal :: Bool -> String -> Value
+constStringInternal nulTerm s = unsafePerformIO $
+    withCStringLen s $ \(sPtr, sLen) ->
+      FFI.constString sPtr (fromIntegral sLen) (FFI.consBool (not nulTerm))
+
+constString :: String -> Value
+constString = constStringInternal False
+
+constStringNul :: String -> Value
+constStringNul = constStringInternal True
+
+--------------------------------------
+
+type Value = FFI.ValueRef
+
+withValue :: Value -> (Value -> IO a) -> IO a
+withValue v f = f v
+
+withBasicBlock :: FFI.BasicBlockRef -> (FFI.BasicBlockRef -> IO a) -> IO a
+withBasicBlock v f = f v
+
+makeCall :: Function -> FFI.BuilderRef -> [Value] -> IO Value
+makeCall = makeCallWithCc FFI.C
+
+makeCallWithCc :: FFI.CallingConvention -> Function -> FFI.BuilderRef -> [Value] -> IO Value
+makeCallWithCc cc func bldPtr args = do
+{-
+      print "makeCall"
+      FFI.dumpValue func
+      mapM_ FFI.dumpValue args
+      print "----------------------"
+-}
+      withArrayLen args $ \ argLen argPtr ->
+        withEmptyCString $ \cstr -> do
+          i <- FFI.buildCall bldPtr func argPtr
+                             (fromIntegral argLen) cstr
+          FFI.setInstructionCallConv i (FFI.fromCallingConvention cc)
+          return i
+
+makeInvoke :: BasicBlock -> BasicBlock -> Function -> FFI.BuilderRef ->
+              [Value] -> IO Value
+makeInvoke = makeInvokeWithCc FFI.C
+
+makeInvokeWithCc :: FFI.CallingConvention -> BasicBlock -> BasicBlock -> Function -> FFI.BuilderRef ->
+              [Value] -> IO Value
+makeInvokeWithCc cc norm expt func bldPtr args =
+      withArrayLen args $ \ argLen argPtr ->
+        withEmptyCString $ \cstr -> do
+          i <- FFI.buildInvoke bldPtr func argPtr (fromIntegral argLen) norm expt cstr
+          FFI.setInstructionCallConv i (FFI.fromCallingConvention cc)
+          return i
+
+getInstructions :: BasicBlock -> IO [(String, Value)]
+getInstructions bb =
+    getObjList withBasicBlock FFI.getFirstInstruction FFI.getNextInstruction bb
+      >>= annotateValueList
+
+getOperands :: Value -> IO [(String, Value)]
+getOperands ii = geto ii >>= annotateValueList
+    where geto i = do
+            num <- FFI.getNumOperands i
+            let oloop instr number total = if number >= total then return [] else do
+                    o <- FFI.getOperand instr number
+                    os <- oloop instr (number + 1) total
+                    return (o : os)
+            oloop i 0 num
+
+--------------------------------------
+
+buildEmptyPhi :: FFI.BuilderRef -> Type -> IO Value
+buildEmptyPhi bldPtr typ = do
+    withEmptyCString $ FFI.buildPhi bldPtr typ
+
+withEmptyCString :: (CString -> IO a) -> IO a
+withEmptyCString = withCString ""
+
+addPhiIns :: Value -> [(Value, BasicBlock)] -> IO ()
+addPhiIns inst incoming = do
+    let (vals, bblks) = unzip incoming
+    withArrayLen vals $ \ count valPtr ->
+      withArray bblks $ \ bblkPtr ->
+        FFI.addIncoming inst valPtr bblkPtr (fromIntegral count)
+
+--------------------------------------
+
+-- | Manage compile passes.
+newtype PassManager = PassManager {
+      fromPassManager :: ForeignPtr FFI.PassManager
+    }
+    deriving (Show, Typeable)
+
+withPassManager :: PassManager -> (FFI.PassManagerRef -> IO a)
+                   -> IO a
+withPassManager = withForeignPtr . fromPassManager
+
+-- | Create a pass manager.
+createPassManager :: IO PassManager
+createPassManager = do
+    ptr <- FFI.createPassManager
+    liftM PassManager $ newForeignPtr FFI.ptrDisposePassManager ptr
+
+-- | Create a pass manager for a module.
+createFunctionPassManager :: Module -> IO PassManager
+createFunctionPassManager modul =
+    withModule modul $ \modulPtr -> do
+        ptr <- FFI.createFunctionPassManagerForModule modulPtr
+        liftM PassManager $ newForeignPtr FFI.ptrDisposePassManager ptr
+
+-- | Add a control flow graph simplification pass to the manager.
+addCFGSimplificationPass :: PassManager -> IO ()
+addCFGSimplificationPass pm = withPassManager pm FFI.addCFGSimplificationPass
+
+-- | Add a constant propagation pass to the manager.
+addConstantPropagationPass :: PassManager -> IO ()
+addConstantPropagationPass pm = withPassManager pm FFI.addConstantPropagationPass
+
+addDemoteMemoryToRegisterPass :: PassManager -> IO ()
+addDemoteMemoryToRegisterPass pm = withPassManager pm FFI.addDemoteMemoryToRegisterPass
+
+-- | Add a global value numbering pass to the manager.
+addGVNPass :: PassManager -> IO ()
+addGVNPass pm = withPassManager pm FFI.addGVNPass
+
+addInstructionCombiningPass :: PassManager -> IO ()
+addInstructionCombiningPass pm = withPassManager pm FFI.addInstructionCombiningPass
+
+addPromoteMemoryToRegisterPass :: PassManager -> IO ()
+addPromoteMemoryToRegisterPass pm = withPassManager pm FFI.addPromoteMemoryToRegisterPass
+
+addReassociatePass :: PassManager -> IO ()
+addReassociatePass pm = withPassManager pm FFI.addReassociatePass
+
+runFunctionPassManager :: PassManager -> Function -> IO FFI.Bool
+runFunctionPassManager pm fcn = withPassManager pm $ \ pmref -> FFI.runFunctionPassManager pmref fcn
+
+initializeFunctionPassManager :: PassManager -> IO FFI.Bool
+initializeFunctionPassManager pm = withPassManager pm FFI.initializeFunctionPassManager
+
+finalizeFunctionPassManager :: PassManager -> IO FFI.Bool
+finalizeFunctionPassManager pm = withPassManager pm FFI.finalizeFunctionPassManager
+
+--------------------------------------
+
+constVector :: [Value] -> IO Value
+constVector xs = do
+    withArrayLen xs $ \ len ptr ->
+        FFI.constVector ptr (fromIntegral len)
+
+constArray :: Type -> [Value] -> IO Value
+constArray t xs = do
+    withArrayLen xs $ \ len ptr ->
+        FFI.constArray t ptr (fromIntegral len)
+
+constStruct :: [Value] -> Bool -> IO Value
+constStruct xs packed = do
+    withArrayLen xs $ \ len ptr ->
+        FFI.constStruct ptr (fromIntegral len) (FFI.consBool packed)
+
+--------------------------------------
+
+getValueNameU :: Value -> IO String
+getValueNameU a = do
+    -- sometimes void values need explicit names too
+    str <- peekCString =<< FFI.getValueName a
+    if str == "" then return (show a) else return str
+
+getBasicBlockNameU :: BasicBlock -> IO String
+getBasicBlockNameU a = do
+    str <- peekCString =<< FFI.getBasicBlockName a
+    if str == "" then return (show a) else return str
+
+getObjList ::
+    (obj -> (objPtr -> IO [Ptr a]) -> io) -> (objPtr -> IO (Ptr a)) ->
+    (Ptr a -> IO (Ptr a)) -> obj -> io
+getObjList withF firstF nextF obj =
+    withF obj $ \ objPtr -> do
+      let oloop p =
+            if p == nullPtr
+              then return []
+              else fmap (p:) $ oloop =<< nextF p
+      oloop =<< firstF objPtr
+
+annotateValueList :: [Value] -> IO [(String, Value)]
+annotateValueList vs = do
+  names <- mapM getValueNameU vs
+  return $ zip names vs
+
+annotateBasicBlockList :: [BasicBlock] -> IO [(String, BasicBlock)]
+annotateBasicBlockList vs = do
+  names <- mapM getBasicBlockNameU vs
+  return $ zip names vs
+
+isConstant :: Value -> IO Bool
+isConstant v = fmap FFI.deconsBool $ FFI.isConstant v
+
+isIntrinsic :: Value -> IO Bool
+isIntrinsic v = fmap (/=0) $ FFI.getIntrinsicID v
+
+--------------------------------------
+
+type Use = FFI.UseRef
+
+hasUsers :: Value -> IO Bool
+hasUsers v = fmap (>0) $ FFI.getNumUses v
+
+getUses :: Value -> IO [Use]
+getUses = getObjList withValue FFI.getFirstUse FFI.getNextUse
+
+getUsers :: [Use] -> IO [(String, Value)]
+getUsers us = mapM FFI.getUser us >>= annotateValueList
+
+getUser :: Use -> IO Value
+getUser = FFI.getUser
+
+isChildOf :: BasicBlock -> Value -> IO Bool
+isChildOf bb v = do
+  bb2 <- FFI.getInstructionParent v
+  return $ bb == bb2
+
+getDep :: Use -> IO (String, String)
+getDep u = do
+  producer <- FFI.getUsedValue u >>= getValueNameU
+  consumer <- FFI.getUser u >>= getValueNameU
+  return (producer, consumer)
diff --git a/private/LLVM/Core/Vector.hs b/private/LLVM/Core/Vector.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/Core/Vector.hs
@@ -0,0 +1,284 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE Rank2Types #-}
+module LLVM.Core.Vector (MkVector(..), vector, cyclicVector, consVector) where
+
+import qualified LLVM.Core.UnaryVector as UnaryVector
+import LLVM.Core.Data (Vector(Vector), FixedList)
+
+import qualified Type.Data.Num.Decimal.Proof as DecProof
+import qualified Type.Data.Num.Decimal.Number as Dec
+import qualified Type.Data.Num.Unary as Unary
+import qualified Type.Base.Proxy as Proxy
+import Type.Data.Num.Decimal.Literal (D2, D4, D8)
+
+import qualified Foreign.Storable.Traversable as Store
+import Foreign.Storable.FixedArray (sizeOfArray)
+import Foreign.Storable (Storable(..))
+
+import qualified Test.QuickCheck as QC
+
+import qualified Control.Monad.Trans.State as MS
+import Control.Applicative (Applicative, pure, liftA2, (<*>))
+import Control.Functor.HT (unzip, outerProduct)
+
+import qualified Data.Traversable as Trav
+import qualified Data.Foldable as Fold
+import qualified Data.NonEmpty as NonEmpty
+import qualified Data.Empty as Empty
+import Data.Traversable (Traversable, foldMapDefault)
+import Data.Foldable (Foldable, foldMap)
+
+import Prelude hiding (replicate, map, head, unzip, zipWith, uncurry)
+
+
+-- XXX Should these really be here?
+class (Dec.Positive n) => MkVector n where
+    type Tuple n a :: *
+    toVector :: Tuple n a -> Vector n a
+    fromVector :: Vector n a -> Tuple n a
+
+
+instance MkVector D2 where
+    type Tuple D2 a = (a,a)
+    toVector (a1, a2) = consVector a1 a2
+    fromVector = uncurry (,)
+
+instance MkVector D4 where
+    type Tuple D4 a = (a,a,a,a)
+    toVector (a1, a2, a3, a4) = consVector a1 a2 a3 a4
+    fromVector = uncurry (,,,)
+
+instance MkVector D8 where
+    type Tuple D8 a = (a,a,a,a,a,a,a,a)
+    toVector (a1, a2, a3, a4, a5, a6, a7, a8) =
+        consVector a1 a2 a3 a4 a5 a6 a7 a8
+    fromVector = uncurry (,,,,,,,)
+
+
+head :: (Dec.Positive n) => Vector n a -> a
+head =
+    withPosDict1 $ \dict v ->
+        case dict of
+            DecProof.UnaryPos ->
+                UnaryVector.head . unaryFromDecimalVector $ v
+
+
+unaryFromDecimalVector :: Vector n a -> UnaryVector.T (Dec.ToUnary n) a
+unaryFromDecimalVector (Vector xs) = UnaryVector.fromFixedList xs
+
+decimalFromUnaryVector :: UnaryVector.T (Dec.ToUnary n) a -> Vector n a
+decimalFromUnaryVector = Vector . UnaryVector.toFixedList
+
+
+type Curried n a b = UnaryVector.Curried (Dec.ToUnary n) a b
+
+uncurry :: (Dec.Natural n) => Curried n a b -> Vector n a -> b
+uncurry f =
+    withNatDict1 $ \dict v ->
+        case dict of
+            DecProof.UnaryNat ->
+                UnaryVector.uncurry f $ unaryFromDecimalVector v
+
+
+withNatDict ::
+    (Dec.Natural n) =>
+    (DecProof.UnaryNat n -> Vector n a) -> Vector n a
+withNatDict f = f DecProof.unaryNat
+
+withNatDict1 ::
+    (Dec.Natural n) =>
+    (DecProof.UnaryNat n -> Vector n a -> b) -> Vector n a -> b
+withNatDict1 f = f DecProof.unaryNat
+
+withPosDict1 ::
+    (Dec.Positive n) =>
+    (DecProof.UnaryPos n -> Vector n a -> b) -> Vector n a -> b
+withPosDict1 f = f DecProof.unaryPos
+
+
+withUnaryDecVector ::
+    (Dec.Natural n) =>
+    (forall m. (Dec.ToUnary n ~ m, Unary.Natural m) => UnaryVector.T m a) ->
+    Vector n a
+withUnaryDecVector v =
+    withNatDict
+        (\dict ->
+            case dict of DecProof.UnaryNat -> decimalFromUnaryVector v)
+
+instance (Storable a, Dec.Positive n) => Storable (Vector n a) where
+    sizeOf v = sizeOfArray (Dec.integralFromProxy $ size v) (head v)
+    alignment = alignment . head
+    peek = Store.peekApplicative
+    poke = Store.poke
+
+size :: Vector n a -> Proxy.Proxy n
+size _ = Proxy.Proxy
+
+--------------------------------------
+
+{- maybe we should export this in order to allow NumericPrelude instances
+unVector :: (Dec.Positive n) => Vector n a -> FixedList n a
+unVector (Vector xs) = xs
+-}
+
+vector :: (Dec.Positive n) => FixedList (Dec.ToUnary n) a -> Vector n a
+vector = Vector
+
+{- |
+Make a constant vector.  Replicates or truncates the list to get length /n/.
+This behaviour is consistent uncurry that of 'LLVM.Core.CodeGen.constCyclicVector'.
+May be abused for constructing vectors from lists uncurry statically unknown size.
+-}
+cyclicVector :: (Dec.Positive n) => NonEmpty.T [] a -> Vector n a
+cyclicVector xs =
+   withUnaryDecVector (UnaryVector.cyclicVector xs)
+
+
+class ConsVector f where
+   type NumberOfArguments f
+   type ResultSize f
+   type ResultElement f
+   consAux ::
+      (NumberOfArguments f ~ m, ResultSize f ~ n, ResultElement f ~ a) =>
+      (FixedList m a -> Vector n a) -> f
+
+instance ConsVector (Vector n a) where
+   type NumberOfArguments (Vector n a) = Unary.Zero
+   type ResultSize (Vector n a) = n
+   type ResultElement (Vector n a) = a
+   consAux f = f Empty.Cons
+
+instance (a ~ ResultElement f, ConsVector f) => ConsVector (a -> f) where
+   type NumberOfArguments (a->f) = Unary.Succ (NumberOfArguments f)
+   type ResultSize (a->f) = ResultSize f
+   type ResultElement (a->f) = ResultElement f
+   consAux f x = consAux (f . NonEmpty.Cons x)
+
+consVector ::
+   (ConsVector f, ResultSize f ~ n, NumberOfArguments f ~ u,
+    u ~ Dec.ToUnary n, Dec.FromUnary u ~ n, Dec.Natural n) => f
+consVector = consAux Vector
+
+
+replicate :: (Dec.Positive n) => a -> Vector n a
+replicate a = withUnaryDecVector (pure a)
+
+
+instance (Dec.Positive n) => Functor (Vector n) where
+   fmap f a =
+      withUnaryDecVector (fmap f $ unaryFromDecimalVector a)
+
+instance (Dec.Positive n) => Applicative (Vector n) where
+   pure = replicate
+   f <*> a =
+      withUnaryDecVector
+         (unaryFromDecimalVector f <*> unaryFromDecimalVector a)
+
+instance (Dec.Positive n) => Foldable (Vector n) where
+   foldMap = foldMapDefault
+
+instance (Dec.Positive n) => Traversable (Vector n) where
+   sequenceA =
+      withNatDict1 $ \dict v ->
+         case dict of
+            DecProof.UnaryNat ->
+               fmap decimalFromUnaryVector $ Trav.sequenceA $
+               unaryFromDecimalVector v
+
+
+
+instance (Eq a, Dec.Positive n) => Eq (Vector n a) where
+   x == y  =  Fold.and $ liftA2 (==) x y
+
+instance (Ord a, Dec.Positive n) => Ord (Vector n a) where
+   compare x y =
+      Fold.foldr (\r rs -> if r==EQ then rs else r) EQ $
+      liftA2 compare x y
+
+instance (Num a, Dec.Positive n) => Num (Vector n a) where
+    (+) = liftA2 (+)
+    (-) = liftA2 (-)
+    (*) = liftA2 (*)
+    negate = fmap negate
+    abs = fmap abs
+    signum = fmap signum
+    fromInteger = pure . fromInteger
+
+instance (Enum a, Dec.Positive n) => Enum (Vector n a) where
+    succ = fmap succ
+    pred = fmap pred
+    fromEnum = error "Vector fromEnum"
+    toEnum = pure . toEnum
+
+instance (Real a, Dec.Positive n) => Real (Vector n a) where
+    toRational = error "Vector toRational"
+
+instance (Integral a, Dec.Positive n) => Integral (Vector n a) where
+    quot = liftA2 quot
+    rem  = liftA2 rem
+    div  = liftA2 div
+    mod  = liftA2 mod
+    quotRem xs ys = unzip $ liftA2 quotRem xs ys
+    divMod  xs ys = unzip $ liftA2 divMod  xs ys
+    toInteger = error "Vector toInteger"
+
+instance (Fractional a, Dec.Positive n) => Fractional (Vector n a) where
+    (/) = liftA2 (/)
+    fromRational = pure . fromRational
+
+instance (RealFrac a, Dec.Positive n) => RealFrac (Vector n a) where
+    properFraction = error "Vector properFraction"
+
+instance (Floating a, Dec.Positive n) => Floating (Vector n a) where
+    pi = pure pi
+    sqrt = fmap sqrt
+    log = fmap log
+    logBase = liftA2 logBase
+    (**) = liftA2 (**)
+    exp = fmap exp
+    sin = fmap sin
+    cos = fmap cos
+    tan = fmap tan
+    asin = fmap asin
+    acos = fmap acos
+    atan = fmap atan
+    sinh = fmap sinh
+    cosh = fmap cosh
+    tanh = fmap tanh
+    asinh = fmap asinh
+    acosh = fmap acosh
+    atanh = fmap atanh
+
+instance (RealFloat a, Dec.Positive n) => RealFloat (Vector n a) where
+    floatRadix = floatRadix . head
+    floatDigits = floatDigits . head
+    floatRange = floatRange . head
+    decodeFloat = error "Vector decodeFloat"
+    encodeFloat = error "Vector encodeFloat"
+    exponent _ = 0
+    scaleFloat 0 x = x
+    scaleFloat _ _ = error "Vector scaleFloat"
+    isNaN = error "Vector isNaN"
+    isInfinite = error "Vector isInfinite"
+    isDenormalized = error "Vector isDenormalized"
+    isNegativeZero = error "Vector isNegativeZero"
+    isIEEE = isIEEE . head
+
+
+indices :: (Dec.Positive n) => Vector n Int
+indices =
+    flip MS.evalState 0 $ Trav.sequenceA $ replicate $ MS.state (\k -> (k,k+1))
+
+instance (Dec.Positive n, QC.Arbitrary a) => QC.Arbitrary (Vector n a) where
+    arbitrary = Trav.sequenceA $ replicate QC.arbitrary
+    shrink v =
+        case indices of
+            ixs ->
+                concatMap
+                    (Trav.sequenceA .
+                     liftA2
+                        (\x doShrink ->
+                            if doShrink then QC.shrink x else [x]) v) $
+                outerProduct (==) (Fold.toList ixs) ixs
diff --git a/private/LLVM/ExecutionEngine/Engine.hs b/private/LLVM/ExecutionEngine/Engine.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/ExecutionEngine/Engine.hs
@@ -0,0 +1,315 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+module LLVM.ExecutionEngine.Engine(
+       EngineAccess,
+       ExecutionEngine(..),
+       getEngine,
+       runEngineAccess, runEngineAccessWithModule,
+       runEngineAccessInterpreterWithModule,
+       getExecutionEngineTargetData,
+       ExecutionFunction,
+       Importer,
+       getExecutionFunction,
+       getPointerToFunction,
+       addModule,
+       addFunctionValue, addGlobalMappings,
+       runFunction, getRunFunction,
+       GenericValue, Generic(..)
+       ) where
+
+import qualified LLVM.Core.Proxy as Proxy
+import qualified LLVM.Core.Data as Data
+import qualified LLVM.Core.Util as U
+
+import LLVM.Core.CodeGen (Value(..), Function)
+import LLVM.Core.CodeGenMonad (GlobalMappings(..))
+import LLVM.Core.Util (Module, withModule, createModule)
+import LLVM.Core.Type (IsFirstClass, typeRef)
+import LLVM.Core.Proxy (Proxy(Proxy))
+
+import qualified LLVM.FFI.ExecutionEngine as FFI
+import qualified LLVM.FFI.Target as FFI
+import qualified LLVM.FFI.Core as FFI (consBool, deconsBool, )
+
+import qualified Control.Monad.Trans.Reader as MR
+import Control.Exception (bracket)
+import Control.Monad.IO.Class (MonadIO, liftIO, )
+import Control.Monad (liftM, )
+import Control.Applicative (Applicative, pure, (<*>), (<$>), )
+
+import qualified Data.EnumBitSet as EnumSet
+import Data.Int (Int8, Int16, Int32, Int64)
+import Data.Word (Word8, Word16, Word32, Word64, Word)
+
+import Foreign.Marshal.Alloc (alloca, free)
+import Foreign.Marshal.Array (withArrayLen)
+import Foreign.ForeignPtr
+         (ForeignPtr, newForeignPtr, withForeignPtr, touchForeignPtr)
+import Foreign.C.String (peekCString)
+import Foreign.Ptr (Ptr, FunPtr, )
+import Foreign.Storable (peek)
+import Foreign.StablePtr (StablePtr, castStablePtrToPtr, castPtrToStablePtr, )
+import System.IO.Unsafe (unsafePerformIO)
+
+
+newtype
+    ExecutionEngine = ExecutionEngine {
+        fromEngine :: ForeignPtr FFI.ExecutionEngine
+    }
+
+withEngine :: ExecutionEngine -> (FFI.ExecutionEngineRef -> IO a) -> IO a
+withEngine = withForeignPtr . fromEngine
+
+createExecutionEngineForModule ::
+    Bool -> FFI.EngineKindSet -> Module -> IO ExecutionEngine
+createExecutionEngineForModule hostCPU kind m =
+    alloca $ \eePtr ->
+        alloca $ \errPtr -> do
+          success <-
+            withModule m $ \mPtr ->
+              if hostCPU
+                then
+                  FFI.createExecutionEngineKindForModuleCPU
+                    eePtr kind mPtr errPtr
+                else
+                  if EnumSet.get FFI.JIT kind
+                    then FFI.createExecutionEngineForModule eePtr mPtr errPtr
+                    else FFI.createInterpreterForModule eePtr mPtr errPtr
+          if FFI.deconsBool success
+            then ioError . userError =<< bracket (peek errPtr) free peekCString
+            else
+                liftM ExecutionEngine $
+                    newForeignPtr FFI.ptrDisposeExecutionEngine =<<
+                    peek eePtr
+
+getTheEngine :: FFI.EngineKindSet -> Module -> IO ExecutionEngine
+getTheEngine = createExecutionEngineForModule True
+
+newtype EngineAccess a = EA (MR.ReaderT ExecutionEngine IO a)
+    deriving (Functor, Applicative, Monad, MonadIO)
+
+-- |The LLVM execution engine is encapsulated so it cannot be accessed directly.
+-- The reason is that (currently) there must only ever be one engine,
+-- so access to it is wrapped in a monad.
+runEngineAccess :: EngineAccess a -> IO a
+runEngineAccess (EA body) = do
+    MR.runReaderT body =<< getTheEngine FFI.kindEither =<< createModule "__empty__"
+
+runEngineAccessWithModule :: Module -> EngineAccess a -> IO a
+runEngineAccessWithModule m (EA body) = do
+    MR.runReaderT body =<< getTheEngine FFI.kindEither m
+
+runEngineAccessInterpreterWithModule :: Module -> EngineAccess a -> IO a
+runEngineAccessInterpreterWithModule m (EA body) = do
+    MR.runReaderT body =<< getTheEngine FFI.kindInterpreter m
+
+
+getEngine :: EngineAccess ExecutionEngine
+getEngine = EA MR.ask
+
+accessEngine :: (FFI.ExecutionEngineRef -> IO a) -> EngineAccess a
+accessEngine act = do
+    engine <- getEngine
+    liftIO $ withEngine engine act
+
+getExecutionEngineTargetData :: EngineAccess FFI.TargetDataRef
+getExecutionEngineTargetData =
+    accessEngine FFI.getExecutionEngineTargetData
+
+{- |
+In contrast to 'generateFunction' this compiles a function once.
+Thus it is faster for many calls to the same function.
+See @examples\/Vector.hs@.
+
+If the function calls back into Haskell code,
+you also have to set the function addresses
+using 'addFunctionValue' or 'addGlobalMappings'.
+
+You must keep the execution engine alive
+as long as you want to call the function.
+Better use 'getExecutionFunction' which handles this for you.
+-}
+getPointerToFunction :: Function f -> EngineAccess (FunPtr f)
+getPointerToFunction (Value f) =
+    accessEngine $ \eePtr -> FFI.getPointerToFunction eePtr f
+
+class ExecutionFunction f where
+    keepAlive :: ExecutionEngine -> f -> f
+
+instance ExecutionFunction (IO a) where
+    keepAlive engine act = do
+        a <- act
+        touchForeignPtr (fromEngine engine)
+        return a
+
+instance ExecutionFunction f => ExecutionFunction (a -> f) where
+    keepAlive engine act = keepAlive engine . act
+
+type Importer f = FunPtr f -> f
+
+getExecutionFunction ::
+    (ExecutionFunction f) => Importer f -> Function f -> EngineAccess f
+getExecutionFunction importer (Value f) = do
+    engine <- getEngine
+    liftIO $ withEngine engine $ \eePtr ->
+        keepAlive engine . importer <$> FFI.getPointerToFunction eePtr f
+
+{- |
+Tell LLVM the address of an external function
+if it cannot resolve a name automatically.
+Alternatively you may declare the function
+with 'staticFunction' instead of 'externFunction'.
+-}
+addFunctionValue :: Function f -> FunPtr f -> EngineAccess ()
+addFunctionValue (Value g) f =
+    accessEngine $ \eePtr -> FFI.addFunctionMapping eePtr g f
+
+{- |
+Pass a list of global mappings to LLVM
+that can be obtained from 'LLVM.Core.getGlobalMappings'.
+-}
+addGlobalMappings :: GlobalMappings -> EngineAccess ()
+addGlobalMappings (GlobalMappings gms) = accessEngine gms
+
+addModule :: Module -> EngineAccess ()
+addModule m =
+    accessEngine $ \eePtr -> U.withModule m $ FFI.addModule eePtr
+
+
+--------------------------------------
+
+newtype GenericValue = GenericValue {
+      fromGenericValue :: ForeignPtr FFI.GenericValue
+    }
+
+withGenericValue :: GenericValue -> (FFI.GenericValueRef -> IO a) -> IO a
+withGenericValue = withForeignPtr . fromGenericValue
+
+createGenericValueWith :: IO FFI.GenericValueRef -> IO GenericValue
+createGenericValueWith f = do
+  ptr <- f
+  liftM GenericValue $ newForeignPtr FFI.ptrDisposeGenericValue ptr
+
+withAll :: [GenericValue] -> (Int -> Ptr FFI.GenericValueRef -> IO a) -> IO a
+withAll ps a = go [] ps
+    where go ptrs (x:xs) = withGenericValue x $ \ptr -> go (ptr:ptrs) xs
+          go ptrs _ = withArrayLen (reverse ptrs) a
+
+runFunction :: U.Function -> [GenericValue] -> EngineAccess GenericValue
+runFunction func args =
+    liftIO =<< getRunFunction <*> pure func <*> pure args
+
+getRunFunction :: EngineAccess (U.Function -> [GenericValue] -> IO GenericValue)
+getRunFunction = do
+    engine <- getEngine
+    return $ \ func args ->
+             withAll args $ \argLen argPtr ->
+             withEngine engine $ \eePtr ->
+                 createGenericValueWith $ FFI.runFunction eePtr func
+                                              (fromIntegral argLen) argPtr
+
+class Generic a where
+    toGeneric :: a -> GenericValue
+    fromGeneric :: GenericValue -> a
+
+instance Generic () where
+    toGeneric _ = error "toGeneric ()"
+    fromGeneric _ = ()
+
+toGenericInt :: (Integral a, IsFirstClass a) => Bool -> a -> GenericValue
+toGenericInt signed val = unsafePerformIO $ createGenericValueWith $ do
+    typ <- typeRef $ Proxy.fromValue val
+    FFI.createGenericValueOfInt
+        typ (fromIntegral val) (FFI.consBool signed)
+
+fromGenericInt :: (Integral a, IsFirstClass a) => Bool -> GenericValue -> a
+fromGenericInt signed val = unsafePerformIO $
+    withGenericValue val $ \ref ->
+        fmap fromIntegral $ FFI.genericValueToInt ref (FFI.consBool signed)
+
+--instance Generic Bool where
+--    toGeneric = toGenericInt False . FFI.consBool
+--    fromGeneric = toBool . fromGenericInt False
+
+instance Generic Int where
+    toGeneric = toGenericInt True
+    fromGeneric = fromGenericInt True
+
+instance Generic Int8 where
+    toGeneric = toGenericInt True
+    fromGeneric = fromGenericInt True
+
+instance Generic Int16 where
+    toGeneric = toGenericInt True
+    fromGeneric = fromGenericInt True
+
+instance Generic Int32 where
+    toGeneric = toGenericInt True
+    fromGeneric = fromGenericInt True
+
+instance Generic Int64 where
+    toGeneric = toGenericInt True
+    fromGeneric = fromGenericInt True
+
+instance Generic Word where
+    toGeneric = toGenericInt False
+    fromGeneric = fromGenericInt False
+
+instance Generic Word8 where
+    toGeneric = toGenericInt False
+    fromGeneric = fromGenericInt False
+
+instance Generic Word16 where
+    toGeneric = toGenericInt False
+    fromGeneric = fromGenericInt False
+
+instance Generic Word32 where
+    toGeneric = toGenericInt False
+    fromGeneric = fromGenericInt False
+
+instance Generic Word64 where
+    toGeneric = toGenericInt False
+    fromGeneric = fromGenericInt False
+
+toGenericReal :: (Real a, IsFirstClass a) => a -> GenericValue
+toGenericReal val = unsafePerformIO $ createGenericValueWith $ do
+    typ <- typeRef $ Proxy.fromValue val
+    FFI.createGenericValueOfFloat typ (realToFrac val)
+
+fromGenericReal :: forall a . (Fractional a, IsFirstClass a) => GenericValue -> a
+fromGenericReal val = unsafePerformIO $
+    withGenericValue val $ \ ref -> do
+        typ <- typeRef (Proxy :: Proxy a)
+        fmap realToFrac $ FFI.genericValueToFloat typ ref
+
+instance Generic Float where
+    toGeneric = toGenericReal
+    fromGeneric = fromGenericReal
+
+instance Generic Double where
+    toGeneric = toGenericReal
+    fromGeneric = fromGenericReal
+
+instance Generic (Data.Ptr a) where
+    toGeneric =
+        unsafePerformIO . createGenericValueWith .
+        FFI.createGenericValueOfPointer . Data.uncheckedToPtr
+    fromGeneric val =
+        Data.uncheckedFromPtr . unsafePerformIO . withGenericValue val $
+        FFI.genericValueToPointer
+
+instance Generic (Ptr a) where
+    toGeneric =
+        unsafePerformIO . createGenericValueWith .
+        FFI.createGenericValueOfPointer
+    fromGeneric val =
+        unsafePerformIO . withGenericValue val $ FFI.genericValueToPointer
+
+instance Generic (StablePtr a) where
+    toGeneric =
+        unsafePerformIO . createGenericValueWith .
+        FFI.createGenericValueOfPointer . castStablePtrToPtr
+    fromGeneric val =
+        unsafePerformIO . fmap castPtrToStablePtr . withGenericValue val $
+        FFI.genericValueToPointer
diff --git a/private/LLVM/ExecutionEngine/Marshal.hs b/private/LLVM/ExecutionEngine/Marshal.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/ExecutionEngine/Marshal.hs
@@ -0,0 +1,455 @@
+module LLVM.ExecutionEngine.Marshal (
+    Marshal(..),
+    MarshalVector(..),
+    sizeOf,
+    alignment,
+    StructFields,
+    sizeOfArray,
+    pokeList,
+
+    with,
+    alloca,
+
+    Stored(..),
+    castToStoredPtr,
+    castFromStoredPtr,
+
+    -- * for testing
+    expandBits,
+    gatherBits,
+    adjustSign,
+    chop,
+    cut,
+    split,
+    merge,
+    ) where
+
+import qualified LLVM.Core.Vector as Vector ()
+import qualified LLVM.Core.Data as Data
+import qualified LLVM.Core.Type as Type
+import qualified LLVM.Core.Proxy as LP
+import qualified LLVM.ExecutionEngine.Target as Target
+import LLVM.ExecutionEngine.Target (TargetData)
+import LLVM.Core.Data (Ptr)
+
+import qualified LLVM.Target.Native as Native
+import qualified LLVM.FFI.Core as FFI
+
+import qualified Type.Data.Num.Decimal.Number as Dec
+import Type.Base.Proxy (Proxy(Proxy))
+
+import qualified Foreign.Storable as Store
+import qualified Foreign
+import Foreign.StablePtr (StablePtr)
+import Foreign.Ptr (FunPtr)
+
+import System.IO.Unsafe (unsafePerformIO)
+
+import qualified Control.Monad.Trans.State as MS
+import Control.Applicative (liftA2, pure, (<$>))
+
+import qualified Data.Traversable as Trav
+import qualified Data.Foldable as Fold
+import qualified Data.List.HT as ListHT
+import Data.Bits (shiftL, shiftR, testBit, (.&.))
+import Data.Int (Int8, Int16, Int32, Int64)
+import Data.Word (Word8, Word16, Word32, Word64, Word)
+
+
+
+targetData :: TargetData
+targetData =
+    unsafePerformIO $ Native.initializeNativeTarget >> Target.getTargetData
+
+
+sizeOf :: (Type.IsType a) => LP.Proxy a -> Int
+sizeOf = Target.storeSizeOfType targetData . Type.unsafeTypeRef
+
+alignment :: (Type.IsType a) => LP.Proxy a -> Int
+alignment = Target.abiAlignmentOfType targetData . Type.unsafeTypeRef
+
+sizeOfArray :: (Type.IsType a) => LP.Proxy a -> Int -> Int
+sizeOfArray proxy n =
+   Target.abiSizeOfType targetData (Type.unsafeTypeRef proxy) * n
+
+
+{- |
+Exchange data via memory in a format that is compatible with LLVM's data layout.
+Prominent differences to 'Foreign.Storable' are:
+
+* LLVM's @i1@ requires a byte in memory,
+  whereas Haskell's 'Bool' occupies a 32-bit word with 'Foreign.poke'.
+
+* LLVM's @<4 x i8>@ orders vector elements depending on machine endianess,
+  whereas 'Foreign.poke' uses ascending order
+  which is compatible with arrays.
+
+This class also supports 'Data.Struct', 'Data.Vector', 'Data.Array'.
+-}
+class (Type.IsType a) => Marshal a where
+    peek :: Ptr a -> IO a
+    poke :: Ptr a -> a -> IO ()
+
+peekPrimitive :: (Type.Storable a) => Ptr a -> IO a
+peekPrimitive = Store.peek . Type.toPtr
+
+pokePrimitive :: (Type.Storable a) => Ptr a -> a -> IO ()
+pokePrimitive = Store.poke . Type.toPtr
+
+instance Marshal Float  where
+    peek = peekPrimitive; poke = pokePrimitive
+instance Marshal Double where
+    peek = peekPrimitive; poke = pokePrimitive
+
+instance Marshal Int   where
+    peek = peekPrimitive; poke = pokePrimitive
+instance Marshal Int8  where
+    peek = peekPrimitive; poke = pokePrimitive
+instance Marshal Int16 where
+    peek = peekPrimitive; poke = pokePrimitive
+instance Marshal Int32 where
+    peek = peekPrimitive; poke = pokePrimitive
+instance Marshal Int64 where
+    peek = peekPrimitive; poke = pokePrimitive
+instance Marshal Word   where
+    peek = peekPrimitive; poke = pokePrimitive
+instance Marshal Word8  where
+    peek = peekPrimitive; poke = pokePrimitive
+instance Marshal Word16 where
+    peek = peekPrimitive; poke = pokePrimitive
+instance Marshal Word32 where
+    peek = peekPrimitive; poke = pokePrimitive
+instance Marshal Word64 where
+    peek = peekPrimitive; poke = pokePrimitive
+instance (Store.Storable a) => Marshal (Foreign.Ptr a) where
+    peek = peekPrimitive; poke = pokePrimitive
+instance (Type.IsType a) => Marshal (Ptr a) where
+    peek = peekPrimitive; poke = pokePrimitive
+instance (Type.IsFunction a) => Marshal (FunPtr a) where
+    peek = peekPrimitive; poke = pokePrimitive
+instance Marshal (StablePtr a) where
+    peek = peekPrimitive; poke = pokePrimitive
+
+instance (Type.Positive d) => Marshal (Data.WordN d) where
+    peek ptr =
+        fmap (Data.WordN . merge 8 . map toInteger . word8s) $
+        peekVectorGen ptr $ sizeOf (proxyFromPtr ptr)
+    poke ptr (Data.WordN a) =
+        pokeVectorGen ptr . word8s . map fromInteger .
+        take (sizeOf (proxyFromPtr ptr)) . split 8 $ a
+
+instance (Type.Positive d) => Marshal (Data.IntN d) where
+    peek ptr =
+        fmap (consIntN Proxy . merge 8 . map toInteger . word8s) $
+        peekVectorGen ptr $ sizeOf (proxyFromPtr ptr)
+    poke ptr a =
+        pokeVectorGen ptr . word8s . map fromInteger .
+        take (sizeOf (proxyFromPtr ptr)) . split 8 $ deconsIntN Proxy a
+
+cut :: Int -> Integer -> Integer
+cut n w = (shiftL 1 n - 1) .&. w
+
+split :: Int -> Integer -> [Integer]
+split n = map (cut n) . iterate (flip shiftR n)
+
+merge :: Int -> [Integer] -> Integer
+merge m xs = sum $ zipWith shiftL xs $ iterate (m+) 0
+
+instance Marshal Bool where
+    peek = fmap (/= 0) . Store.peek . castBoolPtr
+    poke ptr a = Store.poke (castBoolPtr ptr) (fromIntegral $ fromEnum a)
+
+castBoolPtr :: Ptr Bool -> Foreign.Ptr Word8
+castBoolPtr = Foreign.castPtr . Data.uncheckedToPtr
+
+instance
+    (Type.Natural n, Marshal a, Type.IsSized a) =>
+        Marshal (Data.Array n a) where
+    peek = peekArray Proxy LP.Proxy
+    poke = pokeArray Fold.toList
+
+peekArray ::
+    (Type.Natural n, Marshal a) =>
+    Proxy n -> LP.Proxy a ->
+    Ptr (Data.Array n a) -> IO (Data.Array n a)
+peekArray n proxy =
+    let step = Target.abiSizeOfType targetData $ Type.unsafeTypeRef proxy
+    in \ptr ->
+        fmap Data.Array $ mapM peek $
+        take (Dec.integralFromProxy n) $
+        iterate (flip plusPtr step) (castElemPtr ptr)
+
+pokeArray :: (Marshal a) => (f a -> [a]) -> Ptr (f a) -> f a -> IO ()
+pokeArray toList ptr = pokeList (castElemPtr ptr) . toList
+
+pokeList :: (Marshal a) => Ptr a -> [a] -> IO ()
+pokeList = pokeListAux LP.Proxy
+
+pokeListAux :: (Marshal a) => LP.Proxy a -> Ptr a -> [a] -> IO ()
+pokeListAux proxy =
+    let step = Target.abiSizeOfType targetData $ Type.unsafeTypeRef proxy
+    in \ptr -> sequence_ . zipWith poke (iterate (flip plusPtr step) ptr)
+
+castElemPtr :: Ptr (f a) -> Ptr a
+castElemPtr = Data.uncheckedFromPtr . Foreign.castPtr . Data.uncheckedToPtr
+
+
+instance
+    (Type.Positive n, MarshalVector a) =>
+        Marshal (Data.Vector n a) where
+    peek = peekVector
+    poke = pokeVector
+
+class (Type.IsPrimitive a) => MarshalVector a where
+    peekVector ::
+        (Type.Positive n) =>
+        Ptr (Data.Vector n a) -> IO (Data.Vector n a)
+    pokeVector ::
+        (Type.Positive n) =>
+        Ptr (Data.Vector n a) -> Data.Vector n a -> IO ()
+
+instance MarshalVector Bool where
+    peekVector ptr =
+        fmap (vectorFromList . expandBits) $
+        peekVectorGen ptr $ sizeOf (proxyFromPtr ptr)
+    pokeVector ptr = pokeVectorGen ptr . gatherBits . Fold.toList
+
+expandBits :: [Word8] -> [Bool]
+expandBits = concatMap (\byte -> map (testBit byte) [0..7])
+
+vectorFromList :: (Type.Positive n) => [a] -> Data.Vector n a
+vectorFromList =
+    MS.evalState $ Trav.sequence $ pure $ MS.state $ \(y:ys) -> (y,ys)
+
+gatherBits :: [Bool] -> [Word8]
+gatherBits =
+    map (sum . zipWith (flip shiftL) [0..] . map (fromIntegral . fromEnum)) .
+    ListHT.sliceVertical 8
+
+
+instance (Type.Positive d) => MarshalVector (Data.WordN d) where
+    peekVector ptr = fmap Data.WordN <$> peekNVector Proxy ptr
+    pokeVector ptr = pokeNVector Proxy ptr . fmap (\(Data.WordN x) -> x)
+
+instance (Type.Positive d) => MarshalVector (Data.IntN d) where
+    peekVector ptr = fmap (consIntN Proxy) <$> peekNVector Proxy ptr
+    pokeVector ptr = pokeNVector Proxy ptr . fmap (deconsIntN Proxy)
+
+consIntN :: (Type.Positive d) => Proxy d -> Integer -> Data.IntN d
+consIntN proxy = Data.IntN . adjustSign (Dec.integralFromProxy proxy)
+
+deconsIntN :: (Type.Positive d) => Proxy d -> Data.IntN d -> Integer
+deconsIntN proxy (Data.IntN a) = cut (Dec.integralFromProxy proxy) a
+
+adjustSign :: Int -> Integer -> Integer
+adjustSign d =
+    let range = shiftL 1 d
+    in  \a -> if a < div range 2 then a else a-range
+
+peekNVector ::
+    (Type.Positive n, Type.Positive d, Type.IsPrimitive (intn d)) =>
+    Proxy d -> Ptr (Data.Vector n (intn d)) -> IO (Data.Vector n Integer)
+peekNVector proxy ptr =
+    fmap (vectorFromList . chop 8 (Dec.integralFromProxy proxy) .
+          map toInteger . word8s) $
+    peekVectorGen ptr $ sizeOf (proxyFromPtr ptr)
+
+pokeNVector ::
+    (Type.Positive n, Type.Positive d, Type.IsPrimitive (intn d)) =>
+    Proxy d ->
+    Ptr (Data.Vector n (intn d)) -> Data.Vector n Integer -> IO ()
+pokeNVector proxy ptr =
+    pokeVectorGen ptr . take (sizeOf (proxyFromPtr ptr)) . word8s .
+    map fromInteger . chop (Dec.integralFromProxy proxy) 8 . Fold.toList
+
+word8s :: [Word8] -> [Word8]
+word8s = id
+
+proxyFromPtr :: Ptr a -> LP.Proxy a
+proxyFromPtr _ = LP.Proxy
+
+chop :: Int -> Int -> [Integer] -> [Integer]
+chop m n =
+    concat . snd .
+    Trav.mapAccumL
+        (\(valid,acc) x ->
+            let newAcc = acc + cut n (shiftL x valid)
+                nextValid = valid+m
+            in  if nextValid<n
+                    then ((nextValid, newAcc), [])
+                    else
+                        case divMod nextValid n of
+                            (chunks,remd) ->
+                                ((remd, shiftR x (m-remd)),
+                                 (newAcc :) $
+                                 map (cut n . shiftR x) $
+                                 take (chunks-1) $ iterate (n+) (n-valid)))
+        (0,0) .
+    (++ repeat 0)
+
+
+instance MarshalVector Float where
+    peekVector = peekVectorAuto Proxy
+    pokeVector ptr = pokeVectorGen ptr . Fold.toList
+
+instance MarshalVector Double where
+    peekVector = peekVectorAuto Proxy
+    pokeVector ptr = pokeVectorGen ptr . Fold.toList
+
+instance MarshalVector Word where
+    peekVector = peekVectorAuto Proxy
+    pokeVector ptr = pokeVectorGen ptr . Fold.toList
+
+instance MarshalVector Word8 where
+    peekVector = peekVectorAuto Proxy
+    pokeVector ptr = pokeVectorGen ptr . Fold.toList
+
+instance MarshalVector Word16 where
+    peekVector = peekVectorAuto Proxy
+    pokeVector ptr = pokeVectorGen ptr . Fold.toList
+
+instance MarshalVector Word32 where
+    peekVector = peekVectorAuto Proxy
+    pokeVector ptr = pokeVectorGen ptr . Fold.toList
+
+instance MarshalVector Word64 where
+    peekVector = peekVectorAuto Proxy
+    pokeVector ptr = pokeVectorGen ptr . Fold.toList
+
+instance MarshalVector Int where
+    peekVector = peekVectorAuto Proxy
+    pokeVector ptr = pokeVectorGen ptr . Fold.toList
+
+instance MarshalVector Int8 where
+    peekVector = peekVectorAuto Proxy
+    pokeVector ptr = pokeVectorGen ptr . Fold.toList
+
+instance MarshalVector Int16 where
+    peekVector = peekVectorAuto Proxy
+    pokeVector ptr = pokeVectorGen ptr . Fold.toList
+
+instance MarshalVector Int32 where
+    peekVector = peekVectorAuto Proxy
+    pokeVector ptr = pokeVectorGen ptr . Fold.toList
+
+instance MarshalVector Int64 where
+    peekVector = peekVectorAuto Proxy
+    pokeVector ptr = pokeVectorGen ptr . Fold.toList
+
+
+peekVectorAuto ::
+    (Type.Positive n, Type.IsPrimitive a, Store.Storable a) =>
+    Proxy n -> Ptr (Data.Vector n a) -> IO (Data.Vector n a)
+peekVectorAuto proxy ptr =
+    fmap vectorFromList $ peekVectorGen ptr $ Dec.integralFromProxy proxy
+
+peekVectorGen ::
+    (Type.IsType b, Store.Storable chunk) =>
+    Ptr b -> Int -> IO [chunk]
+peekVectorGen = peekVectorAux LP.Proxy (error "vector")
+
+peekVectorAux ::
+    (Type.IsType b, Store.Storable chunk) =>
+    LP.Proxy b -> chunk -> Ptr b -> Int -> IO [chunk]
+peekVectorAux proxy dummyChunk =
+    let (offset,step) = arrayParams proxy dummyChunk
+    in  \ptr n ->
+            mapM (Store.peekByteOff (Data.uncheckedToPtr ptr)) $
+            take n $ iterate (step+) offset
+
+pokeVectorGen ::
+    (Type.IsType b, Store.Storable chunk) =>
+    Ptr b -> [chunk] -> IO ()
+pokeVectorGen = pokeVectorAux LP.Proxy (error "vector")
+
+pokeVectorAux ::
+    (Type.IsType b, Store.Storable chunk) =>
+    LP.Proxy b -> chunk -> Ptr b -> [chunk] -> IO ()
+pokeVectorAux proxy dummyChunk =
+    let (offset,step) = arrayParams proxy dummyChunk
+    in  \ptr xs ->
+            sequence_ $
+            zipWith (Store.pokeByteOff (Data.uncheckedToPtr ptr))
+                (iterate (step+) offset) xs
+
+arrayParams ::
+    (Type.IsType b, Store.Storable chunk) =>
+    LP.Proxy b -> chunk -> (Int,Int)
+arrayParams proxy dummyChunk =
+    let chunkSize = Store.sizeOf dummyChunk
+    in  if Target.littleEndian targetData
+            then (0, chunkSize)
+            else (sizeOf proxy - chunkSize, -chunkSize)
+
+
+instance (StructFields fields) => Marshal (Data.Struct fields) where
+    peek = withPtrProxy $ \proxy ->
+        let typeRef = Type.unsafeTypeRef proxy
+        in fmap Data.Struct . peekStruct typeRef 0
+    poke = withPtrProxy $ \proxy ->
+        let typeRef = Type.unsafeTypeRef proxy
+            pokePlain = pokeStruct typeRef 0
+        in \ptr (Data.Struct as) -> pokePlain ptr as
+
+withPtrProxy :: (LP.Proxy a -> Ptr a -> b) -> Ptr a -> b
+withPtrProxy act = act LP.Proxy
+
+class (Type.StructFields fields) => StructFields fields where
+    peekStruct :: FFI.TypeRef -> Int -> Ptr struct -> IO fields
+    pokeStruct :: FFI.TypeRef -> Int -> Ptr struct -> fields -> IO ()
+
+instance
+    (Marshal a, Type.IsSized a, StructFields as) =>
+        StructFields (a,as) where
+    peekStruct typeRef i =
+        let offset = Target.offsetOfElement targetData typeRef i
+            peekIs = peekStruct typeRef (i+1)
+        in \ptr -> liftA2 (,) (peek $ plusPtr ptr offset) (peekIs ptr)
+    pokeStruct typeRef i =
+        let offset = Target.offsetOfElement targetData typeRef i
+            pokeIs = pokeStruct typeRef (i+1)
+        in \ptr (a,as) -> poke (plusPtr ptr offset) a >> pokeIs ptr as
+
+instance StructFields () where
+    peekStruct _type _i _ptr = return ()
+    pokeStruct _type _i _ptr () = return ()
+
+plusPtr :: Ptr a -> Int -> Ptr b
+plusPtr ptr offset =
+    Data.uncheckedFromPtr $ Foreign.plusPtr (Data.uncheckedToPtr ptr) offset
+
+
+with :: (Marshal a) => a -> (Ptr a -> IO b) -> IO b
+with a act = alloca $ \ptr -> poke ptr a >> act ptr
+
+alloca :: (Type.IsType a) => (Ptr a -> IO b) -> IO b
+alloca = allocaAux LP.Proxy
+
+allocaAux :: (Type.IsType a) => LP.Proxy a -> (Ptr a -> IO b) -> IO b
+allocaAux proxy f =
+    Foreign.allocaBytes (sizeOf proxy) (f . Data.uncheckedFromPtr)
+
+
+{- |
+Provide @Marshal@ functionality through Haskell's 'Storable' interface.
+Thus, @'Ptr' a@ is equivalent to @'Foreign.Ptr' ('Stored' a)@.
+You may e.g. use a @'Foreign.ForeignPtr' ('Stored' a)@
+to manage LLVM data with Haskell's garbage collector.
+-}
+newtype Stored a = Stored {getStored :: a}
+
+castToStoredPtr :: Ptr a -> Foreign.Ptr (Stored a)
+castToStoredPtr = Foreign.castPtr . Data.uncheckedToPtr
+
+castFromStoredPtr :: Foreign.Ptr (Stored a) -> Ptr a
+castFromStoredPtr = Data.uncheckedFromPtr . Foreign.castPtr
+
+
+instance (Marshal a) => Store.Storable (Stored a) where
+    sizeOf = sizeOf . proxyFromStored
+    alignment = alignment . proxyFromStored
+    peek = fmap Stored . peek . castFromStoredPtr
+    poke ptr = poke (castFromStoredPtr ptr) . getStored
+
+proxyFromStored :: Stored a -> LP.Proxy a
+proxyFromStored _ = LP.Proxy
diff --git a/private/LLVM/ExecutionEngine/Target.hs b/private/LLVM/ExecutionEngine/Target.hs
new file mode 100644
--- /dev/null
+++ b/private/LLVM/ExecutionEngine/Target.hs
@@ -0,0 +1,126 @@
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE EmptyDataDecls #-}
+module LLVM.ExecutionEngine.Target (
+    TargetData,
+    dataLayoutStr,
+    abiAlignmentOfType,
+    abiSizeOfType,
+    littleEndian,
+    callFrameAlignmentOfType,
+    intPtrType,
+    offsetOfElement,
+    pointerSize,
+    preferredAlignmentOfType,
+    sizeOfTypeInBits,
+    storeSizeOfType,
+    getTargetData,
+    targetDataFromString,
+    withIntPtrType,
+    ) where
+
+import qualified LLVM.ExecutionEngine.Engine as EE
+import LLVM.Core.Data (WordN)
+
+import qualified LLVM.FFI.Core as FFI
+import qualified LLVM.FFI.Target as FFI
+
+import qualified Type.Data.Num.Decimal.Number as Dec
+import Type.Base.Proxy (Proxy)
+
+import Foreign.ForeignPtr
+         (ForeignPtr,
+          newForeignPtr, withForeignPtr, touchForeignPtr, castForeignPtr)
+import Foreign.C.String (withCString, peekCString)
+
+import Control.Monad (liftM2, (<=<))
+import Control.Applicative ((<$>))
+import Data.Maybe (fromMaybe)
+import System.IO.Unsafe (unsafePerformIO)
+
+
+type Type = FFI.TypeRef
+
+data TargetDataOwner
+
+data TargetData = TargetData (ForeignPtr TargetDataOwner) FFI.TargetDataRef
+
+dataLayoutStr :: TargetData -> String
+dataLayoutStr td = unsafeIO td $ peekCString <=< FFI.copyStringRepOfTargetData
+
+abiAlignmentOfType :: TargetData -> Type -> Int
+abiAlignmentOfType td = unsafeIntIO td . flip FFI.abiAlignmentOfType
+
+abiSizeOfType :: TargetData -> Type -> Int
+abiSizeOfType td = unsafeIntIO td . flip FFI.abiSizeOfType
+
+littleEndian :: TargetData -> Bool
+littleEndian td = FFI.bigEndian /= unsafeIO td FFI.byteOrder
+
+callFrameAlignmentOfType :: TargetData -> Type -> Int
+callFrameAlignmentOfType td = unsafeIntIO td . flip FFI.callFrameAlignmentOfType
+
+-- elementAtOffset :: TargetData -> Type -> Word64 -> Int
+
+intPtrType :: TargetData -> Type
+intPtrType td = unsafeIO td FFI.intPtrType
+
+offsetOfElement :: TargetData -> Type -> Int -> Int
+offsetOfElement td ty k =
+    unsafeIntIO td $ \r -> FFI.offsetOfElement r ty (fromIntegral k)
+
+pointerSize :: TargetData -> Int
+pointerSize td = unsafeIntIO td FFI.pointerSize
+
+-- preferredAlignmentOfGlobal :: TargetData -> Value a -> Int
+
+preferredAlignmentOfType :: TargetData -> Type -> Int
+preferredAlignmentOfType td = unsafeIntIO td . flip FFI.preferredAlignmentOfType
+
+sizeOfTypeInBits :: TargetData -> Type -> Int
+sizeOfTypeInBits td = unsafeIntIO td . flip FFI.sizeOfTypeInBits
+
+storeSizeOfType :: TargetData -> Type -> Int
+storeSizeOfType td = unsafeIntIO td . flip FFI.storeSizeOfType
+
+
+withIntPtrType :: (forall n . (Dec.Positive n) => WordN n -> a) -> a
+withIntPtrType f =
+    fromMaybe (error "withIntPtrType: pointer size must be non-negative") $
+        Dec.reifyPositive (fromIntegral sz) (\ n -> f (g n))
+  where g :: Proxy n -> WordN n
+        g _ = error "withIntPtrType: argument used"
+        sz = pointerSize $ unsafePerformIO getTargetData
+
+
+unsafeIO :: TargetData -> (FFI.TargetDataRef -> IO a) -> a
+unsafeIO (TargetData fptr td) act =
+    unsafePerformIO $ do x <- act td; touchForeignPtr fptr; return x
+
+unsafeIntIO ::
+   (Integral i, Num j) => TargetData -> (FFI.TargetDataRef -> IO i) -> j
+unsafeIntIO td act = fromIntegral $ unsafeIO td act
+
+-- Normally the TargetDataRef never changes,
+-- so the operation are really functions.
+-- The ForeignPtr can point to TargetData or to ExecutionEngine.
+makeTargetData :: ForeignPtr a -> FFI.TargetDataRef -> TargetData
+makeTargetData = TargetData . castForeignPtr
+
+-- Gets the target data for the JIT target.
+getTargetData :: IO TargetData
+getTargetData =
+    EE.runEngineAccess $
+    liftM2 makeTargetData
+        (EE.fromEngine <$> EE.getEngine)
+        EE.getExecutionEngineTargetData
+
+createTargetData :: String -> IO (ForeignPtr FFI.TargetData)
+createTargetData s =
+    newForeignPtr FFI.ptrDisposeTargetData =<<
+    withCString s FFI.createTargetData
+
+targetDataFromString :: String -> TargetData
+targetDataFromString s = unsafePerformIO $ do
+    td <- createTargetData s
+    withForeignPtr td $ return . makeTargetData td
diff --git a/src/LLVM/Core.hs b/src/LLVM/Core.hs
--- a/src/LLVM/Core.hs
+++ b/src/LLVM/Core.hs
@@ -31,7 +31,9 @@
     Target.initializeNativeTarget,
     -- * Modules
     Module, newModule, newNamedModule, defineModule, destroyModule, createModule,
+    getModule,
     setTarget, FFI.hostTriple,
+    setDataLayout,
     PassManager, createPassManager, createFunctionPassManager,
     writeBitcodeToFile, readBitcodeFromFile,
     getModuleValues, getFunctions, getGlobalVariables, ModuleValue, castModuleValue,
@@ -51,11 +53,12 @@
     constVector, constArray,
     constCyclicVector, constCyclicArray,
     constStruct, constPackedStruct,
-    toVector, fromVector, vector, cyclicVector,
+    toVector, fromVector, vector, cyclicVector, consVector,
     -- * Code generation
     CodeGenFunction, CodeGenModule,
     -- * Functions
-    Function, newFunction, newNamedFunction, defineFunction, createFunction, createNamedFunction, setFuncCallConv,
+    Function, newFunction, newNamedFunction, defineFunction,
+    createFunction, createNamedFunction, setFuncCallConv, functionParameter,
     TFunction, liftCodeGenModule, getParams,
     -- * Global variable creation
     Global, newGlobal, newNamedGlobal, defineGlobal, createGlobal, createNamedGlobal,
@@ -83,7 +86,7 @@
 import LLVM.Core.Util hiding (Function, BasicBlock, createModule, constString, constStringNul, constVector, constArray, constStruct, getModuleValues, valueHasType)
 import LLVM.Core.CodeGen
 import LLVM.Core.CodeGenMonad
-          (CodeGenFunction, CodeGenModule, liftCodeGenModule,
+          (CodeGenFunction, CodeGenModule, liftCodeGenModule, getModule,
            GlobalMappings, getGlobalMappings)
 import LLVM.Core.Data
 import LLVM.Core.Instructions
diff --git a/src/LLVM/Core/CodeGen.hs b/src/LLVM/Core/CodeGen.hs
deleted file mode 100644
--- a/src/LLVM/Core/CodeGen.hs
+++ /dev/null
@@ -1,681 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE TypeFamilies #-}
-module LLVM.Core.CodeGen(
-    -- * Module creation
-    newModule, newNamedModule, defineModule, createModule,
-    getModuleValues, ModuleValue, castModuleValue, setTarget,
-    -- * Globals
-    Linkage(..),
-    Visibility(..),
-    -- * Function creation
-    Function, newFunction, newNamedFunction, defineFunction, createFunction, createNamedFunction, setFuncCallConv,
-    addAttributes,
-    FFI.AttributeIndex(..), Attribute(..),
-    externFunction, staticFunction, staticNamedFunction,
-    FunctionArgs, FunctionCodeGen, FunctionResult,
-    TFunction,
-    -- * Global variable creation
-    Global, newGlobal, newNamedGlobal, defineGlobal, createGlobal, createNamedGlobal, TGlobal,
-    externGlobal, staticGlobal,
-    -- * Values
-    Value(..), ConstValue(..),
-    IsConst(..), valueOf, value,
-    IsConstFields,
-    zero, allOnes, undef,
-    createString, createStringNul,
-    withString, withStringNul,
-    constVector, constArray, constStruct, constPackedStruct,
-    constCyclicVector, constCyclicArray,
-    -- * Basic blocks
-    BasicBlock(..), newBasicBlock, newNamedBasicBlock, defineBasicBlock, createBasicBlock, getCurrentBasicBlock,
-    fromLabel, toLabel,
-    -- * Misc
-    withCurrentBuilder
-    ) where
-
-import qualified LLVM.Core.UnaryVector as UnaryVector
-import qualified LLVM.Core.Util as U
-import qualified LLVM.Util.Proxy as LP
-import LLVM.Core.CodeGenMonad
-import LLVM.Core.Type
-import LLVM.Core.Data
-
-import qualified LLVM.FFI.Core.Attribute as Attr
-import qualified LLVM.FFI.Core as FFI
-import LLVM.FFI.Core(Linkage(..), Visibility(..))
-
-import qualified Type.Data.Num.Decimal.Proof as DecProof
-import qualified Type.Data.Num.Decimal.Number as Dec
-import Type.Base.Proxy (Proxy)
-
-import qualified Foreign.Storable as St
-import Foreign.C.String (withCString, withCStringLen)
-import Foreign.StablePtr (StablePtr, castStablePtrToPtr)
-import Foreign.Ptr (Ptr, minusPtr, nullPtr, FunPtr, castFunPtrToPtr)
-import System.IO.Unsafe (unsafePerformIO)
-
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad (liftM, when)
-
-import qualified Data.NonEmpty as NonEmpty
-import qualified Data.Foldable as Fold
-import Data.Typeable (Typeable)
-import Data.Int (Int8, Int16, Int32, Int64)
-import Data.Word (Word8, Word16, Word32, Word64)
-import Data.Tuple.HT (mapSnd)
-import Data.Maybe.HT (toMaybe)
-import Data.Maybe (fromMaybe)
-
-import Text.Printf (printf)
-
---------------------------------------
-
--- | Create a new module.
-newModule :: IO U.Module
-newModule = newNamedModule "_module"  -- XXX should generate a name
-
--- | Create a new explicitely named module.
-newNamedModule :: String              -- ^ module name
-               -> IO U.Module
-newNamedModule = U.createModule
-
--- | Give the body for a module.
-defineModule :: U.Module              -- ^ module that is defined
-             -> CodeGenModule a       -- ^ module body
-             -> IO a
-defineModule = runCodeGenModule
-
--- | Create a new module with the given body.
-createModule :: CodeGenModule a       -- ^ module body
-             -> IO a
-createModule cgm = newModule >>= \ m -> defineModule m cgm
-
-setTarget :: String -> CodeGenModule ()
-setTarget triple = do
-    modul <- getModule
-    liftIO $ U.withModule modul $ \m -> withCString triple $ FFI.setTarget m
-
-
---------------------------------------
-
-newtype ModuleValue = ModuleValue FFI.ValueRef
-    deriving (Show, Typeable)
-
-getModuleValues :: U.Module -> IO [(String, ModuleValue)]
-getModuleValues =
-    liftM (map (\ (s,p) -> (s, ModuleValue p))) . U.getModuleValues
-
-castModuleValue :: forall a . (IsType a) => ModuleValue -> Maybe (Value a)
-castModuleValue (ModuleValue f) =
-    toMaybe (U.valueHasType f (unsafeTypeRef (LP.Proxy :: LP.Proxy a))) (Value f)
-
---------------------------------------
-
-newtype Value a = Value { unValue :: FFI.ValueRef }
-    deriving (Show, Typeable)
-
-newtype ConstValue a = ConstValue { unConstValue :: FFI.ValueRef }
-    deriving (Show, Typeable)
-
--- XXX merge with IsArithmetic?
-class IsConst a where
-    constOf :: a -> ConstValue a
-
-instance IsConst Bool   where constOf = constEnum (typeRef (LP.Proxy :: LP.Proxy Bool))
---instance IsConst Char   where constOf = constEnum (typeRef (0::Word8)) -- XXX Unicode
-instance IsConst Word8  where constOf = constI
-instance IsConst Word16 where constOf = constI
-instance IsConst Word32 where constOf = constI
-instance IsConst Word64 where constOf = constI
-instance IsConst Int8   where constOf = constI
-instance IsConst Int16  where constOf = constI
-instance IsConst Int32  where constOf = constI
-instance IsConst Int64  where constOf = constI
-instance IsConst Float  where constOf = constF
-instance IsConst Double where constOf = constF
---instance IsConst FP128  where constOf = constF
-
-instance (Dec.Positive n) => IsConst (WordN n) where
-    constOf (WordN i) = constInteger i
-instance (Dec.Positive n) => IsConst (IntN n) where
-    constOf (IntN i) = constInteger i
-
-constOfPtr :: (IsType ptr) =>
-    ptr -> Ptr b -> ConstValue ptr
-constOfPtr proto p =
-    let ip = p `minusPtr` nullPtr
-        inttoptrC :: ConstValue int -> ConstValue ptr
-        inttoptrC (ConstValue v) =
-           unsafeConstValue $
-           FFI.constIntToPtr v $ unsafeTypeRef $ LP.fromValue proto
-    in  if St.sizeOf p == 4 then
-            inttoptrC $ constOf (fromIntegral ip :: Word32)
-        else if St.sizeOf p == 8 then
-            inttoptrC $ constOf (fromIntegral ip :: Word64)
-        else
-            error "constOf Ptr: pointer size not 4 or 8"
-
--- This instance doesn't belong here, but mutually recursive modules are painful.
-instance (IsType a) => IsConst (Ptr a) where
-    constOf p = constOfPtr p p
-
-instance (IsFunction a) => IsConst (FunPtr a) where
-    constOf p = constOfPtr p (castFunPtrToPtr p)
-
-instance IsConst (StablePtr a) where
-    constOf p = constOfPtr p (castStablePtrToPtr p)
-
-instance (IsPrimitive a, IsConst a, Dec.Positive n) => IsConst (Vector n a) where
-    constOf (Vector x) = constVectorGen constOf x
-
-instance (IsConst a, IsSized a, Dec.Natural n) => IsConst (Array n a) where
-    constOf (Array xs) = constArray (map constOf xs)
-
-instance (IsConstFields a) => IsConst (Struct a) where
-    constOf (Struct a) =
-        unsafeConstValue $ U.constStruct (constFieldsOf a) False
-instance (IsConstFields a) => IsConst (PackedStruct a) where
-    constOf (PackedStruct a) =
-        unsafeConstValue $ U.constStruct (constFieldsOf a) True
-
-class IsConstFields a where
-    constFieldsOf :: a -> [FFI.ValueRef]
-
-instance (IsConst a, IsConstFields as) => IsConstFields (a, as) where
-    constFieldsOf (a, as) = unConstValue (constOf a) : constFieldsOf as
-instance IsConstFields () where
-    constFieldsOf _ = []
-
-
-unsafeConstValue :: IO FFI.ValueRef -> ConstValue a
-unsafeConstValue =
-    ConstValue . unsafePerformIO
-
-unsafeWithConstValue ::
-    forall a.
-    (IsType a) =>
-    (FFI.TypeRef -> IO FFI.ValueRef) ->
-    ConstValue a
-unsafeWithConstValue f =
-    unsafePerformIO $ fmap ConstValue $
-        f =<< typeRef (LP.Proxy :: LP.Proxy a)
-
-constEnum :: (Enum a) => IO FFI.TypeRef -> a -> ConstValue a
-constEnum mt i =
-    unsafeConstValue $ mt >>= \t ->
-        FFI.constInt t (fromIntegral $ fromEnum i) FFI.false
-
-{-
-ToDo:
-Passes a BigInt as decimal number string.
-Not very efficient but quite generic.
-Maybe Hex is better?
--}
-constInteger :: (IsType (intN n)) => Integer -> ConstValue (intN n)
-constInteger i =
-    unsafeWithConstValue $ \typ ->
-    withCString (show i) $ \cstr ->
-    FFI.constIntOfString typ cstr 10
-
-constI :: (IsInteger a, Integral a) => a -> ConstValue a
-constI i =
-    unsafeWithConstValue $ \typ ->
-    FFI.constInt typ (fromIntegral i) (FFI.consBool $ isSigned $ LP.fromValue i)
-
-constF :: (IsFloating a, Real a) => a -> ConstValue a
-constF i =
-    unsafeWithConstValue $ \typ -> FFI.constReal typ (realToFrac i)
-
-valueOf :: (IsConst a) => a -> Value a
-valueOf = value . constOf
-
-value :: ConstValue a -> Value a
-value (ConstValue a) = Value a
-
-zero :: forall a . (IsType a) => ConstValue a
-zero = unsafeWithConstValue FFI.constNull
-
-allOnes :: forall a . (IsInteger a) => ConstValue a
-allOnes = unsafeWithConstValue FFI.constAllOnes
-
-undef :: forall a . (IsType a) => ConstValue a
-undef = unsafeWithConstValue FFI.getUndef
-
-{-
-createString :: String -> ConstValue (DynamicArray Word8)
-createString = ConstValue . U.constString
-
-constStringNul :: String -> ConstValue (DynamicArray Word8)
-constStringNul = ConstValue . U.constStringNul
--}
-
---------------------------------------
-
-
--- |A function is simply a pointer to the function.
-type Function a = Value (FunPtr a)
-
--- | Create a new named function.
-newNamedFunction :: forall a . (IsFunction a)
-                 => Linkage
-                 -> String   -- ^ Function name
-                 -> CodeGenModule (Function a)
-newNamedFunction linkage name = do
-    modul <- getModule
-    typ <- liftIO $ typeRef (LP.Proxy :: LP.Proxy a)
-    liftIO $ liftM Value $ U.addFunction modul linkage name typ
-
--- | Create a new function.  Use 'newNamedFunction' to create a function with external linkage, since
--- it needs a known name.
-newFunction :: forall a . (IsFunction a)
-            => Linkage
-            -> CodeGenModule (Function a)
-newFunction linkage = genMSym "fun" >>= newNamedFunction linkage
-
-defineFunctionParam ::
-                  Function f        -- ^ Function to define (created by 'newFunction').
-               -> Parameterized r f -- ^ Function body.
-               -> CodeGenModule ()
-defineFunctionParam fn p = do
-    bld <- liftIO $ U.createBuilder
-    let body' = do
-            newBasicBlock >>= defineBasicBlock
-            defineParameterized fn p
-    runCodeGenFunction bld (unValue fn) body'
-
--- | Define a function body.  The basic block returned by the function is the function entry point.
-defineFunction :: forall f . (FunctionArgs f)
-               => Function f        -- ^ Function to define (created by 'newFunction').
-               -> FunctionCodeGen f -- ^ Function body.
-               -> CodeGenModule ()
-defineFunction fn body =
-    defineFunctionParam fn $ paramFunc body
-
--- | Create a new function with the given body.
-createFunction :: (FunctionArgs f)
-               => Linkage
-               -> FunctionCodeGen f  -- ^ Function body.
-               -> CodeGenModule (Function f)
-createFunction linkage body = do
-    f <- newFunction linkage
-    defineFunction f body
-    return f
-
--- | Create a new function with the given body.
-createNamedFunction :: (FunctionArgs f)
-               => Linkage
-               -> String
-               -> FunctionCodeGen f  -- ^ Function body.
-               -> CodeGenModule (Function f)
-createNamedFunction linkage name body = do
-    f <- newNamedFunction linkage name
-    defineFunction f body
-    return f
-
--- | Set the calling convention of a function. By default it is the
--- C calling convention.
-setFuncCallConv :: Function a
-                -> FFI.CallingConvention
-                -> CodeGenModule ()
-setFuncCallConv (Value f) cc = do
-  liftIO $ FFI.setFunctionCallConv f (FFI.fromCallingConvention cc)
-
-data Attribute = Attribute Attr.Name Word64
-
--- | Add attributes to a value.  Beware, what attributes are allowed depends on
--- what kind of value it is.
-addAttributes ::
-    Value a -> FFI.AttributeIndex -> [Attribute] -> CodeGenFunction r ()
-addAttributes (Value f) i as =
-    liftIO $ do
-        context <- FFI.getGlobalContext
-        Fold.forM_ as $ \(Attribute (Attr.Name name) val) -> do
-            attrKind <-
-                withCStringLen name $
-                    uncurry FFI.getEnumAttributeKindForName .
-                    mapSnd fromIntegral
-            attr <- FFI.createEnumAttribute context attrKind val
-            FFI.addCallSiteAttribute f i attr
-
--- Convert a function of type f = t1->t2->...-> IO r to
--- g = Value t1 -> Value t2 -> ... CodeGenFunction r ()
-class IsFunction f => FunctionArgs f where
-    type FunctionCodeGen f :: *
-    type FunctionResult  f :: *
-    paramFunc :: FunctionCodeGen f -> Parameterized (FunctionResult f) f
-
-instance (FunctionArgs b, IsFirstClass a) => FunctionArgs (a -> b) where
-    type FunctionCodeGen (a -> b) = Value a -> FunctionCodeGen b
-    type FunctionResult  (a -> b) = FunctionResult b
-    paramFunc f = param $ \x -> paramFunc (f x)
-
-instance IsFirstClass a => FunctionArgs (IO a) where
-    type FunctionCodeGen (IO a) = CodeGenFunction a ()
-    type FunctionResult (IO a) = a
-    paramFunc = parameterized
-
-
-newtype
-   Parameterized r f =
-      Parameterized (Int -> FFI.ValueRef -> CodeGenFunction r ())
-
-parameterized :: CodeGenFunction r () -> Parameterized r (IO r)
-parameterized code = Parameterized (const $ const code)
-
-param :: (Value a -> Parameterized r b) -> Parameterized r (a -> b)
-param pf =
-   Parameterized $ \n f ->
-      case pf $ Value $ U.getParam f n of
-         Parameterized p -> p (n+1) f
-
-defineParameterized :: Function f -> Parameterized r f -> CodeGenFunction r ()
-defineParameterized f (Parameterized p) = p 0 $ unValue f
-
-
---------------------------------------
-
--- |A basic block is a sequence of non-branching instructions, terminated by a control flow instruction.
-newtype BasicBlock = BasicBlock FFI.BasicBlockRef
-    deriving (Show, Typeable)
-
-createBasicBlock :: CodeGenFunction r BasicBlock
-createBasicBlock = do
-    b <- newBasicBlock
-    defineBasicBlock b
-    return b
-
-newBasicBlock :: CodeGenFunction r BasicBlock
-newBasicBlock = genFSym >>= newNamedBasicBlock
-
-newNamedBasicBlock :: String -> CodeGenFunction r BasicBlock
-newNamedBasicBlock name = do
-    fn <- getFunction
-    liftIO $ liftM BasicBlock $ U.appendBasicBlock fn name
-
-defineBasicBlock :: BasicBlock -> CodeGenFunction r ()
-defineBasicBlock (BasicBlock l) = do
-    bld <- getBuilder
-    liftIO $ U.positionAtEnd bld l
-
-getCurrentBasicBlock :: CodeGenFunction r BasicBlock
-getCurrentBasicBlock = do
-    bld <- getBuilder
-    liftIO $ liftM BasicBlock $ U.getInsertBlock bld
-
-toLabel :: BasicBlock -> Value Label
-toLabel (BasicBlock ptr) =
-    Value (unsafePerformIO $ FFI.basicBlockAsValue ptr)
-
-fromLabel :: Value Label -> BasicBlock
-fromLabel (Value ptr) =
-    BasicBlock (unsafePerformIO $ FFI.valueAsBasicBlock ptr)
-
---------------------------------------
-
---- XXX: the functions in this section (and addGlobalMapping) don't actually use any
--- Function state so should really be in the CodeGenModule monad
-
--- | Create a reference to an external function while code generating for a function.
--- If LLVM cannot resolve its name, then you may try 'staticFunction'.
-externFunction :: forall a r . (IsFunction a) => String -> CodeGenFunction r (Function a)
-externFunction name =
-    externCore name $
-        fmap (unValue :: Function a -> FFI.ValueRef) .
-        newNamedFunction ExternalLinkage
-
--- | As 'externFunction', but for 'Global's rather than 'Function's
-externGlobal :: forall a r . (IsType a) => Bool -> String -> CodeGenFunction r (Global a)
-externGlobal isConst name =
-    externCore name $
-        fmap (unValue :: Global a -> FFI.ValueRef) .
-        newNamedGlobal isConst ExternalLinkage
-
-externCore ::
-    String -> (String -> CodeGenModule FFI.ValueRef) ->
-    CodeGenFunction r (Value ptr)
-externCore name act = do
-    es <- getExterns
-    case lookup name es of
-        Just f -> return $ Value f
-        Nothing -> do
-            f <- liftCodeGenModule $ act name
-            putExterns ((name, f) : es)
-            return $ Value f
-
-{- |
-Make an external C function with a fixed address callable from LLVM code.
-This callback function can also be a Haskell function,
-that was imported like
-
-> foreign import ccall "&nextElement"
->    nextElementFunPtr :: FunPtr (StablePtr (IORef [Word32]) -> IO Word32)
-
-See @examples\/List.hs@.
-
-When you only use 'externFunction', then LLVM cannot resolve the name.
-(However, I do not know why.)
-Thus 'staticFunction' manages a list of static functions.
-This list is automatically installed by 'ExecutionEngine.simpleFunction'
-and can be manually obtained by 'getGlobalMappings'
-and installed by 'ExecutionEngine.addGlobalMappings'.
-\"Installing\" means calling LLVM's @addGlobalMapping@ according to
-<http://old.nabble.com/jit-with-external-functions-td7769793.html>.
--}
-staticFunction :: forall f r. (IsFunction f) => FunPtr f -> CodeGenFunction r (Function f)
-staticFunction = staticNamedFunction ""
-
-{- |
-Due to <https://llvm.org/bugs/show_bug.cgi?id=20656>
-this will fail with MCJIT of LLVM-3.6.
--}
-staticNamedFunction :: forall f r. (IsFunction f) => String -> FunPtr f -> CodeGenFunction r (Function f)
-staticNamedFunction name func = liftCodeGenModule $ do
-    val <- newNamedFunction ExternalLinkage name
-    addFunctionMapping (unValue (val :: Function f)) func
-    return val
-
--- | As 'staticFunction', but for 'Global's rather than 'Function's
-staticGlobal :: forall a r. (IsType a) => Bool -> Ptr a -> CodeGenFunction r (Global a)
-staticGlobal isConst gbl = liftCodeGenModule $ do
-    val <- newNamedGlobal isConst ExternalLinkage ""
-    addGlobalMapping (unValue (val :: Global a)) gbl
-    return val
-
---------------------------------------
-
-withCurrentBuilder :: (FFI.BuilderRef -> IO a) -> CodeGenFunction r a
-withCurrentBuilder body = do
-    bld <- getBuilder
-    liftIO $ U.withBuilder bld body
-
---------------------------------------
-
--- Mark all block terminating instructions.  Not used yet.
---data Terminate = Terminate
-
---------------------------------------
-
-type Global a = Value (Ptr a)
-
--- | Create a new named global variable.
-newNamedGlobal :: forall a . (IsType a)
-               => Bool         -- ^Constant?
-               -> Linkage      -- ^Visibility
-               -> String       -- ^Name
-               -> TGlobal a
-newNamedGlobal isConst linkage name = do
-    modul <- getModule
-    typ <- liftIO $ typeRef (LP.Proxy :: LP.Proxy a)
-    liftIO $ liftM Value $ do
-        g <- U.addGlobal modul linkage name typ
-        when isConst $ FFI.setGlobalConstant g FFI.true
-        return g
-
--- | Create a new global variable.
-newGlobal :: forall a . (IsType a) => Bool -> Linkage -> TGlobal a
-newGlobal isConst linkage = genMSym "glb" >>= newNamedGlobal isConst linkage
-
--- | Give a global variable a (constant) value.
-defineGlobal :: Global a -> ConstValue a -> CodeGenModule ()
-defineGlobal (Value g) (ConstValue v) =
-    liftIO $ FFI.setInitializer g v
-
--- | Create and define a global variable.
-createGlobal :: (IsType a) => Bool -> Linkage -> ConstValue a -> TGlobal a
-createGlobal isConst linkage con = do
-    g <- newGlobal isConst linkage
-    defineGlobal g con
-    return g
-
--- | Create and define a named global variable.
-createNamedGlobal :: (IsType a) => Bool -> Linkage -> String -> ConstValue a -> TGlobal a
-createNamedGlobal isConst linkage name con = do
-    g <- newNamedGlobal isConst linkage name
-    defineGlobal g con
-    return g
-
-type TFunction a = CodeGenModule (Function a)
-type TGlobal a = CodeGenModule (Global a)
-
--- Special string creators
-{-# DEPRECATED createString "use withString instead" #-}
-createString :: String -> TGlobal (Array n Word8)
-createString s = string (length s) (U.constString s)
-
-{-# DEPRECATED createStringNul "use withStringNul instead" #-}
-createStringNul :: String -> TGlobal (Array n Word8)
-createStringNul s = string (length s + 1) (U.constStringNul s)
-
-withString ::
-   String ->
-   (forall n. (Dec.Natural n) => Global (Array n Word8) -> CodeGenModule a) ->
-   CodeGenModule a
-withString s act =
-   let n = length s
-   in  fromMaybe (error "withString: length must always be non-negative") $
-       Dec.reifyNatural (fromIntegral n) (\tn ->
-          do arr <- string n (U.constString s)
-             act (fixArraySize tn arr))
-
-withStringNul ::
-   String ->
-   (forall n. (Dec.Natural n) => Global (Array n Word8) -> CodeGenModule a) ->
-   CodeGenModule a
-withStringNul s act =
-   let n = length s + 1
-   in  fromMaybe (error "withStringNul: length must always be non-negative") $
-       Dec.reifyNatural (fromIntegral n) (\tn ->
-          do arr <- string n (U.constStringNul s)
-             act (fixArraySize tn arr))
-
-fixArraySize :: Proxy n -> Global (Array n a) -> Global (Array n a)
-fixArraySize _ = id
-
-string :: Int -> FFI.ValueRef -> TGlobal (Array n Word8)
-string n s = do
-    modul <- getModule
-    name <- genMSym "str"
-    elemTyp <- liftIO $ typeRef (LP.Proxy :: LP.Proxy Word8)
-    typ <- liftIO $ FFI.arrayType elemTyp (fromIntegral n)
-    liftIO $ liftM Value $ do g <- U.addGlobal modul InternalLinkage name typ
-                              FFI.setGlobalConstant g FFI.true
-                              FFI.setInitializer g s
-                              return g
-
---------------------------------------
-
--- |Make a constant vector.
-constVector ::
-    forall a n u.
-    (Dec.Positive n, Dec.ToUnary n ~ u,
-     UnaryVector.Length (FixedList u) ~ u) =>
-    UnaryVector.FixedList u (ConstValue a) ->
-    ConstValue (Vector n a)
-constVector =
-    constVectorGen id
-
-constVectorGen ::
-    forall a b n u.
-    (Dec.Positive n, Dec.ToUnary n ~ u) =>
-    (b -> ConstValue a) ->
-    UnaryVector.FixedList u b ->
-    ConstValue (Vector n a)
-constVectorGen f xs =
-    unsafeConstValue $
-    U.constVector
-        (case DecProof.unaryNat :: DecProof.UnaryNat n of
-             DecProof.UnaryNat ->
-                 map (unConstValue . f) $
-                 Fold.toList
-                     (UnaryVector.fromFixedList xs :: UnaryVector.T u b))
-
-{- |
-Make a constant vector.
-Replicates or truncates the list to get length @n@.
--}
-constCyclicVector ::
-    forall a n.
-    (Dec.Positive n) =>
-    NonEmpty.T [] (ConstValue a) ->
-    ConstValue (Vector n a)
-constCyclicVector xs =
-    unsafeConstValue $
-    U.constVector
-        (take (Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n)) $
-         map unConstValue $ NonEmpty.flatten $ NonEmpty.cycle xs)
-
-
-constArray ::
-    forall a n . (IsSized a, Dec.Natural n) =>
-    [ConstValue a] -> ConstValue (Array n a)
-constArray xs = unsafeConstValue $ do
-    let m = length xs
-        n = Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n)
-    when (m /= n) $
-        error $
-            printf "LLVM.constArray: number of array elements (%d) mismatches typed array length (%d)"
-                m n
-    typ <- typeRef (LP.Proxy :: LP.Proxy a)
-    U.constArray typ $ map unConstValue xs
-
-{- |
-Make a constant array.
-Replicates or truncates the list to get length @n@.
--}
-constCyclicArray ::
-    forall a n.
-    (IsSized a, Dec.Natural n) =>
-    NonEmpty.T [] (ConstValue a) ->
-    ConstValue (Vector n a)
-constCyclicArray xs = unsafeConstValue $ do
-    typ <- typeRef (LP.Proxy :: LP.Proxy a)
-    U.constArray typ
-        (take (Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n)) $
-         map unConstValue $ NonEmpty.flatten $ NonEmpty.cycle xs)
-
--- |Make a constant struct.
-constStruct ::
-    (IsConstStruct c) => c -> ConstValue (Struct (ConstStructOf c))
-constStruct struct =
-    unsafeConstValue $ U.constStruct (constValueFieldsOf struct) False
-
--- |Make a constant packed struct.
-constPackedStruct ::
-    (IsConstStruct c) => c -> ConstValue (PackedStruct (ConstStructOf c))
-constPackedStruct struct =
-    unsafeConstValue $ U.constStruct (constValueFieldsOf struct) True
-
-class IsConstStruct c where
-    type ConstStructOf c :: *
-    constValueFieldsOf :: c -> [FFI.ValueRef]
-
-instance (IsConst a, IsConstStruct cs) => IsConstStruct (ConstValue a, cs) where
-    type ConstStructOf (ConstValue a, cs) = (a, ConstStructOf cs)
-    constValueFieldsOf (a, as) = unConstValue a : constValueFieldsOf as
-instance IsConstStruct () where
-    type ConstStructOf () = ()
-    constValueFieldsOf _ = []
diff --git a/src/LLVM/Core/CodeGenMonad.hs b/src/LLVM/Core/CodeGenMonad.hs
deleted file mode 100644
--- a/src/LLVM/Core/CodeGenMonad.hs
+++ /dev/null
@@ -1,181 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-module LLVM.Core.CodeGenMonad(
-    -- * Module code generation
-    CodeGenModule, runCodeGenModule, genMSym, getModule,
-    GlobalMappings(..), addGlobalMapping, getGlobalMappings,
-    addFunctionMapping,
-    -- * Function code generation
-    CodeGenFunction, runCodeGenFunction, liftCodeGenModule, genFSym, getFunction, getBuilder, getFunctionModule, getExterns, putExterns,
-    ) where
-
-import LLVM.Core.Util (Module, Builder, Function, getValueNameU, withModule, )
-
-import qualified LLVM.FFI.Core as FFI
-import qualified LLVM.FFI.ExecutionEngine as EE
-
-import Foreign.C.String (withCString, )
-import Foreign.Ptr (FunPtr, Ptr, nullPtr, )
-
-import Control.Monad.Trans.State (StateT, runStateT, evalStateT, get, gets, put, modify, )
-import Control.Monad.IO.Class (MonadIO, liftIO, )
-import Control.Monad (when, )
-import Control.Applicative (Applicative, )
-import Data.Monoid (Monoid, mempty, mappend, )
-import Data.Semigroup (Semigroup, (<>), )
-
-import Data.Typeable (Typeable)
-
---------------------------------------
-
-data CGMState = CGMState {
-    cgm_module :: Module,
-    cgm_externs :: [(String, Function)],
-    cgm_global_mappings :: GlobalMappings,
-    cgm_next :: !Int
-    }
-    deriving (Show, Typeable)
-newtype CodeGenModule a = CGM (StateT CGMState IO a)
-    deriving (Functor, Applicative, Monad, MonadIO, Typeable)
-
-genMSym :: String -> CodeGenModule String
-genMSym prefix = do
-    s <- CGM get
-    let n = cgm_next s
-    CGM $ put (s { cgm_next = n + 1 })
-    return $ "_" ++ prefix ++ show n
-
-getModule :: CodeGenModule Module
-getModule = CGM $ gets cgm_module
-
-runCodeGenModule :: Module -> CodeGenModule a -> IO a
-runCodeGenModule m (CGM body) =
-    evalStateT body $
-    CGMState {
-        cgm_module = m, cgm_next = 1,
-        cgm_externs = [], cgm_global_mappings = mempty
-    }
-
---------------------------------------
-
-data CGFState r = CGFState {
-    cgf_module :: CGMState,
-    cgf_builder :: Builder,
-    cgf_function :: Function,
-    cgf_next :: !Int
-    }
-    deriving (Show, Typeable)
-newtype CodeGenFunction r a = CGF (StateT (CGFState r) IO a)
-    deriving (Functor, Applicative, Monad, MonadIO, Typeable)
-
-genFSym :: CodeGenFunction a String
-genFSym = do
-    s <- CGF get
-    let n = cgf_next s
-    CGF $ put (s { cgf_next = n + 1 })
-    return $ "_L" ++ show n
-
-getFunction :: CodeGenFunction a Function
-getFunction = CGF $ gets cgf_function
-
-getBuilder :: CodeGenFunction a Builder
-getBuilder = CGF $ gets cgf_builder
-
-getFunctionModule :: CodeGenFunction a Module
-getFunctionModule = CGF $ gets (cgm_module . cgf_module)
-
-getExterns :: CodeGenFunction a [(String, Function)]
-getExterns = CGF $ gets (cgm_externs . cgf_module)
-
-putExterns :: [(String, Function)] -> CodeGenFunction a ()
-putExterns es = do
-    cgf <- CGF get
-    let cgm' = (cgf_module cgf) { cgm_externs = es }
-    CGF $ put (cgf { cgf_module = cgm' })
-
-
-type Value = FFI.ValueRef
-
-addGlobalMapping ::
-    Value -> Ptr a -> CodeGenModule ()
-addGlobalMapping value func = CGM $ do
-    addMappingToState $
-        GlobalMappings (\ee -> EE.addGlobalMapping ee value func)
-
-addFunctionMapping ::
-    Function -> FunPtr f -> CodeGenModule ()
-addFunctionMapping value func = CGM $ do
-    {-
-    We need to fetch the name from the value
-    since it might have been disambiguized after adding.
-    -}
-    name <- liftIO $ getValueNameU value
-    modul <- gets cgm_module
-    addMappingToState $
-        GlobalMappings $ \ee -> do
-            {-
-            Between adding and application
-            the program may have been restructured by optimization passes.
-            I have not seen that the optimizer alters a Function Value pointer,
-            but the optimizer can remove an unused function.
-            That would render the original value invalid.
-            -}
-            currentValue <-
-                liftIO $
-                    withCString name $ \cname ->
-                    withModule modul $ \cmodule ->
-                        FFI.getNamedFunction cmodule cname
-            -- the optimizer could have removed the function
-            when (currentValue/=nullPtr) $
-                EE.addFunctionMapping ee currentValue func
-
-addMappingToState :: GlobalMappings -> StateT CGMState IO ()
-addMappingToState gm =
-    modify $ \cgm ->
-        cgm { cgm_global_mappings = cgm_global_mappings cgm <> gm }
-
-newtype GlobalMappings =
-    GlobalMappings (EE.ExecutionEngineRef -> IO ())
-
-instance Show GlobalMappings where
-    show _ = "GlobalMappings"
-
-instance Semigroup GlobalMappings where
-    GlobalMappings x <> GlobalMappings y =
-        GlobalMappings (\ee -> x ee >> y ee)
-
-instance Monoid GlobalMappings where
-    mempty = GlobalMappings $ const $ return ()
-    mappend = (<>)
-
-
-{- |
-Get a list created by calls to 'staticFunction'
-that must be passed to the execution engine
-via 'LLVM.ExecutionEngine.addGlobalMappings'.
--}
-getGlobalMappings ::
-    CodeGenModule GlobalMappings
-getGlobalMappings =
-    CGM $ gets cgm_global_mappings
-
-runCodeGenFunction :: Builder -> Function -> CodeGenFunction r a -> CodeGenModule a
-runCodeGenFunction bld fn (CGF body) = do
-    cgm <- CGM get
-    let cgf = CGFState { cgf_module = cgm,
-                         cgf_builder = bld,
-                         cgf_function = fn,
-                         cgf_next = 1 }
-    (a, cgf') <- liftIO $ runStateT body cgf
-    CGM $ put (cgf_module cgf')
-    return a
-
---------------------------------------
-
--- | Allows you to define part of a module while in the middle of defining a function.
-liftCodeGenModule :: CodeGenModule a -> CodeGenFunction r a
-liftCodeGenModule (CGM act) = do
-    cgf <- CGF get
-    (a, cgm') <- liftIO $ runStateT act (cgf_module cgf)
-    CGF $ put (cgf { cgf_module = cgm' })
-    return a
diff --git a/src/LLVM/Core/Data.hs b/src/LLVM/Core/Data.hs
deleted file mode 100644
--- a/src/LLVM/Core/Data.hs
+++ /dev/null
@@ -1,84 +0,0 @@
-{-# LANGUAGE EmptyDataDecls #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module LLVM.Core.Data (
-    IntN(..), WordN(..), FP128(..),
-    Array(..), Vector(..), Label, Struct(..), PackedStruct(..),
-    FixedList,
-    ) where
-
-import qualified LLVM.Core.UnaryVector as UnaryVector
-import LLVM.Core.UnaryVector (FixedList)
-
-import qualified Type.Data.Num.Decimal.Proof as DecProof
-import qualified Type.Data.Num.Decimal.Number as Dec
-import Type.Base.Proxy (Proxy(Proxy))
-
-import qualified Data.Foldable as Fold
-import qualified Data.Bits as Bits
-
-import Data.Typeable (Typeable)
-
-
--- TODO:
--- Make instances IntN, WordN to actually do the right thing.
--- Make FP128 do the right thing
--- Make Array functions.
-
--- |Variable sized signed integer.
--- The /n/ parameter should belong to @PosI@.
-newtype IntN n = IntN Integer
-    deriving (Show, Eq, Ord, Typeable)
-
-instance (Dec.Positive n) => Bounded (IntN n) where
-    minBound =
-        withBitSize $
-        IntN . negate . Bits.shiftL 1 . subtract 1 . Dec.integralFromProxy
-    maxBound =
-        withBitSize $
-        IntN . subtract 1 . Bits.shiftL 1 . subtract 1 . Dec.integralFromProxy
-
--- |Variable sized unsigned integer.
--- The /n/ parameter should belong to @PosI@.
-newtype WordN n = WordN Integer
-    deriving (Show, Eq, Ord, Typeable)
-
-instance (Dec.Positive n) => Bounded (WordN n) where
-    minBound = WordN 0
-    maxBound =
-        withBitSize $ WordN . subtract 1 . Bits.shiftL 1 . Dec.integralFromProxy
-
-withBitSize :: (Proxy n -> f n) -> f n
-withBitSize f = f Proxy
-
--- |128 bit floating point.
-newtype FP128 = FP128 Rational
-    deriving (Show, Typeable)
-
-
--- |Fixed sized arrays, the array size is encoded in the /n/ parameter.
-newtype Array n a = Array [a]
-    deriving (Show, Typeable)
-
--- |Fixed sized vector, the array size is encoded in the /n/ parameter.
-newtype Vector n a = Vector (FixedList (Dec.ToUnary n) a)
-
-instance (Dec.Natural n, Show a) => Show (Vector n a) where
-    showsPrec p (Vector xs) =
-        case DecProof.unaryNat :: DecProof.UnaryNat n of
-            DecProof.UnaryNat ->
-                showParen (p>10) $
-                    showString "Vector " .
-                    showList (Fold.toList
-                        (UnaryVector.fromFixedList xs
-                            :: UnaryVector.T (Dec.ToUnary n) a))
-
--- |Label type, produced by a basic block.
-data Label
-    deriving (Typeable)
-
--- |Struct types; a list (nested tuple) of component types.
-newtype Struct a = Struct a
-    deriving (Show, Typeable)
-newtype PackedStruct a = PackedStruct a
-    deriving (Show, Typeable)
diff --git a/src/LLVM/Core/Instructions.hs b/src/LLVM/Core/Instructions.hs
deleted file mode 100644
--- a/src/LLVM/Core/Instructions.hs
+++ /dev/null
@@ -1,1251 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
-module LLVM.Core.Instructions(
-    -- * ADT representation of IR
-    BinOpDesc(..), InstrDesc(..), ArgDesc(..), getInstrDesc,
-    -- * Terminator instructions
-    ret,
-    condBr,
-    br,
-    switch,
-    invoke, invokeWithConv,
-    invokeFromFunction, invokeWithConvFromFunction,
-    unreachable,
-    -- * Arithmetic binary operations
-    -- | Arithmetic operations with the normal semantics.
-    -- The u instructions are unsigned, the s instructions are signed.
-    add, sub, mul, neg,
-    iadd, isub, imul, ineg,
-    iaddNoWrap, isubNoWrap, imulNoWrap, inegNoWrap,
-    fadd, fsub, fmul, fneg,
-    idiv, irem,
-    udiv, sdiv, fdiv, urem, srem, frem,
-    -- * Logical binary operations
-    -- |Logical instructions with the normal semantics.
-    shl, shr, lshr, ashr, and, or, xor, inv,
-    -- * Vector operations
-    extractelement,
-    insertelement,
-    shufflevector,
-    -- * Aggregate operation
-    extractvalue,
-    insertvalue,
-    -- * Memory access
-    malloc, arrayMalloc,
-    alloca, arrayAlloca,
-    free,
-    load,
-    store,
-    getElementPtr, getElementPtr0,
-    -- * Conversions
-    ValueCons,
-    trunc, zext, sext, ext, zadapt, sadapt, adapt,
-    fptrunc, fpext,
-    fptoui, fptosi, fptoint,
-    uitofp, sitofp, inttofp,
-    ptrtoint, inttoptr,
-    bitcast,
-    -- * Comparison
-    CmpPredicate(..), IntPredicate(..), FPPredicate(..),
-    CmpRet, CmpResult, CmpValueResult,
-    cmp, pcmp, icmp, fcmp,
-    select,
-    -- * Fast math
-    setHasNoNaNs,
-    setHasNoInfs,
-    setHasNoSignedZeros,
-    setHasAllowReciprocal,
-    setFastMath,
-    -- * Other
-    phi, addPhiInputs,
-    call, callWithConv,
-    callFromFunction, callWithConvFromFunction,
-    Call, applyCall, runCall,
-
-    -- * Classes and types
-    ValueCons2, BinOpValue,
-    Terminate, Ret, CallArgs,
-    CodeGen.FunctionArgs, CodeGen.FunctionCodeGen, CodeGen.FunctionResult,
-    AllocArg,
-    GetElementPtr, ElementPtrType, IsIndexArg, IsIndexType,
-    GetValue, ValueType,
-    GetField, FieldType,
-    ) where
-
-import qualified LLVM.Core.Util as U
-import qualified LLVM.Util.Proxy as LP
-import qualified LLVM.Core.CodeGen as CodeGen
-import LLVM.Core.Instructions.Private
-            (ValueCons, unValue, convert, unop,
-             FFIBinOp, FFIConstBinOp,
-             GetField, FieldType, GetElementPtr, ElementPtrType,
-             IsIndexArg, IsIndexType, getIxList, getArg,
-             CmpPredicate(..),
-             uintFromCmpPredicate, sintFromCmpPredicate, fpFromCmpPredicate)
-import LLVM.Core.Data
-import LLVM.Core.Type
-import LLVM.Core.CodeGenMonad
-import LLVM.Core.CodeGen
-            (BasicBlock(BasicBlock), Function, withCurrentBuilder,
-             ConstValue(ConstValue), zero,
-             Value(Value), value, valueOf)
-
-import qualified LLVM.FFI.Core as FFI
-import LLVM.FFI.Core (IntPredicate(..), FPPredicate(..))
-
-import qualified Type.Data.Num.Decimal.Number as Dec
-import Type.Data.Num.Decimal.Literal (d1)
-import Type.Data.Num.Decimal.Number ((:<:), (:>:))
-import Type.Base.Proxy (Proxy)
-
-import Foreign.Ptr (Ptr, FunPtr, )
-import Foreign.C (CUInt, CInt)
-
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad (liftM)
-
-import qualified Data.Map as Map
-import Data.Map (Map)
-import Data.Int (Int8, Int16, Int32, Int64)
-import Data.Word (Word8, Word16, Word32, Word64)
-
-import Prelude hiding (and, or)
-
-
--- TODO:
--- Add vector version of arithmetic
--- Add rest of instructions
--- Use Terminate to ensure bb termination (how?)
--- more intrinsics are needed to, e.g., create an empty vector
-
-data ArgDesc = AV String | AI Int | AL String | AE
-
-instance Show ArgDesc where
-    -- show (AV s) = "V_" ++ s
-    -- show (AI i) = "I_" ++ show i
-    -- show (AL l) = "L_" ++ l
-    show (AV s) = s
-    show (AI i) = show i
-    show (AL l) = l
-    show AE = "voidarg?"
-
-data BinOpDesc = BOAdd | BOAddNuw | BOAddNsw | BOAddNuwNsw | BOFAdd
-               | BOSub | BOSubNuw | BOSubNsw | BOSubNuwNsw | BOFSub
-               | BOMul | BOMulNuw | BOMulNsw | BOMulNuwNsw | BOFMul
-               | BOUDiv | BOSDiv | BOSDivExact | BOFDiv | BOURem | BOSRem | BOFRem
-               | BOShL | BOLShR | BOAShR | BOAnd | BOOr | BOXor
-    deriving Show
-
--- FIXME: complete definitions for unimplemented instructions
-data InstrDesc =
-    -- terminators
-    IDRet TypeDesc ArgDesc | IDRetVoid
-  | IDBrCond ArgDesc ArgDesc ArgDesc | IDBrUncond ArgDesc
-  | IDSwitch [(ArgDesc, ArgDesc)]
-  | IDIndirectBr
-  | IDInvoke
-  | IDUnwind
-  | IDUnreachable
-    -- binary operators (including bitwise)
-  | IDBinOp BinOpDesc TypeDesc ArgDesc ArgDesc
-    -- memory access and addressing
-  | IDAlloca TypeDesc Int Int | IDLoad TypeDesc ArgDesc | IDStore TypeDesc ArgDesc ArgDesc
-  | IDGetElementPtr TypeDesc [ArgDesc]
-    -- conversion
-  | IDTrunc TypeDesc TypeDesc ArgDesc | IDZExt TypeDesc TypeDesc ArgDesc
-  | IDSExt TypeDesc TypeDesc ArgDesc | IDFPtoUI TypeDesc TypeDesc ArgDesc
-  | IDFPtoSI TypeDesc TypeDesc ArgDesc | IDUItoFP TypeDesc TypeDesc ArgDesc
-  | IDSItoFP TypeDesc TypeDesc ArgDesc
-  | IDFPTrunc TypeDesc TypeDesc ArgDesc | IDFPExt TypeDesc TypeDesc ArgDesc
-  | IDPtrToInt TypeDesc TypeDesc ArgDesc | IDIntToPtr TypeDesc TypeDesc ArgDesc
-  | IDBitcast TypeDesc TypeDesc ArgDesc
-    -- other
-  | IDICmp IntPredicate ArgDesc ArgDesc | IDFCmp FPPredicate ArgDesc ArgDesc
-  | IDPhi TypeDesc [(ArgDesc, ArgDesc)] | IDCall TypeDesc ArgDesc [ArgDesc]
-  | IDSelect TypeDesc ArgDesc ArgDesc | IDUserOp1 | IDUserOp2 | IDVAArg
-    -- vector operators
-  | IDExtractElement | IDInsertElement | IDShuffleVector
-    -- aggregate operators
-  | IDExtractValue | IDInsertValue
-    -- invalid
-  | IDInvalidOp
-    deriving Show
-
--- TODO: overflow support for binary operations (add/sub/mul)
-getInstrDesc :: FFI.ValueRef -> IO (String, InstrDesc)
-getInstrDesc v = do
-    valueName <- U.getValueNameU v
-    opcode <- FFI.instGetOpcode v
-    t <- FFI.typeOf v >>= typeDesc2
-    -- FIXME: sizeof() does not work for types!
-    --tsize <- FFI.typeOf v -- >>= FFI.sizeOf -- >>= FFI.constIntGetZExtValue >>= return . fromIntegral
-    tsize <- return 1
-    ovs <- U.getOperands v
-    os <- mapM getArgDesc ovs
-    os0 <- return $ case os of {o:_   -> o; _ -> AE}
-    os1 <- return $ case os of {_:o:_ -> o; _ -> AE}
-    instr <-
-        case Map.lookup opcode binOpMap of -- binary arithmetic
-          Just op -> return $ IDBinOp op t os0 os1
-          Nothing ->
-            case Map.lookup opcode convOpMap of
-              Just op -> do
-                t2 <-
-                    case ovs of
-                        (_name,ov):_ -> FFI.typeOf ov >>= typeDesc2
-                        _ -> return TDVoid
-                return $ op t2 t os0
-              Nothing ->
-                case opcode of
-                  1 -> return $ if null os then IDRetVoid else IDRet t os0
-                  2 -> return $ if length os == 1 then IDBrUncond os0 else IDBrCond os0 (os !! 2) os1
-                  3 -> return $ IDSwitch $ toPairs os
-                  -- TODO (can skip for now)
-                  -- 4 -> return IndirectBr ; 5 -> return Invoke
-                  6 -> return IDUnwind; 7 -> return IDUnreachable
-                  26 -> return $ IDAlloca (getPtrType t) tsize (getImmInt os0)
-                  27 -> return $ IDLoad t os0; 28 -> return $ IDStore t os0 os1
-                  29 -> return $ IDGetElementPtr t os
-                  42 -> do
-                      pInt <- FFI.cmpInstGetIntPredicate v
-                      return $ IDICmp (FFI.toIntPredicate pInt) os0 os1
-                  43 -> do
-                      pFloat <- FFI.cmpInstGetRealPredicate v
-                      return $ IDFCmp (FFI.toRealPredicate pFloat) os0 os1
-                  44 -> return $ IDPhi t $ toPairs os
-                  -- FIXME: getelementptr arguments are not handled
-                  45 -> return $ IDCall t (last os) (init os)
-                  46 -> return $ IDSelect t os0 os1
-                  -- TODO (can skip for now)
-                  -- 47 -> return UserOp1 ; 48 -> return UserOp2 ; 49 -> return VAArg
-                  -- 50 -> return ExtractElement ; 51 -> return InsertElement ; 52 -> return ShuffleVector
-                  -- 53 -> return ExtractValue ; 54 -> return InsertValue
-                  _ -> return IDInvalidOp
-    return (valueName, instr)
-    --if instr /= InvalidOp then return instr else fail $ "Invalid opcode: " ++ show opcode
-        where toPairs xs = zip (stride 2 xs) (stride 2 (drop 1 xs))
-              stride _ [] = []
-              stride n (x:xs) = x : stride n (drop (n-1) xs)
-              getPtrType (TDPtr t) = t
-              getPtrType _ = TDVoid
-              getImmInt (AI i) = i
-              getImmInt _ = 0
-
-binOpMap :: Map CInt BinOpDesc
-binOpMap =
-    Map.fromList
-        [(8, BOAdd), (9, BOFAdd), (10, BOSub), (11, BOFSub),
-         (12, BOMul), (13, BOFMul), (14, BOUDiv), (15, BOSDiv),
-         (16, BOFDiv), (17, BOURem), (18, BOSRem), (19, BOFRem),
-         (20, BOShL), (21, BOLShR), (22, BOAShR), (23, BOAnd),
-         (24, BOOr), (25, BOXor)]
-
-convOpMap :: Map CInt (TypeDesc -> TypeDesc -> ArgDesc -> InstrDesc)
-convOpMap =
-    Map.fromList
-        [(30, IDTrunc), (31, IDZExt), (32, IDSExt), (33, IDFPtoUI),
-         (34, IDFPtoSI), (35, IDUItoFP), (36, IDSItoFP), (37, IDFPTrunc),
-         (38, IDFPExt), (39, IDPtrToInt), (40, IDIntToPtr), (41, IDBitcast)]
-
--- TODO: fix for non-int constants
-getArgDesc :: (String, FFI.ValueRef) -> IO ArgDesc
-getArgDesc (vname, v) = do
-    isC <- U.isConstant v
-    t <- FFI.typeOf v >>= typeDesc2
-    if isC
-      then case t of
-             TDInt _ _ -> do
-                          cV <- FFI.constIntGetSExtValue v
-                          return $ AI $ fromIntegral cV
-             _ -> return AE
-      else case t of
-             TDLabel -> return $ AL vname
-             _ -> return $ AV vname
-
---------------------------------------
-
-type Terminate = ()
-terminate :: Terminate
-terminate = ()
-
---------------------------------------
-
--- |Acceptable arguments to the 'ret' instruction.
-class Ret a r where
-    ret' :: a -> CodeGenFunction r Terminate
-
--- | Return from the current function with the given value.  Use () as the return value for what would be a void function in C.
-ret :: (Ret a r) => a -> CodeGenFunction r Terminate
-ret = ret'
-
--- overlaps with Ret () ()!
-{-
-instance (IsFirstClass a, IsConst a) => Ret a a where
-    ret' = ret . valueOf
--}
-
-instance Ret (Value a) a where
-    ret' (Value a) = do
-        withCurrentBuilder_ $ \ bldPtr -> FFI.buildRet bldPtr a
-        return terminate
-
-instance Ret () () where
-    ret' _ = do
-        withCurrentBuilder_ $ FFI.buildRetVoid
-        return terminate
-
-withCurrentBuilder_ :: (FFI.BuilderRef -> IO a) -> CodeGenFunction r ()
-withCurrentBuilder_ p = withCurrentBuilder p >> return ()
-
---------------------------------------
-
--- | Branch to the first basic block if the boolean is true, otherwise to the second basic block.
-condBr :: Value Bool -- ^ Boolean to branch upon.
-       -> BasicBlock -- ^ Target for true.
-       -> BasicBlock -- ^ Target for false.
-       -> CodeGenFunction r Terminate
-condBr (Value b) (BasicBlock t1) (BasicBlock t2) = do
-    withCurrentBuilder_ $ \ bldPtr -> FFI.buildCondBr bldPtr b t1 t2
-    return terminate
-
---------------------------------------
-
--- | Unconditionally branch to the given basic block.
-br :: BasicBlock  -- ^ Branch target.
-   -> CodeGenFunction r Terminate
-br (BasicBlock t) = do
-    withCurrentBuilder_ $ \ bldPtr -> FFI.buildBr bldPtr t
-    return terminate
-
---------------------------------------
-
--- | Branch table instruction.
-switch :: (IsInteger a)
-       => Value a                        -- ^ Value to branch upon.
-       -> BasicBlock                     -- ^ Default branch target.
-       -> [(ConstValue a, BasicBlock)]   -- ^ Labels and corresponding branch targets.
-       -> CodeGenFunction r Terminate
-switch (Value val) (BasicBlock dflt) arms = do
-    withCurrentBuilder_ $ \ bldPtr -> do
-        inst <- FFI.buildSwitch bldPtr val dflt (fromIntegral $ length arms)
-        sequence_ [ FFI.addCase inst c b | (ConstValue c, BasicBlock b) <- arms ]
-    return terminate
-
---------------------------------------
-
--- |Inform the code generator that this code can never be reached.
-unreachable :: CodeGenFunction r Terminate
-unreachable = do
-    withCurrentBuilder_ FFI.buildUnreachable
-    return terminate
-
---------------------------------------
-
-
-withArithmeticType ::
-    (IsArithmetic c) =>
-    (ArithmeticType c -> a -> CodeGenFunction r (v c)) ->
-    (a -> CodeGenFunction r (v c))
-withArithmeticType f = f arithmeticType
-
-
-class (ValueCons value0, ValueCons value1) => ValueCons2 value0 value1 where
-    type BinOpValue (value0 :: * -> *) (value1 :: * -> *) :: * -> *
-    binop ::
-        FFIConstBinOp -> FFIBinOp ->
-        value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 b)
-
-instance ValueCons2 Value Value where
-    type BinOpValue Value Value = Value
-    binop _ op (Value a1) (Value a2) = buildBinOp op a1 a2
-
-instance ValueCons2 Value ConstValue where
-    type BinOpValue Value ConstValue = Value
-    binop _ op (Value a1) (ConstValue a2) = buildBinOp op a1 a2
-
-instance ValueCons2 ConstValue Value where
-    type BinOpValue ConstValue Value = Value
-    binop _ op (ConstValue a1) (Value a2) = buildBinOp op a1 a2
-
-instance ValueCons2 ConstValue ConstValue where
-    type BinOpValue ConstValue ConstValue = ConstValue
-    binop cop _ (ConstValue a1) (ConstValue a2) =
-        liftIO $ fmap ConstValue $ cop a1 a2
-
-
-add, sub, mul ::
-    (ValueCons2 value0 value1, IsArithmetic a) =>
-    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
-add =
-    curry $ withArithmeticType $ \typ -> uncurry $ case typ of
-      IntegerType  -> binop FFI.constAdd  FFI.buildAdd
-      FloatingType -> binop FFI.constFAdd FFI.buildFAdd
-
-sub =
-    curry $ withArithmeticType $ \typ -> uncurry $ case typ of
-      IntegerType  -> binop FFI.constSub  FFI.buildSub
-      FloatingType -> binop FFI.constFSub FFI.buildFSub
-
-mul =
-    curry $ withArithmeticType $ \typ -> uncurry $ case typ of
-      IntegerType  -> binop FFI.constMul  FFI.buildMul
-      FloatingType -> binop FFI.constFMul FFI.buildFMul
-
-iadd, isub, imul ::
-    (ValueCons2 value0 value1, IsInteger a) =>
-    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
-iadd = binop FFI.constAdd FFI.buildAdd
-isub = binop FFI.constSub FFI.buildSub
-imul = binop FFI.constMul FFI.buildMul
-
-iaddNoWrap, isubNoWrap, imulNoWrap ::
-    (ValueCons2 value0 value1, IsInteger a) =>
-    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
-iaddNoWrap =
-    sbinop FFI.constNSWAdd FFI.buildNSWAdd FFI.constNUWAdd FFI.buildNUWAdd
-isubNoWrap =
-    sbinop FFI.constNSWSub FFI.buildNSWSub FFI.constNUWSub FFI.buildNUWSub
-imulNoWrap =
-    sbinop FFI.constNSWMul FFI.buildNSWMul FFI.constNUWMul FFI.buildNUWMul
-
--- | signed or unsigned integer division depending on the type
-idiv ::
-    (ValueCons2 value0 value1, IsInteger a) =>
-    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
-idiv = sbinop FFI.constSDiv FFI.buildSDiv FFI.constUDiv FFI.buildUDiv
--- | signed or unsigned remainder depending on the type
-irem ::
-    (ValueCons2 value0 value1, IsInteger a) =>
-    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
-irem = sbinop FFI.constSRem FFI.buildSRem FFI.constURem FFI.buildURem
-
-{-# DEPRECATED udiv "use idiv instead" #-}
-{-# DEPRECATED sdiv "use idiv instead" #-}
-{-# DEPRECATED urem "use irem instead" #-}
-{-# DEPRECATED srem "use irem instead" #-}
-udiv, sdiv, urem, srem ::
-    (ValueCons2 value0 value1, IsInteger a) =>
-    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
-udiv = binop FFI.constUDiv FFI.buildUDiv
-sdiv = binop FFI.constSDiv FFI.buildSDiv
-urem = binop FFI.constURem FFI.buildURem
-srem = binop FFI.constSRem FFI.buildSRem
-
-fadd, fsub, fmul ::
-    (ValueCons2 value0 value1, IsFloating a) =>
-    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
-fadd = binop FFI.constFAdd FFI.buildFAdd
-fsub = binop FFI.constFSub FFI.buildFSub
-fmul = binop FFI.constFMul FFI.buildFMul
-
--- | Floating point division.
-fdiv ::
-    (ValueCons2 value0 value1, IsFloating a) =>
-    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
-fdiv = binop FFI.constFDiv FFI.buildFDiv
--- | Floating point remainder.
-frem ::
-    (ValueCons2 value0 value1, IsFloating a) =>
-    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
-frem = binop FFI.constFRem FFI.buildFRem
-
-shl, lshr, ashr, and, or, xor ::
-    (ValueCons2 value0 value1, IsInteger a) =>
-    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
-shl  = binop FFI.constShl  FFI.buildShl
-lshr = binop FFI.constLShr FFI.buildLShr
-ashr = binop FFI.constAShr FFI.buildAShr
-and  = binop FFI.constAnd  FFI.buildAnd
-or   = binop FFI.constOr   FFI.buildOr
-xor  = binop FFI.constXor  FFI.buildXor
-
-shr ::
-    (ValueCons2 value0 value1, IsInteger a) =>
-    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
-shr = sbinop FFI.constAShr FFI.buildAShr FFI.constLShr FFI.buildLShr
-
-sbinop ::
-    forall value0 value1 a b r.
-    (ValueCons2 value0 value1, IsInteger a) =>
-    FFIConstBinOp -> FFIBinOp ->
-    FFIConstBinOp -> FFIBinOp ->
-    value0 a -> value1 a -> CodeGenFunction r (BinOpValue value0 value1 b)
-sbinop scop sop ucop uop =
-    if isSigned (LP.Proxy :: LP.Proxy a)
-        then binop scop sop
-        else binop ucop uop
-
-
-buildBinOp ::
-    FFIBinOp -> FFI.ValueRef -> FFI.ValueRef -> CodeGenFunction r (Value a)
-buildBinOp op a1 a2 =
-    liftM Value $
-    withCurrentBuilder $ \ bld ->
-      U.withEmptyCString $ op bld a1 a2
-
-neg ::
-    (ValueCons value, IsArithmetic a) =>
-    value a -> CodeGenFunction r (value a)
-neg =
-    withArithmeticType $ \typ -> case typ of
-      IntegerType  -> unop FFI.constNeg FFI.buildNeg
-      FloatingType -> unop FFI.constFNeg FFI.buildFNeg
-
-ineg ::
-    (ValueCons value, IsInteger a) =>
-    value a -> CodeGenFunction r (value a)
-ineg = unop FFI.constNeg FFI.buildNeg
-
-inegNoWrap ::
-    forall value a r.
-    (ValueCons value, IsInteger a) =>
-    value a -> CodeGenFunction r (value a)
-inegNoWrap =
-   if isSigned (LP.Proxy :: LP.Proxy a)
-     then unop FFI.constNSWNeg FFI.buildNSWNeg
-     else unop FFI.constNUWNeg FFI.buildNUWNeg
-
-fneg ::
-    (ValueCons value, IsFloating a) =>
-    value a -> CodeGenFunction r (value a)
-fneg = unop FFI.constFNeg FFI.buildFNeg
-
-inv ::
-    (ValueCons value, IsInteger a) =>
-    value a -> CodeGenFunction r (value a)
-inv = unop FFI.constNot FFI.buildNot
-
---------------------------------------
-
--- | Get a value from a vector.
-extractelement :: (Dec.Positive n, IsPrimitive a)
-               => Value (Vector n a)               -- ^ Vector
-               -> Value Word32                     -- ^ Index into the vector
-               -> CodeGenFunction r (Value a)
-extractelement (Value vec) (Value i) =
-    liftM Value $
-    withCurrentBuilder $ \ bldPtr ->
-      U.withEmptyCString $ FFI.buildExtractElement bldPtr vec i
-
--- | Insert a value into a vector, nondestructive.
-insertelement :: (Dec.Positive n, IsPrimitive a)
-              => Value (Vector n a)                -- ^ Vector
-              -> Value a                           -- ^ Value to insert
-              -> Value Word32                      -- ^ Index into the vector
-              -> CodeGenFunction r (Value (Vector n a))
-insertelement (Value vec) (Value e) (Value i) =
-    liftM Value $
-    withCurrentBuilder $ \ bldPtr ->
-      U.withEmptyCString $ FFI.buildInsertElement bldPtr vec e i
-
--- | Permute vector.
-shufflevector :: (Dec.Positive n, Dec.Positive m, IsPrimitive a)
-              => Value (Vector n a)
-              -> Value (Vector n a)
-              -> ConstValue (Vector m Word32)
-              -> CodeGenFunction r (Value (Vector m a))
-shufflevector (Value a) (Value b) (ConstValue mask) =
-    liftM Value $
-    withCurrentBuilder $ \ bldPtr ->
-      U.withEmptyCString $ FFI.buildShuffleVector bldPtr a b mask
-
-
--- |Acceptable arguments to 'extractvalue' and 'insertvalue'.
-class GetValue agg ix where
-    type ValueType agg ix :: *
-    getIx :: LP.Proxy agg -> ix -> CUInt
-
-instance (GetField as i, Dec.Natural i) => GetValue (Struct as) (Proxy i) where
-    type ValueType (Struct as) (Proxy i) = FieldType as i
-    getIx _ n = Dec.integralFromProxy n
-
-instance (IsFirstClass a, Dec.Natural n) => GetValue (Array n a) Word32 where
-    type ValueType (Array n a) Word32 = a
-    getIx _ n = fromIntegral n
-
-instance (IsFirstClass a, Dec.Natural n) => GetValue (Array n a) Word64 where
-    type ValueType (Array n a) Word64 = a
-    getIx _ n = fromIntegral n
-
-
-instance (IsFirstClass a, Dec.Natural n, Dec.Natural i, i :<: n) => GetValue (Array n a) (Proxy i) where
-    type ValueType (Array n a) (Proxy i) = a
-    getIx _ n = Dec.integralFromProxy n
-
-
--- | Get a value from an aggregate.
-extractvalue :: forall r agg i.
-                GetValue agg i
-             => Value agg                   -- ^ Aggregate
-             -> i                           -- ^ Index into the aggregate
-             -> CodeGenFunction r (Value (ValueType agg i))
-extractvalue (Value agg) i =
-    liftM Value $
-    withCurrentBuilder $ \ bldPtr ->
-      U.withEmptyCString $
-        FFI.buildExtractValue bldPtr agg (getIx (LP.Proxy :: LP.Proxy agg) i)
-
--- | Insert a value into an aggregate, nondestructive.
-insertvalue :: forall r agg i.
-               GetValue agg i
-            => Value agg                   -- ^ Aggregate
-            -> Value (ValueType agg i)     -- ^ Value to insert
-            -> i                           -- ^ Index into the aggregate
-            -> CodeGenFunction r (Value agg)
-insertvalue (Value agg) (Value e) i =
-    liftM Value $
-    withCurrentBuilder $ \ bldPtr ->
-      U.withEmptyCString $
-        FFI.buildInsertValue bldPtr agg e (getIx (LP.Proxy :: LP.Proxy agg) i)
-
-
---------------------------------------
-
--- | Truncate a value to a shorter bit width.
-trunc :: (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :>: SizeOf b)
-      => value a -> CodeGenFunction r (value b)
-trunc = convert FFI.constTrunc FFI.buildTrunc
-
--- | Zero extend a value to a wider width.
--- If possible, use 'ext' that chooses the right padding according to the types
-zext :: (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)
-     => value a -> CodeGenFunction r (value b)
-zext = convert FFI.constZExt FFI.buildZExt
-
--- | Sign extend a value to wider width.
--- If possible, use 'ext' that chooses the right padding according to the types
-sext :: (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)
-     => value a -> CodeGenFunction r (value b)
-sext = convert FFI.constSExt FFI.buildSExt
-
--- | Extend a value to wider width.
--- If the target type is signed, then preserve the sign,
--- If the target type is unsigned, then extended by zeros.
-ext :: forall value a b r. (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, Signed a ~ Signed b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)
-     => value a -> CodeGenFunction r (value b)
-ext =
-   if isSigned (LP.Proxy :: LP.Proxy b)
-     then convert FFI.constSExt FFI.buildSExt
-     else convert FFI.constZExt FFI.buildZExt
-
--- | It is 'zext', 'trunc' or nop depending on the relation of the sizes.
-zadapt :: forall value a b r. (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b)
-     => value a -> CodeGenFunction r (value b)
-zadapt =
-   case compare (sizeOf (typeDesc (LP.Proxy :: LP.Proxy a)))
-                (sizeOf (typeDesc (LP.Proxy :: LP.Proxy b))) of
-      LT -> convert FFI.constZExt FFI.buildZExt
-      EQ -> convert FFI.constBitCast FFI.buildBitCast
-      GT -> convert FFI.constTrunc FFI.buildTrunc
-
--- | It is 'sext', 'trunc' or nop depending on the relation of the sizes.
-sadapt :: forall value a b r. (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b)
-     => value a -> CodeGenFunction r (value b)
-sadapt =
-   case compare (sizeOf (typeDesc (LP.Proxy :: LP.Proxy a)))
-                (sizeOf (typeDesc (LP.Proxy :: LP.Proxy b))) of
-      LT -> convert FFI.constSExt FFI.buildSExt
-      EQ -> convert FFI.constBitCast FFI.buildBitCast
-      GT -> convert FFI.constTrunc FFI.buildTrunc
-
--- | It is 'sadapt' or 'zadapt' depending on the sign mode.
-adapt :: forall value a b r. (ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b, Signed a ~ Signed b)
-     => value a -> CodeGenFunction r (value b)
-adapt =
-   case compare (sizeOf (typeDesc (LP.Proxy :: LP.Proxy a)))
-                (sizeOf (typeDesc (LP.Proxy :: LP.Proxy b))) of
-      LT ->
-         if isSigned (LP.Proxy :: LP.Proxy b)
-           then convert FFI.constSExt FFI.buildSExt
-           else convert FFI.constZExt FFI.buildZExt
-      EQ -> convert FFI.constBitCast FFI.buildBitCast
-      GT -> convert FFI.constTrunc FFI.buildTrunc
-
--- | Truncate a floating point value.
-fptrunc :: (ValueCons value, IsFloating a, IsFloating b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :>: SizeOf b)
-        => value a -> CodeGenFunction r (value b)
-fptrunc = convert FFI.constFPTrunc FFI.buildFPTrunc
-
--- | Extend a floating point value.
-fpext :: (ValueCons value, IsFloating a, IsFloating b, ShapeOf a ~ ShapeOf b, IsSized a, IsSized b, SizeOf a :<: SizeOf b)
-      => value a -> CodeGenFunction r (value b)
-fpext = convert FFI.constFPExt FFI.buildFPExt
-
-{-# DEPRECATED fptoui "use fptoint since it is type-safe with respect to signs" #-}
--- | Convert a floating point value to an unsigned integer.
-fptoui :: (ValueCons value, IsFloating a, IsInteger b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)
-fptoui = convert FFI.constFPToUI FFI.buildFPToUI
-
-{-# DEPRECATED fptosi "use fptoint since it is type-safe with respect to signs" #-}
--- | Convert a floating point value to a signed integer.
-fptosi :: (ValueCons value, IsFloating a, IsInteger b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)
-fptosi = convert FFI.constFPToSI FFI.buildFPToSI
-
--- | Convert a floating point value to an integer.
--- It is mapped to @fptosi@ or @fptoui@ depending on the type @a@.
-fptoint :: forall value a b r. (ValueCons value, IsFloating a, IsInteger b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)
-fptoint =
-   if isSigned (LP.Proxy :: LP.Proxy b)
-     then convert FFI.constFPToSI FFI.buildFPToSI
-     else convert FFI.constFPToUI FFI.buildFPToUI
-
-
-{- DEPRECATED uitofp "use inttofp since it is type-safe with respect to signs" -}
--- | Convert an unsigned integer to a floating point value.
--- Although 'inttofp' should be prefered, this function may be useful for conversion from Bool.
-uitofp :: (ValueCons value, IsInteger a, IsFloating b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)
-uitofp = convert FFI.constUIToFP FFI.buildUIToFP
-
-{- DEPRECATED sitofp "use inttofp since it is type-safe with respect to signs" -}
--- | Convert a signed integer to a floating point value.
--- Although 'inttofp' should be prefered, this function may be useful for conversion from Bool.
-sitofp :: (ValueCons value, IsInteger a, IsFloating b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)
-sitofp = convert FFI.constSIToFP FFI.buildSIToFP
-
--- | Convert an integer to a floating point value.
--- It is mapped to @sitofp@ or @uitofp@ depending on the type @a@.
-inttofp :: forall value a b r. (ValueCons value, IsInteger a, IsFloating b, ShapeOf a ~ ShapeOf b) => value a -> CodeGenFunction r (value b)
-inttofp =
-   if isSigned (LP.Proxy :: LP.Proxy a)
-     then convert FFI.constSIToFP FFI.buildSIToFP
-     else convert FFI.constUIToFP FFI.buildUIToFP
-
-
--- | Convert a pointer to an integer.
-ptrtoint :: (ValueCons value, IsInteger b, IsPrimitive b) => value (Ptr a) -> CodeGenFunction r (value b)
-ptrtoint = convert FFI.constPtrToInt FFI.buildPtrToInt
-
--- | Convert an integer to a pointer.
-inttoptr :: (ValueCons value, IsInteger a, IsType b) => value a -> CodeGenFunction r (value (Ptr b))
-inttoptr = convert FFI.constIntToPtr FFI.buildIntToPtr
-
--- | Convert between to values of the same size by just copying the bit pattern.
-bitcast :: (ValueCons value, IsFirstClass a, IsFirstClass b, IsSized a, IsSized b, SizeOf a ~ SizeOf b)
-        => value a -> CodeGenFunction r (value b)
-bitcast = convert FFI.constBitCast FFI.buildBitCast
-
-
---------------------------------------
-
-type CmpValueResult value0 value1 a = BinOpValue value0 value1 (CmpResult a)
-
-type CmpResult c = ShapedType (ShapeOf c) Bool
-
-class (IsFirstClass c) => CmpRet c where
-    cmpBld :: LP.Proxy c -> CmpPredicate -> FFIBinOp
-    cmpCnst :: LP.Proxy c -> CmpPredicate -> FFIConstBinOp
-
-instance CmpRet Float   where cmpBld _ = fcmpBld ; cmpCnst _ = fcmpCnst
-instance CmpRet Double  where cmpBld _ = fcmpBld ; cmpCnst _ = fcmpCnst
-instance CmpRet FP128   where cmpBld _ = fcmpBld ; cmpCnst _ = fcmpCnst
-instance CmpRet Bool    where cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
-instance CmpRet Word8   where cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
-instance CmpRet Word16  where cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
-instance CmpRet Word32  where cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
-instance CmpRet Word64  where cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
-instance CmpRet Int8    where cmpBld _ = scmpBld ; cmpCnst _ = scmpCnst
-instance CmpRet Int16   where cmpBld _ = scmpBld ; cmpCnst _ = scmpCnst
-instance CmpRet Int32   where cmpBld _ = scmpBld ; cmpCnst _ = scmpCnst
-instance CmpRet Int64   where cmpBld _ = scmpBld ; cmpCnst _ = scmpCnst
-instance (IsType a) =>
-         CmpRet (Ptr a) where cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
-
-instance (Dec.Positive n) => CmpRet (WordN n) where
-    cmpBld _ = ucmpBld ; cmpCnst _ = ucmpCnst
-instance (Dec.Positive n) => CmpRet (IntN n) where
-    cmpBld _ = scmpBld ; cmpCnst _ = scmpCnst
-
-instance (CmpRet a, IsPrimitive a, Dec.Positive n) => CmpRet (Vector n a) where
-    cmpBld _ = cmpBld (LP.Proxy :: LP.Proxy a)
-    cmpCnst _ = cmpCnst (LP.Proxy :: LP.Proxy a)
-
-
-{- |
-Compare values of ordered types
-and choose predicates according to the compared types.
-Floating point numbers are compared in \"ordered\" mode,
-that is @NaN@ operands yields 'False' as result.
-Pointers are compared unsigned.
-These choices are consistent with comparison in plain Haskell.
--}
-cmp :: forall value0 value1 a r.
-   (ValueCons2 value0 value1, CmpRet a) =>
-   CmpPredicate -> value0 a -> value1 a ->
-   CodeGenFunction r (CmpValueResult value0 value1 a)
-cmp p =
-    binop
-        (cmpCnst (LP.Proxy :: LP.Proxy a) p)
-        (cmpBld (LP.Proxy :: LP.Proxy a) p)
-
-ucmpBld :: CmpPredicate -> FFIBinOp
-ucmpBld p = flip FFI.buildICmp (FFI.fromIntPredicate (uintFromCmpPredicate p))
-
-scmpBld :: CmpPredicate -> FFIBinOp
-scmpBld p = flip FFI.buildICmp (FFI.fromIntPredicate (sintFromCmpPredicate p))
-
-fcmpBld :: CmpPredicate -> FFIBinOp
-fcmpBld p = flip FFI.buildFCmp (FFI.fromRealPredicate (fpFromCmpPredicate p))
-
-
-ucmpCnst :: CmpPredicate -> FFIConstBinOp
-ucmpCnst p = FFI.constICmp (FFI.fromIntPredicate (uintFromCmpPredicate p))
-
-scmpCnst :: CmpPredicate -> FFIConstBinOp
-scmpCnst p = FFI.constICmp (FFI.fromIntPredicate (sintFromCmpPredicate p))
-
-fcmpCnst :: CmpPredicate -> FFIConstBinOp
-fcmpCnst p = FFI.constFCmp (FFI.fromRealPredicate (fpFromCmpPredicate p))
-
-
-_ucmp ::
-    (ValueCons2 value0 value1, CmpRet a, IsInteger a) =>
-    CmpPredicate -> value0 a -> value1 a ->
-    CodeGenFunction r (CmpValueResult value0 value1 a)
-_ucmp p = binop (ucmpCnst p) (ucmpBld p)
-
-_scmp ::
-    (ValueCons2 value0 value1, CmpRet a, IsInteger a) =>
-    CmpPredicate -> value0 a -> value1 a ->
-    CodeGenFunction r (CmpValueResult value0 value1 a)
-_scmp p = binop (scmpCnst p) (scmpBld p)
-
-pcmp ::
-    (ValueCons2 value0 value1, IsType a) =>
-    IntPredicate -> value0 (Ptr a) -> value1 (Ptr a) ->
-    CodeGenFunction r (BinOpValue value0 value1 (Ptr a))
-pcmp p =
-    binop
-        (FFI.constICmp (FFI.fromIntPredicate p))
-        (flip FFI.buildICmp (FFI.fromIntPredicate p))
-
-
-{-# DEPRECATED icmp "use cmp or pcmp instead" #-}
--- | Compare integers.
-icmp ::
-    (ValueCons2 value0 value1, CmpRet a, IsIntegerOrPointer a) =>
-    IntPredicate -> value0 a -> value1 a ->
-    CodeGenFunction r (CmpValueResult value0 value1 a)
-icmp p =
-    binop
-        (FFI.constICmp (FFI.fromIntPredicate p))
-        (flip FFI.buildICmp (FFI.fromIntPredicate p))
-
--- | Compare floating point values.
-fcmp ::
-    (ValueCons2 value0 value1, CmpRet a, IsFloating a) =>
-    FPPredicate -> value0 a -> value1 a ->
-    CodeGenFunction r (CmpValueResult value0 value1 a)
-fcmp p =
-    binop
-        (FFI.constFCmp (FFI.fromRealPredicate p))
-        (flip FFI.buildFCmp (FFI.fromRealPredicate p))
-
---------------------------------------
-
-setHasNoNaNs, setHasNoInfs, setHasNoSignedZeros, setHasAllowReciprocal,
-    setFastMath :: (IsFloating a) => Bool -> Value a -> CodeGenFunction r ()
-setHasNoNaNs          = fastMath FFI.setHasNoNaNs
-setHasNoInfs          = fastMath FFI.setHasNoInfs
-setHasNoSignedZeros   = fastMath FFI.setHasNoSignedZeros
-setHasAllowReciprocal = fastMath FFI.setHasAllowReciprocal
-setFastMath           = fastMath FFI.setHasUnsafeAlgebra
-
-fastMath ::
-    (IsFloating a) =>
-    (FFI.ValueRef -> FFI.Bool -> IO ()) ->
-    Bool -> Value a -> CodeGenFunction r ()
-fastMath setter b (Value v) = liftIO $ setter v $ FFI.consBool b
-
-
---------------------------------------
-
--- XXX could do const song and dance
--- | Select between two values depending on a boolean.
-select :: (CmpRet a) => Value (CmpResult a) -> Value a -> Value a -> CodeGenFunction r (Value a)
-select (Value cnd) (Value thn) (Value els) =
-    liftM Value $
-      withCurrentBuilder $ \ bldPtr ->
-        U.withEmptyCString $
-          FFI.buildSelect bldPtr cnd thn els
-
---------------------------------------
-
-type Caller = FFI.BuilderRef -> [FFI.ValueRef] -> IO FFI.ValueRef
-
-{-
-Function (a -> b -> IO c)
-Value a -> Value b -> CodeGenFunction r c
--}
-
--- |Acceptable arguments to 'call'.
-class (f ~ CalledFunction g, r ~ CallerResult g, g ~ CallerFunction f r) =>
-         CallArgs f g r where
-    type CalledFunction g :: *
-    type CallerResult g :: *
-    type CallerFunction f r :: *
-    doCall :: Call f -> g
-
-instance (CallArgs b b' r) => CallArgs (a -> b) (Value a -> b') r where
-    type CalledFunction (Value a -> b') = a -> CalledFunction b'
-    type CallerResult (Value a -> b') = CallerResult b'
-    type CallerFunction (a -> b) r = Value a -> CallerFunction b r
-    doCall f a = doCall (applyCall f a)
-
---instance (CallArgs b b') => CallArgs (a -> b) (ConstValue a -> b') where
---    doCall mkCall args f (ConstValue arg) = doCall mkCall (arg : args) (f (LP.Proxy :: LP.Proxy a))
-
-instance CallArgs (IO a) (CodeGenFunction r (Value a)) r where
-    type CalledFunction (CodeGenFunction r (Value a)) = IO a
-    type CallerResult (CodeGenFunction r (Value a)) = r
-    type CallerFunction (IO a) r = CodeGenFunction r (Value a)
-    doCall = runCall
-
-doCallDef :: Caller -> [FFI.ValueRef] -> b -> CodeGenFunction r (Value a)
-doCallDef mkCall args _ =
-    withCurrentBuilder $ \ bld ->
-      liftM Value $ mkCall bld (reverse args)
-
--- | Call a function with the given arguments.  The 'call' instruction is variadic, i.e., the number of arguments
--- it takes depends on the type of /f/.
-call :: (CallArgs f g r) => Function f -> g
-call = doCall . callFromFunction
-
-data Call a = Call Caller [FFI.ValueRef]
-
-callFromFunction :: Function a -> Call a
-callFromFunction (Value f) = Call (U.makeCall f) []
-
--- like Applicative.<*>
-infixl 4 `applyCall`
-
-applyCall :: Call (a -> b) -> Value a -> Call b
-applyCall (Call mkCall args) (Value arg) = Call mkCall (arg:args)
-
-runCall :: Call (IO a) -> CodeGenFunction r (Value a)
-runCall (Call mkCall args) = doCallDef mkCall args ()
-
-
-invokeFromFunction ::
-          BasicBlock         -- ^Normal return point.
-       -> BasicBlock         -- ^Exception return point.
-       -> Function f         -- ^Function to call.
-       -> Call f
-invokeFromFunction (BasicBlock norm) (BasicBlock expt) (Value f) =
-    Call (U.makeInvoke norm expt f) []
-
--- | Call a function with exception handling.
-invoke :: (CallArgs f g r)
-       => BasicBlock         -- ^Normal return point.
-       -> BasicBlock         -- ^Exception return point.
-       -> Function f         -- ^Function to call.
-       -> g
-invoke norm expt f = doCall $ invokeFromFunction norm expt f
-
-callWithConvFromFunction :: FFI.CallingConvention -> Function f -> Call f
-callWithConvFromFunction cc (Value f) =
-    Call (U.makeCallWithCc cc f) []
-
--- | Call a function with the given arguments.  The 'call' instruction
--- is variadic, i.e., the number of arguments it takes depends on the
--- type of /f/.
--- This also sets the calling convention of the call to the function.
--- As LLVM itself defines, if the calling conventions of the calling
--- /instruction/ and the function being /called/ are different, undefined
--- behavior results.
-callWithConv :: (CallArgs f g r) => FFI.CallingConvention -> Function f -> g
-callWithConv cc f = doCall $ callWithConvFromFunction cc f
-
-invokeWithConvFromFunction ::
-          FFI.CallingConvention -- ^Calling convention
-       -> BasicBlock         -- ^Normal return point.
-       -> BasicBlock         -- ^Exception return point.
-       -> Function f         -- ^Function to call.
-       -> Call f
-invokeWithConvFromFunction cc (BasicBlock norm) (BasicBlock expt) (Value f) =
-    Call (U.makeInvokeWithCc cc norm expt f) []
-
--- | Call a function with exception handling.
--- This also sets the calling convention of the call to the function.
--- As LLVM itself defines, if the calling conventions of the calling
--- /instruction/ and the function being /called/ are different, undefined
--- behavior results.
-invokeWithConv :: (CallArgs f g r)
-               => FFI.CallingConvention -- ^Calling convention
-               -> BasicBlock         -- ^Normal return point.
-               -> BasicBlock         -- ^Exception return point.
-               -> Function f         -- ^Function to call.
-               -> g
-invokeWithConv cc norm expt f =
-    doCall $ invokeWithConvFromFunction cc norm expt f
-
---------------------------------------
-
--- XXX could do const song and dance
--- |Join several variables (virtual registers) from different basic blocks into one.
--- All of the variables in the list are joined.  See also 'addPhiInputs'.
-phi :: forall a r . (IsFirstClass a) => [(Value a, BasicBlock)] -> CodeGenFunction r (Value a)
-phi incoming =
-    liftM Value $
-      withCurrentBuilder $ \ bldPtr -> do
-        inst <- U.buildEmptyPhi bldPtr =<< typeRef (LP.Proxy :: LP.Proxy a)
-        U.addPhiIns inst [ (v, b) | (Value v, BasicBlock b) <- incoming ]
-        return inst
-
--- |Add additional inputs to an existing phi node.
--- The reason for this instruction is that sometimes the structure of the code
--- makes it impossible to have all variables in scope at the point where you need the phi node.
-addPhiInputs :: forall a r . (IsFirstClass a)
-             => Value a                      -- ^Must be a variable from a call to 'phi'.
-             -> [(Value a, BasicBlock)]      -- ^Variables to add.
-             -> CodeGenFunction r ()
-addPhiInputs (Value inst) incoming =
-    liftIO $ U.addPhiIns inst [ (v, b) | (Value v, BasicBlock b) <- incoming ]
-
-
---------------------------------------
-
--- | Acceptable argument to array memory allocation.
-class AllocArg a where
-    getAllocArg :: a -> Value Word32
-instance AllocArg (Value Word32) where
-    getAllocArg = id
-instance AllocArg (ConstValue Word32) where
-    getAllocArg = value
-instance AllocArg Word32 where
-    getAllocArg = valueOf
-
--- could be moved to Util.Memory
--- FFI.buildMalloc deprecated since LLVM-2.7
--- XXX What's the type returned by malloc
--- | Allocate heap memory.
-malloc :: forall a r . (IsSized a) => CodeGenFunction r (Value (Ptr a))
-malloc = arrayMalloc (1::Word32)
-
-{-
-I use a pointer type as size parameter of 'malloc'.
-This way I hope that the parameter has always the correct size (32 or 64 bit).
-A side effect is that we can convert the result of 'getelementptr' using 'bitcast',
-that does not suffer from the slow assembly problem. (bug #8281)
--}
-foreign import ccall "&aligned_malloc_sizeptr"
-   alignedMalloc :: FunPtr (Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8))
-
-foreign import ccall "&aligned_free"
-   alignedFree :: FunPtr (Ptr Word8 -> IO ())
-
-
-{-
-There is a bug in LLVM-2.7 and LLVM-2.8
-(http://llvm.org/bugs/show_bug.cgi?id=8281)
-that causes huge assembly times for expressions like
-ptrtoint(getelementptr(zero,..)).
-If you break those expressions into two statements
-at separate lines, everything is fine.
-But the C interface is too clever,
-and rewrites two separate statements into a functional expression on a single line.
-Such code is generated whenever you call
-buildMalloc, buildArrayMalloc, sizeOf (called by buildMalloc), or alignOf.
-One possible way is to write a getelementptr expression
-containing a nullptr in a way
-that hides the constant nature of nullptr.
-
-    ptr <- alloca
-    store (value zero) ptr
-    z <- load ptr
-    size <- bitcast =<<
-       getElementPtr (z :: Value (Ptr a)) (getAllocArg s, ())
-
-However, I found that bitcast on pointers causes no problems.
-Thus I switched to using pointers for size quantities.
-This still allows for optimizations involving pointers.
--}
-
--- XXX What's the type returned by arrayMalloc?
--- | Allocate heap (array) memory.
-arrayMalloc :: forall a r s . (IsSized a, AllocArg s) =>
-               s -> CodeGenFunction r (Value (Ptr a)) -- XXX
-arrayMalloc s = do
-    func <- CodeGen.staticNamedFunction "alignedMalloc" alignedMalloc
---    func <- externFunction "malloc"
-
-    size <- sizeOfArray (LP.Proxy :: LP.Proxy a) (getAllocArg s)
-    alignment <- alignOf (LP.Proxy :: LP.Proxy a)
-    bitcast =<<
-       call
-          (func :: Function (Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)))
-          size
-          alignment
-
--- XXX What's the type returned by malloc
--- | Allocate stack memory.
-alloca :: forall a r . (IsSized a) => CodeGenFunction r (Value (Ptr a))
-alloca =
-    liftM Value $
-    withCurrentBuilder $ \ bldPtr -> do
-      typ <- typeRef (LP.Proxy :: LP.Proxy a)
-      U.withEmptyCString $ FFI.buildAlloca bldPtr typ
-
--- XXX What's the type returned by arrayAlloca?
--- | Allocate stack (array) memory.
-arrayAlloca :: forall a r s . (IsSized a, AllocArg s) =>
-               s -> CodeGenFunction r (Value (Ptr a))
-arrayAlloca s =
-    liftM Value $
-    withCurrentBuilder $ \ bldPtr -> do
-      typ <- typeRef (LP.Proxy :: LP.Proxy a)
-      U.withEmptyCString $
-        FFI.buildArrayAlloca bldPtr typ (case getAllocArg s of Value v -> v)
-
--- FFI.buildFree deprecated since LLVM-2.7
--- XXX What's the type of free?
--- | Free heap memory.
-free :: (IsType a) => Value (Ptr a) -> CodeGenFunction r ()
-free ptr = do
-    func <- CodeGen.staticNamedFunction "alignedFree" alignedFree
---    func <- externFunction "free"
-    _ <- call (func :: Function (Ptr Word8 -> IO ())) =<< bitcast ptr
-    return ()
-
-
--- | If we want to export that, then we should have a Size type
--- This is the official implementation,
--- but it suffers from the ptrtoint(gep) bug.
-_sizeOf ::
-    forall a r.
-    (IsSized a) => LP.Proxy a -> CodeGenFunction r (Value Word64)
-_sizeOf a =
-    liftIO $ liftM Value $
-    FFI.sizeOf =<< typeRef a
-
-_alignOf ::
-    forall a r.
-    (IsSized a) => LP.Proxy a -> CodeGenFunction r (Value Word64)
-_alignOf a =
-    liftIO $ liftM Value $
-    FFI.alignOf =<< typeRef a
-
-
--- Here are reimplementation from Constants.cpp that avoid the ptrtoint(gep) bug #8281.
--- see ConstantExpr::getSizeOf
-sizeOfArray ::
-    forall a r . (IsSized a) =>
-    LP.Proxy a -> Value Word32 -> CodeGenFunction r (Value (Ptr Word8))
-sizeOfArray _ len =
-    bitcast =<<
-       getElementPtr (value zero :: Value (Ptr a)) (len, ())
-
--- see ConstantExpr::getAlignOf
-alignOf ::
-    forall a r . (IsSized a) =>
-    LP.Proxy a -> CodeGenFunction r (Value (Ptr Word8))
-alignOf _ =
-    bitcast =<<
-       getElementPtr0 (value zero :: Value (Ptr (Struct (Bool, (a, ()))))) (d1, ())
-
-
--- | Load a value from memory.
-load :: Value (Ptr a)                   -- ^ Address to load from.
-     -> CodeGenFunction r (Value a)
-load (Value p) =
-    liftM Value $
-    withCurrentBuilder $ \ bldPtr ->
-      U.withEmptyCString $ FFI.buildLoad bldPtr p
-
--- | Store a value in memory
-store :: Value a                        -- ^ Value to store.
-      -> Value (Ptr a)                  -- ^ Address to store to.
-      -> CodeGenFunction r ()
-store (Value v) (Value p) = do
-    withCurrentBuilder_ $ \ bldPtr ->
-      FFI.buildStore bldPtr v p
-    return ()
-
--- | Address arithmetic.  See LLVM description.
--- (The type isn't as accurate as it should be.)
-_getElementPtrDynamic :: (IsInteger i) =>
-    Value (Ptr a) -> [Value i] -> CodeGenFunction r (Value (Ptr b))
-_getElementPtrDynamic (Value ptr) ixs =
-    liftM Value $
-    withCurrentBuilder $ \ bldPtr ->
-      U.withArrayLen [ v | Value v <- ixs ] $ \ idxLen idxPtr ->
-        U.withEmptyCString $
-          FFI.buildGEP bldPtr ptr idxPtr (fromIntegral idxLen)
-
--- | Address arithmetic.  See LLVM description.
--- The index is a nested tuple of the form @(i1,(i2,( ... ())))@.
--- (This is without a doubt the most confusing LLVM instruction, but the types help.)
-getElementPtr :: forall a o i r . (GetElementPtr o i, IsIndexArg a) =>
-                 Value (Ptr o) -> (a, i) -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
-getElementPtr (Value ptr) (a, ixs) =
-    let ixl = getArg a : getIxList (LP.Proxy :: LP.Proxy o) ixs in
-    liftM Value $
-    withCurrentBuilder $ \ bldPtr ->
-      U.withArrayLen ixl $ \ idxLen idxPtr ->
-        U.withEmptyCString $
-          FFI.buildGEP bldPtr ptr idxPtr (fromIntegral idxLen)
-
--- | Like getElementPtr, but with an initial index that is 0.
--- This is useful since any pointer first need to be indexed off the pointer, and then into
--- its actual value.  This first indexing is often with 0.
-getElementPtr0 :: (GetElementPtr o i) =>
-                  Value (Ptr o) -> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
-getElementPtr0 p i = getElementPtr p (0::Word32, i)
-
-_getElementPtr :: forall value o i i0 r.
-    (ValueCons value, GetElementPtr o i, IsIndexType i0) =>
-    value (Ptr o) -> (value i0, i) ->
-    CodeGenFunction r (value (Ptr (ElementPtrType o i)))
-_getElementPtr vptr (a, ixs) =
-    let withArgs act =
-            U.withArrayLen
-                (unValue a : getIxList (LP.Proxy :: LP.Proxy o) ixs) $
-            \ idxLen idxPtr ->
-                act idxPtr (fromIntegral idxLen)
-    in  unop
-            (\ptr -> withArgs $ FFI.constGEP ptr)
-            (\bldPtr ptr cstr ->
-                withArgs $ \idxPtr idxLen ->
-                    FFI.buildGEP bldPtr ptr idxPtr idxLen cstr)
-            vptr
-
---------------------------------------
-{-
-instance (IsConst a) => Show (ConstValue a) -- XXX
-instance (IsConst a) => Eq (ConstValue a)
-
-{-
-instance (IsConst a) => Eq (ConstValue a) where
-    ConstValue x == ConstValue y  =
-        if isFloating x then ConstValue (FFI.constFCmp (FFI.fromRealPredicate  FPOEQ) x y)
-                        else ConstValue (FFI.constICmp (FFI.fromIntPredicate IntEQ) x y)
-    ConstValue x /= ConstValue y  =
-        if isFloating x then ConstValue (FFI.constFCmp (FFI.fromRealPredicate  FPONE) x y)
-                        else ConstValue (FFI.constICmp (FFI.fromIntPredicate IntNE) x y)
-
-instance (IsConst a) => Ord (ConstValue a) where
-    ConstValue x <  ConstValue y  =
-        if isFloating x then ConstValue (FFI.constFCmp (FFI.fromRealPredicate  FPOLT) x y)
-                        else ConstValue (FFI.constICmp (FFI.fromIntPredicate IntLT) x y)
-    ConstValue x <= ConstValue y  =
-        if isFloating x then ConstValue (FFI.constFCmp (FFI.fromRealPredicate  FPOLE) x y)
-                        else ConstValue (FFI.constICmp (FFI.fromIntPredicate IntLE) x y)
-    ConstValue x >  ConstValue y  =
-        if isFloating x then ConstValue (FFI.constFCmp (FFI.fromRealPredicate  FPOGT) x y)
-                        else ConstValue (FFI.constICmp (FFI.fromIntPredicate IntGT) x y)
-    ConstValue x >= ConstValue y  =
-        if isFloating x then ConstValue (FFI.constFCmp (FFI.fromRealPredicate  FPOGE) x y)
-                        else ConstValue (FFI.constICmp (FFI.fromIntPredicate IntGE) x y)
--}
-
-instance (Num a, IsConst a) => Num (ConstValue a) where
-    ConstValue x + ConstValue y  =  ConstValue (FFI.constAdd x y)
-    ConstValue x - ConstValue y  =  ConstValue (FFI.constSub x y)
-    ConstValue x * ConstValue y  =  ConstValue (FFI.constMul x y)
-    negate (ConstValue x)        =  ConstValue (FFI.constNeg x)
-    fromInteger x                =  constOf (fromInteger x :: a)
--}
diff --git a/src/LLVM/Core/Instructions/Guided.hs b/src/LLVM/Core/Instructions/Guided.hs
deleted file mode 100644
--- a/src/LLVM/Core/Instructions/Guided.hs
+++ /dev/null
@@ -1,356 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE EmptyDataDecls #-}
-{- |
-This module provides some functions from the "LLVM.Core.Instructions" module
-in a way that enables easier type handling.
-E.g. 'trunc' on vectors requires you to prove
-that reducing the bitsize of the elements
-reduces the bitsize of the whole vector.
-We solve the problem by adding a 'Guide' parameter.
-It can be either 'scalar' or 'vector'.
-We impose the bitsize constraint only on the element type,
-but not on the size of the whole value (scalar or vector).
-
-Another example:
-If you call 'trunc' on a Vector input,
-GHC cannot infer that the result must be a 'Data.Vector' of the same size.
-Using the guide, it can.
-However, in practice this is not as useful as I thought initially.
--}
-module LLVM.Core.Instructions.Guided (
-    Guide,
-    scalar,
-    vector,
-    getElementPtr,
-    getElementPtr0,
-    trunc,
-    ext,
-    extBool,
-    zadapt,
-    sadapt,
-    adapt,
-    fptrunc,
-    fpext,
-    fptoint,
-    inttofp,
-    ptrtoint,
-    inttoptr,
-    bitcast,
-    select,
-    cmp,
-    icmp,
-    pcmp,
-    fcmp,
-    ) where
-
-import qualified LLVM.Core.Instructions.Private as Priv
-import qualified LLVM.Core.Type as Type
-import qualified LLVM.Core.Util as U
-import qualified LLVM.Util.Proxy as LP
-import LLVM.Core.Instructions.Private (ValueCons)
-import LLVM.Core.CodeGenMonad (CodeGenFunction)
-import LLVM.Core.CodeGen (ConstValue, zero)
-import LLVM.Core.Type
-         (IsArithmetic, IsInteger, IsIntegerOrPointer, IsFloating,
-          IsFirstClass, IsPrimitive,
-          Signed, Positive, IsType, IsSized, SizeOf,
-          isFloating, sizeOf, typeDesc)
-
-import qualified LLVM.FFI.Core as FFI
-
-import Type.Data.Num.Decimal.Number ((:<:), (:>:))
-
-import Foreign.Ptr (Ptr)
-
-import qualified Control.Functor.HT as FuncHT
-
-import Data.Word (Word32)
-
-
-data Guide shape elem = Guide
-
-instance Functor (Guide shape) where
-    fmap _ Guide = Guide
-
-scalar :: Guide Type.ScalarShape a
-scalar = Guide
-
-vector :: (Positive n) => Guide (Type.VectorShape n) a
-vector = Guide
-
-proxyFromGuide :: Guide shape elem -> LP.Proxy elem
-proxyFromGuide Guide = LP.Proxy
-
-
-type Type shape a = Type.ShapedType shape a
-type VT value shape a = value (Type shape a)
-
-getElementPtr ::
-    (ValueCons value, Priv.GetElementPtr o i, Priv.IsIndexType i0) =>
-    Guide shape (Ptr o, i0) ->
-    VT value shape (Ptr o) ->
-    (VT value shape i0, i) ->
-    CodeGenFunction r (VT value shape (Ptr (Priv.ElementPtrType o i)))
-getElementPtr guide vptr (a, ixs) =
-    getElementPtrGen (fmap fst guide) vptr (Priv.unValue a, ixs)
-
-getElementPtr0 ::
-    (ValueCons value, Priv.GetElementPtr o i) =>
-    Guide shape (Ptr o) ->
-    VT value shape (Ptr o) -> i ->
-    CodeGenFunction r (VT value shape (Ptr (Priv.ElementPtrType o i)))
-getElementPtr0 guide vptr ixs =
-    getElementPtrGen guide vptr
-        (Priv.unConst (zero :: ConstValue Word32), ixs)
-
-getElementPtrGen ::
-    (ValueCons value, Priv.GetElementPtr o i) =>
-    Guide shape (Ptr o) ->
-    VT value shape (Ptr o) -> (FFI.ValueRef, i) ->
-    CodeGenFunction r (VT value shape (Ptr (Priv.ElementPtrType o i)))
-getElementPtrGen guide vptr (i0val,ixs) =
-    let withArgs act =
-            U.withArrayLen
-                (i0val : Priv.getIxList (LP.element (proxyFromGuide guide)) ixs) $
-            \ idxLen idxPtr ->
-                act idxPtr (fromIntegral idxLen)
-    in  Priv.unop
-            (\ptr -> withArgs $ FFI.constGEP ptr)
-            (\bldPtr ptr cstr ->
-                withArgs $ \idxPtr idxLen ->
-                    FFI.buildGEP bldPtr ptr idxPtr idxLen cstr)
-            vptr
-
-
--- | Truncate a value to a shorter bit width.
-trunc ::
-    (ValueCons value, IsInteger av, IsInteger bv,
-     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv,
-     IsSized a, IsSized b, SizeOf a :>: SizeOf b) =>
-    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
-trunc = convert FFI.constTrunc FFI.buildTrunc
-
-isSigned :: (IsArithmetic a) => Guide shape a -> Bool
-isSigned = Type.isSigned . proxyFromGuide
-
--- | Extend a value to wider width.
--- If the target type is signed, then preserve the sign,
--- If the target type is unsigned, then extended by zeros.
-ext ::
-    (ValueCons value, IsInteger a, IsInteger b, IsType bv, Signed a ~ Signed b,
-     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv,
-     IsSized a, IsSized b, SizeOf a :<: SizeOf b) =>
-    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
-ext guide =
-   if isSigned (fmap snd guide)
-     then convert FFI.constSExt FFI.buildSExt guide
-     else convert FFI.constZExt FFI.buildZExt guide
-
-extBool ::
-    (ValueCons value, IsInteger b, IsType bv,
-     IsPrimitive b, Type shape Bool ~ av, Type shape b ~ bv) =>
-    Guide shape (Bool,b) -> value av -> CodeGenFunction r (value bv)
-extBool guide =
-   if isSigned (fmap snd guide)
-     then convert FFI.constSExt FFI.buildSExt guide
-     else convert FFI.constZExt FFI.buildZExt guide
-
-
-compareGuideSizes :: (IsType a, IsType b) => Guide shape (a,b) -> Ordering
-compareGuideSizes guide =
-   case FuncHT.unzip $ proxyFromGuide guide of
-      (a,b) -> compare (sizeOf (typeDesc a)) (sizeOf (typeDesc b))
-
--- | It is 'zext', 'trunc' or nop depending on the relation of the sizes.
-zadapt ::
-    (ValueCons value, IsInteger a, IsInteger b, IsType bv,
-     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv) =>
-    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
-zadapt guide =
-   case compareGuideSizes guide of
-      LT -> convert FFI.constZExt FFI.buildZExt guide
-      EQ -> convert FFI.constBitCast FFI.buildBitCast guide
-      GT -> convert FFI.constTrunc FFI.buildTrunc guide
-
--- | It is 'sext', 'trunc' or nop depending on the relation of the sizes.
-sadapt ::
-    (ValueCons value, IsInteger a, IsInteger b, IsType bv,
-     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv) =>
-    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
-sadapt guide =
-   case compareGuideSizes guide of
-      LT -> convert FFI.constSExt FFI.buildSExt guide
-      EQ -> convert FFI.constBitCast FFI.buildBitCast guide
-      GT -> convert FFI.constTrunc FFI.buildTrunc guide
-
--- | It is 'sadapt' or 'zadapt' depending on the sign mode.
-adapt ::
-    (ValueCons value, IsInteger a, IsInteger b, IsType bv,
-     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv,
-     Signed a ~ Signed b) =>
-    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
-adapt guide =
-   case compareGuideSizes guide of
-      LT ->
-         if isSigned (fmap snd guide)
-           then convert FFI.constSExt FFI.buildSExt guide
-           else convert FFI.constZExt FFI.buildZExt guide
-      EQ -> convert FFI.constBitCast FFI.buildBitCast guide
-      GT -> convert FFI.constTrunc FFI.buildTrunc guide
-
--- | Truncate a floating point value.
-fptrunc ::
-    (ValueCons value, IsFloating av, IsFloating bv,
-     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv,
-     IsSized a, IsSized b, SizeOf a :>: SizeOf b) =>
-    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
-fptrunc = convert FFI.constFPTrunc FFI.buildFPTrunc
-
--- | Extend a floating point value.
-fpext ::
-    (ValueCons value, IsFloating av, IsFloating bv,
-     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv,
-     IsSized a, IsSized b, SizeOf a :<: SizeOf b) =>
-    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
-fpext = convert FFI.constFPExt FFI.buildFPExt
-
--- | Convert a floating point value to an integer.
--- It is mapped to @fptosi@ or @fptoui@ depending on the type @a@.
-fptoint ::
-    (ValueCons value, IsFloating a, IsInteger b, IsType bv,
-     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv) =>
-    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
-fptoint guide =
-   if isSigned (fmap snd guide)
-     then convert FFI.constFPToSI FFI.buildFPToSI guide
-     else convert FFI.constFPToUI FFI.buildFPToUI guide
-
-
--- | Convert an integer to a floating point value.
--- It is mapped to @sitofp@ or @uitofp@ depending on the type @a@.
-inttofp ::
-    (ValueCons value, IsInteger a, IsFloating b, IsType bv,
-     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv) =>
-    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
-inttofp guide =
-   if isSigned (fmap fst guide)
-     then convert FFI.constSIToFP FFI.buildSIToFP guide
-     else convert FFI.constUIToFP FFI.buildUIToFP guide
-
-
--- | Convert a pointer to an integer.
-ptrtoint ::
-    (ValueCons value, IsType a, IsInteger b, IsType bv,
-     IsPrimitive b, Type shape (Ptr a) ~ av, Type shape b ~ bv) =>
-    Guide shape (Ptr a, b) -> value av -> CodeGenFunction r (value bv)
-ptrtoint = convert FFI.constPtrToInt FFI.buildPtrToInt
-
--- | Convert an integer to a pointer.
-inttoptr ::
-    (ValueCons value, IsInteger a, IsType b, IsType bv,
-     IsPrimitive a, Type shape a ~ av, Type shape (Ptr b) ~ bv) =>
-    Guide shape (a, Ptr b) -> value av -> CodeGenFunction r (value bv)
-inttoptr = convert FFI.constIntToPtr FFI.buildIntToPtr
-
--- | Convert between to values of the same size by just copying the bit pattern.
-bitcast ::
-    (ValueCons value, IsFirstClass a, IsFirstClass bv,
-     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv,
-     IsSized a, IsSized b, SizeOf a ~ SizeOf b) =>
-    Guide shape (a,b) -> value av -> CodeGenFunction r (value bv)
-bitcast = convert FFI.constBitCast FFI.buildBitCast
-
-
-convert ::
-    (ValueCons value, IsType bv,
-     IsPrimitive a, IsPrimitive b, Type shape a ~ av, Type shape b ~ bv) =>
-    Priv.FFIConstConvert -> Priv.FFIConvert -> Guide shape (a,b) ->
-    value av -> CodeGenFunction r (value bv)
-convert cnvConst cnv Guide = Priv.convert cnvConst cnv
-
-
-
-select ::
-    (ValueCons value, IsPrimitive a,
-     Type shape a ~ av, Type shape Bool ~ bv) =>
-    Guide shape a ->
-    value bv -> value av -> value av -> CodeGenFunction r (value av)
-select Guide = Priv.trinop FFI.constSelect FFI.buildSelect
-
-
-cmp ::
-    (ValueCons value, IsArithmetic a, IsPrimitive a,
-     Type shape a ~ av, Type shape Bool ~ bv) =>
-    Guide shape a ->
-    Priv.CmpPredicate -> value av -> value av -> CodeGenFunction r (value bv)
-cmp guide@Guide p =
-    let cmpop constCmp buildCmp predi =
-            Priv.binop (constCmp predi) (flip buildCmp predi)
-    in  if isFloating (proxyFromGuide guide)
-          then
-            cmpop FFI.constFCmp FFI.buildFCmp $
-            FFI.fromRealPredicate $ Priv.fpFromCmpPredicate p
-          else
-            cmpop FFI.constICmp FFI.buildICmp $
-            FFI.fromIntPredicate $
-            if isSigned guide
-              then Priv.sintFromCmpPredicate p
-              else Priv.uintFromCmpPredicate p
-
-_cmp ::
-    (ValueCons value, IsArithmetic a, IsPrimitive a,
-     Type shape a ~ av, Type shape Bool ~ bv) =>
-    Guide shape a ->
-    Priv.CmpPredicate -> value av -> value av -> CodeGenFunction r (value bv)
-_cmp guide@Guide p =
-    if isFloating (proxyFromGuide guide)
-      then
-        let predi = FFI.fromRealPredicate $ Priv.fpFromCmpPredicate p
-        in  Priv.binop
-                (FFI.constFCmp predi)
-                (flip FFI.buildFCmp predi)
-      else
-        let predi =
-              FFI.fromIntPredicate $
-              if isSigned guide
-                then Priv.sintFromCmpPredicate p
-                else Priv.uintFromCmpPredicate p
-        in  Priv.binop
-                (FFI.constICmp predi)
-                (flip FFI.buildICmp predi)
-
-{-# DEPRECATED icmp "use cmp or pcmp instead" #-}
--- | Compare integers.
-icmp ::
-    (ValueCons value, IsIntegerOrPointer a, IsPrimitive a,
-     Type shape a ~ av, Type shape Bool ~ bv) =>
-    Guide shape a ->
-    FFI.IntPredicate -> value av -> value av -> CodeGenFunction r (value bv)
-icmp Guide p =
-    Priv.binop
-        (FFI.constICmp (FFI.fromIntPredicate p))
-        (flip FFI.buildICmp (FFI.fromIntPredicate p))
-
--- | Compare pointers.
-pcmp :: (ValueCons value, Type shape (Ptr a) ~ av, Type shape Bool ~ bv) =>
-    Guide shape (Ptr a) ->
-    FFI.IntPredicate -> value av -> value av -> CodeGenFunction r (value bv)
-pcmp Guide p =
-    Priv.binop
-        (FFI.constICmp (FFI.fromIntPredicate p))
-        (flip FFI.buildICmp (FFI.fromIntPredicate p))
-
--- | Compare floating point values.
-fcmp ::
-    (ValueCons value, IsFloating a, IsPrimitive a,
-     Type shape a ~ av, Type shape Bool ~ bv) =>
-    Guide shape a ->
-    FFI.FPPredicate -> value av -> value av -> CodeGenFunction r (value bv)
-fcmp Guide p =
-    Priv.binop
-        (FFI.constFCmp (FFI.fromRealPredicate p))
-        (flip FFI.buildFCmp (FFI.fromRealPredicate p))
diff --git a/src/LLVM/Core/Instructions/Private.hs b/src/LLVM/Core/Instructions/Private.hs
deleted file mode 100644
--- a/src/LLVM/Core/Instructions/Private.hs
+++ /dev/null
@@ -1,291 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-module LLVM.Core.Instructions.Private where
-
-import qualified LLVM.Core.Util as U
-import qualified LLVM.Util.Proxy as LP
-import LLVM.Core.Type (IsType, IsPrimitive, typeRef)
-import LLVM.Core.Data (Vector, Array, Struct, PackedStruct)
-import LLVM.Core.CodeGenMonad (CodeGenFunction)
-import LLVM.Core.CodeGen
-            (ConstValue(ConstValue), constOf, Value(Value), withCurrentBuilder)
-
-import qualified LLVM.FFI.Core as FFI
-import LLVM.FFI.Core (IntPredicate(..), FPPredicate(..))
-
-import qualified Type.Data.Num.Decimal.Number as Dec
-import Type.Data.Num.Decimal.Number (Pred)
-import Type.Base.Proxy (Proxy)
-
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad (liftM)
-
-import Data.Typeable (Typeable)
-import Data.Int (Int32, Int64)
-import Data.Word (Word32, Word64)
-
-
-
-type FFIConstConvert = FFI.ValueRef -> FFI.TypeRef -> IO FFI.ValueRef
-type FFIConvert =
-        FFI.BuilderRef -> FFI.ValueRef -> FFI.TypeRef ->
-        U.CString -> IO FFI.ValueRef
-
-type FFIConstUnOp = FFI.ValueRef -> IO FFI.ValueRef
-type FFIUnOp = FFI.BuilderRef -> FFI.ValueRef -> U.CString -> IO FFI.ValueRef
-
-type FFIConstBinOp = FFI.ValueRef -> FFI.ValueRef -> IO FFI.ValueRef
-type FFIBinOp =
-        FFI.BuilderRef -> FFI.ValueRef -> FFI.ValueRef ->
-        U.CString -> IO FFI.ValueRef
-
-type FFIConstTrinOp =
-        FFI.ValueRef -> FFI.ValueRef -> FFI.ValueRef -> IO FFI.ValueRef
-type FFITrinOp =
-        FFI.BuilderRef -> FFI.ValueRef -> FFI.ValueRef -> FFI.ValueRef ->
-        U.CString -> IO FFI.ValueRef
-
-
-class ValueCons value where
-    switchValueCons :: f ConstValue -> f Value -> f value
-
-instance ValueCons ConstValue where
-    switchValueCons f _ = f
-
-instance ValueCons Value where
-    switchValueCons _ f = f
-
-
-convert :: (ValueCons value, IsType b) =>
-    FFIConstConvert -> FFIConvert -> value a -> CodeGenFunction r (value b)
-convert cop op =
-    getUnOp $
-    switchValueCons
-        (UnOp $ convertConstValue LP.Proxy cop)
-        (UnOp $ convertValue LP.Proxy op)
-
-convertConstValue ::
-    (IsType b) =>
-    LP.Proxy b -> FFIConstConvert ->
-    ConstValue a -> CodeGenFunction r (ConstValue b)
-convertConstValue proxy conv (ConstValue a) =
-    liftM ConstValue $ liftIO $ conv a =<< typeRef proxy
-
-convertValue ::
-    (IsType b) =>
-    LP.Proxy b -> FFIConvert -> Value a -> CodeGenFunction r (Value b)
-convertValue proxy conv (Value a) =
-    liftM Value $
-    withCurrentBuilder $ \ bldPtr -> do
-      typ <- typeRef proxy
-      U.withEmptyCString $ conv bldPtr a typ
-
-
-newtype UnValue a value = UnValue {getUnValue :: value a -> FFI.ValueRef}
-
-unValue :: (ValueCons value) => value a -> FFI.ValueRef
-unValue =
-    getUnValue $
-    switchValueCons
-        (UnValue $ \(ConstValue a) -> a)
-        (UnValue $ \(Value a) -> a)
-
-newtype UnOp a b r value =
-    UnOp {getUnOp :: value a -> CodeGenFunction r (value b)}
-
-unop ::
-    (ValueCons value) =>
-    FFIConstUnOp -> FFIUnOp -> value a -> CodeGenFunction r (value b)
-unop cop op =
-    getUnOp $
-    switchValueCons
-        (UnOp $ \(ConstValue a) -> liftIO $ fmap ConstValue $ cop a)
-        (UnOp $ \(Value a) ->
-            liftM Value $
-            withCurrentBuilder $ \ bld ->
-                U.withEmptyCString $ op bld a)
-
-newtype BinOp a b c r value =
-    BinOp {getBinOp :: value a -> value b -> CodeGenFunction r (value c)}
-
-binop ::
-    (ValueCons value) =>
-    FFIConstBinOp -> FFIBinOp ->
-    value a -> value b -> CodeGenFunction r (value c)
-binop cop op =
-    getBinOp $
-    switchValueCons
-        (BinOp $ \(ConstValue a) (ConstValue b) ->
-            liftIO $ fmap ConstValue $ cop a b)
-        (BinOp $ \(Value a) (Value b) ->
-            liftM Value $
-            withCurrentBuilder $ \ bld ->
-                U.withEmptyCString $ op bld a b)
-
-newtype TrinOp a b c d r value =
-    TrinOp {
-        getTrinOp ::
-            value a -> value b -> value c -> CodeGenFunction r (value d)
-    }
-
-trinop ::
-    (ValueCons value) =>
-    FFIConstTrinOp -> FFITrinOp ->
-    value a -> value b -> value c -> CodeGenFunction r (value d)
-trinop cop op =
-    getTrinOp $
-    switchValueCons
-        (TrinOp $ \(ConstValue a) (ConstValue b) (ConstValue c) ->
-            liftIO $ fmap ConstValue $ cop a b c)
-        (TrinOp $ \(Value a) (Value b) (Value c) ->
-            liftM Value $
-            withCurrentBuilder $ \ bld ->
-                U.withEmptyCString $ op bld a b c)
-
-
-
--- | Acceptable arguments to 'getElementPointer'.
-class GetElementPtr optr ixs where
-    type ElementPtrType optr ixs :: *
-    getIxList :: LP.Proxy optr -> ixs -> [FFI.ValueRef]
-
--- | Acceptable single index to 'getElementPointer'.
-class IsIndexArg a where
-    getArg :: a -> FFI.ValueRef
-
-{- |
-In principle we do not need the getValueArg method,
-because we could just use 'unValue'.
-However, we want to prevent users
-from defining their own (disfunctional) IsIndexType instances.
--}
-class (IsPrimitive i) => IsIndexType i where
-    getValueArg :: (ValueCons value) => value i -> FFI.ValueRef
-
-instance IsIndexType Word32 where
-    getValueArg = unValue
-
-instance IsIndexType Word64 where
-    getValueArg = unValue
-
-instance IsIndexType Int32 where
-    getValueArg = unValue
-
-instance IsIndexType Int64 where
-    getValueArg = unValue
-
-instance IsIndexType i => IsIndexArg (ConstValue i) where
-    getArg = getValueArg
-
-instance IsIndexType i => IsIndexArg (Value i) where
-    getArg = getValueArg
-
-instance IsIndexArg Word32 where
-    getArg = unConst . constOf
-
-instance IsIndexArg Word64 where
-    getArg = unConst . constOf
-
-instance IsIndexArg Int32 where
-    getArg = unConst . constOf
-
-instance IsIndexArg Int64 where
-    getArg = unConst . constOf
-
-unConst :: ConstValue a -> FFI.ValueRef
-unConst (ConstValue v) = v
-
--- End of indexing
-instance GetElementPtr a () where
-    type ElementPtrType a () = a
-    getIxList LP.Proxy () = []
-
--- Index in Array
-instance
-    (GetElementPtr o i, IsIndexArg a, Dec.Natural k) =>
-        GetElementPtr (Array k o) (a, i) where
-    type ElementPtrType (Array k o) (a, i) = ElementPtrType o i
-    getIxList proxy (v, i) = getArg v : getIxList (LP.element proxy) i
-
--- Index in Vector
-instance
-    (GetElementPtr o i, IsIndexArg a, Dec.Positive k) =>
-        GetElementPtr (Vector k o) (a, i) where
-    type ElementPtrType (Vector k o) (a, i) = ElementPtrType o i
-    getIxList proxy (v, i) = getArg v : getIxList (LP.element proxy) i
-
-fieldProxy :: LP.Proxy (struct fs) -> Proxy a -> LP.Proxy (FieldType fs a)
-fieldProxy LP.Proxy _proxy = LP.Proxy
-
--- Index in Struct and PackedStruct.
--- The index has to be a type level integer to statically determine the record field type
-instance
-    (GetElementPtr (FieldType fs a) i, Dec.Natural a) =>
-        GetElementPtr (Struct fs) (Proxy a, i) where
-    type ElementPtrType (Struct fs) (Proxy a, i) =
-            ElementPtrType (FieldType fs a) i
-    getIxList proxy (a, i) =
-        unConst (constOf (Dec.integralFromProxy a :: Word32)) :
-        getIxList (fieldProxy proxy a) i
-instance
-    (GetElementPtr (FieldType fs a) i, Dec.Natural a) =>
-        GetElementPtr (PackedStruct fs) (Proxy a, i) where
-    type ElementPtrType (PackedStruct fs) (Proxy a, i) =
-            ElementPtrType (FieldType fs a) i
-    getIxList proxy (a, i) =
-        unConst (constOf (Dec.integralFromProxy a :: Word32)) :
-        getIxList (fieldProxy proxy a) i
-
-class GetField as i where type FieldType as i :: *
-instance GetField (a, as) Dec.Zero where
-    type FieldType (a, as) Dec.Zero = a
-instance
-    (GetField as (Pred (Dec.Pos i0 i1))) =>
-        GetField (a, as) (Dec.Pos i0 i1) where
-    type FieldType (a,as) (Dec.Pos i0 i1) = FieldType as (Pred (Dec.Pos i0 i1))
-
-
-
-data CmpPredicate =
-    CmpEQ                       -- ^ equal
-  | CmpNE                       -- ^ not equal
-  | CmpGT                       -- ^ greater than
-  | CmpGE                       -- ^ greater or equal
-  | CmpLT                       -- ^ less than
-  | CmpLE                       -- ^ less or equal
-    deriving (Eq, Ord, Enum, Show, Typeable)
-
-uintFromCmpPredicate :: CmpPredicate -> IntPredicate
-uintFromCmpPredicate p =
-   case p of
-      CmpEQ -> IntEQ
-      CmpNE -> IntNE
-      CmpGT -> IntUGT
-      CmpGE -> IntUGE
-      CmpLT -> IntULT
-      CmpLE -> IntULE
-
-sintFromCmpPredicate :: CmpPredicate -> IntPredicate
-sintFromCmpPredicate p =
-   case p of
-      CmpEQ -> IntEQ
-      CmpNE -> IntNE
-      CmpGT -> IntSGT
-      CmpGE -> IntSGE
-      CmpLT -> IntSLT
-      CmpLE -> IntSLE
-
-fpFromCmpPredicate :: CmpPredicate -> FPPredicate
-fpFromCmpPredicate p =
-   case p of
-      CmpEQ -> FPOEQ
-      CmpNE -> FPONE
-      CmpGT -> FPOGT
-      CmpGE -> FPOGE
-      CmpLT -> FPOLT
-      CmpLE -> FPOLE
diff --git a/src/LLVM/Core/Type.hs b/src/LLVM/Core/Type.hs
deleted file mode 100644
--- a/src/LLVM/Core/Type.hs
+++ /dev/null
@@ -1,627 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE EmptyDataDecls #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE TypeFamilies #-}
--- |The LLVM type system is captured with a number of Haskell type classes.
--- In general, an LLVM type @T@ is represented as @Value T@, where @T@ is some Haskell type.
--- The various types @T@ are classified by various type classes, e.g., 'IsFirstClass' for
--- those types that are LLVM first class types (passable as arguments etc).
--- All valid LLVM types belong to the 'IsType' class.
-module LLVM.Core.Type(
-    -- * Type classifier
-    IsType(..),
-    -- ** Special type classifiers
-    Dec.Natural,
-    Dec.Positive,
-    IsArithmetic(arithmeticType),
-    ArithmeticType(IntegerType,FloatingType),
-    IsInteger, Signed,
-    IsIntegerOrPointer,
-    IsFloating,
-    IsPrimitive,
-    IsFirstClass,
-    IsSized, SizeOf, sizeOf,
-    IsFunction,
-    -- ** Others
-    IsScalarOrVector,
-    ShapeOf, ScalarShape, VectorShape,
-    Shape, ShapedType,
-    StructFields,
-    UnknownSize, -- needed for arrays of structs
-    -- ** Structs
-    CurryStruct(..), consStruct,
-    UncurryStruct(uncurryStruct), Curried,
-    (:&), (&),
-    -- ** Type tests
-    TypeDesc(..),
-    isFloating,
-    isSigned,
-    typeRef,
-    unsafeTypeRef,
-    typeName,
-    intrinsicTypeName,
-    typeDesc2,
-    VarArgs, CastVarArgs,
-    ) where
-
-import qualified LLVM.FFI.Core as FFI
-
-import LLVM.Core.Util (functionType, structType)
-import LLVM.Core.Data
-        (IntN, WordN, Vector, Array, FP128,
-         Struct(Struct), PackedStruct(PackedStruct), Label)
-import LLVM.Util.Proxy (Proxy(Proxy))
-
-import qualified Type.Data.Num.Decimal.Number as Dec
-import Type.Data.Num.Decimal.Number ((:*:))
-import Type.Data.Num.Decimal.Literal (D1, D8, D16, D32, D64, D128, D99)
-import Type.Data.Bool (True, False)
-
-import Foreign.StablePtr (StablePtr, )
-import Foreign.Ptr (FunPtr, Ptr)
-import System.IO.Unsafe (unsafePerformIO)
-
-import Data.Typeable (Typeable)
-import Data.List (intercalate)
-import Data.Int (Int8, Int16, Int32, Int64)
-import Data.Word (Word8, Word16, Word32, Word64)
-
-
-#include "MachDeps.h"
-
--- TODO:
--- Move IntN, WordN to a special module that implements those types
---   properly in Haskell.
--- Also move Array and Vector to a Haskell module to implement them.
--- Add Label?
--- Add structures (using tuples, maybe nested).
-
--- |The 'IsType' class classifies all types that have an LLVM representation.
-class IsType a where
-    typeDesc :: Proxy a -> TypeDesc
-
-typeRef :: (IsType a) => Proxy a -> IO FFI.TypeRef
-typeRef = code . typeDesc
-  where code TDFloat  = FFI.floatType
-        code TDDouble = FFI.doubleType
-        code TDFP128  = FFI.fp128Type
-        code TDVoid   = FFI.voidType
-        code (TDInt _ n)  = FFI.integerType (fromInteger n)
-        code (TDArray n a) = withCode FFI.arrayType (code a) (fromInteger n)
-        code (TDVector n a) = withCode FFI.vectorType (code a) (fromInteger n)
-        code (TDPtr a) = withCode FFI.pointerType (code a) 0
-        code (TDFunction va as b) = do
-            bt <- code b
-            ast <- mapM code as
-            functionType va bt ast
-        code TDLabel = FFI.labelType
-        code (TDStruct ts packed) = withCode structType (mapM code ts) packed
-        code TDInvalidType = error "typeRef TDInvalidType"
-
-unsafeTypeRef :: (IsType a) => Proxy a -> FFI.TypeRef
-unsafeTypeRef = unsafePerformIO . typeRef
-
-
-withCode ::
-    Monad m =>
-    (a -> b -> m c) ->
-    m a -> b -> m c
-withCode f mx y =
-    mx >>= \x -> f x y
-
-
-typeName :: (IsType a) => Proxy a -> String
-typeName = code . typeDesc
-  where code TDFloat  = "f32"
-        code TDDouble = "f64"
-        code TDFP128  = "f128"
-        code TDVoid   = "void"
-        code (TDInt _ n)  = "i" ++ show n
-        code (TDArray n a) = "[" ++ show n ++ " x " ++ code a ++ "]"
-        code (TDVector n a) = "<" ++ show n ++ " x " ++ code a ++ ">"
-        code (TDPtr a) = code a ++ "*"
-        code (TDFunction _ as b) = code b ++ "(" ++ intercalate "," (map code as) ++ ")"
-        code TDLabel = "label"
-        code (TDStruct as packed) = (if packed then "<{" else "{") ++
-                                    intercalate "," (map code as) ++
-                                    (if packed then "}>" else "}")
-        code TDInvalidType = error "typeName TDInvalidType"
-
-intrinsicTypeName :: (IsType a) => Proxy a -> String
-intrinsicTypeName = code . typeDesc
-  where code TDFloat  = "f32"
-        code TDDouble = "f64"
-        code TDFP128  = "f128"
-        code (TDInt _ n)  = "i" ++ show n
-        code (TDVector n a) = "v" ++ show n ++ code a
-        code _ = error "intrinsicTypeName: type not supported in intrinsics"
-
-typeDesc2 :: FFI.TypeRef -> IO TypeDesc
-typeDesc2 t = do
-    tk <- FFI.getTypeKind t
-    case tk of
-      FFI.VoidTypeKind -> return TDVoid
-      FFI.FloatTypeKind -> return TDFloat
-      FFI.DoubleTypeKind -> return TDDouble
-      -- FIXME: FFI.X86_FP80TypeKind -> return "X86_FP80"
-      FFI.FP128TypeKind -> return TDFP128
-      -- FIXME: FFI.PPC_FP128TypeKind -> return "PPC_FP128"
-      FFI.LabelTypeKind -> return TDLabel
-      FFI.IntegerTypeKind -> do
-                n <- FFI.getIntTypeWidth t
-                return $ TDInt False (fromIntegral n)
-      -- FIXME: FFI.FunctionTypeKind
-      -- FIXME: FFI.StructTypeKind -> return "(Struct ...)"
-      FFI.ArrayTypeKind -> do
-                n <- FFI.getArrayLength t
-                et <- FFI.getElementType t
-                etd <- typeDesc2 et
-                return $ TDArray (fromIntegral n) etd
-      FFI.PointerTypeKind -> do
-                et <- FFI.getElementType t
-                etd <- typeDesc2 et
-                return $ TDPtr etd
-      -- FIXME: FFI.OpaqueTypeKind -> return "Opaque"
-      FFI.VectorTypeKind -> do
-                n <- FFI.getVectorSize t
-                et <- FFI.getElementType t
-                etd <- typeDesc2 et
-                return $ TDVector (fromIntegral n) etd
-      -- FIXME: LLVMMetadataTypeKind,    /**< Metadata */
-      -- FIXME: LLVMX86_MMXTypeKind      /**< X86 MMX */
-      _ -> return TDInvalidType
-
--- |Type descriptor, used to convey type information through the LLVM API.
-data TypeDesc = TDFloat | TDDouble | TDFP128 | TDVoid | TDInt Bool Integer
-              | TDArray Integer TypeDesc | TDVector Integer TypeDesc
-              | TDPtr TypeDesc | TDFunction Bool [TypeDesc] TypeDesc | TDLabel
-              | TDStruct [TypeDesc] Bool | TDInvalidType
-    deriving (Eq, Ord, Show, Typeable)
-
--- XXX isFloating and typeName could be extracted from typeRef
--- Usage:
---   superclass of IsConst
---   add, sub, mul, neg context
---   used to get type name to call intrinsic
--- |Arithmetic types, i.e., integral and floating types.
-class IsFirstClass a => IsArithmetic a where
-    arithmeticType :: ArithmeticType a
-
-data ArithmeticType a = IntegerType | FloatingType
-
-instance Functor ArithmeticType where
-    fmap _ IntegerType  = IntegerType
-    fmap _ FloatingType = FloatingType
-
-vectorArithmeticType :: ArithmeticType a -> ArithmeticType (Vector n a)
-vectorArithmeticType t =
-    case t of
-        IntegerType  -> IntegerType
-        FloatingType -> FloatingType
-
-
--- Usage:
---  constI, allOnes
---  many instructions.  XXX some need vector
---  used to find signedness in Arithmetic
--- |Integral types.
-class (IsArithmetic a, IsIntegerOrPointer a) => IsInteger a where
-   type Signed a :: *
-
--- Usage:
---  icmp
--- |Integral or pointer type.
-class IsIntegerOrPointer a
-
-isSigned :: (IsArithmetic a) => Proxy a -> Bool
-isSigned = is . typeDesc
-  where is (TDInt s _) = s
-        is (TDVector _ a) = is a
-        is TDFloat = True
-        is TDDouble = True
-        is TDFP128 = True
-        is _ = error "isSigned got impossible input"
-
--- Usage:
---  constF
---  many instructions
--- |Floating types.
-class IsArithmetic a => IsFloating a
-
-isFloating :: (IsArithmetic a) => Proxy a -> Bool
-isFloating = is . typeDesc
-  where is TDFloat = True
-        is TDDouble = True
-        is TDFP128 = True
-        is (TDVector _ a) = is a
-        is _ = False
-
--- Usage:
---  Precondition for Vector
--- |Primitive types.
--- class (IsType a) => IsPrimitive a
-class (IsScalarOrVector a, ShapeOf a ~ ScalarShape) => IsPrimitive a
-
-data ScalarShape
-data VectorShape n
-
-class Shape shape where
-    type ShapedType shape a :: *
-
-instance Shape ScalarShape where
-    type ShapedType ScalarShape a = a
-
-instance Shape (VectorShape n) where
-    type ShapedType (VectorShape n) a = Vector n a
-
--- |Number of elements for instructions that handle both primitive and vector types
-class (IsFirstClass a) => IsScalarOrVector a where
-    type ShapeOf a :: *
-
-
--- Usage:
---  Precondition for function args and result.
---  Used by some instructions, like ret and phi.
---  XXX IsSized as precondition?
--- |First class types, i.e., the types that can be passed as arguments, etc.
-class IsType a => IsFirstClass a
-
--- Usage:
---  Context for Array being a type
---  thus, allocation instructions
--- |Types with a fixed size.
-class (IsType a, Dec.Natural (SizeOf a)) => IsSized a where
-    type SizeOf a :: *
-
-sizeOf :: TypeDesc -> Integer
-sizeOf TDFloat  = 32
-sizeOf TDDouble = 64
-sizeOf TDFP128  = 128
-sizeOf (TDInt _ bits) = bits
-sizeOf (TDArray n typ) = n * sizeOf typ
-sizeOf (TDVector n typ) = n * sizeOf typ
-sizeOf (TDStruct ts _packed) = sum (map sizeOf ts)
-sizeOf _ = error "type has no size"
-
--- |Function type.
-class (IsType a) => IsFunction a where
-    funcType :: [TypeDesc] -> Proxy a -> TypeDesc
-
--- Only make instances for types that make sense in Haskell
--- (i.e., some floating types are excluded).
-
--- Floating point types.
-instance IsType Float  where typeDesc _ = TDFloat
-instance IsType Double where typeDesc _ = TDDouble
-instance IsType FP128  where typeDesc _ = TDFP128
-
--- Void type
-instance IsType ()     where typeDesc _ = TDVoid
-
--- Label type
-instance IsType Label  where typeDesc _ = TDLabel
-
--- Variable size integer types
-instance (Dec.Positive n) => IsType (IntN n)
-    where typeDesc _ =
-             TDInt True
-                (Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n))
-
-instance (Dec.Positive n) => IsType (WordN n)
-    where typeDesc _ =
-             TDInt False
-                (Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n))
-
--- Fixed size integer types.
-instance IsType Bool   where typeDesc _ = TDInt False  1
-instance IsType Word8  where typeDesc _ = TDInt False  8
-instance IsType Word16 where typeDesc _ = TDInt False 16
-instance IsType Word32 where typeDesc _ = TDInt False 32
-instance IsType Word64 where typeDesc _ = TDInt False 64
-instance IsType Int8   where typeDesc _ = TDInt True   8
-instance IsType Int16  where typeDesc _ = TDInt True  16
-instance IsType Int32  where typeDesc _ = TDInt True  32
-instance IsType Int64  where typeDesc _ = TDInt True  64
-
--- Sequence types
-instance (Dec.Natural n, IsSized a) => IsType (Array n a)
-    where typeDesc _ =
-             TDArray
-                (Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n))
-                (typeDesc (Proxy :: Proxy a))
-instance (Dec.Positive n, IsPrimitive a) => IsType (Vector n a)
-    where typeDesc _ =
-             TDVector
-                (Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton n))
-                (typeDesc (Proxy :: Proxy a))
-
--- Pointer type.
-instance (IsType a) => IsType (Ptr a) where
-    typeDesc _ = TDPtr (typeDesc (Proxy :: Proxy a))
-
-instance (IsFunction f) => IsType (FunPtr f) where
-    typeDesc _ = TDPtr (typeDesc (Proxy :: Proxy f))
-
-instance IsType (StablePtr a) where
-    typeDesc _ = TDPtr (typeDesc (Proxy :: Proxy Int8))
-{-
-    typeDesc _ = TDPtr TDVoid
-
-List: Type.cpp:1311: static llvm::PointerType* llvm::PointerType::get(const llvm::Type*, unsigned int): Assertion `ValueType != Type::VoidTy && "Pointer to void is not valid, use sbyte* instead!"' failed.
--}
-
-
--- Functions.
-instance (IsFirstClass a, IsFunction b) => IsType (a->b) where
-    typeDesc = funcType []
-
--- Function base type, always IO.
-instance (IsFirstClass a) => IsType (IO a) where
-    typeDesc = funcType []
-
--- Struct types, basically a list of component types.
-instance (StructFields a) => IsType (Struct a) where
-    typeDesc p = TDStruct (fieldTypes $ fmap (\(Struct a) -> a) p) False
-
-instance (StructFields a) => IsType (PackedStruct a) where
-    typeDesc p = TDStruct (fieldTypes $ fmap (\(PackedStruct a) -> a) p) True
-
--- Use a nested tuples for struct fields.
-class StructFields as where
-    fieldTypes :: Proxy as -> [TypeDesc]
-
-instance (IsSized a, StructFields as) => StructFields (a :& as) where
-    fieldTypes p = typeDesc (fmap fst p) : fieldTypes (fmap snd p)
-instance StructFields () where
-    fieldTypes Proxy = []
-
-
--- Simplifies construction, pattern matching and conversion to and from records
-class CurryStruct f where
-    type UncurriedArgument f
-    type UncurriedResult f
-    curryStruct :: (Struct (UncurriedArgument f) -> UncurriedResult f) -> f
-
-instance CurryStruct (Struct a) where
-    type UncurriedArgument (Struct a) = ()
-    type UncurriedResult (Struct a) = Struct a
-    curryStruct g = g $ Struct ()
-
-instance (CurryStruct f) => CurryStruct (a->f) where
-    type UncurriedArgument (a->f) = (a, UncurriedArgument f)
-    type UncurriedResult (a->f) = UncurriedResult f
-    curryStruct g a = curryStruct (\(Struct r) -> g $ Struct (a,r))
-
-consStruct ::
-    (CurryStruct f, UncurriedResult f ~ Struct (UncurriedArgument f)) => f
-consStruct = curryStruct id
-
-class UncurryStruct a where
-    type Curried a b
-    curryStruct' :: (Struct a -> b) -> Curried a b
-    uncurryStruct :: Curried a b -> Struct a -> b
-
-instance UncurryStruct () where
-    type Curried () b = b
-    curryStruct' f = f $ Struct ()
-    uncurryStruct f (Struct ()) = f
-
-instance (UncurryStruct r) => UncurryStruct (a,r) where
-    type Curried (a,r) b = a -> Curried r b
-    curryStruct' f a = curryStruct' (\(Struct r) -> f $ Struct (a,r))
-    uncurryStruct f (Struct (a,r)) = uncurryStruct (f a) $ Struct r
-
--- An alias for pairs to make structs look nicer
-infixr :&
-type (:&) a as = (a, as)
-infixr &
-(&) :: a -> as -> a :& as
-a & as = (a, as)
-
-
---- Instances to classify types
-instance IsArithmetic Float  where arithmeticType = FloatingType
-instance IsArithmetic Double where arithmeticType = FloatingType
-instance IsArithmetic FP128  where arithmeticType = FloatingType
-instance (Dec.Positive n) => IsArithmetic (IntN n)  where arithmeticType = IntegerType
-instance (Dec.Positive n) => IsArithmetic (WordN n) where arithmeticType = IntegerType
-{-
-This instance is more dangerous than useful.
-E.g. 'inv' can be mixed up with 'neg'.
-For arithmetic on i1 you might better use @IntN D1@ or @WordN D1@.
--}
-instance IsArithmetic Bool   where arithmeticType = IntegerType
-instance IsArithmetic Int8   where arithmeticType = IntegerType
-instance IsArithmetic Int16  where arithmeticType = IntegerType
-instance IsArithmetic Int32  where arithmeticType = IntegerType
-instance IsArithmetic Int64  where arithmeticType = IntegerType
-instance IsArithmetic Word8  where arithmeticType = IntegerType
-instance IsArithmetic Word16 where arithmeticType = IntegerType
-instance IsArithmetic Word32 where arithmeticType = IntegerType
-instance IsArithmetic Word64 where arithmeticType = IntegerType
-instance (Dec.Positive n, IsPrimitive a, IsArithmetic a) =>
-         IsArithmetic (Vector n a) where
-   arithmeticType = vectorArithmeticType arithmeticType
---   arithmeticType = fmap (pure :: a -> Vector n a) arithmeticType
-
-instance IsFloating Float
-instance IsFloating Double
-instance IsFloating FP128
-instance (Dec.Positive n, IsPrimitive a, IsFloating a) => IsFloating (Vector n a)
-
-data NotANumber
-
-instance (Dec.Positive n) => IsInteger (IntN  n) where type Signed (IntN  n) = True
-instance (Dec.Positive n) => IsInteger (WordN n) where type Signed (WordN n) = False
-instance IsInteger Bool   where type Signed Bool = NotANumber
-instance IsInteger Int8   where type Signed Int8 = True
-instance IsInteger Int16  where type Signed Int16 = True
-instance IsInteger Int32  where type Signed Int32 = True
-instance IsInteger Int64  where type Signed Int64 = True
-instance IsInteger Word8  where type Signed Word8 = False
-instance IsInteger Word16 where type Signed Word16 = False
-instance IsInteger Word32 where type Signed Word32 = False
-instance IsInteger Word64 where type Signed Word64 = False
-instance (Dec.Positive n, IsPrimitive a, IsInteger a) => IsInteger (Vector n a)
-                          where type Signed (Vector n a) = Signed a
-
-instance (Dec.Positive n) => IsIntegerOrPointer (IntN n)
-instance (Dec.Positive n) => IsIntegerOrPointer (WordN n)
-instance IsIntegerOrPointer Bool
-instance IsIntegerOrPointer Int8
-instance IsIntegerOrPointer Int16
-instance IsIntegerOrPointer Int32
-instance IsIntegerOrPointer Int64
-instance IsIntegerOrPointer Word8
-instance IsIntegerOrPointer Word16
-instance IsIntegerOrPointer Word32
-instance IsIntegerOrPointer Word64
-instance (Dec.Positive n, IsPrimitive a, IsInteger a) => IsIntegerOrPointer (Vector n a)
-instance (IsType a) => IsIntegerOrPointer (Ptr a)
-
-instance IsFirstClass Float
-instance IsFirstClass Double
-instance IsFirstClass FP128
-instance (Dec.Positive n) => IsFirstClass (IntN n)
-instance (Dec.Positive n) => IsFirstClass (WordN n)
-instance IsFirstClass Bool
-instance IsFirstClass Int8
-instance IsFirstClass Int16
-instance IsFirstClass Int32
-instance IsFirstClass Int64
-instance IsFirstClass Word8
-instance IsFirstClass Word16
-instance IsFirstClass Word32
-instance IsFirstClass Word64
-instance (Dec.Positive n, IsPrimitive a) => IsFirstClass (Vector n a)
-instance (Dec.Natural n, IsSized a) => IsFirstClass (Array n a)
-instance (IsType a) => IsFirstClass (Ptr a)
-instance (IsFunction a) => IsFirstClass (FunPtr a)
-instance IsFirstClass (StablePtr a)
-instance IsFirstClass Label
-instance IsFirstClass () -- XXX This isn't right, but () can be returned
-instance (StructFields as) => IsFirstClass (Struct as)
-
-instance (Dec.Positive n) => IsSized (IntN n)  where type SizeOf (IntN  n) = n
-instance (Dec.Positive n) => IsSized (WordN n) where type SizeOf (WordN n) = n
-instance IsSized Float  where type SizeOf Float  = D32
-instance IsSized Double where type SizeOf Double = D64
-instance IsSized FP128  where type SizeOf FP128  = D128
-instance IsSized Bool   where type SizeOf Bool   = D1
-instance IsSized Int8   where type SizeOf Int8   = D8
-instance IsSized Int16  where type SizeOf Int16  = D16
-instance IsSized Int32  where type SizeOf Int32  = D32
-instance IsSized Int64  where type SizeOf Int64  = D64
-instance IsSized Word8  where type SizeOf Word8  = D8
-instance IsSized Word16 where type SizeOf Word16 = D16
-instance IsSized Word32 where type SizeOf Word32 = D32
-instance IsSized Word64 where type SizeOf Word64 = D64
-{-
-Can we derive Dec.Natural (n :*: SizeOf a)
-from (Dec.Natural n, Dec.Natural (n :*: SizeOf a))?
--}
-instance
-    (Dec.Natural n, IsSized a, Dec.Natural (n :*: SizeOf a)) =>
-        IsSized (Array n a) where
-    type SizeOf (Array n a) = n :*: SizeOf a
-instance
-    (Dec.Positive n, IsPrimitive a, IsSized a, Dec.Natural (n :*: SizeOf a)) =>
-        IsSized (Vector n a) where
-    type SizeOf (Vector n a) = n :*: SizeOf a
-instance (IsType a) => IsSized (Ptr a) where type SizeOf (Ptr a) = PtrSize
-instance (IsFunction a) => IsSized (FunPtr a) where type SizeOf (FunPtr a) =  PtrSize
-instance IsSized (StablePtr a) where type SizeOf (StablePtr a) =  PtrSize
--- instance IsSized Label PtrSize -- labels are not quite first classed
--- We cannot compute the sizes statically :(
-instance (StructFields as) => IsSized (Struct as) where
-    type SizeOf (Struct as) = UnknownSize
-instance (StructFields as) => IsSized (PackedStruct as) where
-    type SizeOf (PackedStruct as) = UnknownSize
-
-type UnknownSize = D99   -- XXX this is wrong!
-
-#if WORD_SIZE_IN_BITS == 32
-type PtrSize = D32
-#elif WORD_SIZE_IN_BITS == 64
-type PtrSize = D64
-#else
-#error cannot determine type of PtrSize
-#endif
-
-instance IsPrimitive Float
-instance IsPrimitive Double
-instance IsPrimitive FP128
-instance (Dec.Positive n) => IsPrimitive (IntN n)
-instance (Dec.Positive n) => IsPrimitive (WordN n)
-instance IsPrimitive Bool
-instance IsPrimitive Int8
-instance IsPrimitive Int16
-instance IsPrimitive Int32
-instance IsPrimitive Int64
-instance IsPrimitive Word8
-instance IsPrimitive Word16
-instance IsPrimitive Word32
-instance IsPrimitive Word64
-instance IsPrimitive Label
-instance IsPrimitive ()
-instance (IsType a) => IsPrimitive (Ptr a)
-
-
-instance (Dec.Positive n) =>
-         IsScalarOrVector (IntN n)  where type ShapeOf (IntN n)  = ScalarShape
-instance (Dec.Positive n) =>
-         IsScalarOrVector (WordN n) where type ShapeOf (WordN n) = ScalarShape
-instance IsScalarOrVector Float  where type ShapeOf Float  = ScalarShape
-instance IsScalarOrVector Double where type ShapeOf Double = ScalarShape
-instance IsScalarOrVector FP128  where type ShapeOf FP128  = ScalarShape
-instance IsScalarOrVector Bool   where type ShapeOf Bool   = ScalarShape
-instance IsScalarOrVector Int8   where type ShapeOf Int8   = ScalarShape
-instance IsScalarOrVector Int16  where type ShapeOf Int16  = ScalarShape
-instance IsScalarOrVector Int32  where type ShapeOf Int32  = ScalarShape
-instance IsScalarOrVector Int64  where type ShapeOf Int64  = ScalarShape
-instance IsScalarOrVector Word8  where type ShapeOf Word8  = ScalarShape
-instance IsScalarOrVector Word16 where type ShapeOf Word16 = ScalarShape
-instance IsScalarOrVector Word32 where type ShapeOf Word32 = ScalarShape
-instance IsScalarOrVector Word64 where type ShapeOf Word64 = ScalarShape
-instance IsScalarOrVector Label  where type ShapeOf Label  = ScalarShape
-instance IsScalarOrVector ()     where type ShapeOf ()     = ScalarShape
-instance (IsType a) =>
-         IsScalarOrVector (Ptr a) where type ShapeOf (Ptr a) = ScalarShape
-
-instance (Dec.Positive n, IsPrimitive a) =>
-         IsScalarOrVector (Vector n a) where
-    type ShapeOf (Vector n a) = VectorShape n
-
-
--- Functions.
-instance (IsFirstClass a, IsFunction b) => IsFunction (a->b) where
-    funcType ts _ = funcType (typeDesc (Proxy :: Proxy a) : ts) (Proxy :: Proxy b)
-instance (IsFirstClass a) => IsFunction (IO a) where
-    funcType ts _ = TDFunction False (reverse ts) (typeDesc (Proxy :: Proxy a))
-instance (IsFirstClass a) => IsFunction (VarArgs a) where
-    funcType ts _ = TDFunction True  (reverse ts) (typeDesc (Proxy :: Proxy a))
-
--- |The 'VarArgs' type is a placeholder for the real 'IO' type that
--- can be obtained with 'castVarArgs'.
-data VarArgs a
-    deriving (Typeable)
-instance IsType (VarArgs a) where
-    typeDesc _ = error "typeDesc: Dummy type VarArgs used incorrectly"
-
--- |Define what vararg types are permissible.
-class CastVarArgs a b
-instance (CastVarArgs b c) => CastVarArgs (a -> b) (a -> c)
-instance CastVarArgs (VarArgs a) (IO a)
-instance (IsFirstClass a, CastVarArgs (VarArgs b) c) => CastVarArgs (VarArgs b) (a -> c)
-
-
-
-
--- XXX Structures not implemented.  Tuples is probably an easy way.
-
diff --git a/src/LLVM/Core/UnaryVector.hs b/src/LLVM/Core/UnaryVector.hs
deleted file mode 100644
--- a/src/LLVM/Core/UnaryVector.hs
+++ /dev/null
@@ -1,42 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-module LLVM.Core.UnaryVector (
-   T, vector, cyclicVector,
-   FixedLength.fromFixedList, FixedLength.toFixedList, FixedLength.head,
-   FixedList, Length,
-   FixedLength.Curried, FixedLength.uncurry,
-   ) where
-
-import qualified Type.Data.Num.Unary as Unary
-
-import qualified Data.FixedLength as FixedLength
-import Data.FixedLength (T, List, Length, end, (!:))
-
-import qualified Data.NonEmpty as NonEmpty
-
-import Prelude hiding (head)
-
-
-type FixedList n = List n
-
-
-vector :: (Unary.Natural n, n ~ Length (List n)) => List n a -> T n a
-vector = FixedLength.fromFixedList
-
-cyclicVector :: (Unary.Natural n) => NonEmpty.T [] a -> T n a
-cyclicVector xt@(NonEmpty.Cons x xs) =
-   runOp0 $
-   Unary.switchNat
-      (Op0 end)
-      (Op0 $ x !: cyclicVectorAppend xt xs)
-
-cyclicVectorAppend :: (Unary.Natural n) => NonEmpty.T [] a -> [a] -> T n a
-cyclicVectorAppend ys xt =
-   runOp0 $
-   Unary.switchNat
-      (Op0 end)
-      (Op0 $
-       case xt of
-          [] -> cyclicVector ys
-          x:xs -> x !: cyclicVectorAppend ys xs)
-
-newtype Op0 a n = Op0 {runOp0 :: T n a}
diff --git a/src/LLVM/Core/Util.hs b/src/LLVM/Core/Util.hs
deleted file mode 100644
--- a/src/LLVM/Core/Util.hs
+++ /dev/null
@@ -1,480 +0,0 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-module LLVM.Core.Util(
-    -- * Module handling
-    Module(..), withModule, createModule, destroyModule, writeBitcodeToFile, readBitcodeFromFile,
-    getModuleValues, getFunctions, getGlobalVariables, valueHasType,
-    -- * Pass manager handling
-    PassManager(..), withPassManager, createPassManager, createFunctionPassManager,
-    runFunctionPassManager, initializeFunctionPassManager, finalizeFunctionPassManager,
-    -- * Instruction builder
-    Builder(..), withBuilder, createBuilder, positionAtEnd, getInsertBlock,
-    -- * Basic blocks
-    BasicBlock,
-    appendBasicBlock, getBasicBlocks,
-    -- * Functions
-    Function,
-    addFunction, getParam, getParams,
-    -- * Structs
-    structType,
-    -- * Globals
-    addGlobal,
-    constString, constStringNul, constVector, constArray, constStruct,
-    -- * Instructions
-    makeCall, makeInvoke,
-    makeCallWithCc, makeInvokeWithCc,
-    withValue, getInstructions, getOperands,
-    -- * Uses and Users
-    hasUsers, getUsers, getUses, getUser, isChildOf, getDep,
-    -- * Misc
-    CString, withArrayLen,
-    withEmptyCString,
-    functionType, buildEmptyPhi, addPhiIns,
-    showTypeOf, getValueNameU, getObjList, annotateValueList,
-    isConstant, isIntrinsic,
-    -- * Transformation passes
-    addCFGSimplificationPass, addConstantPropagationPass, addDemoteMemoryToRegisterPass,
-    addGVNPass, addInstructionCombiningPass, addPromoteMemoryToRegisterPass, addReassociatePass,
-    ) where
-
-import qualified LLVM.FFI.Core as FFI
-import qualified LLVM.FFI.BitWriter as FFI
-import qualified LLVM.FFI.BitReader as FFI
-import qualified LLVM.FFI.Transforms.Scalar as FFI
-
-import Foreign.C.String (withCString, withCStringLen, CString, peekCString)
-import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr)
-import Foreign.Ptr (Ptr, nullPtr)
-import Foreign.Marshal.Array (withArrayLen, withArray, allocaArray, peekArray)
-import Foreign.Marshal.Alloc (alloca)
-import Foreign.Storable (Storable(..))
-import System.IO.Unsafe (unsafePerformIO)
-
-import Data.Typeable (Typeable)
-import Data.List (intercalate)
-import Control.Monad (liftM, when)
-
-
-type Type = FFI.TypeRef
-
-functionType :: Bool -> Type -> [Type] -> IO Type
-functionType varargs retType paramTypes =
-    withArrayLen paramTypes $ \ len ptr ->
-        FFI.functionType retType ptr (fromIntegral len) (FFI.consBool varargs)
-
-structType :: [Type] -> Bool -> IO Type
-structType types packed =
-    withArrayLen types $ \ len ptr ->
-        FFI.structType ptr (fromIntegral len) (FFI.consBool packed)
-
---------------------------------------
--- Handle modules
-
--- Don't use a finalizer for the module, but instead provide an
--- explicit destructor.  This is because handing a module to
--- a module provider changes ownership of the module to the provider,
--- and we don't want to free it by mistake.
-
--- | Type of top level modules.
-newtype Module = Module {
-      fromModule :: FFI.ModuleRef
-    }
-    deriving (Show, Typeable)
-
-withModule :: Module -> (FFI.ModuleRef -> IO a) -> IO a
-withModule modul f = f (fromModule modul)
-
-createModule :: String -> IO Module
-createModule name =
-    withCString name $ \ namePtr -> do
-      liftM Module $ FFI.moduleCreateWithName namePtr
-
--- | Free all storage related to a module.  *Note*, this is a dangerous call, since referring
--- to the module after this call is an error.  The reason for the explicit call to free
--- the module instead of an automatic lifetime management is that modules have a
--- somewhat complicated ownership.  Handing a module to a module provider changes
--- the ownership of the module, and the module provider will free the module when necessary.
-destroyModule :: Module -> IO ()
-destroyModule = FFI.disposeModule . fromModule
-
--- |Write a module to a file.
-writeBitcodeToFile :: String -> Module -> IO ()
-writeBitcodeToFile name mdl =
-    withCString name $ \ namePtr ->
-      withModule mdl $ \ mdlPtr -> do
-        rc <- FFI.writeBitcodeToFile mdlPtr namePtr
-        when (rc /= 0) $
-          ioError $ userError $ "writeBitcodeToFile: return code " ++ show rc
-
--- |Read a module from a file.
-readBitcodeFromFile :: String -> IO Module
-readBitcodeFromFile name =
-    withCString name $ \ namePtr ->
-      alloca $ \ bufPtr ->
-      alloca $ \ modPtr ->
-      alloca $ \ errStr -> do
-        rrc <- FFI.createMemoryBufferWithContentsOfFile namePtr bufPtr errStr
-        if FFI.deconsBool rrc then do
-            msg <- peek errStr >>= peekCString
-            ioError $ userError $ "readBitcodeFromFile: read return code " ++ show rrc ++ ", " ++ msg
-         else do
-            buf <- peek bufPtr
-            prc <- FFI.parseBitcode buf modPtr errStr
-            if FFI.deconsBool prc then do
-                msg <- peek errStr >>= peekCString
-                ioError $ userError $ "readBitcodeFromFile: parse return code " ++ show prc ++ ", " ++ msg
-             else do
-                ptr <- peek modPtr
-                return $ Module ptr
-{-
-                liftM Module $ newForeignPtr FFI.ptrDisposeModule ptr
--}
-
-getModuleValues :: Module -> IO [(String, Value)]
-getModuleValues mdl = do
-  fs <- getFunctions mdl
-  gs <- getGlobalVariables mdl
-  return (fs ++ gs)
-
-getFunctions :: Module -> IO [(String, Value)]
-getFunctions mdl =
-    getObjList withModule FFI.getFirstFunction FFI.getNextFunction mdl
-      >>= annotateValueList
-
-getGlobalVariables :: Module -> IO [(String, Value)]
-getGlobalVariables mdl =
-    getObjList withModule FFI.getFirstGlobal FFI.getNextGlobal mdl
-      >>= annotateValueList
-
--- This is safe because we just ask for the type of a value.
-valueHasType :: Value -> Type -> Bool
-valueHasType v t = unsafePerformIO $ do
-    vt <- FFI.typeOf v
-    return $ vt == t  -- LLVM uses hash consing for types, so pointer equality works.
-
-showTypeOf :: Value -> IO String
-showTypeOf v = FFI.typeOf v >>= showType'
-
-showType' :: Type -> IO String
-showType' p = do
-    pk <- FFI.getTypeKind p
-    case pk of
-        FFI.VoidTypeKind -> return "()"
-        FFI.FloatTypeKind -> return "Float"
-        FFI.DoubleTypeKind -> return "Double"
-        FFI.X86_FP80TypeKind -> return "X86_FP80"
-        FFI.FP128TypeKind -> return "FP128"
-        FFI.PPC_FP128TypeKind -> return "PPC_FP128"
-        FFI.LabelTypeKind -> return "Label"
-        FFI.IntegerTypeKind -> do w <- FFI.getIntTypeWidth p; return $ "(IntN " ++ show w ++ ")"
-        FFI.FunctionTypeKind -> do
-            r <- FFI.getReturnType p
-            c <- FFI.countParamTypes p
-            let n = fromIntegral c
-            as <- allocaArray n $ \ args -> do
-                     FFI.getParamTypes p args
-                     peekArray n args
-            ts <- mapM showType' (as ++ [r])
-            return $ "(" ++ intercalate " -> " ts ++ ")"
-        FFI.StructTypeKind -> return "(Struct ...)"
-        FFI.ArrayTypeKind -> do n <- FFI.getArrayLength p; t <- FFI.getElementType p >>= showType'; return $ "(Array " ++ show n ++ " " ++ t ++ ")"
-        FFI.PointerTypeKind -> do t <- FFI.getElementType p >>= showType'; return $ "(Ptr " ++ t ++ ")"
-        FFI.OpaqueTypeKind -> return "Opaque"
-        FFI.VectorTypeKind -> do n <- FFI.getVectorSize p; t <- FFI.getElementType p >>= showType'; return $ "(Vector " ++ show n ++ " " ++ t ++ ")"
-
---------------------------------------
--- Handle instruction builders
-
-newtype Builder = Builder {
-      fromBuilder :: ForeignPtr FFI.Builder
-    }
-    deriving (Show, Typeable)
-
-withBuilder :: Builder -> (FFI.BuilderRef -> IO a) -> IO a
-withBuilder = withForeignPtr . fromBuilder
-
-createBuilder :: IO Builder
-createBuilder = do
-    ptr <- FFI.createBuilder
-    liftM Builder $ newForeignPtr FFI.ptrDisposeBuilder ptr
-
-positionAtEnd :: Builder -> FFI.BasicBlockRef -> IO ()
-positionAtEnd bld bblk =
-    withBuilder bld $ \ bldPtr ->
-      FFI.positionAtEnd bldPtr bblk
-
-getInsertBlock :: Builder -> IO FFI.BasicBlockRef
-getInsertBlock bld =
-    withBuilder bld $ \ bldPtr ->
-      FFI.getInsertBlock bldPtr
-
---------------------------------------
-
-type BasicBlock = FFI.BasicBlockRef
-
-appendBasicBlock :: Function -> String -> IO BasicBlock
-appendBasicBlock func name =
-    withCString name $ \ namePtr ->
-      FFI.appendBasicBlock func namePtr
-
-getBasicBlocks :: Value -> IO [(String, BasicBlock)]
-getBasicBlocks v =
-    getObjList withValue FFI.getFirstBasicBlock FFI.getNextBasicBlock v
-      >>= annotateBasicBlockList
-
---------------------------------------
-
-type Function = FFI.ValueRef
-
-addFunction :: Module -> FFI.Linkage -> String -> Type -> IO Function
-addFunction modul linkage name typ =
-    withModule modul $ \ modulPtr ->
-      withCString name $ \ namePtr -> do
-        f <- FFI.addFunction modulPtr namePtr typ
-        FFI.setLinkage f (FFI.fromLinkage linkage)
-        return f
-
-getParam :: Function -> Int -> Value
-getParam f = unsafePerformIO . FFI.getParam f . fromIntegral
-
-getParams :: Value -> IO [(String, Value)]
-getParams v =
-    getObjList withValue FFI.getFirstParam FFI.getNextParam v
-      >>= annotateValueList
-
---------------------------------------
-
-addGlobal :: Module -> FFI.Linkage -> String -> Type -> IO Value
-addGlobal modul linkage name typ =
-    withModule modul $ \ modulPtr ->
-      withCString name $ \ namePtr -> do
-        v <- FFI.addGlobal modulPtr typ namePtr
-        FFI.setLinkage v (FFI.fromLinkage linkage)
-        return v
-
--- unsafePerformIO is safe because it's only used for the withCStringLen conversion
-constStringInternal :: Bool -> String -> Value
-constStringInternal nulTerm s = unsafePerformIO $
-    withCStringLen s $ \(sPtr, sLen) ->
-      FFI.constString sPtr (fromIntegral sLen) (FFI.consBool (not nulTerm))
-
-constString :: String -> Value
-constString = constStringInternal False
-
-constStringNul :: String -> Value
-constStringNul = constStringInternal True
-
---------------------------------------
-
-type Value = FFI.ValueRef
-
-withValue :: Value -> (Value -> IO a) -> IO a
-withValue v f = f v
-
-withBasicBlock :: FFI.BasicBlockRef -> (FFI.BasicBlockRef -> IO a) -> IO a
-withBasicBlock v f = f v
-
-makeCall :: Function -> FFI.BuilderRef -> [Value] -> IO Value
-makeCall = makeCallWithCc FFI.C
-
-makeCallWithCc :: FFI.CallingConvention -> Function -> FFI.BuilderRef -> [Value] -> IO Value
-makeCallWithCc cc func bldPtr args = do
-{-
-      print "makeCall"
-      FFI.dumpValue func
-      mapM_ FFI.dumpValue args
-      print "----------------------"
--}
-      withArrayLen args $ \ argLen argPtr ->
-        withEmptyCString $ \cstr -> do
-          i <- FFI.buildCall bldPtr func argPtr
-                             (fromIntegral argLen) cstr
-          FFI.setInstructionCallConv i (FFI.fromCallingConvention cc)
-          return i
-
-makeInvoke :: BasicBlock -> BasicBlock -> Function -> FFI.BuilderRef ->
-              [Value] -> IO Value
-makeInvoke = makeInvokeWithCc FFI.C
-
-makeInvokeWithCc :: FFI.CallingConvention -> BasicBlock -> BasicBlock -> Function -> FFI.BuilderRef ->
-              [Value] -> IO Value
-makeInvokeWithCc cc norm expt func bldPtr args =
-      withArrayLen args $ \ argLen argPtr ->
-        withEmptyCString $ \cstr -> do
-          i <- FFI.buildInvoke bldPtr func argPtr (fromIntegral argLen) norm expt cstr
-          FFI.setInstructionCallConv i (FFI.fromCallingConvention cc)
-          return i
-
-getInstructions :: BasicBlock -> IO [(String, Value)]
-getInstructions bb =
-    getObjList withBasicBlock FFI.getFirstInstruction FFI.getNextInstruction bb
-      >>= annotateValueList
-
-getOperands :: Value -> IO [(String, Value)]
-getOperands ii = geto ii >>= annotateValueList
-    where geto i = do
-            num <- FFI.getNumOperands i
-            let oloop instr number total = if number >= total then return [] else do
-                    o <- FFI.getOperand instr number
-                    os <- oloop instr (number + 1) total
-                    return (o : os)
-            oloop i 0 num
-
---------------------------------------
-
-buildEmptyPhi :: FFI.BuilderRef -> Type -> IO Value
-buildEmptyPhi bldPtr typ = do
-    withEmptyCString $ FFI.buildPhi bldPtr typ
-
-withEmptyCString :: (CString -> IO a) -> IO a
-withEmptyCString = withCString ""
-
-addPhiIns :: Value -> [(Value, BasicBlock)] -> IO ()
-addPhiIns inst incoming = do
-    let (vals, bblks) = unzip incoming
-    withArrayLen vals $ \ count valPtr ->
-      withArray bblks $ \ bblkPtr ->
-        FFI.addIncoming inst valPtr bblkPtr (fromIntegral count)
-
---------------------------------------
-
--- | Manage compile passes.
-newtype PassManager = PassManager {
-      fromPassManager :: ForeignPtr FFI.PassManager
-    }
-    deriving (Show, Typeable)
-
-withPassManager :: PassManager -> (FFI.PassManagerRef -> IO a)
-                   -> IO a
-withPassManager = withForeignPtr . fromPassManager
-
--- | Create a pass manager.
-createPassManager :: IO PassManager
-createPassManager = do
-    ptr <- FFI.createPassManager
-    liftM PassManager $ newForeignPtr FFI.ptrDisposePassManager ptr
-
--- | Create a pass manager for a module.
-createFunctionPassManager :: Module -> IO PassManager
-createFunctionPassManager modul =
-    withModule modul $ \modulPtr -> do
-        ptr <- FFI.createFunctionPassManagerForModule modulPtr
-        liftM PassManager $ newForeignPtr FFI.ptrDisposePassManager ptr
-
--- | Add a control flow graph simplification pass to the manager.
-addCFGSimplificationPass :: PassManager -> IO ()
-addCFGSimplificationPass pm = withPassManager pm FFI.addCFGSimplificationPass
-
--- | Add a constant propagation pass to the manager.
-addConstantPropagationPass :: PassManager -> IO ()
-addConstantPropagationPass pm = withPassManager pm FFI.addConstantPropagationPass
-
-addDemoteMemoryToRegisterPass :: PassManager -> IO ()
-addDemoteMemoryToRegisterPass pm = withPassManager pm FFI.addDemoteMemoryToRegisterPass
-
--- | Add a global value numbering pass to the manager.
-addGVNPass :: PassManager -> IO ()
-addGVNPass pm = withPassManager pm FFI.addGVNPass
-
-addInstructionCombiningPass :: PassManager -> IO ()
-addInstructionCombiningPass pm = withPassManager pm FFI.addInstructionCombiningPass
-
-addPromoteMemoryToRegisterPass :: PassManager -> IO ()
-addPromoteMemoryToRegisterPass pm = withPassManager pm FFI.addPromoteMemoryToRegisterPass
-
-addReassociatePass :: PassManager -> IO ()
-addReassociatePass pm = withPassManager pm FFI.addReassociatePass
-
-runFunctionPassManager :: PassManager -> Function -> IO FFI.Bool
-runFunctionPassManager pm fcn = withPassManager pm $ \ pmref -> FFI.runFunctionPassManager pmref fcn
-
-initializeFunctionPassManager :: PassManager -> IO FFI.Bool
-initializeFunctionPassManager pm = withPassManager pm FFI.initializeFunctionPassManager
-
-finalizeFunctionPassManager :: PassManager -> IO FFI.Bool
-finalizeFunctionPassManager pm = withPassManager pm FFI.finalizeFunctionPassManager
-
---------------------------------------
-
-constVector :: [Value] -> IO Value
-constVector xs = do
-    withArrayLen xs $ \ len ptr ->
-        FFI.constVector ptr (fromIntegral len)
-
-constArray :: Type -> [Value] -> IO Value
-constArray t xs = do
-    withArrayLen xs $ \ len ptr ->
-        FFI.constArray t ptr (fromIntegral len)
-
-constStruct :: [Value] -> Bool -> IO Value
-constStruct xs packed = do
-    withArrayLen xs $ \ len ptr ->
-        FFI.constStruct ptr (fromIntegral len) (FFI.consBool packed)
-
---------------------------------------
-
-getValueNameU :: Value -> IO String
-getValueNameU a = do
-    -- sometimes void values need explicit names too
-    str <- peekCString =<< FFI.getValueName a
-    if str == "" then return (show a) else return str
-
-getBasicBlockNameU :: BasicBlock -> IO String
-getBasicBlockNameU a = do
-    str <- peekCString =<< FFI.getBasicBlockName a
-    if str == "" then return (show a) else return str
-
-getObjList ::
-    (obj -> (objPtr -> IO [Ptr a]) -> io) -> (objPtr -> IO (Ptr a)) ->
-    (Ptr a -> IO (Ptr a)) -> obj -> io
-getObjList withF firstF nextF obj =
-    withF obj $ \ objPtr -> do
-      let oloop p =
-            if p == nullPtr
-              then return []
-              else fmap (p:) $ oloop =<< nextF p
-      oloop =<< firstF objPtr
-
-annotateValueList :: [Value] -> IO [(String, Value)]
-annotateValueList vs = do
-  names <- mapM getValueNameU vs
-  return $ zip names vs
-
-annotateBasicBlockList :: [BasicBlock] -> IO [(String, BasicBlock)]
-annotateBasicBlockList vs = do
-  names <- mapM getBasicBlockNameU vs
-  return $ zip names vs
-
-isConstant :: Value -> IO Bool
-isConstant v = fmap FFI.deconsBool $ FFI.isConstant v
-
-isIntrinsic :: Value -> IO Bool
-isIntrinsic v = fmap (/=0) $ FFI.getIntrinsicID v
-
---------------------------------------
-
-type Use = FFI.UseRef
-
-hasUsers :: Value -> IO Bool
-hasUsers v = fmap (>0) $ FFI.getNumUses v
-
-getUses :: Value -> IO [Use]
-getUses = getObjList withValue FFI.getFirstUse FFI.getNextUse
-
-getUsers :: [Use] -> IO [(String, Value)]
-getUsers us = mapM FFI.getUser us >>= annotateValueList
-
-getUser :: Use -> IO Value
-getUser = FFI.getUser
-
-isChildOf :: BasicBlock -> Value -> IO Bool
-isChildOf bb v = do
-  bb2 <- FFI.getInstructionParent v
-  return $ bb == bb2
-
-getDep :: Use -> IO (String, String)
-getDep u = do
-  producer <- FFI.getUsedValue u >>= getValueNameU
-  consumer <- FFI.getUser u >>= getValueNameU
-  return (producer, consumer)
diff --git a/src/LLVM/Core/Vector.hs b/src/LLVM/Core/Vector.hs
deleted file mode 100644
--- a/src/LLVM/Core/Vector.hs
+++ /dev/null
@@ -1,277 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE Rank2Types #-}
-module LLVM.Core.Vector (MkVector(..), vector, cyclicVector, ) where
-
-import qualified LLVM.ExecutionEngine.Target as Target
-import qualified LLVM.Core.UnaryVector as UnaryVector
-import qualified LLVM.Util.Proxy as Proxy
-import LLVM.Core.Type (IsPrimitive, unsafeTypeRef)
-import LLVM.Core.Data (Vector(Vector), FixedList)
-
-import qualified Type.Data.Num.Decimal.Proof as DecProof
-import qualified Type.Data.Num.Decimal.Number as Dec
-import qualified Type.Data.Num.Unary as Unary
-import Type.Data.Num.Decimal.Literal (D2, D4, D8)
-
-import qualified Foreign.Storable.Traversable as Store
-import Foreign.Storable (Storable(..))
-
-import qualified Test.QuickCheck as QC
-
-import qualified Control.Monad.Trans.State as MS
-import Control.Applicative (Applicative, pure, liftA2, (<*>))
-import Control.Functor.HT (unzip, outerProduct)
-
-import qualified Data.Traversable as Trav
-import qualified Data.Foldable as Fold
-import qualified Data.NonEmpty as NonEmpty
-import qualified Data.Empty as Empty
-import Data.Traversable (Traversable, foldMapDefault)
-import Data.Foldable (Foldable, foldMap)
-import Data.NonEmpty ((!:))
-
-import System.IO.Unsafe (unsafePerformIO)
-
-import Prelude hiding (replicate, map, head, unzip, zipWith, uncurry)
-
-
--- XXX Should these really be here?
-class (Dec.Positive n, IsPrimitive a) => MkVector n a where
-    type Tuple n a :: *
-    toVector :: Tuple n a -> Vector n a
-    fromVector :: Vector n a -> Tuple n a
-
-
-instance (IsPrimitive a) => MkVector D2 a where
-    type Tuple D2 a = (a,a)
-    toVector (a1, a2) = vector (a1 !: a2 !: Empty.Cons)
-    fromVector = uncurry $ \a1 a2 -> (a1, a2)
-
-instance (IsPrimitive a) => MkVector D4 a where
-    type Tuple D4 a = (a,a,a,a)
-    toVector (a1, a2, a3, a4) = vector (a1 !: a2 !: a3 !: a4 !: Empty.Cons)
-    fromVector = uncurry $ \a1 a2 a3 a4 -> (a1, a2, a3, a4)
-
-instance (IsPrimitive a) => MkVector D8 a where
-    type Tuple D8 a = (a,a,a,a,a,a,a,a)
-    toVector (a1, a2, a3, a4, a5, a6, a7, a8) =
-        vector (a1 !: a2 !: a3 !: a4 !: a5 !: a6 !: a7 !: a8 !: Empty.Cons)
-    fromVector =
-        uncurry $ \a1 a2 a3 a4 a5 a6 a7 a8 ->
-            (a1, a2, a3, a4, a5, a6, a7, a8)
-
-
-head :: (Dec.Positive n) => Vector n a -> a
-head =
-    withPosDict1 $ \dict v ->
-        case dict of
-            DecProof.UnaryPos ->
-                UnaryVector.head . unaryFromDecimalVector $ v
-
-
-unaryFromDecimalVector :: Vector n a -> UnaryVector.T (Dec.ToUnary n) a
-unaryFromDecimalVector (Vector xs) = UnaryVector.fromFixedList xs
-
-decimalFromUnaryVector :: UnaryVector.T (Dec.ToUnary n) a -> Vector n a
-decimalFromUnaryVector = Vector . UnaryVector.toFixedList
-
-
-type Curried n a b = UnaryVector.Curried (Dec.ToUnary n) a b
-
-uncurry ::
-    (Dec.Natural n) =>
-    Curried n a b -> Vector n a -> b
-uncurry f =
-    withNatDict1 $ \dict v ->
-        case dict of
-            DecProof.UnaryNat ->
-                UnaryVector.uncurry f $ unaryFromDecimalVector v
-
-
-withNatDict ::
-    (Dec.Natural n) =>
-    (DecProof.UnaryNat n -> Vector n a) -> Vector n a
-withNatDict f = f DecProof.unaryNat
-
-withNatDict1 ::
-    (Dec.Natural n) =>
-    (DecProof.UnaryNat n -> Vector n a -> b) -> Vector n a -> b
-withNatDict1 f = f DecProof.unaryNat
-
-withPosDict1 ::
-    (Dec.Positive n) =>
-    (DecProof.UnaryPos n -> Vector n a -> b) -> Vector n a -> b
-withPosDict1 f = f DecProof.unaryPos
-
-
-withUnaryDecVector ::
-    (Dec.Natural n) =>
-    (forall m. (Dec.ToUnary n ~ m, Unary.Natural m) => UnaryVector.T m a) ->
-    Vector n a
-withUnaryDecVector v =
-    withNatDict
-        (\dict ->
-            case dict of DecProof.UnaryNat -> decimalFromUnaryVector v)
-
-instance (Storable a, Dec.Positive n, IsPrimitive a) => Storable (Vector n a) where
-    sizeOf a =
-        Target.storeSizeOfType ourTargetData $
-        unsafeTypeRef $ Proxy.fromValue a
-    alignment a =
-        Target.abiAlignmentOfType ourTargetData $
-        unsafeTypeRef $ Proxy.fromValue a
-    peek = Store.peekApplicative
-    poke = Store.poke
-
--- XXX The JITer target data.  This isn't really right.
-ourTargetData :: Target.TargetData
-ourTargetData = unsafePerformIO Target.getTargetData
-
---------------------------------------
-
-{- maybe we should export this in order to allow NumericPrelude instances
-unVector :: (Dec.Positive n) => Vector n a -> FixedList n a
-unVector (Vector xs) = xs
--}
-
-vector ::
-    (Dec.Positive n) =>
-    FixedList (Dec.ToUnary n) a -> Vector n a
-vector = Vector
-
-{- |
-Make a constant vector.  Replicates or truncates the list to get length /n/.
-This behaviour is consistent uncurry that of 'LLVM.Core.CodeGen.constCyclicVector'.
-May be abused for constructing vectors from lists uncurry statically unknown size.
--}
-cyclicVector :: (Dec.Positive n) => NonEmpty.T [] a -> Vector n a
-cyclicVector xs =
-   withUnaryDecVector (UnaryVector.cyclicVector xs)
-
-
-replicate :: (Dec.Positive n) => a -> Vector n a
-replicate a = withUnaryDecVector (pure a)
-
-
-instance (Dec.Positive n) => Functor (Vector n) where
-   fmap f a =
-      withUnaryDecVector (fmap f $ unaryFromDecimalVector a)
-
-instance (Dec.Positive n) => Applicative (Vector n) where
-   pure = replicate
-   f <*> a =
-      withUnaryDecVector
-         (unaryFromDecimalVector f <*> unaryFromDecimalVector a)
-
-instance (Dec.Positive n) => Foldable (Vector n) where
-   foldMap = foldMapDefault
-
-instance (Dec.Positive n) => Traversable (Vector n) where
-   sequenceA =
-      withNatDict1 $ \dict v ->
-         case dict of
-            DecProof.UnaryNat ->
-               fmap decimalFromUnaryVector $ Trav.sequenceA $
-               unaryFromDecimalVector v
-
-
-
-instance (Eq a, Dec.Positive n) => Eq (Vector n a) where
-   x == y  =  Fold.and $ liftA2 (==) x y
-
-instance (Ord a, Dec.Positive n) => Ord (Vector n a) where
-   compare x y =
-      Fold.foldr (\r rs -> if r==EQ then rs else r) EQ $
-      liftA2 compare x y
-
-instance (Num a, Dec.Positive n) => Num (Vector n a) where
-    (+) = liftA2 (+)
-    (-) = liftA2 (-)
-    (*) = liftA2 (*)
-    negate = fmap negate
-    abs = fmap abs
-    signum = fmap signum
-    fromInteger = pure . fromInteger
-
-instance (Enum a, Dec.Positive n) => Enum (Vector n a) where
-    succ = fmap succ
-    pred = fmap pred
-    fromEnum = error "Vector fromEnum"
-    toEnum = pure . toEnum
-
-instance (Real a, Dec.Positive n) => Real (Vector n a) where
-    toRational = error "Vector toRational"
-
-instance (Integral a, Dec.Positive n) => Integral (Vector n a) where
-    quot = liftA2 quot
-    rem  = liftA2 rem
-    div  = liftA2 div
-    mod  = liftA2 mod
-    quotRem xs ys = unzip $ liftA2 quotRem xs ys
-    divMod  xs ys = unzip $ liftA2 divMod  xs ys
-    toInteger = error "Vector toInteger"
-
-instance (Fractional a, Dec.Positive n) => Fractional (Vector n a) where
-    (/) = liftA2 (/)
-    fromRational = pure . fromRational
-
-instance (RealFrac a, Dec.Positive n) => RealFrac (Vector n a) where
-    properFraction = error "Vector properFraction"
-
-instance (Floating a, Dec.Positive n) => Floating (Vector n a) where
-    pi = pure pi
-    sqrt = fmap sqrt
-    log = fmap log
-    logBase = liftA2 logBase
-    (**) = liftA2 (**)
-    exp = fmap exp
-    sin = fmap sin
-    cos = fmap cos
-    tan = fmap tan
-    asin = fmap asin
-    acos = fmap acos
-    atan = fmap atan
-    sinh = fmap sinh
-    cosh = fmap cosh
-    tanh = fmap tanh
-    asinh = fmap asinh
-    acosh = fmap acosh
-    atanh = fmap atanh
-
-instance (RealFloat a, Dec.Positive n) => RealFloat (Vector n a) where
-    floatRadix = floatRadix . head
-    floatDigits = floatDigits . head
-    floatRange = floatRange . head
-    decodeFloat = error "Vector decodeFloat"
-    encodeFloat = error "Vector encodeFloat"
-    exponent _ = 0
-    scaleFloat 0 x = x
-    scaleFloat _ _ = error "Vector scaleFloat"
-    isNaN = error "Vector isNaN"
-    isInfinite = error "Vector isInfinite"
-    isDenormalized = error "Vector isDenormalized"
-    isNegativeZero = error "Vector isNegativeZero"
-    isIEEE = isIEEE . head
-
-
-indices :: (Dec.Positive n) => Vector n Int
-indices =
-    flip MS.evalState 0 $ Trav.sequenceA $ replicate $ MS.state (\k -> (k,k+1))
-
-instance (Dec.Positive n, QC.Arbitrary a) => QC.Arbitrary (Vector n a) where
-    arbitrary = Trav.sequenceA $ replicate QC.arbitrary
-    shrink v =
-        case indices of
-            ixs ->
-                concatMap
-                    (Trav.sequenceA .
-                     liftA2
-                        (\x doShrink ->
-                            if doShrink then QC.shrink x else [x]) v) $
-                outerProduct (==) (Fold.toList ixs) ixs
diff --git a/src/LLVM/ExecutionEngine.hs b/src/LLVM/ExecutionEngine.hs
--- a/src/LLVM/ExecutionEngine.hs
+++ b/src/LLVM/ExecutionEngine.hs
@@ -9,6 +9,7 @@
     runEngineAccessWithModule,
     addModule,
     ExecutionFunction,
+    Importer,
     getExecutionFunction,
     getPointerToFunction,
     addFunctionValue,
@@ -26,11 +27,17 @@
     module LLVM.ExecutionEngine.Target,
     -- * Exchange data with JIT code in memory
     Marshal.Marshal(..),
+    Marshal.MarshalVector(..),
     Marshal.sizeOf,
     Marshal.alignment,
     Marshal.StructFields,
     Marshal.sizeOfArray,
     Marshal.pokeList,
+    Marshal.with,
+    Marshal.alloca,
+    Marshal.Stored(..),
+    Marshal.castToStoredPtr,
+    Marshal.castFromStoredPtr,
     ) where
 
 import qualified LLVM.ExecutionEngine.Marshal as Marshal
diff --git a/src/LLVM/ExecutionEngine/Engine.hs b/src/LLVM/ExecutionEngine/Engine.hs
deleted file mode 100644
--- a/src/LLVM/ExecutionEngine/Engine.hs
+++ /dev/null
@@ -1,297 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-module LLVM.ExecutionEngine.Engine(
-       EngineAccess,
-       ExecutionEngine(..),
-       getEngine,
-       runEngineAccess, runEngineAccessWithModule,
-       runEngineAccessInterpreterWithModule,
-       getExecutionEngineTargetData,
-       ExecutionFunction,
-       getExecutionFunction,
-       getPointerToFunction,
-       addModule,
-       addFunctionValue, addGlobalMappings,
-       runFunction, getRunFunction,
-       GenericValue, Generic(..)
-       ) where
-
-import qualified LLVM.Util.Proxy as Proxy
-import qualified LLVM.Core.Util as U
-
-import LLVM.Core.CodeGen (Value(..), Function)
-import LLVM.Core.CodeGenMonad (GlobalMappings(..))
-import LLVM.Core.Util (Module, withModule, createModule)
-import LLVM.Core.Type (IsFirstClass, typeRef)
-import LLVM.Util.Proxy (Proxy(Proxy))
-
-import qualified LLVM.FFI.ExecutionEngine as FFI
-import qualified LLVM.FFI.Target as FFI
-import qualified LLVM.FFI.Core as FFI (consBool, deconsBool, )
-
-import qualified Control.Monad.Trans.Reader as MR
-import Control.Monad.IO.Class (MonadIO, liftIO, )
-import Control.Monad (liftM, )
-import Control.Applicative (Applicative, pure, (<*>), (<$>), )
-
-import qualified Data.EnumBitSet as EnumSet
-import Data.Int (Int8, Int16, Int32, Int64)
-import Data.Word (Word8, Word16, Word32, Word64)
-
-import Foreign.Marshal.Alloc (alloca, free)
-import Foreign.Marshal.Array (withArrayLen)
-import Foreign.ForeignPtr
-         (ForeignPtr, newForeignPtr, withForeignPtr, touchForeignPtr)
-import Foreign.C.String (peekCString)
-import Foreign.Ptr (Ptr, FunPtr, )
-import Foreign.Storable (peek)
-import Foreign.StablePtr (StablePtr, castStablePtrToPtr, castPtrToStablePtr, )
-import System.IO.Unsafe (unsafePerformIO)
-
-
-newtype
-    ExecutionEngine = ExecutionEngine {
-        fromEngine :: ForeignPtr FFI.ExecutionEngine
-    }
-
-withEngine :: ExecutionEngine -> (FFI.ExecutionEngineRef -> IO a) -> IO a
-withEngine = withForeignPtr . fromEngine
-
-createExecutionEngineForModule ::
-    Bool -> FFI.EngineKindSet -> Module -> IO ExecutionEngine
-createExecutionEngineForModule hostCPU kind m =
-    alloca $ \eePtr ->
-        alloca $ \errPtr -> do
-          success <-
-            withModule m $ \mPtr ->
-              if hostCPU
-                then
-                  FFI.createExecutionEngineKindForModuleCPU
-                    eePtr kind mPtr errPtr
-                else
-                  if EnumSet.get FFI.JIT kind
-                    then FFI.createExecutionEngineForModule eePtr mPtr errPtr
-                    else FFI.createInterpreterForModule eePtr mPtr errPtr
-          if FFI.deconsBool success
-            then do
-                err <- peek errPtr
-                errStr <- peekCString err
-                free err
-                ioError . userError $ errStr
-            else
-                liftM ExecutionEngine $
-                    newForeignPtr FFI.ptrDisposeExecutionEngine =<<
-                    peek eePtr
-
-getTheEngine :: FFI.EngineKindSet -> Module -> IO ExecutionEngine
-getTheEngine = createExecutionEngineForModule True
-
-newtype EngineAccess a = EA (MR.ReaderT ExecutionEngine IO a)
-    deriving (Functor, Applicative, Monad, MonadIO)
-
--- |The LLVM execution engine is encapsulated so it cannot be accessed directly.
--- The reason is that (currently) there must only ever be one engine,
--- so access to it is wrapped in a monad.
-runEngineAccess :: EngineAccess a -> IO a
-runEngineAccess (EA body) = do
-    MR.runReaderT body =<< getTheEngine FFI.kindEither =<< createModule "__empty__"
-
-runEngineAccessWithModule :: Module -> EngineAccess a -> IO a
-runEngineAccessWithModule m (EA body) = do
-    MR.runReaderT body =<< getTheEngine FFI.kindEither m
-
-runEngineAccessInterpreterWithModule :: Module -> EngineAccess a -> IO a
-runEngineAccessInterpreterWithModule m (EA body) = do
-    MR.runReaderT body =<< getTheEngine FFI.kindInterpreter m
-
-
-getEngine :: EngineAccess ExecutionEngine
-getEngine = EA MR.ask
-
-accessEngine :: (FFI.ExecutionEngineRef -> IO a) -> EngineAccess a
-accessEngine act = do
-    engine <- getEngine
-    liftIO $ withEngine engine act
-
-getExecutionEngineTargetData :: EngineAccess FFI.TargetDataRef
-getExecutionEngineTargetData =
-    accessEngine FFI.getExecutionEngineTargetData
-
-{- |
-In contrast to 'generateFunction' this compiles a function once.
-Thus it is faster for many calls to the same function.
-See @examples\/Vector.hs@.
-
-If the function calls back into Haskell code,
-you also have to set the function addresses
-using 'addFunctionValue' or 'addGlobalMappings'.
-
-You must keep the execution engine alive
-as long as you want to call the function.
-Better use 'getExecutionFunction' which handles this for you.
--}
-getPointerToFunction :: Function f -> EngineAccess (FunPtr f)
-getPointerToFunction (Value f) =
-    accessEngine $ \eePtr -> FFI.getPointerToFunction eePtr f
-
-class ExecutionFunction f where
-    keepAlive :: ExecutionEngine -> f -> f
-
-instance ExecutionFunction (IO a) where
-    keepAlive engine act = do
-        a <- act
-        touchForeignPtr (fromEngine engine)
-        return a
-
-instance ExecutionFunction f => ExecutionFunction (a -> f) where
-    keepAlive engine act = keepAlive engine . act
-
-getExecutionFunction ::
-    (ExecutionFunction f) => (FunPtr f -> f) -> Function f -> EngineAccess f
-getExecutionFunction importer (Value f) = do
-    engine <- getEngine
-    liftIO $ withEngine engine $ \eePtr ->
-        keepAlive engine . importer <$> FFI.getPointerToFunction eePtr f
-
-{- |
-Tell LLVM the address of an external function
-if it cannot resolve a name automatically.
-Alternatively you may declare the function
-with 'staticFunction' instead of 'externFunction'.
--}
-addFunctionValue :: Function f -> FunPtr f -> EngineAccess ()
-addFunctionValue (Value g) f =
-    accessEngine $ \eePtr -> FFI.addFunctionMapping eePtr g f
-
-{- |
-Pass a list of global mappings to LLVM
-that can be obtained from 'LLVM.Core.getGlobalMappings'.
--}
-addGlobalMappings :: GlobalMappings -> EngineAccess ()
-addGlobalMappings (GlobalMappings gms) = accessEngine gms
-
-addModule :: Module -> EngineAccess ()
-addModule m =
-    accessEngine $ \eePtr -> U.withModule m $ FFI.addModule eePtr
-
-
---------------------------------------
-
-newtype GenericValue = GenericValue {
-      fromGenericValue :: ForeignPtr FFI.GenericValue
-    }
-
-withGenericValue :: GenericValue -> (FFI.GenericValueRef -> IO a) -> IO a
-withGenericValue = withForeignPtr . fromGenericValue
-
-createGenericValueWith :: IO FFI.GenericValueRef -> IO GenericValue
-createGenericValueWith f = do
-  ptr <- f
-  liftM GenericValue $ newForeignPtr FFI.ptrDisposeGenericValue ptr
-
-withAll :: [GenericValue] -> (Int -> Ptr FFI.GenericValueRef -> IO a) -> IO a
-withAll ps a = go [] ps
-    where go ptrs (x:xs) = withGenericValue x $ \ptr -> go (ptr:ptrs) xs
-          go ptrs _ = withArrayLen (reverse ptrs) a
-
-runFunction :: U.Function -> [GenericValue] -> EngineAccess GenericValue
-runFunction func args =
-    liftIO =<< getRunFunction <*> pure func <*> pure args
-
-getRunFunction :: EngineAccess (U.Function -> [GenericValue] -> IO GenericValue)
-getRunFunction = do
-    engine <- getEngine
-    return $ \ func args ->
-             withAll args $ \argLen argPtr ->
-             withEngine engine $ \eePtr ->
-                 createGenericValueWith $ FFI.runFunction eePtr func
-                                              (fromIntegral argLen) argPtr
-
-class Generic a where
-    toGeneric :: a -> GenericValue
-    fromGeneric :: GenericValue -> a
-
-instance Generic () where
-    toGeneric _ = error "toGeneric ()"
-    fromGeneric _ = ()
-
-toGenericInt :: (Integral a, IsFirstClass a) => Bool -> a -> GenericValue
-toGenericInt signed val = unsafePerformIO $ createGenericValueWith $ do
-    typ <- typeRef $ Proxy.fromValue val
-    FFI.createGenericValueOfInt
-        typ (fromIntegral val) (FFI.consBool signed)
-
-fromGenericInt :: (Integral a, IsFirstClass a) => Bool -> GenericValue -> a
-fromGenericInt signed val = unsafePerformIO $
-    withGenericValue val $ \ref ->
-        fmap fromIntegral $ FFI.genericValueToInt ref (FFI.consBool signed)
-
---instance Generic Bool where
---    toGeneric = toGenericInt False . FFI.consBool
---    fromGeneric = toBool . fromGenericInt False
-
-instance Generic Int8 where
-    toGeneric = toGenericInt True
-    fromGeneric = fromGenericInt True
-
-instance Generic Int16 where
-    toGeneric = toGenericInt True
-    fromGeneric = fromGenericInt True
-
-instance Generic Int32 where
-    toGeneric = toGenericInt True
-    fromGeneric = fromGenericInt True
-
-{-
-instance Generic Int where
-    toGeneric = toGenericInt True
-    fromGeneric = fromGenericInt True
--}
-
-instance Generic Int64 where
-    toGeneric = toGenericInt True
-    fromGeneric = fromGenericInt True
-
-instance Generic Word8 where
-    toGeneric = toGenericInt False
-    fromGeneric = fromGenericInt False
-
-instance Generic Word16 where
-    toGeneric = toGenericInt False
-    fromGeneric = fromGenericInt False
-
-instance Generic Word32 where
-    toGeneric = toGenericInt False
-    fromGeneric = fromGenericInt False
-
-instance Generic Word64 where
-    toGeneric = toGenericInt False
-    fromGeneric = fromGenericInt False
-
-toGenericReal :: (Real a, IsFirstClass a) => a -> GenericValue
-toGenericReal val = unsafePerformIO $ createGenericValueWith $ do
-    typ <- typeRef $ Proxy.fromValue val
-    FFI.createGenericValueOfFloat typ (realToFrac val)
-
-fromGenericReal :: forall a . (Fractional a, IsFirstClass a) => GenericValue -> a
-fromGenericReal val = unsafePerformIO $
-    withGenericValue val $ \ ref -> do
-        typ <- typeRef (Proxy :: Proxy a)
-        fmap realToFrac $ FFI.genericValueToFloat typ ref
-
-instance Generic Float where
-    toGeneric = toGenericReal
-    fromGeneric = fromGenericReal
-
-instance Generic Double where
-    toGeneric = toGenericReal
-    fromGeneric = fromGenericReal
-
-instance Generic (Ptr a) where
-    toGeneric = unsafePerformIO . createGenericValueWith . FFI.createGenericValueOfPointer
-    fromGeneric val = unsafePerformIO . withGenericValue val $ FFI.genericValueToPointer
-
-instance Generic (StablePtr a) where
-    toGeneric = unsafePerformIO . createGenericValueWith . FFI.createGenericValueOfPointer . castStablePtrToPtr
-    fromGeneric val = unsafePerformIO . fmap castPtrToStablePtr . withGenericValue val $ FFI.genericValueToPointer
diff --git a/src/LLVM/ExecutionEngine/Marshal.hs b/src/LLVM/ExecutionEngine/Marshal.hs
deleted file mode 100644
--- a/src/LLVM/ExecutionEngine/Marshal.hs
+++ /dev/null
@@ -1,186 +0,0 @@
-{- |
-A 'Marshal' class that is compatible with LLVM's data layout.
-Most prominent difference is that LLVM's @i1@ requires a byte in memory,
-whereas Haskell's 'Bool' occupies a 32-bit word.
-Additionally this class supports 'Data.Struct', 'Data.Vector', 'Data.Array'.
--}
-module LLVM.ExecutionEngine.Marshal (
-    Marshal(..),
-    sizeOf,
-    alignment,
-    StructFields,
-    sizeOfArray,
-    pokeList,
-    ) where
-
-import qualified LLVM.Core.Vector as Vector ()
-import qualified LLVM.Core.Data as Data
-import qualified LLVM.Core.Type as Type
-import qualified LLVM.Util.Proxy as LP
-import qualified LLVM.ExecutionEngine.Target as Target
-import LLVM.ExecutionEngine.Target (TargetData)
-
-import qualified LLVM.FFI.Core as FFI
-
-import qualified Type.Data.Num.Decimal.Number as Dec
-import Type.Base.Proxy (Proxy(Proxy))
-
-import qualified Foreign.Storable as Store
-import Foreign.StablePtr (StablePtr)
-import Foreign.Ptr (Ptr, FunPtr, castPtr, plusPtr)
-
-import System.IO.Unsafe (unsafePerformIO)
-
-import qualified Control.Monad.Trans.State as MS
-import Control.Applicative (liftA2, pure)
-
-import qualified Data.Traversable as Trav
-import qualified Data.Foldable as Fold
-import Data.Int (Int8, Int16, Int32, Int64)
-import Data.Word (Word8, Word16, Word32, Word64)
-
-
-
-targetData :: TargetData
-targetData = unsafePerformIO Target.getTargetData
-
-
-sizeOf :: (Type.IsType a) => LP.Proxy a -> Int
-sizeOf = Target.storeSizeOfType targetData . Type.unsafeTypeRef
-
-alignment :: (Type.IsType a) => LP.Proxy a -> Int
-alignment = Target.abiAlignmentOfType targetData . Type.unsafeTypeRef
-
-sizeOfArray :: (Type.IsType a) => LP.Proxy a -> Int -> Int
-sizeOfArray proxy n =
-   Target.abiSizeOfType targetData (Type.unsafeTypeRef proxy) * n
-
-
-class (Type.IsType a) => Marshal a where
-    peek :: Ptr a -> IO a
-    poke :: Ptr a -> a -> IO ()
-
-peekPrimitive :: (Store.Storable a) => Ptr a -> IO a
-peekPrimitive = Store.peek
-
-pokePrimitive :: (Store.Storable a) => Ptr a -> a -> IO ()
-pokePrimitive = Store.poke
-
-instance Marshal Float  where
-    peek = peekPrimitive; poke = pokePrimitive
-instance Marshal Double where
-    peek = peekPrimitive; poke = pokePrimitive
-
-instance Marshal Int8  where
-    peek = peekPrimitive; poke = pokePrimitive
-instance Marshal Int16 where
-    peek = peekPrimitive; poke = pokePrimitive
-instance Marshal Int32 where
-    peek = peekPrimitive; poke = pokePrimitive
-instance Marshal Int64 where
-    peek = peekPrimitive; poke = pokePrimitive
-instance Marshal Word8  where
-    peek = peekPrimitive; poke = pokePrimitive
-instance Marshal Word16 where
-    peek = peekPrimitive; poke = pokePrimitive
-instance Marshal Word32 where
-    peek = peekPrimitive; poke = pokePrimitive
-instance Marshal Word64 where
-    peek = peekPrimitive; poke = pokePrimitive
-instance (Type.IsType a) => Marshal (Ptr a) where
-    peek = peekPrimitive; poke = pokePrimitive
-instance (Type.IsFunction a) => Marshal (FunPtr a) where
-    peek = peekPrimitive; poke = pokePrimitive
-instance Marshal (StablePtr a) where
-    peek = peekPrimitive; poke = pokePrimitive
-
-instance Marshal Bool where
-    peek = fmap (/= 0) . Store.peek . castBoolPtr
-    poke ptr a = Store.poke (castBoolPtr ptr) (fromIntegral $ fromEnum a)
-
-castBoolPtr :: Ptr Bool -> Ptr Word8
-castBoolPtr = castPtr
-
-instance
-    (Type.Natural n, Marshal a, Type.IsSized a) =>
-        Marshal (Data.Array n a) where
-    peek = peekArray Proxy LP.Proxy
-    poke = pokeArray (\(Data.Array as) -> as)
-
-instance
-    (Type.Positive n, Marshal a, Type.IsPrimitive a) =>
-        Marshal (Data.Vector n a) where
-    peek = peekVector Proxy LP.Proxy
-    poke = pokeArray Fold.toList
-
-peekArray ::
-    (Type.Natural n, Marshal a) =>
-    Proxy n -> LP.Proxy a ->
-    Ptr (Data.Array n a) -> IO (Data.Array n a)
-peekArray n proxy =
-    let step = Target.abiSizeOfType targetData $ Type.unsafeTypeRef proxy
-    in \ptr ->
-        fmap Data.Array $ mapM peek $
-        take (Dec.integralFromProxy n) $
-        iterate (flip plusPtr step) (castElemPtr ptr)
-
-peekVector ::
-    (Type.Positive n, Marshal a) =>
-    Proxy n -> LP.Proxy a ->
-    Ptr (Data.Vector n a) -> IO (Data.Vector n a)
-peekVector _n proxy =
-    let step = Target.abiSizeOfType targetData $ Type.unsafeTypeRef proxy
-    in \ptr ->
-        flip MS.evalStateT (castElemPtr ptr) $
-        Trav.traverse
-            (\() -> MS.StateT $ \ptri -> do
-                a <- peek ptri
-                return (a, plusPtr ptri step))
-            (pure ())
-
-pokeArray :: (Marshal a) => (f a -> [a]) -> Ptr (f a) -> f a -> IO ()
-pokeArray toList ptr = pokeList (castElemPtr ptr) . toList
-
-pokeList :: (Marshal a) => Ptr a -> [a] -> IO ()
-pokeList = pokeListAux LP.Proxy
-
-pokeListAux :: (Marshal a) => LP.Proxy a -> Ptr a -> [a] -> IO ()
-pokeListAux proxy =
-    let step = Target.abiSizeOfType targetData $ Type.unsafeTypeRef proxy
-    in \ptr -> sequence_ . zipWith poke (iterate (flip plusPtr step) ptr)
-
-castElemPtr :: Ptr (f a) -> Ptr a
-castElemPtr = castPtr
-
-
-instance (StructFields fields) => Marshal (Data.Struct fields) where
-    peek = withPtrProxy $ \proxy ->
-        let typeRef = Type.unsafeTypeRef proxy
-        in fmap Data.Struct . peekStruct typeRef 0
-    poke = withPtrProxy $ \proxy ->
-        let typeRef = Type.unsafeTypeRef proxy
-            pokePlain = pokeStruct typeRef 0
-        in \ptr (Data.Struct as) -> pokePlain ptr as
-
-withPtrProxy :: (LP.Proxy a -> Ptr a -> b) -> Ptr a -> b
-withPtrProxy act = act LP.Proxy
-
-class (Type.StructFields fields) => StructFields fields where
-    peekStruct :: FFI.TypeRef -> Int -> Ptr struct -> IO fields
-    pokeStruct :: FFI.TypeRef -> Int -> Ptr struct -> fields -> IO ()
-
-instance
-    (Marshal a, Type.IsSized a, StructFields as) =>
-        StructFields (a,as) where
-    peekStruct typeRef i =
-        let offset = Target.offsetOfElement targetData typeRef i
-            peekIs = peekStruct typeRef (i+1)
-        in \ptr -> liftA2 (,) (peek $ plusPtr ptr offset) (peekIs ptr)
-    pokeStruct typeRef i =
-        let offset = Target.offsetOfElement targetData typeRef i
-            pokeIs = pokeStruct typeRef (i+1)
-        in \ptr (a,as) -> poke (plusPtr ptr offset) a >> pokeIs ptr as
-
-instance StructFields () where
-    peekStruct _type _i _ptr = return ()
-    pokeStruct _type _i _ptr () = return ()
diff --git a/src/LLVM/ExecutionEngine/Target.hs b/src/LLVM/ExecutionEngine/Target.hs
deleted file mode 100644
--- a/src/LLVM/ExecutionEngine/Target.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-module LLVM.ExecutionEngine.Target(TargetData(..), getTargetData, targetDataFromString, withIntPtrType) where
-
-import qualified LLVM.ExecutionEngine.Engine as EE
-import LLVM.Core.Data (WordN)
-
-import qualified LLVM.FFI.Core as FFI
-import qualified LLVM.FFI.Target as FFI
-
-import qualified Type.Data.Num.Decimal.Number as Dec
-import Type.Base.Proxy (Proxy)
-
-import Foreign.ForeignPtr
-         (ForeignPtr, newForeignPtr, withForeignPtr, touchForeignPtr)
-import Foreign.C.String (withCString)
-
-import Control.Monad (liftM2)
-import Control.Applicative ((<$>))
-import Data.Typeable (Typeable)
-import Data.Maybe (fromMaybe)
-import System.IO.Unsafe (unsafePerformIO)
-
-
-type Type = FFI.TypeRef
-
-data TargetData = TargetData {
-    abiAlignmentOfType         :: Type -> Int,
-    abiSizeOfType              :: Type -> Int,
-    littleEndian               :: Bool,
-    callFrameAlignmentOfType   :: Type -> Int,
---  elementAtOffset            :: Type -> Word64 -> Int,
-    intPtrType                 :: Type,
-    offsetOfElement            :: Type -> Int -> Int,
-    pointerSize                :: Int,
---  preferredAlignmentOfGlobal :: Value a -> Int,
-    preferredAlignmentOfType   :: Type -> Int,
-    sizeOfTypeInBits           :: Type -> Int,
-    storeSizeOfType            :: Type -> Int
-    }
-    deriving (Typeable)
-
-withIntPtrType :: (forall n . (Dec.Positive n) => WordN n -> a) -> a
-withIntPtrType f =
-    fromMaybe (error "withIntPtrType: pointer size must be non-negative") $
-        Dec.reifyPositive (fromIntegral sz) (\ n -> f (g n))
-  where g :: Proxy n -> WordN n
-        g _ = error "withIntPtrType: argument used"
-        sz = pointerSize $ unsafePerformIO getTargetData
-
-
-unsafeIO :: ForeignPtr a -> IO b -> b
-unsafeIO fptr act =
-    unsafePerformIO $ do x <- act; touchForeignPtr fptr; return x
-
-unsafeIntIO :: (Integral i, Num j) => ForeignPtr a -> IO i -> j
-unsafeIntIO fptr = fromIntegral . unsafeIO fptr
-
--- Normally the TargetDataRef never changes, so the operation
--- are really pure functions.
-makeTargetData :: ForeignPtr a -> FFI.TargetDataRef -> TargetData
-makeTargetData fptr r = TargetData {
-    abiAlignmentOfType       = unsafeIntIO fptr . FFI.abiAlignmentOfType r,
-    abiSizeOfType            = unsafeIntIO fptr . FFI.abiSizeOfType r,
-    littleEndian             = unsafeIO fptr (FFI.byteOrder r) /= FFI.bigEndian,
-    callFrameAlignmentOfType = unsafeIntIO fptr . FFI.callFrameAlignmentOfType r,
-    intPtrType               = unsafeIO fptr $ FFI.intPtrType r,
-    offsetOfElement          = \ty k ->
-        unsafeIntIO fptr $ FFI.offsetOfElement r ty (fromIntegral k),
-    pointerSize              = unsafeIntIO fptr $ FFI.pointerSize r,
-    preferredAlignmentOfType = unsafeIntIO fptr . FFI.preferredAlignmentOfType r,
-    sizeOfTypeInBits         = unsafeIntIO fptr . FFI.sizeOfTypeInBits r,
-    storeSizeOfType          = unsafeIntIO fptr . FFI.storeSizeOfType r
-    }
-
--- Gets the target data for the JIT target.
-getTargetData :: IO TargetData
-getTargetData =
-    EE.runEngineAccess $
-    liftM2 makeTargetData
-        (EE.fromEngine <$> EE.getEngine)
-        EE.getExecutionEngineTargetData
-
-createTargetData :: String -> IO (ForeignPtr FFI.TargetData)
-createTargetData s =
-    newForeignPtr FFI.ptrDisposeTargetData =<<
-    withCString s FFI.createTargetData
-
-targetDataFromString :: String -> TargetData
-targetDataFromString s = unsafePerformIO $ do
-    td <- createTargetData s
-    withForeignPtr td $ return . makeTargetData td
diff --git a/src/LLVM/Util/Arithmetic.hs b/src/LLVM/Util/Arithmetic.hs
--- a/src/LLVM/Util/Arithmetic.hs
+++ b/src/LLVM/Util/Arithmetic.hs
@@ -2,10 +2,8 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE TypeFamilies #-}
 module LLVM.Util.Arithmetic(
     TValue,
@@ -13,7 +11,7 @@
     (%&&), (%||),
     (?), (??),
     retrn, set,
-    ArithFunction, arithFunction,
+    ArithFunction, arithFunction, Return,
     ToArithFunction, toArithFunction, recursiveFunction,
     CallIntrinsic,
     ) where
@@ -21,6 +19,7 @@
 import qualified LLVM.Util.Intrinsic as Intrinsic
 import qualified LLVM.Core as LLVM
 import LLVM.Util.Loop (mapVector, mapVector2)
+import LLVM.Core.CodeGen (UnValue, CodeValue, CodeResult)
 import LLVM.Core
 
 import qualified Type.Data.Num.Decimal.Number as Dec
@@ -79,19 +78,21 @@
     select c' t' f'
 
 -- | Return a value from an 'arithFunction'.
-retrn :: (Ret (Value a) r) => TValue r a -> CodeGenFunction r ()
+retrn :: TValue a a -> CodeGenFunction a ()
 retrn x = x >>= ret
 
 -- | Use @x <- set $ ...@ to make a binding.
 set :: TValue r a -> CodeGenFunction r (TValue r a)
 set x = do x' <- x; return (return x')
 
-instance Eq (TValue r a) where
+instance Eq (CodeGenFunction r av) where
     (==) = error "CodeGenFunction Value: (==)"
-instance Ord (TValue r a) where
+instance Ord (CodeGenFunction r av) where
     compare = error "CodeGenFunction Value: compare"
 
-instance (IsArithmetic a, CmpRet a, Num a, IsConst a) => Num (TValue r a) where
+instance
+    (IsArithmetic a, CmpRet a, Num a, IsConst a, Value a ~ av) =>
+        Num (CodeGenFunction r av) where
     (+) = binop add
     (-) = binop sub
     (*) = binop mul
@@ -100,29 +101,41 @@
     signum x = x %< 0 ?? (-1, x %> 0 ?? (1, 0))
     fromInteger = return . valueOf . fromInteger
 
-instance (IsArithmetic a, CmpRet a, Num a, IsConst a) => Enum (TValue r a) where
+instance
+    (IsArithmetic a, CmpRet a, Num a, IsConst a, Value a ~ av) =>
+        Enum (CodeGenFunction r av) where
     succ x = x + 1
     pred x = x - 1
     fromEnum _ = error "CodeGenFunction Value: fromEnum"
     toEnum = fromIntegral
 
-instance (IsArithmetic a, CmpRet a, Num a, IsConst a) => Real (TValue r a) where
+instance
+    (IsArithmetic a, CmpRet a, Num a, IsConst a, Value a ~ av) =>
+        Real (CodeGenFunction r av) where
     toRational _ = error "CodeGenFunction Value: toRational"
 
-instance (CmpRet a, Num a, IsConst a, IsInteger a) => Integral (TValue r a) where
+instance
+    (CmpRet a, Num a, IsConst a, IsInteger a, Value a ~ av) =>
+        Integral (CodeGenFunction r av) where
     quot = binop idiv
     rem  = binop irem
     quotRem x y = (quot x y, rem x y)
     toInteger _ = error "CodeGenFunction Value: toInteger"
 
-instance (CmpRet a, Fractional a, IsConst a, IsFloating a) => Fractional (TValue r a) where
+instance
+    (CmpRet a, Fractional a, IsConst a, IsFloating a, Value a ~ av) =>
+        Fractional (CodeGenFunction r av) where
     (/) = binop fdiv
     fromRational = return . valueOf . fromRational
 
-instance (CmpRet a, Fractional a, IsConst a, IsFloating a) => RealFrac (TValue r a) where
+instance
+    (CmpRet a, Fractional a, IsConst a, IsFloating a, Value a ~ av) =>
+        RealFrac (CodeGenFunction r av) where
     properFraction _ = error "CodeGenFunction Value: properFraction"
 
-instance (CmpRet a, CallIntrinsic a, Floating a, IsConst a, IsFloating a) => Floating (TValue r a) where
+instance
+    (CmpRet a, CallIntrinsic a, Floating a, IsConst a, IsFloating a, Value a ~ av) =>
+        Floating (CodeGenFunction r av) where
     pi = return $ valueOf pi
     sqrt = callIntrinsic1 "sqrt"
     sin = callIntrinsic1 "sin"
@@ -141,7 +154,9 @@
     acosh x          = log (x + sqrt (x*x - 1))
     atanh x          = (log (1 + x) - log (1 - x)) / 2
 
-instance (CmpRet a, CallIntrinsic a, RealFloat a, IsConst a, IsFloating a) => RealFloat (TValue r a) where
+instance
+    (CmpRet a, CallIntrinsic a, RealFloat a, IsConst a, IsFloating a, Value a ~ av) =>
+        RealFloat (CodeGenFunction r av) where
     floatRadix _ = floatRadix (undefined :: a)
     floatDigits _ = floatDigits (undefined :: a)
     floatRange _ = floatRange (undefined :: a)
@@ -165,58 +180,94 @@
 
 -------------------------------------------
 
-class ArithFunction r z a b | a -> b r z, b r z -> a where
+{- |
+Turn
+@(a -> b -> CodeGenFunction r c)@
+into
+@(a -> b -> CodeGenFunction r ())@
+for @r ~ Result c@
+-}
+class (RetB a ~ b, CodeValue a ~ z, RetA z b ~ a) => Return z a b where
+    type RetA z b
+    type RetB a
+    addRet :: a -> b
+
+instance
+    (Ret z, Result z ~ r, r ~ ra, r ~ rb, z ~ a, unit ~ ()) =>
+        Return z (CodeGenFunction ra a) (CodeGenFunction rb unit) where
+    type RetA z (CodeGenFunction rb unit) = CodeGenFunction (Result z) z
+    type RetB (CodeGenFunction ra a) = CodeGenFunction ra ()
+    addRet code = ret =<< code
+
+instance (Return z b0 b1, a0 ~ a1) => Return z (a0 -> b0) (a1 -> b1) where
+    type RetA z (a1 -> b1) = a1 -> RetA z b1
+    type RetB (a0 -> b0) = a0 -> RetB b0
+    addRet f = addRet . f
+
+
+class (FunA r b ~ a, FunB a ~ b, CodeResult a ~ r) => ArithFunction r a b where
+    type FunA r b
+    type FunB a
     arithFunction' :: a -> b
 
 instance
-    (Ret a r) =>
-        ArithFunction r a (CodeGenFunction r a) (CodeGenFunction r ()) where
-    arithFunction' x = x >>= ret
+    (r ~ ra, r ~ rb, a ~ b) =>
+        ArithFunction r (CodeGenFunction ra a) (CodeGenFunction rb b) where
+    type FunA r (CodeGenFunction rb b) = CodeGenFunction r b
+    type FunB (CodeGenFunction ra a) = CodeGenFunction ra a
+    arithFunction' x = x
 
 instance
-    (ArithFunction r z b0 b1) =>
-        ArithFunction r z (CodeGenFunction r a -> b0) (a -> b1) where
+    (ArithFunction r b0 b1, a0 ~ CodeGenFunction r a1) =>
+        ArithFunction r (a0 -> b0) (a1 -> b1) where
+    type FunA r (a1 -> b1) = CodeGenFunction r a1 -> FunA r b1
+    type FunB (a0 -> b0) = CodeValue a0 -> FunB b0
     arithFunction' f = arithFunction' . f . return
 
 -- |Unlift a function with @TValue@ to have @Value@ arguments.
-arithFunction :: ArithFunction r z a b => a -> b
-arithFunction = arithFunction'
+arithFunction :: (ArithFunction r a b, r ~ Result z, Return z b c) => a -> c
+arithFunction = addRet . arithFunction'
 
 
-class ToArithFunction r a b | a r -> b, b -> a r where
+class
+    (TFunB r a ~ b, TFunA b ~ a, CodeResult b ~ r) =>
+        ToArithFunction r a b where
+    type TFunA b
+    type TFunB r a
     toArithFunction' :: CodeGenFunction r (Call a) -> b
 
-instance ToArithFunction r (IO b) (CodeGenFunction r (Value b)) where
-    toArithFunction' cl = cl >>= runCall
+instance (Value a ~ b) => ToArithFunction r (IO a) (CodeGenFunction r b) where
+    type TFunA (CodeGenFunction r b) = IO (UnValue b)
+    type TFunB r (IO a) = CodeGenFunction r (Value a)
+    toArithFunction' cl = runCall =<< cl
 
 instance
-    ToArithFunction r b0 b1 =>
-        ToArithFunction r (a -> b0) (CodeGenFunction r (Value a) -> b1) where
+    (ToArithFunction r b0 b1, CodeGenFunction r (Value a0) ~ a1) =>
+        ToArithFunction r (a0 -> b0) (a1 -> b1) where
+    type TFunA (a1 -> b1) = UnValue (CodeValue a1) -> TFunA b1
+    type TFunB r (a0 -> b0) = CodeGenFunction r (Value a0) -> TFunB r b0
     toArithFunction' cl x =
         toArithFunction' (liftM2 applyCall cl x)
 
 
 _toArithFunction2 ::
-   Function (a -> b -> IO c) -> TValue r a -> TValue r b -> TValue r c
+    Function (a -> b -> IO c) -> TValue r a -> TValue r b -> TValue r c
 _toArithFunction2 f tx ty = do
     x <- tx
     y <- ty
     runCall $ callFromFunction f `applyCall` x `applyCall` y
 
 -- |Lift a function from having @Value@ arguments to having @TValue@ arguments.
-toArithFunction ::
-    (ToArithFunction r f g) =>
-    Function f -> g
-toArithFunction f =
-    toArithFunction' $ return $ callFromFunction f
+toArithFunction :: (ToArithFunction r f g) => Function f -> g
+toArithFunction = toArithFunction' . return . callFromFunction
 
 -------------------------------------------
 
 -- |Define a recursive 'arithFunction', gets passed itself as the first argument.
 recursiveFunction ::
     (IsFunction f, FunctionArgs f, code ~ FunctionCodeGen f,
-     ArithFunction r1 z arith code,
-     ToArithFunction r0 f g) =>
+     ArithFunction r arith open, r ~ Result z, Return z open code,
+     ToArithFunction r f g) =>
     (g -> arith) -> CodeGenModule (Function f)
 recursiveFunction af = do
     f <- newFunction ExternalLinkage
diff --git a/src/LLVM/Util/Foreign.hs b/src/LLVM/Util/Foreign.hs
--- a/src/LLVM/Util/Foreign.hs
+++ b/src/LLVM/Util/Foreign.hs
@@ -3,28 +3,35 @@
 -- The functions in Foreign.* do not obey the required alignment.
 module LLVM.Util.Foreign where
 
+import qualified LLVM.ExecutionEngine as EE
+import qualified LLVM.Util.Proxy as LP
+import qualified LLVM.Core as LLVM
+
 import Foreign.Marshal.Alloc (allocaBytes)
-import Foreign.Marshal.Array (allocaArray, pokeArray)
-import Foreign.Storable (Storable(poke, sizeOf, alignment))
-import Foreign.Ptr (alignPtr, Ptr)
+import Foreign.Ptr (alignPtr)
 
 
-with :: Storable a => a -> (Ptr a -> IO b) -> IO b
+with :: (EE.Marshal a) => a -> (LLVM.Ptr a -> IO b) -> IO b
 with x act =
     alloca $ \ p -> do
-    poke p x
+    EE.poke p x
     act p
 
-alloca :: forall a b . Storable a => (Ptr a -> IO b) -> IO b
+alloca :: forall a b. (EE.Marshal a) => (LLVM.Ptr a -> IO b) -> IO b
 alloca act =
-    allocaBytes (2 * sizeOf (undefined :: a)) $ \ p ->
-       act $ alignPtr p (alignment (undefined :: a))
+    allocaBytes (2 * EE.sizeOf (LP.Proxy :: LP.Proxy a)) $ \ p ->
+        act $ LLVM.uncheckedFromPtr $
+        alignPtr p (EE.alignment (LP.Proxy :: LP.Proxy a))
 
-withArrayLen :: (Storable a) => [a] -> (Int -> Ptr a -> IO b) -> IO b
+withArrayLen :: (EE.Marshal a) => [a] -> (Int -> LLVM.Ptr a -> IO b) -> IO b
 withArrayLen xs act =
     let l = length xs in
-    allocaArray (l+1) $ \ p -> do
-    let p' = alignPtr p (alignment (head xs))
-    pokeArray p' xs
+    allocaBytes ((l+1) * EE.sizeOf (proxyFromList xs)) $ \ p -> do
+    let p' =
+            LLVM.uncheckedFromPtr $
+            alignPtr p $ EE.alignment $ proxyFromList xs
+    EE.pokeList p' xs
     act l p'
 
+proxyFromList :: [a] -> LP.Proxy a
+proxyFromList _ = LP.Proxy
diff --git a/src/LLVM/Util/Intrinsic.hs b/src/LLVM/Util/Intrinsic.hs
--- a/src/LLVM/Util/Intrinsic.hs
+++ b/src/LLVM/Util/Intrinsic.hs
@@ -6,7 +6,7 @@
    call1, call2,
    ) where
 
-import qualified LLVM.Util.Proxy as LP
+import qualified LLVM.Core.Proxy as LP
 import qualified LLVM.Core as LLVM
 import LLVM.Core
    (CodeGenFunction, Value, IsType, IsFirstClass,
diff --git a/src/LLVM/Util/Memory.hs b/src/LLVM/Util/Memory.hs
--- a/src/LLVM/Util/Memory.hs
+++ b/src/LLVM/Util/Memory.hs
@@ -6,17 +6,17 @@
     IsLengthType,
     ) where
 
-import LLVM.Util.Proxy (Proxy(Proxy))
+import LLVM.Core.Proxy (Proxy(Proxy))
 import LLVM.Core
 
-import Foreign.Ptr (Ptr, )
-import Data.Word (Word8, Word32, Word64, )
+import Data.Word (Word8, Word32, Word64, Word)
 
 import Control.Functor.HT (void, )
 
 
 class IsFirstClass len => IsLengthType len where
 
+instance IsLengthType Word where
 instance IsLengthType Word32 where
 instance IsLengthType Word64 where
 
diff --git a/src/LLVM/Util/Optimize.hs b/src/LLVM/Util/Optimize.hs
--- a/src/LLVM/Util/Optimize.hs
+++ b/src/LLVM/Util/Optimize.hs
@@ -11,6 +11,15 @@
 
 {- |
 Result tells whether the module was modified by any of the passes.
+
+It is very important that you set target triple and target data layout
+before optimizing.
+Otherwise the optimizer will make wrong assumptions
+and e.g. corrupt your record offsets.
+See e.g. example/Array for how this can be achieved.
+
+In the future I might enforce via types
+that you set target parameters before optimization.
 -}
 optimizeModule :: Int -> Module -> IO Bool
 optimizeModule optLevel mdl =
diff --git a/src/LLVM/Util/Proxy.hs b/src/LLVM/Util/Proxy.hs
--- a/src/LLVM/Util/Proxy.hs
+++ b/src/LLVM/Util/Proxy.hs
@@ -1,19 +1,5 @@
-module LLVM.Util.Proxy where
-
-import Control.Applicative (Applicative, pure, (<*>), )
-
-data Proxy a = Proxy
-
-instance Functor Proxy where
-   fmap _f Proxy = Proxy
-
-instance Applicative Proxy where
-   pure _ = Proxy
-   Proxy <*> Proxy = Proxy
-
-
-fromValue :: a -> Proxy a
-fromValue _ = Proxy
+module LLVM.Util.Proxy (
+   module LLVM.Core.Proxy,
+   ) where
 
-element :: Proxy (f a) -> Proxy a
-element Proxy = Proxy
+import LLVM.Core.Proxy
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,21 @@
+module Main where
+
+import qualified Test.Marshal as Marshal
+import qualified Test.Chop as Chop
+
+import qualified LLVM.Core as LLVM
+
+import Data.Tuple.HT (mapPair, mapFst)
+
+import qualified Test.QuickCheck as QC
+
+
+main :: IO ()
+main = do
+   LLVM.initializeNativeTarget
+
+   mapM_ (\(msg,prop) -> putStr (msg++": ") >> prop >>= QC.quickCheck) $
+      map (mapPair (("Chop."++),return)) Chop.tests ++
+      map (mapPair (("Marshal."++),return)) Marshal.testsRoundTrip ++
+      map (mapFst ("Marshal."++)) Marshal.testsExtract ++
+      []
diff --git a/test/Makefile b/test/Makefile
deleted file mode 100644
--- a/test/Makefile
+++ /dev/null
@@ -1,16 +0,0 @@
-ghc := ghc
-ghcflags := -Wall -Werror
-tests := TestType TestValue
-
-all: $(tests:%=%.out)
-
-%.out: %.test
-	./$< > $@ 2>&1; s=$$?; cat $@; \
-	if [ $$s != 0 ]; then mv $@ $(basename $@).err; exit 1; fi
-
-.PRECIOUS: %.test
-%.test: %.hs
-	$(ghc) $(ghcflags) --make -o $@ -main-is $(basename $<).main $<
-
-clean:
-	-rm -f *.o *.hi $(tests:%=%.test) $(tests:%=%.out)
diff --git a/test/Test/Chop.hs b/test/Test/Chop.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Chop.hs
@@ -0,0 +1,63 @@
+module Test.Chop where
+
+import qualified LLVM.ExecutionEngine.Marshal as Marshal
+
+import Data.Bits (shiftL)
+import Data.Word (Word8)
+
+import qualified Test.QuickCheck as QC
+
+
+divUp :: Integral a => a -> a -> a
+divUp a b = - div (-a) b
+
+expandBits :: [Word8] -> Bool
+expandBits xs  =  xs == Marshal.gatherBits (Marshal.expandBits xs)
+
+gatherBits :: [Bool] -> Bool
+gatherBits xs =
+    Marshal.gatherBits xs
+    ==
+    (take (divUp (length xs) 8) $ map fromIntegral $
+     Marshal.chop 1 8 $ map (toInteger . fromEnum) xs)
+
+forAllBitWidth :: (Int -> QC.Property) -> QC.Property
+forAllBitWidth = QC.forAll (QC.choose (1,100))
+
+chopBig :: QC.NonNegative Int -> QC.Property
+chopBig (QC.NonNegative k) =
+    forAllBitWidth $ \m ->
+    forAllBitWidth $ \n ->
+    QC.forAll (QC.listOf $ QC.choose (0, shiftL 1 m - 1)) $ \xs ->
+        take k (Marshal.chop m n xs)
+        ==
+        take k (Marshal.split n $ Marshal.merge m xs)
+
+chop :: QC.NonNegative Int -> QC.Property
+chop (QC.NonNegative k) =
+    forAllBitWidth $ \m ->
+    forAllBitWidth $ \n ->
+    QC.forAll (QC.listOf $ QC.choose (0, shiftL 1 m - 1)) $ \xs ->
+        take k (Marshal.chop n m $ Marshal.chop m n xs)
+        ==
+        take k (xs ++ repeat 0)
+
+chopSigned :: QC.NonNegative Int -> QC.Property
+chopSigned (QC.NonNegative k) =
+    forAllBitWidth $ \m ->
+    forAllBitWidth $ \n ->
+    QC.forAll (QC.listOf $ QC.choose (- shiftL 1 m, shiftL 1 m - 1)) $ \xs ->
+        take k (map (Marshal.adjustSign (m+1)) $ Marshal.chop n (m+1) $
+                Marshal.chop (m+1) n $ map (Marshal.cut (m+1)) xs)
+        ==
+        take k (xs ++ repeat 0)
+
+
+tests :: [(String, QC.Property)]
+tests =
+    ("expandBits", QC.property expandBits) :
+    ("gatherBits", QC.property gatherBits) :
+    ("chopBig",  QC.property chopBig) :
+    ("chop", QC.property chop) :
+    ("chopSigned", QC.property chopSigned) :
+    []
diff --git a/test/Test/Marshal.hs b/test/Test/Marshal.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Marshal.hs
@@ -0,0 +1,280 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE Rank2Types #-}
+module Test.Marshal (testsRoundTrip, testsExtract) where
+
+import qualified LLVM.ExecutionEngine as EE
+import qualified LLVM.Util.Optimize as Opt
+import qualified LLVM.Util.Proxy as LP
+import qualified LLVM.Core as LLVM
+
+import qualified Type.Data.Num.Decimal as TypeNum
+import Type.Base.Proxy (Proxy(Proxy))
+
+import Foreign.Ptr (FunPtr, Ptr, nullPtr, plusPtr, castPtr)
+
+import qualified Data.Foldable as Fold
+import Data.Word (Word8, Word16, Word32, Word64)
+import Data.Int (Int8, Int16, Int32, Int64)
+import Data.Tuple.HT (mapPair, mapFst)
+
+import qualified Test.QuickCheck.Monadic as QCMon
+import qualified Test.QuickCheck as QC
+
+import Control.Monad (liftM2, void, (<=<))
+
+
+
+type RoundTrip a = a -> QC.Property
+type RoundTripVec n a = RoundTrip (LLVM.Vector n a)
+
+roundTrip :: (EE.Marshal a, Eq a) => RoundTrip a
+roundTrip x =
+   QCMon.monadicIO $ do
+      y <- QCMon.run $ EE.with x EE.peek
+      QCMon.assert $ x==y
+
+testsRoundTrip :: [(String, QC.Property)]
+testsRoundTrip =
+   map (mapFst ("RoundTrip." ++)) $
+   ("f32", QC.property (roundTrip :: RoundTrip Float)) :
+   ("f64", QC.property (roundTrip :: RoundTrip Double)) :
+   ("i1", QC.property (roundTrip :: RoundTrip Bool)) :
+   ("i2", QC.property (roundTrip :: RoundTrip Int2)) :
+   ("i3", QC.property (roundTrip :: RoundTrip Int3)) :
+   ("i24", QC.property (roundTrip :: RoundTrip Int24)) :
+   ("i64", QC.property (roundTrip :: RoundTrip Int64)) :
+   ("i2", QC.property (roundTrip :: RoundTrip Word2)) :
+   ("i3", QC.property (roundTrip :: RoundTrip Word3)) :
+   ("i17", QC.property (roundTrip :: RoundTrip Word17)) :
+   ("i32", QC.property (roundTrip :: RoundTrip Word32)) :
+   ("ptr", QC.property ((roundTrip :: RoundTrip (Ptr Word8)) . plusPtr nullPtr)) :
+   ("()", QC.property (roundTrip :: RoundTrip (LLVM.Struct ()))) :
+   ("struct-i8",
+      QC.property (roundTrip :: RoundTrip (LLVM.Struct (Word8,())))) :
+   ("struct-i8-i24",
+      QC.property (roundTrip :: RoundTrip (LLVM.Struct (Word8,(Int24,()))))) :
+   ("struct-i3-f32",
+      QC.property (roundTrip :: RoundTrip (LLVM.Struct (Int3,(Float,()))))) :
+   ("struct-i16-i1-i64",
+      QC.property
+         (roundTrip :: RoundTrip (LLVM.Struct (Int16,(Bool,(Word64,())))))) :
+   ("v8f32", QC.property (roundTrip :: RoundTripVec TypeNum.D8 Float)) :
+   ("v5f64", QC.property (roundTrip :: RoundTripVec TypeNum.D5 Double)) :
+   ("v7i1", QC.property (roundTrip :: RoundTripVec TypeNum.D7 Bool)) :
+   ("v13i1", QC.property (roundTrip :: RoundTripVec TypeNum.D13 Bool)) :
+   ("v4i2", QC.property (roundTrip :: RoundTripVec TypeNum.D4 Int2)) :
+   ("v10i2", QC.property (roundTrip :: RoundTripVec TypeNum.D10 Word2)) :
+   ("v7i3", QC.property (roundTrip :: RoundTripVec TypeNum.D7 Int3)) :
+   ("v5i3", QC.property (roundTrip :: RoundTripVec TypeNum.D5 Word3)) :
+   ("v9i24", QC.property (roundTrip :: RoundTripVec TypeNum.D9 Int24)) :
+   ("v3i17", QC.property (roundTrip :: RoundTripVec TypeNum.D3 Word17)) :
+   ("v5i8", QC.property (roundTrip :: RoundTripVec TypeNum.D5 Word8)) :
+   ("v3i16", QC.property (roundTrip :: RoundTripVec TypeNum.D3 Word16)) :
+   ("v4i8", QC.property (roundTrip :: RoundTripVec TypeNum.D4 Int8)) :
+   ("v7i32", QC.property (roundTrip :: RoundTripVec TypeNum.D7 Int32)) :
+   []
+
+
+type Importer func = FunPtr func -> func
+
+generateFunction ::
+   EE.ExecutionFunction f =>
+   Importer f -> LLVM.CodeGenModule (LLVM.Function f) -> IO f
+generateFunction imprt code = do
+   td <- EE.getTargetData
+   (m,func) <-
+      LLVM.createModule $ do
+         LLVM.setTarget LLVM.hostTriple
+         LLVM.setDataLayout $ EE.dataLayoutStr td
+         liftM2 (,) LLVM.getModule code
+   LLVM.writeBitcodeToFile "Test.bc" m
+   void $ Opt.optimizeModule 3 m
+   LLVM.writeBitcodeToFile "TestOpt.bc" m
+   EE.runEngineAccessWithModule m $ EE.getExecutionFunction imprt func
+
+
+foreign import ccall safe "dynamic" derefTestCasePtr ::
+   Importer (LLVM.Ptr inp -> LLVM.Ptr out -> IO ())
+
+modul ::
+   (LLVM.IsType inp, LLVM.IsType out) =>
+   (LLVM.Value inp -> LLVM.CodeGenFunction () (LLVM.Value out)) ->
+   LLVM.CodeGenModule (LLVM.Function (LLVM.Ptr inp -> LLVM.Ptr out -> IO ()))
+modul codegen =
+   LLVM.createFunction LLVM.ExternalLinkage $ \xPtr yPtr -> do
+      flip LLVM.store yPtr =<< codegen =<< LLVM.load xPtr
+      LLVM.ret ()
+
+run ::
+   (Show inp, EE.Marshal inp, EE.Marshal out) =>
+   QC.Gen inp ->
+   (LLVM.Value inp -> LLVM.CodeGenFunction () (LLVM.Value out)) ->
+   (inp -> out -> Bool) ->
+   IO QC.Property
+run qcgen codegen predicate = do
+   funIO <- generateFunction derefTestCasePtr $ modul codegen
+   return $ QC.forAll qcgen $ \x ->
+      QCMon.monadicIO $ do
+         y <-
+            QCMon.run $
+               EE.with x $ \xPtr ->
+               EE.alloca $ \yPtr -> do
+                  funIO xPtr yPtr
+                  EE.peek yPtr
+         QCMon.assert $ predicate x y
+
+
+type Extract n a = QC.Gen (LLVM.Vector n a, Word32)
+
+extractElem ::
+   (TypeNum.Positive n,
+    (n TypeNum.:*: LLVM.SizeOf a) ~ size, TypeNum.Natural size,
+    Show a, Eq a,
+    EE.MarshalVector a, EE.Marshal a, LLVM.IsSized a, LLVM.IsPrimitive a) =>
+   Extract n a -> IO QC.Property
+extractElem qcgen =
+   run
+      (fmap (uncurry LLVM.consStruct) qcgen)
+      (\vi -> do
+         v <- LLVM.extractvalue vi TypeNum.d0
+         i <- LLVM.extractvalue vi TypeNum.d1
+         LLVM.extractelement v i)
+      (LLVM.uncurryStruct $ \v i a ->
+         a == Fold.toList v !! fromIntegral i)
+
+
+vectorSize :: LLVM.Vector n a -> Proxy n
+vectorSize _ = Proxy
+
+genVector :: (TypeNum.Positive n, QC.Arbitrary a) => Extract n a
+genVector = do
+   v <- QC.arbitrary
+   i <- QC.choose (0, TypeNum.integralFromProxy (vectorSize v) - 1)
+   return (v,i)
+
+
+type Int2 = LLVM.IntN TypeNum.D2
+type Int3 = LLVM.IntN TypeNum.D3
+type Word2 = LLVM.WordN TypeNum.D2
+type Word3 = LLVM.WordN TypeNum.D3
+type Int24 = LLVM.IntN TypeNum.D24
+type Word17 = LLVM.IntN TypeNum.D17
+
+
+testsVector :: [(String, IO QC.Property)]
+testsVector =
+   map (mapFst ("Vector." ++)) $
+   ("v8f32", extractElem (genVector :: Extract TypeNum.D8 Float)) :
+   ("v5f64", extractElem (genVector :: Extract TypeNum.D5 Double)) :
+   ("v7i1", extractElem (genVector :: Extract TypeNum.D7 Bool)) :
+   ("v13i1", extractElem (genVector :: Extract TypeNum.D13 Bool)) :
+   ("v4i2", extractElem (genVector :: Extract TypeNum.D4 Int2)) :
+   ("v10i2", extractElem (genVector :: Extract TypeNum.D10 Word2)) :
+   -- ToDo: broken on LLVM<=9: https://bugs.llvm.org/show_bug.cgi?id=44915
+   ("v7i3", extractElem (genVector :: Extract TypeNum.D7 Int3)) :
+   ("v5i3", extractElem (genVector :: Extract TypeNum.D5 Word3)) :
+   ("v9i24", extractElem (genVector :: Extract TypeNum.D9 Int24)) :
+   ("v3i17", extractElem (genVector :: Extract TypeNum.D3 Word17)) :
+   ("v5i8", extractElem (genVector :: Extract TypeNum.D5 Word8)) :
+   ("v3i16", extractElem (genVector :: Extract TypeNum.D3 Word16)) :
+   ("v4i8", extractElem (genVector :: Extract TypeNum.D4 Int8)) :
+   ("v7i32", extractElem (genVector :: Extract TypeNum.D7 Int32)) :
+   []
+
+
+{-
+Conversion from a Ptr Word8 triggers improper optimization
+if target data layout is not set for module prior to optimization.
+-}
+runViaBytePtr ::
+   (Show inp, EE.Marshal inp, EE.Marshal out) =>
+   QC.Gen inp ->
+   (LLVM.Value inp -> LLVM.CodeGenFunction () (LLVM.Value out)) ->
+   (inp -> out -> Bool) ->
+   IO QC.Property
+runViaBytePtr qcgen codegen predicate = do
+   funIO <-
+      generateFunction derefTestCasePtr $
+         LLVM.createFunction LLVM.ExternalLinkage $ \xPtr yPtr -> do
+            flip LLVM.store yPtr =<< codegen =<< LLVM.load =<< LLVM.bitcast xPtr
+            LLVM.ret ()
+   return $ QC.forAll qcgen $ \x ->
+      QCMon.monadicIO $ do
+         y <-
+            QCMon.run $
+               EE.with x $ \xPtr ->
+               EE.alloca $ \yPtr -> do
+                  funIO (castToBytePtr xPtr) yPtr
+                  EE.peek yPtr
+         QCMon.assert $ predicate x y
+
+castToBytePtr :: LLVM.Ptr a -> LLVM.Ptr Word8
+castToBytePtr = LLVM.fromPtr . castPtr . LLVM.uncheckedToPtr
+
+extractValue ::
+   (QC.Arbitrary s, Show s, EE.Marshal s, EE.Marshal a, Eq a) =>
+   LP.Proxy s ->
+   (s -> a) ->
+   (forall r. LLVM.Value s -> LLVM.CodeGenFunction r (LLVM.Value a)) ->
+   Bool ->
+   IO QC.Property
+extractValue LP.Proxy select extract viaBytePtr =
+   (if viaBytePtr then runViaBytePtr else run)
+      QC.arbitrary extract (\s x -> select s == x)
+
+type Pair a b = LLVM.Struct (a,(b,()))
+type Triple a b c = LLVM.Struct (a,(b,(c,())))
+
+sfst :: LLVM.Struct (a,z) -> a
+sfst (LLVM.Struct (a,_)) = a
+ssnd :: LLVM.Struct (a,(b,z)) -> b
+ssnd (LLVM.Struct (_,(b,_))) = b
+sthd :: LLVM.Struct (a,(b,(c,z))) -> c
+sthd (LLVM.Struct (_,(_,(c,_)))) = c
+
+exv ::
+   (LLVM.GetField s i, TypeNum.Natural i, LLVM.FieldType s i ~ a) =>
+   Proxy i ->
+   LLVM.Value (LLVM.Struct s) -> LLVM.CodeGenFunction r (LLVM.Value a)
+exv = flip LLVM.extractvalue
+
+proxyA :: LP.Proxy (Triple Int16 Bool Word64)
+proxyA = LP.Proxy
+
+proxyB :: LP.Proxy (Triple Bool Bool Int8)
+proxyB = LP.Proxy
+
+proxyC :: LP.Proxy (Pair Bool (Pair Float Word64))
+proxyC = LP.Proxy
+
+testsStruct :: [(String, Bool -> IO QC.Property)]
+testsStruct =
+   ("{i16,i1,i64} 0",
+      extractValue proxyA sfst (exv TypeNum.d0)) :
+   ("{i16,i1,i64} 1",
+      extractValue proxyA ssnd (exv TypeNum.d1)) :
+   ("{i16,i1,i64} 2",
+      extractValue proxyA sthd (exv TypeNum.d2)) :
+   ("{i1,i1,i8} 0",
+      extractValue proxyB sfst (exv TypeNum.d0)) :
+   ("{i1,i1,i8} 1",
+      extractValue proxyB ssnd (exv TypeNum.d1)) :
+   ("{i1,i1,i8} 2",
+      extractValue proxyB sthd (exv TypeNum.d2)) :
+   ("{i1,{float,i64}} 0",
+      extractValue proxyC sfst (exv TypeNum.d0)) :
+   ("{i1,{float,i64}} 1 0",
+      extractValue proxyC (sfst.ssnd) (exv TypeNum.d0 <=< exv TypeNum.d1)) :
+   ("{i1,{float,i64}} 1 1",
+      extractValue proxyC (ssnd.ssnd) (exv TypeNum.d1 <=< exv TypeNum.d1)) :
+   []
+
+
+testsExtract :: [(String, IO QC.Property)]
+testsExtract =
+   map (mapFst ("Extract." ++)) $
+      testsVector ++
+      map (mapPair (("Struct." ++), ($False))) testsStruct ++
+      map (mapPair (("StructByte." ++), ($True))) testsStruct
diff --git a/test/TestValue.hs b/test/TestValue.hs
deleted file mode 100644
--- a/test/TestValue.hs
+++ /dev/null
@@ -1,69 +0,0 @@
-module TestValue (main) where
-    
-import qualified LLVM.Core as Core
-import qualified LLVM.Core.Type as T
-import qualified LLVM.Core.Value as V
-  
-testArguments :: (T.DynamicType r, T.Params p, V.Params p v, V.Value v)
-                 => T.Module -> String -> IO (V.Function r p)
-testArguments m name = do
-  func <- Core.addFunction m name (T.function undefined undefined)
-  V.dumpValue func
-  let arg = V.params func
-  V.dumpValue arg
-  return func
-  
-voidArguments :: T.Module -> IO ()
-voidArguments m = do
-  func <- Core.addFunction m "void" (T.function (undefined :: T.Void) ())
-  V.dumpValue func
-  return ()   
-
-type F a = V.Function a a
-type P a = V.Function (T.Pointer a) (T.Pointer a)
-type V a = V.Function (T.Vector a) (T.Vector a)
-
-arguments :: T.Module -> IO ()
-arguments m = do
-  voidArguments m
-
-  testArguments m "int1" :: IO (F T.Int1)
-  testArguments m "int8" :: IO (F T.Int8)
-  testArguments m "int16" :: IO (F T.Int16)
-  testArguments m "int32" :: IO (F T.Int32)
-  testArguments m "int64" :: IO (F T.Int64)
-  testArguments m "float" :: IO (F T.Float)
-  testArguments m "double" :: IO (F T.Double)
-  testArguments m "float128" :: IO (F T.Float128)
-  testArguments m "x86Float80" :: IO (F T.X86Float80)
-  testArguments m "ppcFloat128" :: IO (F T.PPCFloat128)
-
-  testArguments m "ptrInt1" :: IO (P T.Int1)
-  testArguments m "ptrInt8" :: IO (P T.Int8)
-  testArguments m "ptrInt16" :: IO (P T.Int16)
-  testArguments m "ptrInt32" :: IO (P T.Int32)
-  testArguments m "ptrInt64" :: IO (P T.Int64)
-  testArguments m "ptrFloat" :: IO (P T.Float)
-  testArguments m "ptrDouble" :: IO (P T.Double)
-  testArguments m "ptrFloat128" :: IO (P T.Float128)
-  testArguments m "ptrX86Float80" :: IO (P T.X86Float80)
-  testArguments m "ptrPpcFloat128" :: IO (P T.PPCFloat128)
-
-  testArguments m "vecInt1" :: IO (V T.Int1)
-  testArguments m "vecInt8" :: IO (V T.Int8)
-  testArguments m "vecInt16" :: IO (V T.Int16)
-  testArguments m "vecInt32" :: IO (V T.Int32)
-  testArguments m "vecInt64" :: IO (V T.Int64)
-  testArguments m "vecFloat" :: IO (V T.Float)
-  testArguments m "vecDouble" :: IO (V T.Double)
-  testArguments m "vecFloat128" :: IO (V T.Float128)
-  testArguments m "vecX86Float80" :: IO (V T.X86Float80)
-  testArguments m "vecPpcFloat128" :: IO (V T.PPCFloat128)
-
-  return ()
-
-main :: IO ()
-main = do
-  m <- Core.createModule "m"
-  arguments m
-  return ()