diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,31 @@
+Copyright (c) 2020, Henning Thielemann
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * The names of contributors may not be used to endorse or promote
+      products derived from this software without specific prior
+      written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Makefile b/Makefile
new file mode 100644
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,5 @@
+run-test:
+	runhaskell Setup.lhs configure --user -f-debug
+	runhaskell Setup.lhs build
+	runhaskell Setup.lhs configure --user -fdebug
+	runhaskell Setup.lhs build
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#! /usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/llvm-dsl.cabal b/llvm-dsl.cabal
new file mode 100644
--- /dev/null
+++ b/llvm-dsl.cabal
@@ -0,0 +1,100 @@
+Cabal-Version:  2.2
+Name:           llvm-dsl
+Version:        0.1.2
+License:        BSD-3-Clause
+License-File:   LICENSE
+Author:         Henning Thielemann <haskell@henning-thielemann.de>
+Maintainer:     Henning Thielemann <haskell@henning-thielemann.de>
+Homepage:       https://wiki.haskell.org/LLVM
+Category:       Compilers/Interpreters, Code Generation
+Synopsis:       Support for writing an EDSL with LLVM-JIT as target
+Description:
+  Support for writing an EDSL with LLVM-JIT as target.
+  .
+  * "LLVM.DSL.Expression":
+    Code snippets that represent arithmetics
+    and support arithmetic operators.
+  .
+  * "LLVM.DSL.Parameter":
+    Parameterize LLVM-generated code.
+  .
+  * "LLVM.DSL.Execution":
+    Assemble functions to modules and run them.
+Stability:      Experimental
+Tested-With:    GHC==7.0.4, GHC==7.4.2, GHC==7.8.4
+Tested-With:    GHC==8.4.4, GHC==8.6.5, GHC==8.8.4
+Tested-With:    GHC==9.0.2, GHC==9.2.8, GHC==9.4.6
+Build-Type:     Simple
+Extra-Source-Files:
+  Makefile
+
+Source-Repository head
+  Type:     darcs
+  Location: https://hub.darcs.net/thielema/llvm-dsl/
+
+Source-Repository this
+  Tag:      0.1.2
+  Type:     darcs
+  Location: https://hub.darcs.net/thielema/llvm-dsl/
+
+Flag debug
+  Description: Automatically dump LLVM Bitcode files for debugging
+  Default: False
+  Manual: True
+
+Library
+  Build-Depends:
+    llvm-extra >=0.11 && <0.13,
+    llvm-tf >=9.0 && <17.1,
+    tfp >=1.0 && <1.1,
+    numeric-prelude >=0.4.3 && <0.5,
+    storable-record >=0.0.5 && <0.1,
+    storable-enum >=0.0 && <0.1,
+    bool8 >=0.0 && <0.1,
+    vault >=0.3 && <0.4,
+    transformers >=0.1.1 && <0.7,
+    utility-ht >=0.0.15 && <0.1,
+    unsafe >=0.0 && <0.1,
+    prelude-compat >=0.0 && <0.0.1,
+    base >=3 && <5
+
+  Default-Language: Haskell98
+  GHC-Options: -Wall
+  Hs-source-dirs: src
+  If flag(debug)
+    Hs-source-dirs: src/debug-on
+  Else
+    Hs-source-dirs: src/debug-off
+  Exposed-Modules:
+    LLVM.DSL.Expression
+    LLVM.DSL.Expression.Vector
+    LLVM.DSL.Expression.Maybe
+    LLVM.DSL.Value
+    LLVM.DSL.Parameter
+    LLVM.DSL.Execution
+    LLVM.DSL.Render.Run
+    LLVM.DSL.Render.Argument
+    LLVM.DSL.Debug.Counter
+    LLVM.DSL.Debug.StablePtr
+    LLVM.DSL.Debug.Marshal
+    LLVM.DSL.Example.Median
+  Other-Modules:
+    LLVM.DSL.Dump
+
+Test-Suite llvm-dsl-test
+  Type: exitcode-stdio-1.0
+  Build-Depends:
+    doctest-exitcode-stdio >=0.0 && <0.1,
+    llvm-dsl,
+    llvm-extra,
+    llvm-tf,
+    tfp,
+    transformers,
+    base >=3 && <5
+
+  Default-Language: Haskell98
+  GHC-Options: -Wall
+  Hs-source-dirs: test
+  Main-Is: Main.hs
+  Other-Modules:
+    Test.LLVM.DSL.Example.Median
diff --git a/src/LLVM/DSL/Debug/Counter.hs b/src/LLVM/DSL/Debug/Counter.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/DSL/Debug/Counter.hs
@@ -0,0 +1,24 @@
+module LLVM.DSL.Debug.Counter where
+
+import qualified Data.IORef as IORef
+import qualified Data.List.HT as ListHT
+
+
+newtype T ident = Cons Int
+   deriving (Eq, Ord)
+
+instance Enum (T ident) where
+   fromEnum (Cons n) = n
+   toEnum n = (Cons n)
+
+format :: Int -> T ident -> String
+format pad (Cons n) = ListHT.padLeft '0' pad (show n)
+
+new :: IO (IORef.IORef (T ident))
+new = IORef.newIORef (Cons 0)
+
+next :: IORef.IORef (T ident) -> IO (T ident)
+next cnt = do
+   a <- IORef.readIORef cnt
+   IORef.modifyIORef cnt succ
+   return a
diff --git a/src/LLVM/DSL/Debug/Marshal.hs b/src/LLVM/DSL/Debug/Marshal.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/DSL/Debug/Marshal.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE Rank2Types #-}
+module LLVM.DSL.Debug.Marshal where
+
+import qualified LLVM.DSL.Debug.Counter as Counter
+
+import qualified Type.Data.Num.Decimal as TypeNum
+import Type.Base.Proxy (Proxy)
+
+import qualified LLVM.Extra.Marshal as Marshal
+import qualified LLVM.ExecutionEngine as EE
+import qualified LLVM.Util.Proxy as LP
+import qualified LLVM.Core as LLVM
+import LLVM.Core (Array, ConstValue, constOf)
+
+import qualified System.IO as IO
+import Numeric (showHex)
+
+import qualified Data.IORef as IORef
+import qualified Data.List as List
+
+import qualified Foreign.Storable as Store
+import Foreign.Marshal.Array (advancePtr)
+import Foreign.Storable (peek, peekByteOff)
+import Foreign.Ptr (Ptr, castPtr)
+import Data.Word (Word8, Word32)
+import System.IO.Unsafe (unsafePerformIO)
+
+import Control.Monad (when)
+import Data.Maybe (fromMaybe)
+
+
+data Dump = Dump
+
+dumpCounter :: IORef.IORef (Counter.T Dump)
+dumpCounter = unsafePerformIO Counter.new
+
+toBytePtr :: LLVM.Ptr a -> Ptr Word8
+toBytePtr = castPtr . LLVM.uncheckedToPtr
+
+format :: Marshal.C a => a -> IO String
+format a =
+   Marshal.with a $ \ptr ->
+      fmap (concatMap (\byte ->
+               (if byte<16 then ('0':) else id) (showHex byte ""))) $
+      mapM peek
+         (List.take (sizeOf a) $
+          List.iterate (flip advancePtr 1) $
+          toBytePtr ptr)
+
+dump :: Marshal.C a => FilePath -> a -> Counter.T Dump -> IO ()
+dump path a cnt =
+   IO.withBinaryFile
+      (path ++ Counter.format 3 cnt ++ ".dump")
+      IO.WriteMode $ \h ->
+   Marshal.with a $ \ptr ->
+   IO.hPutBuf h (toBytePtr ptr) (sizeOf a)
+
+
+type ArrayElem = Word32
+
+{-
+Unfortunately, you cannot 'alloca' or 'malloc' the constructed array,
+because an IsSized instance is missing.
+We may employ a specialised reifyIntegral for this purpose.
+-}
+withConstArray ::
+   Marshal.C a =>
+   a ->
+   (forall n. TypeNum.Natural n => ConstValue (Array n ArrayElem) -> b) ->
+   IO b
+withConstArray a f =
+   Marshal.with a $ \ptr -> do
+      content <-
+         mapM
+            (peekByteOff $ toBytePtr ptr)
+            (takeWhile (< sizeOf a)
+               [0, Store.sizeOf (undefined :: ArrayElem) ..])
+          :: IO [ArrayElem]
+      return $
+         fromMaybe (error "Debug.Storable.withConstArray: length must always be non-negative") $
+         TypeNum.reifyNatural (fromIntegral (length content))
+            (\n ->
+               let makeArray ::
+                      TypeNum.Natural n =>
+                      Proxy n -> [ConstValue ArrayElem] ->
+                      ConstValue (Array n ArrayElem)
+                   makeArray _ = LLVM.constArray
+               in  f (makeArray n (map constOf content)))
+
+
+traceMalloc :: Marshal.C a => a -> Int -> Ptr a -> IO (Ptr a)
+traceMalloc a size ptr = do
+   when False $ putStrLn $
+      showString "%addr" . shows ptr .
+      showString " = call float* @malloc(i8* getelementptr (i8* null, i32 " .
+      shows size .
+      showString "))   ; alignment " . shows (alignment a) $
+      ""
+   return ptr
+
+proxyFromData :: a -> LP.Proxy (Marshal.Struct a)
+proxyFromData _ = LP.Proxy
+
+sizeOf, alignment :: (Marshal.C a) => a -> Int
+sizeOf = EE.sizeOf . proxyFromData
+
+alignment = EE.alignment . proxyFromData
diff --git a/src/LLVM/DSL/Debug/StablePtr.hs b/src/LLVM/DSL/Debug/StablePtr.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/DSL/Debug/StablePtr.hs
@@ -0,0 +1,12 @@
+module LLVM.DSL.Debug.StablePtr where
+
+import Foreign.StablePtr (StablePtr, castStablePtrToPtr)
+import Control.Monad (when)
+
+
+{-# INLINE trace #-}
+trace :: String -> StablePtr a -> IO (StablePtr a)
+trace name s = do
+   when False $
+      putStrLn $ "EventIterator." ++ name ++ ": " ++ (show $ castStablePtrToPtr $ s)
+   return s
diff --git a/src/LLVM/DSL/Example/Median.hs b/src/LLVM/DSL/Example/Median.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/DSL/Example/Median.hs
@@ -0,0 +1,98 @@
+module LLVM.DSL.Example.Median where
+
+import qualified LLVM.DSL.Expression as Expr
+import LLVM.DSL.Expression (Exp, (==*), (<=*), (&&*), (||*))
+
+import qualified LLVM.Extra.Multi.Vector as MVec
+import qualified LLVM.Extra.Multi.Value as MV
+
+import qualified LLVM.Core as LLVM
+
+import Data.Tuple.HT (uncurry3)
+import Data.Word (Word8)
+
+
+
+median3IfThen :: (MV.Comparison a) => Exp a -> Exp a -> Exp a -> Exp a
+median3IfThen a b c =
+   Expr.ifThenElse (a<=*b)
+      (Expr.ifThenElse (b<=*c)
+         b
+         (Expr.ifThenElse (a<=*c) c a))
+      (Expr.ifThenElse (a<=*c)
+         a
+         (Expr.ifThenElse (b<=*c) c b))
+
+median3Select ::
+   (MV.Comparison a, MV.Select a) => Exp a -> Exp a -> Exp a -> Exp a
+median3Select a b c =
+   Expr.select (a<=*b)
+      (Expr.select (b<=*c)
+         b
+         (Expr.select (a<=*c) c a))
+      (Expr.select (a<=*c)
+         a
+         (Expr.select (b<=*c) c b))
+
+median3SelectShared ::
+   (MV.Comparison a, MV.Select a) => Exp a -> Exp a -> Exp a -> Exp a
+median3SelectShared a b c =
+   Expr.with (a<=*b) $ \a_le_b ->
+   Expr.with (b<=*c) $ \b_le_c ->
+   Expr.with (a<=*c) $ \a_le_c ->
+   Expr.select a_le_b
+      (Expr.select b_le_c b (Expr.select a_le_c c a))
+      (Expr.select a_le_c a (Expr.select b_le_c c b))
+
+median3MinMax ::
+   (MV.Comparison a, MV.Select a) => Exp a -> Exp a -> Exp a -> Exp a
+median3MinMax a b c =
+   let minab = Expr.min a b in
+   let maxab = Expr.max a b in
+   Expr.select (maxab <=* c) maxab $ Expr.select (minab <=* c) c minab
+
+median3MinMaxVector ::
+   (LLVM.Positive n, MVec.C a) =>
+   (MV.Comparison a, MV.Select a) =>
+   MVec.T n a -> MVec.T n a -> MVec.T n a ->
+   LLVM.CodeGenFunction r (MVec.T n a)
+median3MinMaxVector a b c =
+   MVec.map (uncurry3 (Expr.unliftM3 median3MinMax) . MV.unzip3) $
+   MVec.zip3 a b c
+
+
+type MV = MV.T
+
+median3Case ::
+   (MV.Comparison a, MV.Select a) =>
+   MV a -> MV a -> MV a -> LLVM.CodeGenFunction r (MV a)
+median3Case a b c = do
+   a_le_b <- MV.cmp LLVM.CmpLE a b
+   a_le_c <- MV.cmp LLVM.CmpLE a c
+   b_le_c <- MV.cmp LLVM.CmpLE b c
+   let mask = MV.fromInteger'
+   a_le_b_mask <- MV.select a_le_b (mask 1) (mask 0)
+   a_le_c_mask <- MV.select a_le_c (mask 2) (mask 0)
+   b_le_c_mask <- MV.select b_le_c (mask 4) (mask 0)
+   maskMV <- MV.or a_le_b_mask =<< MV.or a_le_c_mask b_le_c_mask
+   let maskE = Expr.lift0 (maskMV :: MV Word8)
+   selectB <- Expr.unExp (maskE ==* 0 ||* maskE ==* 7)
+   selectA <- Expr.unExp (maskE ==* 1 ||* maskE ==* 6)
+   MV.select selectA a =<< MV.select selectB b c
+
+median3CaseVec ::
+   (MV.Comparison a, MV.Select a) =>
+   MV a -> MV a -> MV a -> LLVM.CodeGenFunction r (MV a)
+median3CaseVec a b c = do
+   a_le_b <- MV.cmp LLVM.CmpLE a b
+   a_le_c <- MV.cmp LLVM.CmpLE a c
+   b_le_c <- MV.cmp LLVM.CmpLE b c
+   let check ab ac bc =
+         Expr.select (Expr.lift0 a_le_b) 1 0 ==* (ab :: Exp Word8)
+         &&*
+         Expr.select (Expr.lift0 a_le_c) 1 0 ==* (ac :: Exp Word8)
+         &&*
+         Expr.select (Expr.lift0 b_le_c) 1 0 ==* (bc :: Exp Word8)
+   selectB <- Expr.unExp (check 0 0 0 ||* check 1 1 1)
+   selectA <- Expr.unExp (check 1 0 0 ||* check 0 1 1)
+   MV.select selectA a =<< MV.select selectB b c
diff --git a/src/LLVM/DSL/Execution.hs b/src/LLVM/DSL/Execution.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/DSL/Execution.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE TypeFamilies #-}
+module LLVM.DSL.Execution where
+
+import qualified LLVM.DSL.Dump as Dump
+
+import qualified LLVM.Extra.Function as LLVMFunction
+
+import qualified LLVM.ExecutionEngine as EE
+import qualified LLVM.Util.Optimize as Opt
+import qualified LLVM.Core as LLVM
+
+import Foreign.Ptr (FunPtr)
+
+import Control.Monad (void, liftM2, when)
+import Control.Applicative (liftA2, pure, (<$>))
+
+import Data.Functor.Compose (Compose(Compose))
+
+import Prelude2010
+import Prelude ()
+
+
+dumper :: String -> IO (String -> LLVM.Module -> IO ())
+dumper = Dump.writer
+
+compile :: String -> Exec funcs -> IO funcs
+compile name (Compose bld) = do
+   LLVM.initializeNativeTarget
+   td <- EE.getTargetData
+   m <- LLVM.newNamedModule name
+   (funcs, mappings) <-
+      LLVM.defineModule m $ do
+         LLVM.setTarget LLVM.hostTriple
+         LLVM.setDataLayout $ EE.dataLayoutStr td
+         liftM2 (,) bld LLVM.getGlobalMappings
+   writeBitcodeToFile <- dumper name
+   writeBitcodeToFile "" m
+   when True $ do
+      void $ Opt.optimizeModule 3 m
+      writeBitcodeToFile "-opt" m
+   EE.runEngineAccessWithModule m $
+      EE.addGlobalMappings mappings >> funcs
+
+
+type Exec = Compose LLVM.CodeGenModule EE.EngineAccess
+type Importer f = FunPtr f -> f
+
+createLLVMFunction ::
+   (LLVMFunction.C f) =>
+   String -> LLVMFunction.CodeGen f -> LLVM.CodeGenModule (LLVM.Function f)
+createLLVMFunction = LLVMFunction.createNamed LLVM.ExternalLinkage
+
+createFunction ::
+   (EE.ExecutionFunction f, LLVMFunction.C f) =>
+   Importer f -> String -> LLVMFunction.CodeGen f -> Exec f
+createFunction importer name f =
+   Compose $ EE.getExecutionFunction importer <$> createLLVMFunction name f
+
+
+type Finalizer a = (EE.ExecutionEngine, LLVM.Ptr a -> IO ())
+
+createFinalizer ::
+   (EE.ExecutionFunction f, LLVMFunction.C f) =>
+   Importer f -> String -> LLVMFunction.CodeGen f ->
+   Exec (EE.ExecutionEngine, f)
+createFinalizer importer name f =
+   liftA2 (,)
+      (Compose $ pure EE.getEngine)
+      (createFunction importer name f)
diff --git a/src/LLVM/DSL/Expression.hs b/src/LLVM/DSL/Expression.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/DSL/Expression.hs
@@ -0,0 +1,839 @@
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module LLVM.DSL.Expression where
+
+import qualified LLVM.Extra.ScalarOrVector as SoV
+import qualified LLVM.Extra.Multi.Value as MultiValue
+import qualified LLVM.Extra.FastMath as FastMath
+import qualified LLVM.Extra.Scalar as Scalar
+import qualified LLVM.Extra.Arithmetic as A
+import qualified LLVM.Extra.Control as C
+import qualified LLVM.Core as LLVM
+import LLVM.Extra.Multi.Value (PatternTuple, Decomposed, Atom)
+
+import qualified Control.Monad.HT as Monad
+import Control.Monad.IO.Class (liftIO)
+
+import qualified Data.Enum.Storable as Enum
+import qualified Data.Tuple.HT as TupleHT
+import qualified Data.Tuple as Tuple
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import Data.Complex (Complex((:+)))
+import Data.Bool8 (Bool8)
+
+import qualified Foreign.Storable.Record.Tuple as StTuple
+
+import qualified Algebra.Transcendental as Trans
+import qualified Algebra.Algebraic as Algebraic
+import qualified Algebra.Absolute as Absolute
+import qualified Algebra.Module as Module
+import qualified Algebra.Field as Field
+import qualified Algebra.Ring as Ring
+import qualified Algebra.Additive as Additive
+
+import qualified Number.Complex as Complex
+
+import System.IO.Unsafe (unsafePerformIO)
+
+import qualified Prelude as P
+import Prelude hiding
+   (fst, snd, min, max, zip, unzip, zip3, unzip3,
+    curry, uncurry, recip, pi, sqrt, maybe, toEnum, fromEnum, pred, succ)
+
+
+newtype Exp a = Exp {unExp :: forall r. LLVM.CodeGenFunction r (MultiValue.T a)}
+
+
+{-
+Using IORef should be thread-safe here,
+because you cannot fork within CodeGenFunction.
+-}
+unique :: (forall r. LLVM.CodeGenFunction r (MultiValue.T a)) -> Exp a
+unique = Exp
+
+_unique :: (forall r. LLVM.CodeGenFunction r (MultiValue.T a)) -> Exp a
+_unique code = unsafePerformIO $ fmap (withKey code) $ newIORef Nothing
+
+withKey ::
+   (forall r. LLVM.CodeGenFunction r (MultiValue.T a)) ->
+   IORef (Maybe (MultiValue.T a)) -> Exp a
+withKey code ref =
+   Exp (do
+      ma <- liftIO $ readIORef ref
+      case ma of
+         Just a -> return a
+         Nothing -> do
+            a <- code
+            liftIO $ writeIORef ref $ Just a
+            return a)
+
+
+with :: Exp a -> (Exp a -> Exp b) -> Exp b
+with (Exp code) f =
+   Exp (do
+      a <- code
+      unExp (f (Exp (return a))))
+
+
+class Value val where
+   lift0 :: MultiValue.T a -> val a
+   lift1 ::
+      (MultiValue.T a -> MultiValue.T b) ->
+      val a -> val b
+   lift2 ::
+      (MultiValue.T a -> MultiValue.T b -> MultiValue.T c) ->
+      val a -> val b -> val c
+
+instance Value MultiValue.T where
+   lift0 = id
+   lift1 = id
+   lift2 = id
+
+instance Value Exp where
+   lift0 a = unique (return a)
+   lift1 f (Exp a) = unique (Monad.lift f a)
+   lift2 f (Exp a) (Exp b) = unique (Monad.lift2 f a b)
+
+lift3 ::
+   (Value val) =>
+   (MultiValue.T a -> MultiValue.T b -> MultiValue.T c -> MultiValue.T d) ->
+   val a -> val b -> val c -> val d
+lift3 f a b = lift2 (MultiValue.uncurry f) (zip a b)
+
+lift4 ::
+   (Value val) =>
+   (MultiValue.T a -> MultiValue.T b -> MultiValue.T c -> MultiValue.T d ->
+    MultiValue.T e) ->
+   val a -> val b -> val c -> val d -> val e
+lift4 f a b = lift3 (MultiValue.uncurry f) (zip a b)
+
+
+
+liftM ::
+   (Aggregate ae am) =>
+   (forall r.
+    am -> LLVM.CodeGenFunction r (MultiValue.T b)) ->
+   (ae -> Exp b)
+liftM f a = unique (f =<< bundle a)
+
+liftM2 ::
+   (Aggregate ae am) =>
+   (Aggregate be bm) =>
+   (forall r.
+    am -> bm -> LLVM.CodeGenFunction r (MultiValue.T c)) ->
+   (ae -> be -> Exp c)
+liftM2 f a b = unique (Monad.liftJoin2 f (bundle a) (bundle b))
+
+liftM3 ::
+   (Aggregate ae am) =>
+   (Aggregate be bm) =>
+   (Aggregate ce cm) =>
+   (forall r.
+    am -> bm -> cm -> LLVM.CodeGenFunction r (MultiValue.T d)) ->
+   (ae -> be -> ce -> Exp d)
+liftM3 f a b c = unique (Monad.liftJoin3 f (bundle a) (bundle b) (bundle c))
+
+
+unliftM1 ::
+   (Aggregate ae am) =>
+   (Aggregate be bm) =>
+   (ae -> be) ->
+   am -> LLVM.CodeGenFunction r bm
+unliftM1 f ix = bundle (f (dissect ix))
+
+unliftM2 ::
+   (Aggregate ae am) =>
+   (Aggregate be bm) =>
+   (Aggregate ce cm) =>
+   (ae -> be -> ce) ->
+   am -> bm -> LLVM.CodeGenFunction r cm
+unliftM2 f ix jx = bundle (f (dissect ix) (dissect jx))
+
+unliftM3 ::
+   (Aggregate ae am) =>
+   (Aggregate be bm) =>
+   (Aggregate ce cm) =>
+   (Aggregate de dm) =>
+   (ae -> be -> ce -> de) ->
+   am -> bm -> cm -> LLVM.CodeGenFunction r dm
+unliftM3 f ix jx kx = bundle (f (dissect ix) (dissect jx) (dissect kx))
+
+unliftM4 ::
+   (Aggregate ae am) =>
+   (Aggregate be bm) =>
+   (Aggregate ce cm) =>
+   (Aggregate de dm) =>
+   (Aggregate ee em) =>
+   (ae -> be -> ce -> de -> ee) ->
+   am -> bm -> cm -> dm -> LLVM.CodeGenFunction r em
+unliftM4 f ix jx kx lx =
+   bundle (f (dissect ix) (dissect jx) (dissect kx) (dissect lx))
+
+
+liftReprM ::
+   (forall r.
+    MultiValue.Repr a ->
+    LLVM.CodeGenFunction r (MultiValue.Repr b)) ->
+   (Exp a -> Exp b)
+liftReprM f = liftM (MultiValue.liftM f)
+
+liftReprM2 ::
+   (forall r.
+    MultiValue.Repr a -> MultiValue.Repr b ->
+    LLVM.CodeGenFunction r (MultiValue.Repr c)) ->
+   (Exp a -> Exp b -> Exp c)
+liftReprM2 f = liftM2 (MultiValue.liftM2 f)
+
+liftReprM3 ::
+   (forall r.
+    MultiValue.Repr a -> MultiValue.Repr b -> MultiValue.Repr c ->
+    LLVM.CodeGenFunction r (MultiValue.Repr d)) ->
+   (Exp a -> Exp b -> Exp c -> Exp d)
+liftReprM3 f = liftM3 (MultiValue.liftM3 f)
+
+
+
+zip :: (Value val) => val a -> val b -> val (a, b)
+zip = lift2 MultiValue.zip
+
+zip3 :: (Value val) => val a -> val b -> val c -> val (a, b, c)
+zip3 = lift3 MultiValue.zip3
+
+zip4 :: (Value val) => val a -> val b -> val c -> val d -> val (a, b, c, d)
+zip4 = lift4 MultiValue.zip4
+
+unzip :: (Value val) => val (a, b) -> (val a, val b)
+unzip ab = (fst ab, snd ab)
+
+unzip3 :: (Value val) => val (a, b, c) -> (val a, val b, val c)
+unzip3 abc = (fst3 abc, snd3 abc, thd3 abc)
+
+unzip4 :: (Value val) => val (a, b, c, d) -> (val a, val b, val c, val d)
+unzip4 abcd =
+   (lift1 (\(MultiValue.Cons (a,_,_,_)) -> MultiValue.Cons a) abcd,
+    lift1 (\(MultiValue.Cons (_,b,_,_)) -> MultiValue.Cons b) abcd,
+    lift1 (\(MultiValue.Cons (_,_,c,_)) -> MultiValue.Cons c) abcd,
+    lift1 (\(MultiValue.Cons (_,_,_,d)) -> MultiValue.Cons d) abcd)
+
+
+fst :: (Value val) => val (a, b) -> val a
+fst = lift1 MultiValue.fst
+
+snd :: (Value val) => val (a, b) -> val b
+snd = lift1 MultiValue.snd
+
+mapFst :: (Exp a -> Exp b) -> Exp (a, c) -> Exp (b, c)
+mapFst f = liftM (MultiValue.mapFstF (unliftM1 f))
+
+mapSnd :: (Exp b -> Exp c) -> Exp (a, b) -> Exp (a, c)
+mapSnd f = liftM (MultiValue.mapSndF (unliftM1 f))
+
+mapPair :: (Exp a0 -> Exp a1, Exp b0 -> Exp b1) -> Exp (a0, b0) -> Exp (a1, b1)
+mapPair (f,g) = mapFst f . mapSnd g
+
+swap :: (Value val) => val (a, b) -> val (b, a)
+swap = lift1 MultiValue.swap
+
+curry :: (Exp (a,b) -> c) -> (Exp a -> Exp b -> c)
+curry f = Tuple.curry (f . Tuple.uncurry zip)
+
+uncurry :: (Exp a -> Exp b -> c) -> (Exp (a,b) -> c)
+uncurry f = Tuple.uncurry f . unzip
+
+
+fst3 :: (Value val) => val (a,b,c) -> val a
+fst3 = lift1 MultiValue.fst3
+
+snd3 :: (Value val) => val (a,b,c) -> val b
+snd3 = lift1 MultiValue.snd3
+
+thd3 :: (Value val) => val (a,b,c) -> val c
+thd3 = lift1 MultiValue.thd3
+
+mapFst3 :: (Exp a0 -> Exp a1) -> Exp (a0,b,c) -> Exp (a1,b,c)
+mapFst3 f = liftM (MultiValue.mapFst3F (unliftM1 f))
+
+mapSnd3 :: (Exp b0 -> Exp b1) -> Exp (a,b0,c) -> Exp (a,b1,c)
+mapSnd3 f = liftM (MultiValue.mapSnd3F (unliftM1 f))
+
+mapThd3 :: (Exp c0 -> Exp c1) -> Exp (a,b,c0) -> Exp (a,b,c1)
+mapThd3 f = liftM (MultiValue.mapThd3F (unliftM1 f))
+
+mapTriple ::
+   (Exp a0 -> Exp a1, Exp b0 -> Exp b1, Exp c0 -> Exp c1) ->
+   Exp (a0,b0,c0) -> Exp (a1,b1,c1)
+mapTriple (f,g,h) = mapFst3 f . mapSnd3 g . mapThd3 h
+
+
+tuple :: Exp tuple -> Exp (StTuple.Tuple tuple)
+tuple = lift1 MultiValue.tuple
+
+untuple :: Exp (StTuple.Tuple tuple) -> Exp tuple
+untuple = lift1 MultiValue.untuple
+
+
+modifyMultiValue ::
+   (Value val,
+    MultiValue.Compose a,
+    MultiValue.Decompose pattern,
+    MultiValue.PatternTuple pattern ~ tuple) =>
+   pattern ->
+   (Decomposed MultiValue.T pattern -> a) ->
+   val tuple -> val (MultiValue.Composed a)
+modifyMultiValue p f = lift1 $ MultiValue.modify p f
+
+modifyMultiValue2 ::
+   (Value val,
+    MultiValue.Compose a,
+    MultiValue.Decompose patternA,
+    MultiValue.Decompose patternB,
+    MultiValue.PatternTuple patternA ~ tupleA,
+    MultiValue.PatternTuple patternB ~ tupleB) =>
+   patternA ->
+   patternB ->
+   (Decomposed MultiValue.T patternA ->
+    Decomposed MultiValue.T patternB -> a) ->
+   val tupleA -> val tupleB -> val (MultiValue.Composed a)
+modifyMultiValue2 pa pb f = lift2 $ MultiValue.modify2 pa pb f
+
+modifyMultiValueM ::
+   (MultiValue.Compose a,
+    MultiValue.Decompose pattern,
+    MultiValue.PatternTuple pattern ~ tuple) =>
+   pattern ->
+   (forall r.
+    Decomposed MultiValue.T pattern ->
+    LLVM.CodeGenFunction r a) ->
+   Exp tuple -> Exp (MultiValue.Composed a)
+modifyMultiValueM p f = liftM (MultiValue.modifyF p f)
+
+modifyMultiValueM2 ::
+   (MultiValue.Compose a,
+    MultiValue.Decompose patternA,
+    MultiValue.Decompose patternB,
+    MultiValue.PatternTuple patternA ~ tupleA,
+    MultiValue.PatternTuple patternB ~ tupleB) =>
+   patternA ->
+   patternB ->
+   (forall r.
+    Decomposed MultiValue.T patternA ->
+    Decomposed MultiValue.T patternB ->
+    LLVM.CodeGenFunction r a) ->
+   Exp tupleA -> Exp tupleB -> Exp (MultiValue.Composed a)
+modifyMultiValueM2 pa pb f = liftM2 (MultiValue.modifyF2 pa pb f)
+
+
+class Compose multituple where
+   type Composed multituple
+   {- |
+   A nested 'zip'.
+   -}
+   compose :: multituple -> Exp (Composed multituple)
+
+class
+   (Composed (Decomposed Exp pattern) ~ PatternTuple pattern) =>
+      Decompose pattern where
+   {- |
+   Analogous to 'MultiValue.decompose'.
+   -}
+   decompose :: pattern -> Exp (PatternTuple pattern) -> Decomposed Exp pattern
+
+
+{- |
+Analogus to 'MultiValue.modifyMultiValue'.
+-}
+modify ::
+   (Compose a, Decompose pattern) =>
+   pattern ->
+   (Decomposed Exp pattern -> a) ->
+   Exp (PatternTuple pattern) -> Exp (Composed a)
+modify p f = compose . f . decompose p
+
+modify2 ::
+   (Compose a, Decompose patternA, Decompose patternB) =>
+   patternA ->
+   patternB ->
+   (Decomposed Exp patternA -> Decomposed Exp patternB -> a) ->
+   Exp (PatternTuple patternA) ->
+   Exp (PatternTuple patternB) -> Exp (Composed a)
+modify2 pa pb f a b = compose $ f (decompose pa a) (decompose pb b)
+
+
+
+instance Compose (Exp a) where
+   type Composed (Exp a) = a
+   compose = id
+
+instance Decompose (Atom a) where
+   decompose _ = id
+
+
+
+instance Compose () where
+   type Composed () = ()
+   compose = cons
+
+instance Decompose () where
+   decompose _ _ = ()
+
+
+instance (Compose a, Compose b) => Compose (a,b) where
+   type Composed (a,b) = (Composed a, Composed b)
+   compose = Tuple.uncurry zip . TupleHT.mapPair (compose, compose)
+
+instance (Decompose pa, Decompose pb) => Decompose (pa,pb) where
+   decompose (pa,pb) =
+      TupleHT.mapPair (decompose pa, decompose pb) . unzip
+
+
+instance (Compose a, Compose b, Compose c) => Compose (a,b,c) where
+   type Composed (a,b,c) = (Composed a, Composed b, Composed c)
+   compose =
+      TupleHT.uncurry3 zip3 . TupleHT.mapTriple (compose, compose, compose)
+
+instance
+   (Decompose pa, Decompose pb, Decompose pc) =>
+      Decompose (pa,pb,pc) where
+   decompose (pa,pb,pc) =
+      TupleHT.mapTriple (decompose pa, decompose pb, decompose pc) . unzip3
+
+
+instance (Compose a, Compose b, Compose c, Compose d) => Compose (a,b,c,d) where
+   type Composed (a,b,c,d) = (Composed a, Composed b, Composed c, Composed d)
+   compose (a,b,c,d) = zip4 (compose a) (compose b) (compose c) (compose d)
+
+instance
+   (Decompose pa, Decompose pb, Decompose pc, Decompose pd) =>
+      Decompose (pa,pb,pc,pd) where
+   decompose (pa,pb,pc,pd) x =
+      case unzip4 x of
+         (a,b,c,d) ->
+            (decompose pa a, decompose pb b, decompose pc c, decompose pd d)
+
+
+instance (Compose tuple) => Compose (StTuple.Tuple tuple) where
+   type Composed (StTuple.Tuple tuple) = StTuple.Tuple (Composed tuple)
+   compose (StTuple.Tuple tup) = tuple $ compose tup
+
+instance (Decompose p) => Decompose (StTuple.Tuple p) where
+   decompose (StTuple.Tuple p) = StTuple.Tuple . decompose p . untuple
+
+
+instance (Compose a) => Compose (Complex a) where
+   type Composed (Complex a) = Complex (Composed a)
+   compose (r:+i) = consComplex (compose r) (compose i)
+
+instance (Decompose p) => Decompose (Complex p) where
+   decompose (pr:+pi) =
+      Tuple.uncurry (:+) .
+      TupleHT.mapPair (decompose pr, decompose pi) . deconsComplex
+
+{- |
+You can construct complex numbers this way,
+but they will not make you happy,
+because the numeric operations require a RealFloat instance
+that we could only provide with lots of undefined methods
+(also in its superclasses).
+You may either define your own arithmetic
+or use the NumericPrelude type classes.
+-}
+consComplex :: Exp a -> Exp a -> Exp (Complex a)
+consComplex = lift2 MultiValue.consComplex
+
+deconsComplex :: Exp (Complex a) -> (Exp a, Exp a)
+deconsComplex c = (lift1 MultiValue.realPart c, lift1 MultiValue.imagPart c)
+
+
+class (MultiValuesOf exp ~ mv, ExpressionsOf mv ~ exp) => Aggregate exp mv where
+   type MultiValuesOf exp
+   type ExpressionsOf mv
+   bundle :: exp -> LLVM.CodeGenFunction r mv
+   dissect :: mv -> exp
+
+instance Aggregate (Exp a) (MultiValue.T a) where
+   type MultiValuesOf (Exp a) = MultiValue.T a
+   type ExpressionsOf (MultiValue.T a) = Exp a
+   bundle (Exp x) = x
+   dissect x = Exp (return x)
+
+instance (Aggregate ae al, Aggregate be bl) => Aggregate (ae,be) (al,bl) where
+   type MultiValuesOf (ae,be) = (MultiValuesOf ae, MultiValuesOf be)
+   type ExpressionsOf (al,bl) = (ExpressionsOf al, ExpressionsOf bl)
+   bundle (a,b) = Monad.lift2 (,) (bundle a) (bundle b)
+   dissect (a,b) = (dissect a, dissect b)
+
+instance
+   (Aggregate ae al, Aggregate be bl, Aggregate ce cl) =>
+      Aggregate (ae,be,ce) (al,bl,cl) where
+   type MultiValuesOf (ae,be,ce) =
+            (MultiValuesOf ae, MultiValuesOf be, MultiValuesOf ce)
+   type ExpressionsOf (al,bl,cl) =
+            (ExpressionsOf al, ExpressionsOf bl, ExpressionsOf cl)
+   bundle (a,b,c) = Monad.lift3 (,,) (bundle a) (bundle b) (bundle c)
+   dissect (a,b,c) = (dissect a, dissect b, dissect c)
+
+instance
+   (Aggregate ae al, Aggregate be bl, Aggregate ce cl, Aggregate de dl) =>
+      Aggregate (ae,be,ce,de) (al,bl,cl,dl) where
+   type MultiValuesOf (ae,be,ce,de) =
+            (MultiValuesOf ae, MultiValuesOf be,
+             MultiValuesOf ce, MultiValuesOf de)
+   type ExpressionsOf (al,bl,cl,dl) =
+            (ExpressionsOf al, ExpressionsOf bl,
+             ExpressionsOf cl, ExpressionsOf dl)
+   bundle (a,b,c,d) =
+      Monad.lift4 (,,,) (bundle a) (bundle b) (bundle c) (bundle d)
+   dissect (a,b,c,d) = (dissect a, dissect b, dissect c, dissect d)
+
+instance (Aggregate ae al) => Aggregate (Complex.T ae) (Complex.T al) where
+   type MultiValuesOf (Complex.T ae) = Complex.T (MultiValuesOf ae)
+   type ExpressionsOf (Complex.T al) = Complex.T (ExpressionsOf al)
+   dissect = fmap dissect
+   bundle c =
+      Monad.lift2 (Complex.+:)
+         (bundle $ Complex.real c) (bundle $ Complex.imag c)
+
+
+-- ToDo: move to numericprelude?
+newtype Scalar a = Scalar a
+
+instance (Aggregate exp mv) => Aggregate (Scalar exp) (Scalar.T mv) where
+   type MultiValuesOf (Scalar exp) = Scalar.T (MultiValuesOf exp)
+   type ExpressionsOf (Scalar.T mv)  = Scalar (ExpressionsOf mv)
+   bundle (Scalar x) = Scalar.Cons <$> bundle x
+   dissect (Scalar.Cons x) = Scalar $ dissect x
+
+instance (Additive.C a) => Additive.C (Scalar a) where
+   zero = Scalar Additive.zero
+   Scalar a + Scalar b = Scalar (a Additive.+ b)
+   Scalar a - Scalar b = Scalar (a Additive.- b)
+   negate (Scalar a) = Scalar $ Additive.negate a
+
+instance (Ring.C a) => Ring.C (Scalar a) where
+   Scalar a * Scalar b = Scalar (a Ring.* b)
+   fromInteger = Scalar . Ring.fromInteger
+
+instance (Ring.C a, a~b) => Module.C (Scalar a) (Scalar b) where
+   Scalar a *> Scalar b = Scalar (a Ring.* b)
+
+
+cons :: (MultiValue.C a) => a -> Exp a
+cons = lift0 . MultiValue.cons
+
+unit :: Exp ()
+unit = cons ()
+
+zero :: (MultiValue.C a) => Exp a
+zero = lift0 MultiValue.zero
+
+add :: (MultiValue.Additive a) => Exp a -> Exp a -> Exp a
+add = liftM2 MultiValue.add
+
+sub :: (MultiValue.Additive a) => Exp a -> Exp a -> Exp a
+sub = liftM2 MultiValue.sub
+
+neg :: (MultiValue.Additive a) => Exp a -> Exp a
+neg = liftM MultiValue.neg
+
+one :: (MultiValue.IntegerConstant a) => Exp a
+one = fromInteger' 1
+
+mul :: (MultiValue.PseudoRing a) => Exp a -> Exp a -> Exp a
+mul = liftM2 MultiValue.mul
+
+sqr :: (MultiValue.PseudoRing a) => Exp a -> Exp a
+sqr = liftM $ \x -> MultiValue.mul x x
+
+recip :: (MultiValue.Field a, MultiValue.IntegerConstant a) => Exp a -> Exp a
+recip = fdiv one
+
+fdiv :: (MultiValue.Field a) => Exp a -> Exp a -> Exp a
+fdiv = liftM2 MultiValue.fdiv
+
+sqrt :: (MultiValue.Algebraic a) => Exp a -> Exp a
+sqrt = liftM MultiValue.sqrt
+
+pow :: (MultiValue.Transcendental a) => Exp a -> Exp a -> Exp a
+pow = liftM2 MultiValue.pow
+
+idiv :: (MultiValue.Integral a) => Exp a -> Exp a -> Exp a
+idiv = liftM2 MultiValue.idiv
+
+irem :: (MultiValue.Integral a) => Exp a -> Exp a -> Exp a
+irem = liftM2 MultiValue.irem
+
+shl :: (MultiValue.BitShift a) => Exp a -> Exp a -> Exp a
+shl = liftM2 MultiValue.shl
+
+shr :: (MultiValue.BitShift a) => Exp a -> Exp a -> Exp a
+shr = liftM2 MultiValue.shr
+
+fromInteger' :: (MultiValue.IntegerConstant a) => Integer -> Exp a
+fromInteger' = lift0 . MultiValue.fromInteger'
+
+fromRational' :: (MultiValue.RationalConstant a) => Rational -> Exp a
+fromRational' = lift0 . MultiValue.fromRational'
+
+
+boolPFrom8 :: Exp Bool8 -> Exp Bool
+boolPFrom8 = lift1 MultiValue.boolPFrom8
+
+bool8FromP :: Exp Bool -> Exp Bool8
+bool8FromP = lift1 MultiValue.bool8FromP
+
+intFromBool8 :: (MultiValue.NativeInteger i ir) => Exp Bool8 -> Exp i
+intFromBool8 = liftM MultiValue.intFromBool8
+
+floatFromBool8 :: (MultiValue.NativeFloating a ar) => Exp Bool8 -> Exp a
+floatFromBool8 = liftM MultiValue.floatFromBool8
+
+
+toEnum ::
+   (MultiValue.Repr w ~ LLVM.Value w) =>
+   Exp w -> Exp (Enum.T w e)
+toEnum = lift1 MultiValue.toEnum
+
+fromEnum ::
+   (MultiValue.Repr w ~ LLVM.Value w) =>
+   Exp (Enum.T w e) -> Exp w
+fromEnum = lift1 MultiValue.fromEnum
+
+succ, pred ::
+   (LLVM.IsArithmetic w, SoV.IntegerConstant w) =>
+   Exp (Enum.T w e) -> Exp (Enum.T w e)
+succ = liftM MultiValue.succ
+pred = liftM MultiValue.pred
+
+
+fromFastMath :: Exp (FastMath.Number flags a) -> Exp a
+fromFastMath = lift1 FastMath.mvDenumber
+
+toFastMath :: Exp a -> Exp (FastMath.Number flags a)
+toFastMath = lift1 FastMath.mvNumber
+
+
+minBound, maxBound :: (MultiValue.Bounded a) => Exp a
+minBound = lift0 MultiValue.minBound
+maxBound = lift0 MultiValue.maxBound
+
+
+cmp ::
+   (MultiValue.Comparison a) =>
+   LLVM.CmpPredicate -> Exp a -> Exp a -> Exp Bool
+cmp ord = liftM2 (MultiValue.cmp ord)
+
+infix 4 ==*, /=*, <*, <=*, >*, >=*
+
+(==*), (/=*), (<*), (>=*), (>*), (<=*) ::
+   (MultiValue.Comparison a) => Exp a -> Exp a -> Exp Bool
+(==*) = cmp LLVM.CmpEQ
+(/=*) = cmp LLVM.CmpNE
+(<*)  = cmp LLVM.CmpLT
+(>=*) = cmp LLVM.CmpGE
+(>*)  = cmp LLVM.CmpGT
+(<=*) = cmp LLVM.CmpLE
+
+
+min, max :: (MultiValue.Real a) => Exp a -> Exp a -> Exp a
+min = liftM2 A.min
+max = liftM2 A.max
+
+limit :: (MultiValue.Real a) => (Exp a, Exp a) -> Exp a -> Exp a
+limit (l,u) = max l . min u
+
+fraction :: (MultiValue.Fraction a) => Exp a -> Exp a
+fraction = liftM MultiValue.fraction
+
+
+true, false :: Exp Bool
+true = cons True
+false = cons False
+
+infixr 3 &&*
+(&&*) :: Exp Bool -> Exp Bool -> Exp Bool
+(&&*) = liftM2 MultiValue.and
+
+infixr 2 ||*
+(||*) :: Exp Bool -> Exp Bool -> Exp Bool
+(||*) = liftM2 MultiValue.or
+
+not :: Exp Bool -> Exp Bool
+not = liftM MultiValue.inv
+
+{- |
+Like 'ifThenElse' but computes both alternative expressions
+and then uses LLVM's efficient @select@ instruction.
+-}
+select :: (MultiValue.Select a) => Exp Bool -> Exp a -> Exp a -> Exp a
+select = liftM3 MultiValue.select
+
+ifThenElse :: (MultiValue.C a) => Exp Bool -> Exp a -> Exp a -> Exp a
+ifThenElse ec ex ey =
+   unique (do
+      MultiValue.Cons c <- unExp ec
+      C.ifThenElse c (unExp ex) (unExp ey))
+
+
+complement :: (MultiValue.Logic a) => Exp a -> Exp a
+complement = liftM MultiValue.inv
+
+infixl 7 .&.*
+(.&.*) :: (MultiValue.Logic a) => Exp a -> Exp a -> Exp a
+(.&.*) = liftM2 MultiValue.and
+
+infixl 5 .|.*
+(.|.*) :: (MultiValue.Logic a) => Exp a -> Exp a -> Exp a
+(.|.*) = liftM2 MultiValue.or
+
+infixl 6 `xor`
+xor :: (MultiValue.Logic a) => Exp a -> Exp a -> Exp a
+xor = liftM2 MultiValue.xor
+
+
+toMaybe :: Exp Bool -> Exp a -> Exp (Maybe a)
+toMaybe = lift2 MultiValue.toMaybe
+
+maybe :: (MultiValue.C b) => Exp b -> (Exp a -> Exp b) -> Exp (Maybe a) -> Exp b
+maybe n j = liftM $ \m -> do
+   let (MultiValue.Cons b, a) = MultiValue.splitMaybe m
+   C.ifThenElse b (unliftM1 j a) (unExp n)
+
+
+instance
+   (MultiValue.PseudoRing a, MultiValue.Real a, MultiValue.IntegerConstant a) =>
+      Num (Exp a) where
+   fromInteger = fromInteger'
+   (+) = add
+   (-) = sub
+   negate = neg
+   (*) = mul
+   abs = liftM MultiValue.abs
+   signum = liftM MultiValue.signum
+
+instance
+   (MultiValue.Field a, MultiValue.Real a, MultiValue.RationalConstant a) =>
+      Fractional (Exp a) where
+   fromRational = fromRational'
+   (/) = fdiv
+
+instance
+   (MultiValue.Transcendental a, MultiValue.Real a,
+    MultiValue.RationalConstant a) =>
+      Floating (Exp a) where
+   pi = unique MultiValue.pi
+   sin = liftM MultiValue.sin
+   cos = liftM MultiValue.cos
+   sqrt = sqrt
+   (**) = pow
+   exp = liftM MultiValue.exp
+   log = liftM MultiValue.log
+
+   asin _ = error "LLVM missing intrinsic: asin"
+   acos _ = error "LLVM missing intrinsic: acos"
+   atan _ = error "LLVM missing intrinsic: atan"
+
+   sinh x  = (exp x - exp (-x)) / 2
+   cosh x  = (exp x + exp (-x)) / 2
+   asinh x = log (x + sqrt (x*x + 1))
+   acosh x = log (x + sqrt (x*x - 1))
+   atanh x = (log (1 + x) - log (1 - x)) / 2
+
+
+{- |
+We do not require a numeric prelude superclass,
+thus also LLVM only types like vectors are instances.
+-}
+instance (MultiValue.Additive a) => Additive.C (Exp a) where
+   zero = zero
+   (+) = add
+   (-) = sub
+   negate = neg
+
+instance
+   (MultiValue.PseudoRing a, MultiValue.IntegerConstant a) =>
+      Ring.C (Exp a) where
+   one = one
+   (*) = mul
+   fromInteger = fromInteger'
+
+{-
+This instance is enough for Module here.
+The difference to Module instances on Haskell tuples is,
+that LLVM vectors cannot be nested.
+-}
+instance
+   (a ~ MultiValue.Scalar v,
+    MultiValue.PseudoModule v, MultiValue.IntegerConstant a) =>
+      Module.C (Exp a) (Exp v) where
+   (*>) = liftM2 MultiValue.scale
+
+instance
+   (MultiValue.Field a, MultiValue.RationalConstant a) =>
+      Field.C (Exp a) where
+   (/) = fdiv
+   fromRational' = fromRational' . Field.fromRational'
+
+instance
+   (MultiValue.Transcendental a, MultiValue.RationalConstant a) =>
+      Algebraic.C (Exp a) where
+   sqrt = sqrt
+   root n x = pow x (recip $ fromInteger' n)
+   x^/r = pow x (Field.fromRational' r)
+
+
+tau :: (MultiValue.Transcendental a, MultiValue.RationalConstant a) => Exp a
+tau = mul (fromInteger' 2) Trans.pi
+
+instance
+   (MultiValue.Transcendental a, MultiValue.RationalConstant a) =>
+      Trans.C (Exp a) where
+   pi = unique MultiValue.pi
+   sin = liftM MultiValue.sin
+   cos = liftM MultiValue.cos
+   (**) = pow
+   exp = liftM MultiValue.exp
+   log = liftM MultiValue.log
+
+   asin _ = error "LLVM missing intrinsic: asin"
+   acos _ = error "LLVM missing intrinsic: acos"
+   atan _ = error "LLVM missing intrinsic: atan"
+
+
+instance
+   (MultiValue.Real a, MultiValue.PseudoRing a, MultiValue.IntegerConstant a) =>
+      Absolute.C (Exp a) where
+   abs = liftM MultiValue.abs
+   signum = liftM MultiValue.signum
+
+
+fromIntegral ::
+   (MultiValue.NativeInteger i ir, MultiValue.NativeFloating a ar) =>
+   Exp i -> Exp a
+fromIntegral = liftM MultiValue.fromIntegral
+
+truncateToInt ::
+   (MultiValue.NativeInteger i ir, MultiValue.NativeFloating a ar) =>
+   Exp a -> Exp i
+truncateToInt = liftM MultiValue.truncateToInt
+
+floorToInt ::
+   (MultiValue.NativeInteger i ir, MultiValue.NativeFloating a ar) =>
+   Exp a -> Exp i
+floorToInt = liftM MultiValue.floorToInt
+
+ceilingToInt ::
+   (MultiValue.NativeInteger i ir, MultiValue.NativeFloating a ar) =>
+   Exp a -> Exp i
+ceilingToInt = liftM MultiValue.ceilingToInt
+
+roundToIntFast ::
+   (MultiValue.NativeInteger i ir, MultiValue.NativeFloating a ar) =>
+   Exp a -> Exp i
+roundToIntFast = liftM MultiValue.roundToIntFast
+
+splitFractionToInt ::
+   (MultiValue.NativeInteger i ir, MultiValue.NativeFloating a ar) =>
+   Exp a -> (Exp i, Exp a)
+splitFractionToInt = unzip . liftM MultiValue.splitFractionToInt
diff --git a/src/LLVM/DSL/Expression/Maybe.hs b/src/LLVM/DSL/Expression/Maybe.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/DSL/Expression/Maybe.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module LLVM.DSL.Expression.Maybe (
+   T(Cons),
+   select,
+   ) where
+
+import qualified LLVM.DSL.Expression as Expr
+import LLVM.DSL.Expression (Exp)
+
+import qualified LLVM.Extra.Multi.Value as MultiValue
+import qualified LLVM.Extra.Maybe as Maybe
+
+import qualified LLVM.Core as LLVM
+
+import qualified Control.Monad.HT as Monad
+
+
+data T a = Cons (Exp Bool) a
+
+
+{- |
+counterpart to 'Data.Maybe.fromMaybe' with swapped arguments
+-}
+select :: (MultiValue.Select a) => T (Exp a) -> Exp a -> Exp a
+select (Cons b a) d = Expr.select b a d
+
+
+instance (Expr.Aggregate exp mv) => Expr.Aggregate (T exp) (Maybe.T mv) where
+   type MultiValuesOf (T exp) = Maybe.T (Expr.MultiValuesOf exp)
+   type ExpressionsOf (Maybe.T mv) = T (Expr.ExpressionsOf mv)
+   bundle (Cons b a) =
+      Monad.lift2 Maybe.Cons (fmap unbool $ Expr.bundle b) (Expr.bundle a)
+   dissect (Maybe.Cons b a) =
+      Cons (Expr.dissect (MultiValue.Cons b)) (Expr.dissect a)
+
+unbool :: MultiValue.T Bool -> LLVM.Value Bool
+unbool (MultiValue.Cons b) = b
diff --git a/src/LLVM/DSL/Expression/Vector.hs b/src/LLVM/DSL/Expression/Vector.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/DSL/Expression/Vector.hs
@@ -0,0 +1,164 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+module LLVM.DSL.Expression.Vector where
+
+import qualified LLVM.DSL.Expression as Expr
+import LLVM.DSL.Expression (Exp)
+
+import qualified LLVM.Extra.Multi.Value.Vector as MultiValueVec
+import qualified LLVM.Extra.Multi.Value as MultiValue
+import qualified LLVM.Extra.Multi.Vector.Instance as MultiVectorInst
+import qualified LLVM.Extra.Multi.Vector as MultiVector
+import qualified LLVM.Extra.Arithmetic as A
+import qualified LLVM.Core as LLVM
+
+import qualified Data.Tuple.HT as Tuple
+
+import Prelude hiding (replicate, take, zip, fst, snd, min, max)
+
+
+cons ::
+   (LLVM.Positive n, MultiVector.C a) =>
+   LLVM.Vector n a -> Exp (LLVM.Vector n a)
+cons = Expr.lift0 . MultiValueVec.cons
+
+fst ::
+   (LLVM.Positive n, MultiVector.C a, MultiVector.C b) =>
+   Exp (LLVM.Vector n (a,b)) -> Exp (LLVM.Vector n a)
+fst = Expr.lift1 MultiValueVec.fst
+
+snd ::
+   (LLVM.Positive n, MultiVector.C a, MultiVector.C b) =>
+   Exp (LLVM.Vector n (a,b)) -> Exp (LLVM.Vector n b)
+snd = Expr.lift1 MultiValueVec.snd
+
+swap ::
+   (LLVM.Positive n, MultiVector.C a, MultiVector.C b) =>
+   Exp (LLVM.Vector n (a,b)) -> Exp (LLVM.Vector n (b,a))
+swap = Expr.lift1 MultiValueVec.swap
+
+mapFst ::
+   (Exp (LLVM.Vector n a0) -> Exp (LLVM.Vector n a1)) ->
+   Exp (LLVM.Vector n (a0,b)) -> Exp (LLVM.Vector n (a1,b))
+mapFst f =
+   Expr.liftReprM
+      (\(a0,b) -> do
+         MultiValue.Cons a1 <- Expr.unliftM1 f $ MultiValue.Cons a0
+         return (a1,b))
+
+mapSnd ::
+   (Exp (LLVM.Vector n b0) -> Exp (LLVM.Vector n b1)) ->
+   Exp (LLVM.Vector n (a,b0)) -> Exp (LLVM.Vector n (a,b1))
+mapSnd f =
+   Expr.liftReprM
+      (\(a,b0) -> do
+         MultiValue.Cons b1 <- Expr.unliftM1 f $ MultiValue.Cons b0
+         return (a,b1))
+
+
+fst3 ::
+   (LLVM.Positive n, MultiVector.C a, MultiVector.C b, MultiVector.C c) =>
+   Exp (LLVM.Vector n (a,b,c)) -> Exp (LLVM.Vector n a)
+fst3 = Expr.lift1 MultiValueVec.fst3
+
+snd3 ::
+   (LLVM.Positive n, MultiVector.C a, MultiVector.C b, MultiVector.C c) =>
+   Exp (LLVM.Vector n (a,b,c)) -> Exp (LLVM.Vector n b)
+snd3 = Expr.lift1 MultiValueVec.snd3
+
+thd3 ::
+   (LLVM.Positive n, MultiVector.C a, MultiVector.C b, MultiVector.C c) =>
+   Exp (LLVM.Vector n (a,b,c)) -> Exp (LLVM.Vector n c)
+thd3 = Expr.lift1 MultiValueVec.thd3
+
+
+zip ::
+   (LLVM.Positive n, MultiVector.C a, MultiVector.C b) =>
+   Exp (LLVM.Vector n a) -> Exp (LLVM.Vector n b) ->
+   Exp (LLVM.Vector n (a,b))
+zip = Expr.lift2 MultiValueVec.zip
+
+zip3 ::
+   (LLVM.Positive n, MultiVector.C a, MultiVector.C b, MultiVector.C c) =>
+   Exp (LLVM.Vector n a) -> Exp (LLVM.Vector n b) -> Exp (LLVM.Vector n c) ->
+   Exp (LLVM.Vector n (a,b,c))
+zip3 = Expr.lift3 MultiValueVec.zip3
+
+
+replicate ::
+   (LLVM.Positive n, MultiVector.C a) =>
+   Exp a -> Exp (LLVM.Vector n a)
+replicate = Expr.liftM MultiValueVec.replicate
+
+iterate ::
+   (LLVM.Positive n, MultiVector.C a) =>
+   (Exp a -> Exp a) -> Exp a -> Exp (LLVM.Vector n a)
+iterate f = Expr.liftM (MultiValueVec.iterate (Expr.unliftM1 f))
+
+take ::
+   (LLVM.Positive n, LLVM.Positive m, MultiVector.Select a) =>
+   Exp (LLVM.Vector n a) -> Exp (LLVM.Vector m a)
+take = Expr.liftM MultiValueVec.take
+
+takeRev ::
+   (LLVM.Positive n, LLVM.Positive m, MultiVector.Select a) =>
+   Exp (LLVM.Vector n a) -> Exp (LLVM.Vector m a)
+takeRev = Expr.liftM MultiValueVec.takeRev
+
+
+cumulate ::
+   (LLVM.Positive n, MultiVector.Additive a) =>
+   Exp a -> Exp (LLVM.Vector n a) -> (Exp a, Exp (LLVM.Vector n a))
+cumulate a0 v0 =
+   Expr.unzip $
+   Expr.liftM2
+      (\a v ->
+         fmap (uncurry MultiValue.zip .
+               Tuple.mapSnd MultiVectorInst.toMultiValue) $
+         MultiVector.cumulate a $ MultiVectorInst.fromMultiValue v)
+      a0 v0
+
+
+cmp ::
+   (LLVM.Positive n, MultiVector.Comparison a) =>
+   LLVM.CmpPredicate ->
+   Exp (LLVM.Vector n a) -> Exp (LLVM.Vector n a) -> Exp (LLVM.Vector n Bool)
+cmp ord = Expr.liftM2 (MultiValueVec.cmp ord)
+
+select ::
+   (LLVM.Positive n, MultiVector.Select a) =>
+   Exp (LLVM.Vector n Bool) ->
+   Exp (LLVM.Vector n a) -> Exp (LLVM.Vector n a) -> Exp (LLVM.Vector n a)
+select = Expr.liftM3 MultiValueVec.select
+
+
+min, max ::
+   (LLVM.Positive n, MultiVector.Real a) =>
+   Exp (LLVM.Vector n a) -> Exp (LLVM.Vector n a) -> Exp (LLVM.Vector n a)
+min = Expr.liftM2 A.min
+max = Expr.liftM2 A.max
+
+limit ::
+   (LLVM.Positive n, MultiVector.Real a) =>
+   (Exp (LLVM.Vector n a), Exp (LLVM.Vector n a)) ->
+   Exp (LLVM.Vector n a) -> Exp (LLVM.Vector n a)
+limit (l,u) = max l . min u
+
+
+fromIntegral ::
+   (MultiValueVec.NativeInteger i ir, MultiValueVec.NativeFloating a ar,
+    LLVM.ShapeOf ir ~ LLVM.ShapeOf ar) =>
+   Exp i -> Exp a
+fromIntegral = Expr.liftM MultiValueVec.fromIntegral
+
+truncateToInt ::
+   (MultiValueVec.NativeInteger i ir, MultiValueVec.NativeFloating a ar,
+    LLVM.ShapeOf ir ~ LLVM.ShapeOf ar) =>
+   Exp a -> Exp i
+truncateToInt = Expr.liftM MultiValueVec.truncateToInt
+
+splitFractionToInt ::
+   (MultiValueVec.NativeInteger i ir, MultiValueVec.NativeFloating a ar,
+    LLVM.ShapeOf ir ~ LLVM.ShapeOf ar) =>
+   Exp a -> (Exp i, Exp a)
+splitFractionToInt = Expr.unzip . Expr.liftM MultiValueVec.splitFractionToInt
diff --git a/src/LLVM/DSL/Parameter.hs b/src/LLVM/DSL/Parameter.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/DSL/Parameter.hs
@@ -0,0 +1,363 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ExistentialQuantification #-}
+module LLVM.DSL.Parameter (
+   T,
+   ($#),
+   get,
+   valueTuple,
+   multiValue,
+
+   with,
+   withValue,
+   withMulti,
+
+   Tunnel(..),
+   tunnel,
+
+   Tuple(..),
+   withTuple,
+   withTuple1,
+   withTuple2,
+
+   -- * for implementation of new processes
+   wordInt,
+   ) where
+
+import qualified LLVM.Extra.Multi.Value.Marshal as MarshalMV
+import qualified LLVM.Extra.Multi.Value as MultiValue
+import qualified LLVM.Extra.Tuple as Tuple
+import qualified LLVM.Extra.Marshal as Marshal
+
+import qualified Algebra.Transcendental as Trans
+import qualified Algebra.Algebraic as Algebraic
+import qualified Algebra.Field as Field
+import qualified Algebra.Ring as Ring
+import qualified Algebra.Additive as Additive
+
+import qualified Control.Category as Cat
+import qualified Control.Arrow as Arr
+import qualified Control.Applicative as App
+import qualified Control.Functor.HT as FuncHT
+import Control.Applicative (pure, liftA2)
+
+import Data.Tuple.HT (mapFst, mapPair, mapTriple)
+import Data.Word (Word)
+
+import Prelude2010
+import Prelude ()
+
+
+{- |
+This data type is for parameters of parameterized LLVM code.
+It is better than using plain functions of type @p -> a@
+since it allows for numeric instances
+and we can make explicit,
+whether a parameter is constant.
+
+We recommend to use parameters for atomic types.
+Although a parameter of type @T p (a,b)@ is possible,
+it means that the whole parameter is variable
+if only one of the pair elements is variable.
+This way you may miss opportunities for constant folding.
+-}
+data T p a =
+   Constant a |
+   Variable (p -> a)
+
+
+get :: T p a -> (p -> a)
+get (Constant a) = const a
+get (Variable f) = f
+
+
+{- |
+The call @value param v@ requires
+that @v@ represents the same value as @valueTupleOf (get param p)@ for some @p@.
+However @v@ might be the result of a load operation
+and @param@ might be a constant.
+In this case it is more efficient to use @valueTupleOf (get param undefined)@
+since the constant is translated to an LLVM constant
+that allows for certain optimizations.
+
+This is the main function for taking advantage of a constant parameter
+in low-level implementations.
+For simplicity we do not omit constant parameters in the parameter struct
+since this would mean to construct types at runtime and might become ugly.
+Instead we just check using 'value' at the according places in LLVM code
+whether a parameter is constant
+and ignore the parameter from the struct in this case.
+In many cases there will be no speed benefit
+because the parameter will be loaded to a register anyway.
+It can only lead to speed-up if subsequent optimizations
+can precompute constant expressions.
+Another example is 'drop' where a loop with constant loop count can be generated.
+For small loop counts and simple loop bodies the loop might get unrolled.
+-}
+valueTuple ::
+   (Tuple.Value tuple, Tuple.ValueOf tuple ~ value) =>
+   T p tuple -> value -> value
+valueTuple = genericValue Tuple.valueOf
+
+multiValue ::
+   (MultiValue.C a) =>
+   T p a -> MultiValue.T a -> MultiValue.T a
+multiValue = genericValue MultiValue.cons
+
+genericValue ::
+   (a -> value) ->
+   T p a -> value -> value
+genericValue cons p v =
+   case p of
+      Constant a -> cons a
+      Variable _ -> v
+
+
+{- |
+This function provides specialised variants of 'get' and 'value',
+that use the unit type for constants
+and thus save space in parameter structures.
+-}
+{-# INLINE withValue #-}
+withValue ::
+   (Marshal.C tuple, Tuple.ValueOf tuple ~ value) =>
+   T p tuple ->
+   (forall parameters.
+    (Marshal.C parameters) =>
+    (p -> parameters) ->
+    (Tuple.ValueOf parameters -> value) ->
+    a) ->
+   a
+withValue (Constant a) f = f (const ()) (\() -> Tuple.valueOf a)
+withValue (Variable v) f = f v id
+
+{-# INLINE withMulti #-}
+withMulti ::
+   (MarshalMV.C b) =>
+   T p b ->
+   (forall parameters.
+    (MarshalMV.C parameters) =>
+    (p -> parameters) ->
+    (MultiValue.T parameters -> MultiValue.T b) ->
+    a) ->
+   a
+withMulti = with MultiValue.cons
+
+{-# INLINE with #-}
+with ::
+   (MarshalMV.C b) =>
+   (b -> MultiValue.T b) ->
+   T p b ->
+   (forall parameters.
+    (MarshalMV.C parameters) =>
+    (p -> parameters) ->
+    (MultiValue.T parameters -> MultiValue.T b) ->
+    a) ->
+   a
+with cons p f =
+   case p of
+      Constant b -> f (const ()) (\_ -> cons b)
+      Variable v -> f v id
+
+
+data Tunnel p a =
+   forall t.
+   (MarshalMV.C t) => Tunnel (p -> t) (MultiValue.T t -> MultiValue.T a)
+
+tunnel :: (MarshalMV.C a) => (a -> MultiValue.T a) -> T p a -> Tunnel p a
+tunnel cons p =
+   case p of
+      Constant b -> Tunnel (const ()) (\_ -> cons b)
+      Variable v -> Tunnel v id
+
+
+wordInt :: T p Int -> T p Word
+wordInt = fmap fromIntegral
+
+
+infixl 0 $#
+
+($#) :: (T p a -> b) -> (a -> b)
+($#) f a = f (pure a)
+
+
+
+class Tuple tuple where
+   type Composed tuple
+   type Source tuple
+   decompose :: T (Source tuple) (Composed tuple) -> tuple
+
+instance Tuple (T p a) where
+   type Composed (T p a) = a
+   type Source (T p a) = p
+   decompose = id
+
+instance (Tuple a, Tuple b, Source a ~ Source b) => Tuple (a,b) where
+   type Composed (a,b) = (Composed a, Composed b)
+   type Source (a,b) = Source a
+   decompose = mapPair (decompose, decompose) . FuncHT.unzip
+
+instance
+   (Tuple a, Tuple b, Tuple c, Source a ~ Source b, Source b ~ Source c) =>
+      Tuple (a,b,c) where
+   type Composed (a,b,c) = (Composed a, Composed b, Composed c)
+   type Source (a,b,c) = Source a
+   decompose = mapTriple (decompose, decompose, decompose) . FuncHT.unzip3
+
+{- |
+Provide all elements of a nested tuple as separate parameters.
+
+If you do not use one of the tuple elements,
+you will get a type error like
+@Couldn't match type `Param.Composed t0' with `Int'@.
+The problem is that the type checker cannot infer
+that an element is a @Parameter.T@ if it remains unused.
+-}
+withTuple ::
+   (Tuple tuple, Source tuple ~ p, Composed tuple ~ p) =>
+   (tuple -> f p) -> f p
+withTuple f = idFromFunctor $ f . decompose
+
+idFromFunctor :: (T p p -> f p) -> f p
+idFromFunctor f = f Cat.id
+
+withTuple1 ::
+   (Tuple tuple, Source tuple ~ p, Composed tuple ~ p) =>
+   (tuple -> f p a) -> f p a
+withTuple1 f = idFromFunctor1 $ f . decompose
+
+idFromFunctor1 :: (T p p -> f p a) -> f p a
+idFromFunctor1 f = f Cat.id
+
+withTuple2 ::
+   (Tuple tuple, Source tuple ~ p, Composed tuple ~ p) =>
+   (tuple -> f p a b) -> f p a b
+withTuple2 f = idFromFunctor2 $ f . decompose
+
+idFromFunctor2 :: (T p p -> f p a b) -> f p a b
+idFromFunctor2 f = f Cat.id
+
+
+
+{- |
+@.@ can be used for fetching a parameter from a super-parameter.
+-}
+instance Cat.Category T where
+   id = Variable id
+   Constant f . _ = Constant f
+   Variable f . Constant a = Constant (f a)
+   Variable f . Variable g = Variable (f . g)
+
+{- |
+@arr@ is useful for lifting parameter selectors to our parameter type
+without relying on the constructor.
+-}
+instance Arr.Arrow T where
+   arr = Variable
+   first f = Variable (mapFst (get f))
+
+
+
+{- |
+Useful for splitting @T p (a,b)@ into @T p a@ and @T p b@
+using @fmap fst@ and @fmap snd@.
+-}
+instance Functor (T p) where
+   fmap f (Constant a) = Constant (f a)
+   fmap f (Variable g) = Variable (f . g)
+
+{- |
+Useful for combining @T p a@ and @T p b@ to @T p (a,b)@
+using @liftA2 (,)@.
+However, we do not recommend to do so
+because the result parameter can only be constant
+if both operands are constant.
+-}
+instance App.Applicative (T p) where
+   pure a = Constant a
+   Constant f <*> Constant a = Constant (f a)
+   f <*> a = Variable (\p -> get f p (get a p))
+
+instance Monad (T p) where
+   return = pure
+   Constant x >>= f = f x
+   Variable x >>= f =
+      Variable (\p -> get (f (x p)) p)
+
+
+instance Num a => Num (T p a) where
+   (+) = liftA2 (+)
+   (-) = liftA2 (-)
+   (*) = liftA2 (*)
+   negate = fmap negate
+   abs = fmap abs
+   signum = fmap signum
+   fromInteger = pure . fromInteger
+
+instance Fractional a => Fractional (T p a) where
+   (/) = liftA2 (/)
+   fromRational = pure . fromRational
+
+instance Floating a => Floating (T p a) where
+   pi = pure pi
+   sqrt = fmap sqrt
+   (**) = liftA2 (**)
+   exp = fmap exp
+   log = fmap log
+   logBase = liftA2 logBase
+   sin = fmap sin
+   tan = fmap tan
+   cos = fmap cos
+   asin = fmap asin
+   atan = fmap atan
+   acos = fmap acos
+   sinh = fmap sinh
+   tanh = fmap tanh
+   cosh = fmap cosh
+   asinh = fmap asinh
+   atanh = fmap atanh
+   acosh = fmap acosh
+
+
+instance Additive.C a => Additive.C (T p a) where
+   zero = pure Additive.zero
+   negate = fmap Additive.negate
+   (+) = liftA2 (Additive.+)
+   (-) = liftA2 (Additive.-)
+
+instance Ring.C a => Ring.C (T p a) where
+   one = pure Ring.one
+   (*) = liftA2 (Ring.*)
+   x^n = fmap (Ring.^n) x
+   fromInteger = pure . Ring.fromInteger
+
+instance Field.C a => Field.C (T p a) where
+   (/) = liftA2 (Field./)
+   recip = fmap Field.recip
+   fromRational' = pure . Field.fromRational'
+
+instance Algebraic.C a => Algebraic.C (T p a) where
+   x ^/ r = fmap (Algebraic.^/ r) x
+   sqrt = fmap Algebraic.sqrt
+   root n = fmap (Algebraic.root n)
+
+instance Trans.C a => Trans.C (T p a) where
+   pi      = pure   Trans.pi
+   exp     = fmap   Trans.exp
+   log     = fmap   Trans.log
+   logBase = liftA2 Trans.logBase
+   (**)    = liftA2 (Trans.**)
+   sin     = fmap   Trans.sin
+   tan     = fmap   Trans.tan
+   cos     = fmap   Trans.cos
+   asin    = fmap   Trans.asin
+   atan    = fmap   Trans.atan
+   acos    = fmap   Trans.acos
+   sinh    = fmap   Trans.sinh
+   tanh    = fmap   Trans.tanh
+   cosh    = fmap   Trans.cosh
+   asinh   = fmap   Trans.asinh
+   atanh   = fmap   Trans.atanh
+   acosh   = fmap   Trans.acosh
diff --git a/src/LLVM/DSL/Render/Argument.hs b/src/LLVM/DSL/Render/Argument.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/DSL/Render/Argument.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ExistentialQuantification #-}
+module LLVM.DSL.Render.Argument (
+   T(Cons),
+   Creator,
+   unit,
+   primitive,
+   wrap,
+   pair,
+   triple,
+   newDispose,
+   ) where
+
+import qualified LLVM.DSL.Expression as Expr
+import LLVM.DSL.Expression (Exp)
+
+import qualified LLVM.Extra.Multi.Value.Marshal as Marshal
+
+import Data.Tuple.Strict (mapPair, mapTriple)
+
+import Prelude2010
+import Prelude ()
+
+
+
+type Creator p = IO (p, IO ())
+
+
+{- |
+Transfer 'a' to 'adsl' with 'al' as transit stop.
+-}
+data T a adsl =
+   forall al. Marshal.C al =>
+   Cons (Exp al -> adsl) (a -> Creator al)
+
+
+primitiveCreator :: a -> Creator a
+primitiveCreator a = return (a, return ())
+
+unit :: T () ()
+unit = Cons (\ _unit -> ()) primitiveCreator
+
+primitive :: (Marshal.C a) => T a (Exp a)
+primitive = Cons id primitiveCreator
+
+wrap :: (Marshal.C a) => (b -> a) -> (adsl -> bdsl) -> T a adsl -> T b bdsl
+wrap unwrp wrp (Cons pass create) = Cons (wrp . pass) (create . unwrp)
+
+
+pair :: T a ad -> T b bd -> T (a,b) (ad,bd)
+pair (Cons passA createA) (Cons passB createB) =
+   Cons
+      (mapPair (passA,passB) . Expr.unzip)
+      (\(a,b) -> do
+         (pa,finalA) <- createA a
+         (pb,finalB) <- createB b
+         return ((pa,pb), finalB>>finalA))
+
+triple :: T a ad -> T b bd -> T c cd -> T (a,b,c) (ad,bd,cd)
+triple (Cons passA createA) (Cons passB createB) (Cons passC createC) =
+   Cons
+      (mapTriple (passA,passB,passC) . Expr.unzip3)
+      (\(a,b,c) -> do
+         (pa,finalA) <- createA a
+         (pb,finalB) <- createB b
+         (pc,finalC) <- createC c
+         return ((pa,pb,pc), finalC>>finalB>>finalA))
+
+
+newDispose ::
+   (Marshal.C handle) =>
+   (a -> IO handle) -> (handle -> IO ()) ->
+   (Exp handle -> ad) -> T a ad
+newDispose new dispose fetch =
+   Cons fetch
+      (\x -> do
+         it <- new x
+         return (it, dispose it))
diff --git a/src/LLVM/DSL/Render/Run.hs b/src/LLVM/DSL/Render/Run.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/DSL/Render/Run.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE Rank2Types #-}
+{- |
+This is an approach with no pre-defined direction of type dependencies.
+-}
+module LLVM.DSL.Render.Run (
+   T(Cons, decons),
+   postmapPlain,
+   premapDSL,
+   Creator,
+   run,
+   (*->),
+   ) where
+
+import qualified LLVM.DSL.Render.Argument as Arg
+import qualified LLVM.DSL.Expression as Expr
+import LLVM.DSL.Render.Argument (Creator)
+import LLVM.DSL.Expression (Exp)
+
+import qualified LLVM.Extra.Multi.Value.Marshal as Marshal
+
+import Prelude2010
+import Prelude ()
+
+
+
+{-
+Type order of 'f' and 'fdsl' is consistent with 'run',
+but inconsistent with 'Arg.T'.
+-}
+newtype T m p fdsl f =
+   Cons {decons :: (Exp p -> fdsl) -> m (Creator p -> f)}
+
+{-
+We could turn this into an 'Functor'/'fmap' instance,
+however this is less descriptive and
+would require to keep the current type parameter order.
+-}
+postmapPlain :: Functor m => (f -> g) -> T m p fdsl f -> T m p fdsl g
+postmapPlain f build = Cons $ fmap (f .) . decons build
+
+premapDSL :: (gdsl -> fdsl) -> T m p fdsl f -> T m p gdsl f
+premapDSL f build = Cons $ decons build . fmap f
+
+
+-- ToDo: duplicate of Argument
+primitiveCreator :: a -> Creator a
+primitiveCreator a = return (a, return ())
+
+run :: (Functor m) => T m () fdsl f -> fdsl -> m f
+run (Cons build) f = fmap ($ primitiveCreator ()) $ build $ const f
+
+
+-- precedence like Applicative.<*>, but different associativity
+infixr 4 *->
+
+(*->) ::
+   (Functor m) =>
+   Arg.T a adsl ->
+   (forall al. Marshal.C al => T m (p, al) fdsl f) ->
+   T m p (adsl -> fdsl) (a -> f)
+(*->) arg build = Cons $ \f ->
+   case arg of
+      Arg.Cons pass createA ->
+         fmap
+            (\g createP av ->
+               g (do (p,finalP) <- createP
+                     (pa,finalA) <- createA av
+                     return ((p,pa), finalA >> finalP)))
+            (decons build (Expr.uncurry $ \p -> f p . pass))
diff --git a/src/LLVM/DSL/Value.hs b/src/LLVM/DSL/Value.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/DSL/Value.hs
@@ -0,0 +1,554 @@
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
+{- |
+Wrap LLVM code for arithmetic computations.
+Similar to "LLVM.DSL.Expression" but not based on 'MultiValue'
+but on "LLVM.Extra.Arithmetic" methods.
+Detects sharing using a 'Vault'.
+-}
+module LLVM.DSL.Value (
+   T, decons,
+   tau, square, sqrt,
+   max, min, limit, fraction,
+
+   (%==), (%/=), (%<), (%<=), (%>), (%>=), not,
+   (%&&), (%||),
+   (?), (??),
+
+   lift0, lift1, lift2, lift3,
+   unlift0, unlift1, unlift2, unlift3, unlift4, unlift5,
+   constantValue, constant,
+   fromInteger', fromRational',
+
+   Flatten(flattenCode, unfoldCode), Registers,
+   flatten, unfold,
+   flattenCodeTraversable, unfoldCodeTraversable,
+   flattenFunction,
+   ) where
+
+import qualified LLVM.Extra.Control as C
+import qualified LLVM.Extra.Arithmetic as A
+import qualified LLVM.Extra.Tuple as Tuple
+
+import qualified LLVM.Core as LLVM
+
+import qualified Data.Vault.Lazy as Vault
+import qualified Control.Monad.Trans.Class as MT
+import qualified Control.Monad.Trans.State as MS
+import Control.Monad (liftM2, liftM3)
+import Control.Applicative (Applicative, pure, (<*>))
+import Control.Functor.HT (unzip, unzip3)
+
+-- import qualified Algebra.NormedSpace.Maximum   as NormedMax
+import qualified Algebra.NormedSpace.Euclidean as NormedEuc
+import qualified Algebra.NormedSpace.Sum       as NormedSum
+
+import qualified Algebra.Transcendental as Trans
+import qualified Algebra.Algebraic as Algebraic
+import qualified Algebra.Absolute as Absolute
+import qualified Algebra.Module as Module
+import qualified Algebra.Field as Field
+import qualified Algebra.Ring as Ring
+import qualified Algebra.Additive as Additive
+
+import qualified Number.Complex as Complex
+
+import qualified Data.Traversable as Trav
+import qualified Data.Foldable as Fold
+
+import qualified System.Unsafe as Unsafe
+
+import qualified Prelude as P
+import NumericPrelude.Numeric hiding (pi, sqrt, fromRational', fraction)
+import NumericPrelude.Base hiding (min, max, unzip, unzip3, not)
+
+
+{-
+The @r@ type parameter must be hidden and forall-quantified
+because otherwise we would need an impossible type
+where we have to quantify for @r@ and @t@ in different scopes
+while having a class constraint that involves both of them.
+
+> osci ::
+>    (RealRing.C (Value.T r t),
+>     IsFirstClass t, IsFloating t,
+>     IsPrimitive t, IsConst t) =>
+>    (forall r. Wave.T (Value.T r t) (Value.T r y)) ->
+>    t -> t -> T (Value y)
+
+-}
+newtype T a = Cons {code :: forall r. Compute r a}
+
+decons :: T a -> (forall r. LLVM.CodeGenFunction r a)
+decons value =
+   MS.evalStateT (code value) Vault.empty
+
+instance Functor T where
+   fmap f x = consUnique (fmap f (code x))
+
+instance Applicative T where
+   pure = constantValue
+   f <*> x = consUnique (code f <*> code x)
+
+
+type Compute r a =
+   MS.StateT Vault.Vault (LLVM.CodeGenFunction r) a
+
+consUnique :: (forall r. Compute r a) -> T a
+consUnique code0 =
+   Unsafe.performIO $
+   fmap (consKey code0) Vault.newKey
+
+consKey :: (forall r. Compute r a) -> Vault.Key a -> T a
+consKey code0 key =
+   Cons (do
+      ma <- MS.gets (Vault.lookup key)
+      case ma of
+         Just a -> return a
+         Nothing -> do
+            a <- code0
+            MS.modify (Vault.insert key a)
+            return a)
+
+{- |
+We do not require a numeric prelude superclass,
+thus also LLVM only types like vectors are instances.
+-}
+instance (A.Additive a) => Additive.C (T a) where
+   zero = constantValue A.zero
+   (+) = lift2 A.add
+   (-) = lift2 A.sub
+   negate = lift1 A.neg
+
+instance (A.PseudoRing a, A.IntegerConstant a) => Ring.C (T a) where
+   one = constantValue A.one
+   (*) = lift2 A.mul
+   fromInteger = fromInteger'
+
+{-
+This instance is enough for Module here.
+The difference to Module instances on Haskell tuples is,
+that LLVM vectors cannot be nested.
+-}
+instance (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a) =>
+      Module.C (T a) (T v) where
+   (*>) = lift2 A.scale
+
+instance (A.Additive a, A.IntegerConstant a) => Enum (T a) where
+   succ x = x + constantValue A.one
+   pred x = x - constantValue A.one
+   fromEnum _ = error "CodeGenFunction Value: fromEnum"
+   toEnum = constantValue . A.fromInteger' . fromIntegral
+
+{-
+instance (IsArithmetic a, Cmp a b, Num a, IsConst a) => Real (T a) where
+   toRational _ = error "CodeGenFunction Value: toRational"
+
+instance (Cmp a b, Num a, IsConst a, IsInteger a) => Integral (T a) where
+   quot = lift2 idiv
+   rem  = lift2 irem
+   quotRem x y = (quot x y, rem x y)
+   toInteger _ = error "CodeGenFunction Value: toInteger"
+-}
+
+instance (A.Field a, A.RationalConstant a) => Field.C (T a) where
+   (/) = lift2 A.fdiv
+   fromRational' = fromRational' . Field.fromRational'
+
+{-
+instance (Cmp a b, Fractional a, IsConst a, IsFloating a) => RealFrac (T a) where
+   properFraction _ = error "CodeGenFunction Value: properFraction"
+-}
+
+instance (A.Transcendental a, A.RationalConstant a) => Algebraic.C (T a) where
+   sqrt = lift1 A.sqrt
+   root n x = lift2 A.pow x (one / fromInteger n)
+   x^/r = lift2 A.pow x (Field.fromRational' r)
+
+instance (A.Transcendental a, A.RationalConstant a) => Trans.C (T a) where
+   pi = lift0 A.pi
+   sin = lift1 A.sin
+   cos = lift1 A.cos
+   (**) = lift2 A.pow
+   exp = lift1 A.exp
+   log = lift1 A.log
+
+   asin _ = error "LLVM missing intrinsic: asin"
+   acos _ = error "LLVM missing intrinsic: acos"
+   atan _ = error "LLVM missing intrinsic: atan"
+
+
+instance
+   (A.PseudoRing a, A.Real a, A.IntegerConstant a) =>
+      P.Num (T a) where
+   fromInteger = fromInteger'
+   (+) = lift2 A.add
+   (-) = lift2 A.sub
+   (*) = lift2 A.mul
+   negate = lift1 A.neg
+   abs = lift1 A.abs
+   signum = lift1 A.signum
+
+instance
+   (A.Field a, A.Real a, A.RationalConstant a) =>
+      P.Fractional (T a) where
+   fromRational = fromRational'
+   (/) = lift2 A.fdiv
+
+instance
+   (A.Transcendental a, A.Real a, A.RationalConstant a) =>
+      P.Floating (T a) where
+   pi = lift0 A.pi
+   sin = lift1 A.sin
+   cos = lift1 A.cos
+   (**) = lift2 A.pow
+   exp = lift1 A.exp
+   log = lift1 A.log
+
+   asin _ = error "LLVM missing intrinsic: asin"
+   acos _ = error "LLVM missing intrinsic: acos"
+   atan _ = error "LLVM missing intrinsic: atan"
+
+   sinh x  = (exp x - exp (-x)) / 2
+   cosh x  = (exp x + exp (-x)) / 2
+   asinh x = log (x + sqrt (x*x + 1))
+   acosh x = log (x + sqrt (x*x - 1))
+   atanh x = (log (1 + x) - log (1 - x)) / 2
+
+
+tau ::
+   (A.Transcendental a, A.RationalConstant a) =>
+   T a
+tau = fromInteger 2 * Trans.pi
+
+square :: (A.PseudoRing a) => T a -> T a
+square = lift1 A.square
+
+{- |
+The same as 'Algebraic.sqrt',
+but needs only Algebraic constraint, not Transcendental.
+-}
+sqrt ::
+   (A.Algebraic a) =>
+   T a -> T a
+sqrt = lift1 A.sqrt
+
+
+min, max :: (A.Real a) => T a -> T a -> T a
+min = lift2 A.min
+max = lift2 A.max
+
+limit :: (A.Real a) => (T a, T a) -> T a -> T a
+limit (l,u) = max l . min u
+
+fraction :: (A.Fraction a) => T a -> T a
+fraction = lift1 A.fraction
+
+
+instance (A.Real a, A.PseudoRing a, A.IntegerConstant a) =>
+      Absolute.C (T a) where
+   abs = lift1 A.abs
+   signum = lift1 A.signum
+
+{-
+For useful instances with different scalar and vector type,
+we would need a more flexible superclass.
+-}
+instance (A.Real a, A.IntegerConstant a, a ~ A.Scalar a, A.PseudoModule a) =>
+      NormedSum.C (T a) (T a) where
+   norm = lift1 A.abs
+
+instance (A.Real a, A.IntegerConstant a, a ~ A.Scalar a, A.PseudoModule a) =>
+      NormedEuc.Sqr (T a) (T a) where
+   normSqr = lift1 A.square
+
+instance
+   (NormedEuc.Sqr (T a) (T v),
+    A.RationalConstant a, A.Algebraic a) =>
+      NormedEuc.C (T a) (T v) where
+   norm = lift1 A.sqrt . NormedEuc.normSqr
+
+{-
+instance (A.Real a, A.IntegerConstant a, A.PseudoModule a a) =>
+      NormedMax.C (T a) (T a) where
+   norm = lift1 A.abs
+-}
+
+
+infix  4  %==, %/=, %<, %<=, %>=, %>
+
+(%==), (%/=), (%<), (%<=), (%>), (%>=) ::
+   (LLVM.CmpRet a) =>
+   T (LLVM.Value a) -> T (LLVM.Value a) -> T (LLVM.Value (LLVM.CmpResult a))
+(%==) = lift2 $ LLVM.cmp LLVM.CmpEQ
+(%/=) = lift2 $ LLVM.cmp LLVM.CmpNE
+(%>)  = lift2 $ LLVM.cmp LLVM.CmpGT
+(%>=) = lift2 $ LLVM.cmp LLVM.CmpGE
+(%<)  = lift2 $ LLVM.cmp LLVM.CmpLT
+(%<=) = lift2 $ LLVM.cmp LLVM.CmpLE
+
+infixr 3  %&&
+infixr 2  %||
+
+-- | Lazy AND
+(%&&) :: T (LLVM.Value Bool) -> T (LLVM.Value Bool) -> T (LLVM.Value Bool)
+a %&& b = a ? (b, constant False)
+
+-- | Lazy OR
+(%||) :: T (LLVM.Value Bool) -> T (LLVM.Value Bool) -> T (LLVM.Value Bool)
+a %|| b = a ? (constant True, b)
+
+not :: T (LLVM.Value Bool) -> T (LLVM.Value Bool)
+not = lift1 LLVM.inv
+
+
+infix  0 ?
+{- |
+@true ? (t,f)@ evaluates @t@,
+@false ? (t,f)@ evaluates @f@.
+@t@ and @f@ can reuse interim results,
+but they cannot contribute shared results,
+since only one of them will be run.
+Cf. '(??)'
+-}
+(?) ::
+   (Flatten value, Registers value ~ a, Tuple.Phi a) =>
+   T (LLVM.Value Bool) -> (value, value) -> value
+c ? (t, f) =
+   unfoldCode $ consUnique $ do
+      b <- code c
+      shared <- MS.get
+      MT.lift $
+         C.ifThenElse b
+            (MS.evalStateT (flattenCode t) shared)
+            (MS.evalStateT (flattenCode f) shared)
+
+infix 0 ??
+{- |
+The expression @c ?? (t,f)@ evaluates both @t@ and @f@
+and selects components from @t@ and @f@ according to @c@.
+It is useful for vector values and
+for sharing @t@ or @f@ with other branches of an expression.
+-}
+(??) ::
+   (LLVM.IsFirstClass a, LLVM.CmpRet a) =>
+   T (LLVM.Value (LLVM.CmpResult a)) ->
+   (T (LLVM.Value a), T (LLVM.Value a)) ->
+   T (LLVM.Value a)
+c ?? (t, f) = lift3 LLVM.select c t f
+
+
+
+lift0 ::
+   (forall r. LLVM.CodeGenFunction r a) ->
+   T a
+lift0 f =
+   consUnique $ MT.lift $ f
+
+lift1 ::
+   (forall r. a -> LLVM.CodeGenFunction r b) ->
+   T a -> T b
+lift1 f x =
+   consUnique $ MT.lift . f =<< code x
+
+lift2 ::
+   (forall r. a -> b -> LLVM.CodeGenFunction r c) ->
+   T a -> T b -> T c
+lift2 f x y =
+   consUnique $ do
+      xv <- code x
+      yv <- code y
+      MT.lift $ f xv yv
+
+lift3 ::
+   (forall r. a -> b -> c -> LLVM.CodeGenFunction r d) ->
+   T a -> T b -> T c -> T d
+lift3 f x y z =
+   consUnique $ do
+      xv <- code x
+      yv <- code y
+      zv <- code z
+      MT.lift $ f xv yv zv
+
+
+_unlift0 ::
+   T a ->
+   (forall r. LLVM.CodeGenFunction r a)
+_unlift0 = decons
+
+unlift0 ::
+   (Flatten value) =>
+   value ->
+   (forall r. LLVM.CodeGenFunction r (Registers value))
+unlift0 x = flatten x
+
+_unlift1 ::
+   (T a -> T b) ->
+   (forall r. a -> LLVM.CodeGenFunction r b)
+_unlift1 = unlift1
+
+{-
+Better type inference than flattenFunction.
+-}
+unlift1 ::
+   (Flatten value) =>
+   (T a -> value) ->
+   (forall r. a -> LLVM.CodeGenFunction r (Registers value))
+unlift1 f a =
+   flatten (f (constantValue a))
+
+_unlift2 ::
+   (T a -> T b -> T c) ->
+   (forall r. a -> b -> LLVM.CodeGenFunction r c)
+_unlift2 = unlift2
+
+unlift2 ::
+   (Flatten value) =>
+   (T a -> T b -> value) ->
+   (forall r. a -> b -> LLVM.CodeGenFunction r (Registers value))
+unlift2 f a b =
+   flatten (f (constantValue a) (constantValue b))
+
+unlift3 ::
+   (Flatten value) =>
+   (T a -> T b -> T c -> value) ->
+   (forall r. a -> b -> c -> LLVM.CodeGenFunction r (Registers value))
+unlift3 f a b c =
+   flatten (f (constantValue a) (constantValue b) (constantValue c))
+
+unlift4 ::
+   (Flatten value) =>
+   (T a -> T b -> T c -> T d -> value) ->
+   (forall r. a -> b -> c -> d -> LLVM.CodeGenFunction r (Registers value))
+unlift4 f a b c d =
+   flatten $
+   f (constantValue a) (constantValue b) (constantValue c) (constantValue d)
+
+unlift5 ::
+   (Flatten value) =>
+   (T a -> T b -> T c -> T d -> T e -> value) ->
+   (forall r. a -> b -> c -> d -> e -> LLVM.CodeGenFunction r (Registers value))
+unlift5 f a b c d e =
+   flatten $
+   f (constantValue a) (constantValue b) (constantValue c)
+      (constantValue d) (constantValue e)
+
+
+constantValue :: a -> T a
+constantValue x =
+   consUnique (return x)
+
+constant :: (LLVM.IsConst a) => a -> T (LLVM.Value a)
+constant = constantValue . LLVM.valueOf
+
+fromInteger' :: (A.IntegerConstant a) => Integer -> T a
+fromInteger' = constantValue . A.fromInteger'
+
+fromRational' :: (A.RationalConstant a) => P.Rational -> T a
+fromRational' = constantValue . A.fromRational'
+
+
+class Flatten value where
+   type Registers value
+   flattenCode :: value -> Compute r (Registers value)
+   unfoldCode :: T (Registers value) -> value
+
+flatten ::
+   (Flatten value) =>
+   value -> LLVM.CodeGenFunction r (Registers value)
+flatten x = MS.evalStateT (flattenCode x) Vault.empty
+
+unfold ::
+   (Flatten value) =>
+   (Registers value) -> value
+unfold x = unfoldCode $ pure x
+
+flattenCodeTraversable ::
+   (Flatten value, Trav.Traversable f) =>
+   f value -> Compute r (f (Registers value))
+flattenCodeTraversable =
+   Trav.mapM flattenCode
+
+unfoldCodeTraversable ::
+   (Flatten value, Trav.Traversable f, Applicative f) =>
+   T (f (Registers value)) -> f value
+unfoldCodeTraversable =
+   unfoldFromGetters getters
+
+unfoldFromGetters ::
+   (Functor f, Flatten b) =>
+   f (a -> Registers b) -> T a -> f b
+unfoldFromGetters g x =
+   fmap (unfoldCode . flip fmap x) g
+
+getters ::
+   (Trav.Traversable f, Applicative f) =>
+   f (f a -> a)
+getters =
+   fmap (\n x -> Fold.toList x !! n) $
+   MS.evalState (Trav.sequenceA (pure (MS.state $ \n -> (n, succ n)))) 0
+
+
+flattenFunction ::
+   (Flatten a, Flatten b) =>
+   (a -> b) -> (Registers a -> LLVM.CodeGenFunction r (Registers b))
+flattenFunction f =
+   flatten . f . unfold
+
+{-
+This function is hardly useful,
+since most functions are not of type
+@(Registers a -> (forall r. CodeGenFunction r (Registers b)))@
+but of type
+@(forall r. Registers a -> CodeGenFunction r (Registers b))@.
+We would also need a method unfoldF.
+See ValueUnfoldF for some implementations.
+
+unfoldFunction ::
+   (Flatten a, Flatten b) =>
+   (Registers a -> (forall r. LLVM.CodeGenFunction r (Registers b))) -> (a -> b)
+unfoldFunction f x =
+   unfoldF (f =<< flatten x)
+-}
+
+
+instance (Flatten a, Flatten b) => Flatten (a,b) where
+   type Registers (a,b) = (Registers a, Registers b)
+   flattenCode (a,b) =
+      liftM2 (,) (flattenCode a) (flattenCode b)
+   unfoldCode x =
+      case unzip x of
+         (a,b) -> (unfoldCode a, unfoldCode b)
+
+instance (Flatten a, Flatten b, Flatten c) => Flatten (a,b,c) where
+   type Registers (a,b,c) = (Registers a, Registers b, Registers c)
+   flattenCode (a,b,c) =
+      liftM3 (,,) (flattenCode a) (flattenCode b) (flattenCode c)
+   unfoldCode x =
+      case unzip3 x of
+         (a,b,c) -> (unfoldCode a, unfoldCode b, unfoldCode c)
+
+instance Flatten a => Flatten (Complex.T a) where
+   type Registers (Complex.T a) = Complex.T (Registers a)
+--   flattenCode = flattenCodeTraversable
+   flattenCode s =
+      liftM2 (Complex.+:)
+         (flattenCode $ Complex.real s)
+         (flattenCode $ Complex.imag s)
+   unfoldCode =
+      unfoldFromGetters $ Complex.real Complex.+: Complex.imag
+
+
+instance Flatten (T a) where
+   type Registers (T a) = a
+   flattenCode x = code x
+   unfoldCode = id
+
+instance Flatten () where
+   type Registers () = ()
+   flattenCode = return
+   unfoldCode _ = ()
diff --git a/src/debug-off/LLVM/DSL/Dump.hs b/src/debug-off/LLVM/DSL/Dump.hs
new file mode 100644
--- /dev/null
+++ b/src/debug-off/LLVM/DSL/Dump.hs
@@ -0,0 +1,6 @@
+module LLVM.DSL.Dump (writer) where
+
+import qualified LLVM.Core as LLVM
+
+writer :: String -> IO (String -> LLVM.Module -> IO ())
+writer _name = return $ const $ const $ return ()
diff --git a/src/debug-on/LLVM/DSL/Dump.hs b/src/debug-on/LLVM/DSL/Dump.hs
new file mode 100644
--- /dev/null
+++ b/src/debug-on/LLVM/DSL/Dump.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE EmptyDataDecls #-}
+module LLVM.DSL.Dump (writer) where
+
+import qualified LLVM.DSL.Debug.Counter as Counter
+
+import qualified LLVM.Core as LLVM
+
+import qualified Data.IORef as IORef
+
+import System.IO.Unsafe (unsafePerformIO)
+
+
+data BitCodeCnt
+
+{- |
+This is only for debugging purposes
+and thus I felt free to use unsafePerformIO.
+-}
+counter :: IORef.IORef (Counter.T BitCodeCnt)
+counter = unsafePerformIO Counter.new
+
+
+bitcodeToFile :: String -> Counter.T ident -> String -> LLVM.Module -> IO ()
+bitcodeToFile name cnt ext =
+   LLVM.writeBitcodeToFile
+      ("llvm" ++ Counter.format 3 cnt ++ name ++ ext ++ ".bc")
+
+writer :: String -> IO (String -> LLVM.Module -> IO ())
+writer name = fmap (bitcodeToFile name) $ Counter.next counter
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,12 @@
+module Main where
+
+import qualified Test.LLVM.DSL.Example.Median as Median
+import qualified LLVM.Core as LLVM
+
+import qualified Test.DocTest.Driver as DocTest
+
+
+main :: IO ()
+main = do
+   LLVM.initializeNativeTarget
+   DocTest.run Median.run
diff --git a/test/Test/LLVM/DSL/Example/Median.hs b/test/Test/LLVM/DSL/Example/Median.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/LLVM/DSL/Example/Median.hs
@@ -0,0 +1,133 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+module Test.LLVM.DSL.Example.Median where
+
+import qualified LLVM.DSL.Example.Median as Median
+import LLVM.DSL.Example.Median (MV)
+
+import qualified LLVM.DSL.Execution as Exec
+import qualified LLVM.DSL.Expression as Expr
+import LLVM.DSL.Expression (Exp)
+
+import qualified LLVM.Extra.Storable as Memory
+import qualified LLVM.Extra.Multi.Vector as MVec
+import qualified LLVM.Extra.Multi.Value as MV
+
+import qualified LLVM.Core as LLVM
+
+import Type.Data.Num.Decimal (D4)
+
+import qualified Data.Traversable as Trav
+import qualified Data.Foldable as Fold
+import qualified Data.List as List
+import Data.Int (Int32)
+
+import Control.Monad.IO.Class (liftIO)
+import Control.Applicative (liftA3)
+
+import Foreign (Ptr, peek, with, alloca)
+
+import qualified Test.DocTest.Driver as DocTest
+import System.IO.Unsafe (unsafePerformIO)
+
+
+
+unliftM3ExprFloat ::
+   (Exp Float -> Exp Float -> Exp Float -> Exp Float) ->
+   LLVM.Value Float -> LLVM.Value Float -> LLVM.Value Float ->
+   LLVM.CodeGenFunction Float (LLVM.Value Float)
+unliftM3ExprFloat f a b c = do
+   MV.Cons m <- Expr.unliftM3 f (MV.Cons a) (MV.Cons b) (MV.Cons c)
+   return m
+
+unliftM3ExprInt32 ::
+   (Exp Int32 -> Exp Int32 -> Exp Int32 -> Exp Int32) ->
+   LLVM.Value Int32 -> LLVM.Value Int32 -> LLVM.Value Int32 ->
+   LLVM.CodeGenFunction Int32 (LLVM.Value Int32)
+unliftM3ExprInt32 f a b c = do
+   MV.Cons m <- Expr.unliftM3 f (MV.Cons a) (MV.Cons b) (MV.Cons c)
+   return m
+
+unliftM3MVInt32 ::
+   (MV Int32 -> MV Int32 -> MV Int32 ->
+    LLVM.CodeGenFunction Int32 (MV Int32)) ->
+   LLVM.Value Int32 -> LLVM.Value Int32 -> LLVM.Value Int32 ->
+   LLVM.CodeGenFunction Int32 (LLVM.Value Int32)
+unliftM3MVInt32 f a b c = do
+   MV.Cons m <- f (MV.Cons a) (MV.Cons b) (MV.Cons c)
+   return m
+
+
+type ValPtrV4Int32 = LLVM.Value (Ptr (LLVM.Vector D4 Int32))
+
+unliftM3MVV4Int32 ::
+   (MVec.T D4 Int32 -> MVec.T D4 Int32 -> MVec.T D4 Int32 ->
+    LLVM.CodeGenFunction r (MVec.T D4 Int32)) ->
+   ValPtrV4Int32 -> ValPtrV4Int32 -> ValPtrV4Int32 ->
+   ValPtrV4Int32 -> LLVM.CodeGenFunction r ()
+unliftM3MVV4Int32 f aPtr bPtr cPtr mPtr = do
+   a <- MVec.Cons <$> Memory.load aPtr
+   b <- MVec.Cons <$> Memory.load bPtr
+   c <- MVec.Cons <$> Memory.load cPtr
+   MVec.Cons m <- f a b c
+   Memory.store m mPtr
+
+
+foreign import ccall safe "dynamic" derefMedian3Ptr ::
+   Exec.Importer (Int32 -> Int32 -> Int32 -> IO Int32)
+
+foreign import ccall safe "dynamic" derefMedian3V4Ptr ::
+   Exec.Importer
+      (Ptr (LLVM.Vector D4 Int32) ->
+       Ptr (LLVM.Vector D4 Int32) ->
+       Ptr (LLVM.Vector D4 Int32) ->
+       Ptr (LLVM.Vector D4 Int32) ->
+       IO ())
+
+foreign import ccall safe "dynamic" derefMedian3FloatPtr ::
+   Exec.Importer (Float -> Float -> Float -> IO Float)
+
+run :: DocTest.T ()
+run = do
+   let (funcNames, funcs) = unzip $
+
+         let func name f =
+               (name, Exec.createFunction derefMedian3Ptr name f) in
+
+         func "median3IfThen"  (unliftM3ExprInt32 Median.median3IfThen) :
+         func "median3Select"  (unliftM3ExprInt32 Median.median3Select) :
+         func "median3SelectS" (unliftM3ExprInt32 Median.median3SelectShared) :
+         func "median3MinMax"  (unliftM3ExprInt32 Median.median3MinMax) :
+         func "median3Case"    (unliftM3MVInt32 Median.median3Case) :
+         func "median3CaseVec" (unliftM3MVInt32 Median.median3CaseVec) :
+         []
+
+   (medianFloat, medianVector, medianFuncs) <-
+      liftIO $ Exec.compile "median" $
+      liftA3 (,,)
+         (Exec.createFunction derefMedian3FloatPtr "median3MinMaxFloat"
+            (unliftM3ExprFloat Median.median3MinMax))
+         (Exec.createFunction derefMedian3V4Ptr "median3MinMaxVector"
+            (unliftM3MVV4Int32 Median.median3MinMaxVector))
+         (Trav.sequenceA funcs)
+
+   let check expected m = do
+         DocTest.printPrefix (show m ++ "  ")
+         DocTest.property $ m == expected
+
+   do check 3 =<< liftIO (medianFloat 3 1 4)
+      DocTest.printPrefix "medianFloat: "
+      DocTest.property $ \a b c ->
+         unsafePerformIO (medianFloat a b c) == List.sort [a,b,c] !! 1
+
+   liftIO $ alloca $ \mv ->
+      with (LLVM.consVector 3 1 4 1) $ \av ->
+      with (LLVM.consVector 2 7 1 8) $ \bv ->
+      with (LLVM.consVector 5 7 7 2) $ \cv -> do
+         medianVector av bv cv mv
+         print =<< peek mv
+
+   Fold.for_ (zip funcNames medianFuncs) $ \(name, medianFunc) -> do
+      check 3 =<< liftIO (medianFunc 3 1 4)
+      DocTest.printPrefix (name ++ ": ")
+      DocTest.property $ \a b c ->
+         unsafePerformIO (medianFunc a b c) == List.sort [a,b,c] !! 1