diff --git a/Changes.md b/Changes.md
new file mode 100644
--- /dev/null
+++ b/Changes.md
@@ -0,0 +1,6 @@
+# Change log for the `llvm-extra` package
+
+## 0.8.1
+
+* `FastMath`: support for simplified arithmetic primitives
+  under the assumption of the absence of corner cases.
diff --git a/llvm-extra.cabal b/llvm-extra.cabal
--- a/llvm-extra.cabal
+++ b/llvm-extra.cabal
@@ -1,5 +1,5 @@
 Name:           llvm-extra
-Version:        0.8.0.3
+Version:        0.8.1
 License:        BSD3
 License-File:   LICENSE
 Author:         Henning Thielemann <haskell@henning-thielemann.de>
@@ -58,6 +58,7 @@
 Build-Type:     Simple
 Extra-Source-Files:
   Makefile
+  Changes.md
   Problems.txt
   x86/cpuid/LLVM/Extra/ExtensionCheck/X86.hs
   x86/none/LLVM/Extra/ExtensionCheck/X86.hs
@@ -75,7 +76,7 @@
   default:     True
 
 Source-Repository this
-  Tag:         0.8.0.3
+  Tag:         0.8.1
   Type:        darcs
   Location:    http://code.haskell.org/~thielema/llvm-extra/
 
@@ -87,12 +88,15 @@
   Build-Depends:
     -- llvm must be imported with restrictive version bounds,
     -- because we import implicitly and unqualified
-    llvm-tf >=3.1.1 && <3.2,
+    llvm-tf >=3.1.2 && <3.2,
     tfp >=1.0 && <1.1,
     non-empty >=0.2.1 && <0.4,
     containers >=0.1 && <0.7,
+    enumset >=0.0.5 && <0.1,
+    storable-enum >=0.0 && <0.1,
     bool8 >=0.0 && <0.1,
     transformers >=0.1.1 && <0.6,
+    tagged >=0.7 && <0.9,
     utility-ht >=0.0.11 && <0.1,
     prelude-compat >=0.0 && <0.0.1
 
@@ -130,6 +134,7 @@
     LLVM.Extra.Scalar
     LLVM.Extra.Vector
     LLVM.Extra.ScalarOrVector
+    LLVM.Extra.FastMath
     LLVM.Extra.Iterator
     LLVM.Extra.Multi.Iterator
     LLVM.Extra.Multi.Value
diff --git a/src/LLVM/Extra/FastMath.hs b/src/LLVM/Extra/FastMath.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Extra/FastMath.hs
@@ -0,0 +1,318 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module LLVM.Extra.FastMath where
+
+import qualified LLVM.Extra.Multi.Value.Private as MV
+import qualified LLVM.Extra.Arithmetic as A
+import qualified LLVM.Extra.Class as Class
+import qualified LLVM.Core as LLVM
+import LLVM.Util.Proxy (Proxy(Proxy))
+
+import Foreign.Storable (Storable)
+
+import qualified Control.Monad.HT as Monad
+import Control.Applicative ((<$>))
+
+
+data NoNaNs          = NoNaNs          deriving (Show, Eq)
+data NoInfs          = NoInfs          deriving (Show, Eq)
+data NoSignedZeros   = NoSignedZeros   deriving (Show, Eq)
+data AllowReciprocal = AllowReciprocal deriving (Show, Eq)
+data Fast            = Fast            deriving (Show, Eq)
+
+
+class Flags flags where
+   setFlags ::
+      (LLVM.IsFloating a) =>
+      Proxy flags -> Bool -> LLVM.Value a -> LLVM.CodeGenFunction r ()
+
+instance Flags NoNaNs          where setFlags Proxy = LLVM.setHasNoNaNs
+instance Flags NoInfs          where setFlags Proxy = LLVM.setHasNoInfs
+instance Flags NoSignedZeros   where setFlags Proxy = LLVM.setHasNoSignedZeros
+instance Flags AllowReciprocal where setFlags Proxy = LLVM.setHasAllowReciprocal
+instance Flags Fast            where setFlags Proxy = LLVM.setFastMath
+
+instance (Flags f0, Flags f1) => Flags (f0,f1) where
+   setFlags p b v = setFlags (fst<$>p) b v >> setFlags (snd<$>p) b v
+
+instance (Flags f0, Flags f1, Flags f2) => Flags (f0,f1,f2) where
+   setFlags = setSplitFlags $ \(f0,f1,f2) -> (f0,(f1,f2))
+
+instance (Flags f0, Flags f1, Flags f2, Flags f3) => Flags (f0,f1,f2,f3) where
+   setFlags = setSplitFlags $ \(f0,f1,f2,f3) -> (f0,(f1,f2,f3))
+
+instance
+   (Flags f0, Flags f1, Flags f2, Flags f3, Flags f4) =>
+      Flags (f0,f1,f2,f3,f4) where
+   setFlags = setSplitFlags $ \(f0,f1,f2,f3,f4) -> (f0,(f1,f2,f3,f4))
+
+setSplitFlags ::
+   (Flags split, LLVM.IsFloating a) =>
+   (flags -> split) ->
+   Proxy flags -> Bool -> LLVM.Value a -> LLVM.CodeGenFunction r ()
+setSplitFlags split p = setFlags (fmap split p)
+
+
+newtype Number flags a = Number {deconsNumber :: a}
+   deriving (Eq, Ord, Show, Num, Fractional, Floating, Storable)
+
+getNumber :: flags -> Number flags a -> a
+getNumber _ (Number a) = a
+
+instance MultiValue a => MV.C (Number flags a) where
+   type Repr f (Number flags a) = MV.Repr f a
+   cons = mvNumber . MV.cons . deconsNumber
+   undef = mvNumber MV.undef
+   zero = mvNumber MV.zero
+   phis bb = fmap mvNumber . MV.phis bb . mvDenumber
+   addPhis bb a b = MV.addPhis bb (mvDenumber a) (mvDenumber b)
+
+mvNumber :: MV.T a -> MV.T (Number flags a)
+mvNumber (MV.Cons a) = MV.Cons a
+
+mvDenumber :: MV.T (Number flags a) -> MV.T a
+mvDenumber (MV.Cons a) = MV.Cons a
+
+
+class MV.C a => MultiValue a where
+   setMultiValueFlags ::
+      (Flags flags) =>
+      Proxy flags -> Bool -> MV.T (Number flags a) -> LLVM.CodeGenFunction r ()
+
+instance MultiValue Float where
+   setMultiValueFlags p b (MV.Cons a) = setFlags p b a
+
+instance MultiValue Double where
+   setMultiValueFlags p b (MV.Cons a) = setFlags p b a
+
+
+type Id a = a -> a
+
+attachMultiValueFlags ::
+   (Flags flags, MultiValue a) =>
+   Id (LLVM.CodeGenFunction r (MV.T (Number flags a)))
+attachMultiValueFlags act = do
+   mv <- act
+   setMultiValueFlags Proxy True mv
+   return mv
+
+liftNumberM ::
+   (m ~ LLVM.CodeGenFunction r, Flags flags, MultiValue b) =>
+   (MV.T a -> m (MV.T b)) ->
+   MV.T (Number flags a) -> m (MV.T (Number flags b))
+liftNumberM f =
+   attachMultiValueFlags . Monad.lift mvNumber . f . mvDenumber
+
+liftNumberM2 ::
+   (m ~ LLVM.CodeGenFunction r, Flags flags, MultiValue c) =>
+   (MV.T a -> MV.T b -> m (MV.T c)) ->
+   MV.T (Number flags a) -> MV.T (Number flags b) -> m (MV.T (Number flags c))
+liftNumberM2 f a b =
+   attachMultiValueFlags $ Monad.lift mvNumber $ f (mvDenumber a) (mvDenumber b)
+
+
+instance (Flags flags, MV.Compose a) => MV.Compose (Number flags a) where
+   type Composed (Number flags a) = Number flags (MV.Composed a)
+   compose = mvNumber . MV.compose . deconsNumber
+
+instance (Flags flags, MV.Decompose pa) => MV.Decompose (Number flags pa) where
+   decompose (Number p) = Number . MV.decompose p . mvDenumber
+
+type instance
+   MV.Decomposed f (Number flags pa) = Number flags (MV.Decomposed f pa)
+type instance
+   MV.PatternTuple (Number flags pa) = Number flags (MV.PatternTuple pa)
+
+
+instance
+   (Flags flags, MultiValue a, MV.IntegerConstant a) =>
+      MV.IntegerConstant (Number flags a) where
+   fromInteger' = mvNumber . MV.fromInteger'
+
+instance
+   (Flags flags, MultiValue a, MV.RationalConstant a) =>
+      MV.RationalConstant (Number flags a) where
+   fromRational' = mvNumber . MV.fromRational'
+
+instance
+   (Flags flags, MultiValue a, MV.Additive a) =>
+      MV.Additive (Number flags a) where
+   add = liftNumberM2 MV.add
+   sub = liftNumberM2 MV.sub
+   neg = liftNumberM MV.neg
+
+instance
+   (Flags flags, MultiValue a, MV.PseudoRing a) =>
+      MV.PseudoRing (Number flags a) where
+   mul = liftNumberM2 MV.mul
+
+instance
+   (Flags flags, MultiValue a, MV.Field a) =>
+      MV.Field (Number flags a) where
+   fdiv = liftNumberM2 MV.fdiv
+
+type instance MV.Scalar (Number flags a) = Number flags (MV.Scalar a)
+
+instance
+   (Flags flags, MultiValue a, a ~ MV.Scalar v,
+    MultiValue v, MV.PseudoModule v) =>
+      MV.PseudoModule (Number flags v) where
+   scale = liftNumberM2 MV.scale
+
+instance
+   (Flags flags, MultiValue a, MV.Real a) =>
+      MV.Real (Number flags a) where
+   min = liftNumberM2 MV.min
+   max = liftNumberM2 MV.max
+   abs = liftNumberM MV.abs
+   signum = liftNumberM MV.signum
+
+instance
+   (Flags flags, MultiValue a, MV.Fraction a) =>
+      MV.Fraction (Number flags a) where
+   truncate = liftNumberM MV.truncate
+   fraction = liftNumberM MV.fraction
+
+instance
+   (Flags flags, MultiValue a, MV.Algebraic a) =>
+      MV.Algebraic (Number flags a) where
+   sqrt = liftNumberM MV.sqrt
+
+instance
+   (Flags flags, MultiValue a, MV.Transcendental a) =>
+      MV.Transcendental (Number flags a) where
+   pi = fmap mvNumber MV.pi
+   sin = liftNumberM MV.sin
+   cos = liftNumberM MV.cos
+   exp = liftNumberM MV.exp
+   log = liftNumberM MV.log
+   pow = liftNumberM2 MV.pow
+
+instance
+   (Flags flags, MultiValue a, MV.Select a) =>
+      MV.Select (Number flags a) where
+   select = liftNumberM2 . MV.select
+
+instance
+   (Flags flags, MultiValue a, MV.Comparison a) =>
+      MV.Comparison (Number flags a) where
+   cmp p a b = MV.cmp p (mvDenumber a) (mvDenumber b)
+
+instance
+   (Flags flags, MultiValue a, MV.FloatingComparison a) =>
+      MV.FloatingComparison (Number flags a) where
+   fcmp p a b = MV.fcmp p (mvDenumber a) (mvDenumber b)
+
+
+
+class Tuple a where
+   setTupleFlags ::
+      (Flags flags) => Proxy flags -> Bool -> a -> LLVM.CodeGenFunction r ()
+
+instance (LLVM.IsFloating a) => Tuple (LLVM.Value a) where
+   setTupleFlags = setFlags
+
+
+newtype Context flags a = Context a
+
+proxyFromContext :: Context flags a -> Proxy flags
+proxyFromContext (Context _) = Proxy
+
+instance
+   (Flags flags, Class.Zero a, Tuple a) =>
+      Class.Zero (Context flags a) where
+   zeroTuple = Context Class.zeroTuple
+
+instance
+   (Flags flags, Tuple a, A.Additive a) =>
+      A.Additive (Context flags a) where
+   zero = Context A.zero
+   add = liftContext2 A.add
+   sub = liftContext2 A.sub
+   neg = liftContext A.neg
+
+instance
+   (Flags flags, A.PseudoRing a, Tuple a) =>
+      A.PseudoRing (Context flags a) where
+   mul = liftContext2 A.mul
+
+type instance A.Scalar (Context flags a) = Context flags (A.Scalar a)
+
+instance
+   (Flags flags, A.PseudoModule v, Tuple v, A.Scalar v ~ a, Tuple a) =>
+      A.PseudoModule (Context flags v) where
+   scale = liftContext2 A.scale
+
+instance
+   (Flags flags, Tuple a, A.IntegerConstant a) =>
+      A.IntegerConstant (Context flags a) where
+   fromInteger' = Context . A.fromInteger'
+
+instance
+   (Flags flags, Tuple v, A.Field v) =>
+      A.Field (Context flags v) where
+   fdiv = liftContext2 A.fdiv
+
+instance
+   (Flags flags, Tuple a, A.RationalConstant a) =>
+      A.RationalConstant (Context flags a) where
+   fromRational' = Context . A.fromRational'
+
+instance (Flags flags, Tuple a, A.Real a) => A.Real (Context flags a) where
+   min = liftContext2 A.min
+   max = liftContext2 A.max
+   abs = liftContext A.abs
+   signum = liftContext A.signum
+
+instance
+   (Flags flags, Tuple a, A.Fraction a) =>
+      A.Fraction (Context flags a) where
+   truncate = liftContext A.truncate
+   fraction = liftContext A.fraction
+
+instance
+   (Flags flags, Tuple a, A.Comparison a) =>
+      A.Comparison (Context flags a) where
+   type CmpResult (Context flags a) = A.CmpResult a
+   cmp p (Context x) (Context y) = A.cmp p x y
+
+instance
+   (Flags flags, Tuple a, A.FloatingComparison a) =>
+      A.FloatingComparison (Context flags a) where
+   fcmp p (Context x) (Context y) = A.fcmp p x y
+
+instance
+   (Flags flags, Tuple a, A.Algebraic a) =>
+      A.Algebraic (Context flags a) where
+   sqrt = liftContext A.sqrt
+
+instance
+   (Flags flags, Tuple a, A.Transcendental a) =>
+      A.Transcendental (Context flags a) where
+   pi = attachTupleFlags A.pi
+   sin = liftContext A.sin
+   cos = liftContext A.cos
+   exp = liftContext A.exp
+   log = liftContext A.log
+   pow = liftContext2 A.pow
+
+
+attachTupleFlags ::
+   (Flags flags, Tuple a) =>
+   Id (LLVM.CodeGenFunction r (Context flags a))
+attachTupleFlags act = do
+   c@(Context x) <- act
+   setTupleFlags (proxyFromContext c) True x
+   return c
+
+liftContext :: (Flags flags, Tuple b) =>
+   (a -> LLVM.CodeGenFunction r b) ->
+   Context flags a -> LLVM.CodeGenFunction r (Context flags b)
+liftContext f (Context x) = attachTupleFlags (Context <$> f x)
+
+liftContext2 :: (Flags flags, Tuple c) =>
+   (a -> b -> LLVM.CodeGenFunction r c) ->
+   Context flags a -> Context flags b ->
+   LLVM.CodeGenFunction r (Context flags c)
+liftContext2 f (Context x) = liftContext $ f x
diff --git a/src/LLVM/Extra/Iterator.hs b/src/LLVM/Extra/Iterator.hs
--- a/src/LLVM/Extra/Iterator.hs
+++ b/src/LLVM/Extra/Iterator.hs
@@ -91,7 +91,16 @@
       (valueOf True)
       (\running -> MaybeCont.guard running >> return (a, valueOf False))
 
+cons :: (Phi a, Class.Undefined a) => a -> T r a -> T r a
+cons a0 (Cons s next) =
+   Cons Maybe.nothing
+      (fmap (mapSnd Maybe.just) .
+       MaybeCont.fromMaybe .
+       (\ms -> Maybe.run ms
+         (return $ Maybe.just (a0,s))
+         (MaybeCont.toMaybe . next)))
 
+
 instance Functor (T r) where
    fmap f (Cons s next) = Cons s (\s0 -> mapFst f <$> next s0)
 
@@ -138,13 +147,12 @@
                         (\a -> return (valueOf False, (Maybe.just a, s2)))))
             (return . snd))
 
+takeWhileJust :: T r (Maybe.T a) -> T r a
+takeWhileJust (Cons s next) =
+   Cons s (FuncHT.mapFst MaybeCont.fromPlainMaybe <=< next)
+
 takeWhile :: (a -> CodeGenFunction r (Value Bool)) -> T r a -> T r a
-takeWhile p (Cons s next) =
-   Cons s
-      (\s0 -> do
-         (a,s1) <- next s0
-         MaybeCont.guard =<< MaybeCont.lift (p a)
-         return (a,s1))
+takeWhile p = takeWhileJust . mapM (\a -> flip Maybe.fromBool a <$> p a)
 
 {- |
 Attention:
diff --git a/src/LLVM/Extra/MaybeContinuation.hs b/src/LLVM/Extra/MaybeContinuation.hs
--- a/src/LLVM/Extra/MaybeContinuation.hs
+++ b/src/LLVM/Extra/MaybeContinuation.hs
@@ -89,13 +89,11 @@
    m (return (valueOf False, undefTuple)) (return . (,) (valueOf True))
 
 
-fromMaybe ::
-   (Phi z) =>
-   CodeGenFunction r (Maybe.T a) -> T r z a
-fromMaybe m = do
-   Maybe.Cons b a <- lift m
-   guard b
-   return a
+fromPlainMaybe :: (Phi z) => Maybe.T a -> T r z a
+fromPlainMaybe (Maybe.Cons b a) = guard b >> return a
+
+fromMaybe :: (Phi z) => CodeGenFunction r (Maybe.T a) -> T r z a
+fromMaybe m = lift m >>= fromPlainMaybe
 
 toMaybe ::
    (Undefined a) =>
diff --git a/src/LLVM/Extra/MaybePrivate.hs b/src/LLVM/Extra/MaybePrivate.hs
--- a/src/LLVM/Extra/MaybePrivate.hs
+++ b/src/LLVM/Extra/MaybePrivate.hs
@@ -104,3 +104,11 @@
    (a -> b -> CodeGenFunction r c) ->
    T a -> T b -> CodeGenFunction r (T c)
 liftM2 f ma mb = Monad.join $ fmap sequence $ lift2 f ma mb
+
+
+maybeArg ::
+   (Phi b) =>
+   b ->
+   (a -> CodeGenFunction r (T b)) ->
+   T a -> CodeGenFunction r (T b)
+maybeArg undef f m = run m (return $ nothing undef) f
diff --git a/src/LLVM/Extra/Multi/Iterator.hs b/src/LLVM/Extra/Multi/Iterator.hs
--- a/src/LLVM/Extra/Multi/Iterator.hs
+++ b/src/LLVM/Extra/Multi/Iterator.hs
@@ -1,21 +1,31 @@
+{-# LANGUAGE TypeFamilies #-}
 module LLVM.Extra.Multi.Iterator (
    takeWhile,
    countDown,
    take,
+   Enum(..),
    ) where
 
 import qualified LLVM.Extra.Multi.Value as MultiValue
 import qualified LLVM.Extra.Iterator as Iter
+import qualified LLVM.Extra.ScalarOrVector as SoV
+import qualified LLVM.Extra.MaybePrivate as Maybe
+import qualified LLVM.Extra.Arithmetic as A
+import qualified LLVM.Extra.Control as C
+import LLVM.Extra.Class (undefTuple)
 
 import qualified LLVM.Core as LLVM
 import LLVM.Core (CodeGenFunction)
 
 import Control.Applicative (liftA2)
 
-import Prelude hiding (take, takeWhile)
+import qualified Data.Enum.Storable as Enum
 
+import qualified Prelude as P
+import Prelude hiding (take, takeWhile, Enum, enumFrom, enumFromTo)
 
 
+
 takeWhile ::
    (a -> CodeGenFunction r (MultiValue.T Bool)) ->
    Iter.T r a -> Iter.T r a
@@ -37,3 +47,49 @@
     MultiValue.IntegerConstant i) =>
    MultiValue.T i -> Iter.T r a -> Iter.T r a
 take len xs = liftA2 const xs (countDown len)
+
+
+class Enum a where
+   succ, pred :: MultiValue.T a -> LLVM.CodeGenFunction r (MultiValue.T a)
+   enumFrom :: MultiValue.T a -> Iter.T r (MultiValue.T a)
+   enumFromTo :: MultiValue.T a -> MultiValue.T a -> Iter.T r (MultiValue.T a)
+
+instance
+   (LLVM.IsInteger w, SoV.IntegerConstant w, Num w,
+    LLVM.CmpRet w, LLVM.CmpResult w ~ Bool, P.Enum e) =>
+      Enum (Enum.T w e) where
+   succ = MultiValue.succ
+   pred = MultiValue.pred
+   enumFrom = Iter.iterate MultiValue.succ
+   {- |
+   More complicated than 'enumFromToSimple'
+   but works also for e.g. [0 .. (0xFFFF::Word16)].
+   -}
+   enumFromTo from to =
+      Iter.takeWhileJust $
+      Iter.iterate (Maybe.maybeArg undefTuple (succMax to)) (Maybe.just from)
+
+succMax ::
+   (LLVM.IsInteger w, SoV.IntegerConstant w, Num w,
+    LLVM.CmpRet w, LLVM.CmpResult w ~ Bool, P.Enum e) =>
+   MultiValue.T (Enum.T w e) ->
+   MultiValue.T (Enum.T w e) ->
+   LLVM.CodeGenFunction r (Maybe.T (MultiValue.T (Enum.T w e)))
+succMax to e = do
+   MultiValue.Cons less <- MultiValue.cmpEnum A.CmpLT e to
+   C.ifThen less (Maybe.nothing undefTuple) $
+      fmap Maybe.just $ MultiValue.succ e
+
+{- |
+Warning: For [0 .. (0xFFFF::Word16)]
+it would compute an undefined @0xFFFF+1@.
+In modulo arithmetic it would enter an infinite loop.
+-}
+_enumFromToSimple ::
+   (LLVM.IsInteger w, SoV.IntegerConstant w, Num w,
+    LLVM.CmpRet w, LLVM.CmpResult w ~ Bool, P.Enum e) =>
+   MultiValue.T (Enum.T w e) ->
+   MultiValue.T (Enum.T w e) ->
+   Iter.T r (MultiValue.T (Enum.T w e))
+_enumFromToSimple from to =
+   takeWhile (MultiValue.cmpEnum LLVM.CmpGE to) $ enumFrom from
diff --git a/src/LLVM/Extra/Multi/Value/Memory.hs b/src/LLVM/Extra/Multi/Value/Memory.hs
--- a/src/LLVM/Extra/Multi/Value/Memory.hs
+++ b/src/LLVM/Extra/Multi/Value/Memory.hs
@@ -14,6 +14,7 @@
 import Foreign.StablePtr (StablePtr, )
 import Foreign.Ptr (Ptr, FunPtr, castPtr, )
 
+import Data.Tagged (Tagged)
 import Data.Complex (Complex, )
 import Data.Word (Word8, Word16, Word32, Word64, )
 import Data.Int (Int8, Int16, Int32, Int64, )
@@ -179,6 +180,11 @@
    MultiValue.T a -> CodeGenFunction r (Value (LLVM.Struct ()))
 composeUnit _ = return (LLVM.value $ LLVM.constStruct ())
 
+
+instance (C a) => C (Tagged tag a) where
+   type Struct (Tagged tag a) = Struct a
+   decompose = fmap MultiValue.tag . decompose
+   compose = compose . MultiValue.untag
 
 instance (C a) => C (Complex a) where
    type Struct (Complex a) = LLVM.Struct (Struct a, (Struct a, ()))
diff --git a/src/LLVM/Extra/Multi/Value/Private.hs b/src/LLVM/Extra/Multi/Value/Private.hs
--- a/src/LLVM/Extra/Multi/Value/Private.hs
+++ b/src/LLVM/Extra/Multi/Value/Private.hs
@@ -26,8 +26,11 @@
 
 import qualified Data.Tuple.HT as TupleHT
 import qualified Data.Tuple as Tuple
+import qualified Data.EnumBitSet as EnumBitSet
+import qualified Data.Enum.Storable as Enum
 import qualified Data.Bool8 as Bool8
 import Data.Complex (Complex((:+)))
+import Data.Tagged (Tagged(Tagged, unTagged))
 import Data.Function (id, (.), ($), )
 import Data.Tuple.HT (uncurry3, )
 import Data.Maybe (Maybe(Nothing,Just), )
@@ -36,6 +39,7 @@
 import Data.Int (Int8, Int16, Int32, Int64, )
 import Data.Bool8 (Bool8)
 
+import qualified Prelude as P
 import Prelude (Float, Double, Integer, Rational, )
 
 
@@ -252,6 +256,59 @@
 floatFromBool8 = liftM LLVM.uitofp
 
 
+instance
+   (LLVM.IsInteger w, LLVM.IsConst w, P.Num w, P.Enum e) =>
+      C (Enum.T w e) where
+   type Repr f (Enum.T w e) = f w
+   cons = consPrimitive . P.fromIntegral . P.fromEnum . Enum.toPlain
+   undef = undefPrimitive
+   zero = zeroPrimitive
+   phis = phisPrimitive
+   addPhis = addPhisPrimitive
+
+toEnum ::
+   (Repr LLVM.Value w ~ LLVM.Value w) =>
+   T w -> T (Enum.T w e)
+toEnum (Cons w) = Cons w
+
+fromEnum ::
+   (Repr LLVM.Value w ~ LLVM.Value w) =>
+   T (Enum.T w e) -> T w
+fromEnum (Cons w) = Cons w
+
+succ, pred ::
+   (LLVM.IsArithmetic w, SoV.IntegerConstant w) =>
+   T (Enum.T w e) -> LLVM.CodeGenFunction r (T (Enum.T w e))
+succ = liftM $ \w -> A.add w A.one
+pred = liftM $ \w -> A.sub w A.one
+
+-- cannot be an instance of 'Comparison' because there is no 'Real' instance
+cmpEnum ::
+   (LLVM.CmpRet w, LLVM.CmpResult w ~ Bool) =>
+   LLVM.CmpPredicate -> T (Enum.T w a) -> T (Enum.T w a) ->
+   LLVM.CodeGenFunction r (T Bool)
+cmpEnum = liftM2 . LLVM.cmp
+
+
+class (C a) => Bounded a where
+   minBound, maxBound :: T a
+
+instance
+   (LLVM.IsInteger w, LLVM.IsConst w, P.Num w, P.Enum e, P.Bounded e) =>
+      Bounded (Enum.T w e) where
+   minBound = cons P.minBound
+   maxBound = cons P.maxBound
+
+
+instance (LLVM.IsInteger w, LLVM.IsConst w) => C (EnumBitSet.T w i) where
+   type Repr f (EnumBitSet.T w i) = f w
+   cons = consPrimitive . EnumBitSet.decons
+   undef = undefPrimitive
+   zero = zeroPrimitive
+   phis = phisPrimitive
+   addPhis = addPhisPrimitive
+
+
 instance (C a) => C (Maybe a) where
    type Repr f (Maybe a) = (f Bool, Repr f a)
    cons Nothing = nothing
@@ -406,6 +463,31 @@
 unzip4 (Cons (a,b,c,d)) = (Cons a, Cons b, Cons c, Cons d)
 
 
+instance C a => C (Tagged tag a) where
+   type Repr f (Tagged tag a) = Repr f a
+   cons = tag . cons . unTagged
+   undef = tag undef
+   zero = tag zero
+   phis bb = fmap tag . phis bb . untag
+   addPhis bb a b = addPhis bb (untag a) (untag b)
+
+tag :: T a -> T (Tagged tag a)
+tag (Cons a) = Cons a
+
+untag :: T (Tagged tag a) -> T a
+untag (Cons a) = Cons a
+
+liftTaggedM ::
+   (Monad m) => (T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
+liftTaggedM f = Monad.lift tag . f . untag
+
+liftTaggedM2 ::
+   (Monad m) =>
+   (T a -> T b -> m (T c)) ->
+   T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
+liftTaggedM2 f a b = Monad.lift tag $ f (untag a) (untag b)
+
+
 instance (C a) => C (Complex a) where
    type Repr f (Complex a) = Complex (Repr f a)
    cons (a:+b) = consComplex (cons a) (cons b)
@@ -512,7 +594,7 @@
    type Composed () = ()
    compose = cons
 
-instance () => Decompose () where
+instance Decompose () where
    decompose () _ = ()
 
 type instance Decomposed f () = ()
@@ -564,6 +646,17 @@
         (PatternTuple pa, PatternTuple pb, PatternTuple pc, PatternTuple pd)
 
 
+instance (Compose a) => Compose (Tagged tag a) where
+   type Composed (Tagged tag a) = Tagged tag (Composed a)
+   compose = tag . compose . unTagged
+
+instance (Decompose pa) => Decompose (Tagged tag pa) where
+   decompose (Tagged p) = Tagged . decompose p . untag
+
+type instance Decomposed f (Tagged tag pa) = Tagged tag (Decomposed f pa)
+type instance PatternTuple (Tagged tag pa) = Tagged tag (PatternTuple pa)
+
+
 instance (Compose a) => Compose (Complex a) where
    type Composed (Complex a) = Complex (Composed a)
    compose (a:+b) = consComplex (compose a) (compose b)
@@ -644,10 +737,16 @@
 instance (Dec.Positive n) => IntegerConstant (WordN n) where fromInteger' = Cons . LLVM.value . SoV.constFromInteger
 instance (Dec.Positive n) => IntegerConstant (IntN n) where fromInteger' = Cons . LLVM.value . SoV.constFromInteger
 
+instance IntegerConstant a => IntegerConstant (Tagged tag a) where
+   fromInteger' = tag . fromInteger'
+
 instance RationalConstant Float  where fromRational' = Cons . LLVM.value . SoV.constFromRational
 instance RationalConstant Double where fromRational' = Cons . LLVM.value . SoV.constFromRational
 
+instance RationalConstant a => RationalConstant (Tagged tag a) where
+   fromRational' = tag . fromRational'
 
+
 instance (IntegerConstant a) => A.IntegerConstant (T a) where
    fromInteger' = fromInteger'
 
@@ -720,6 +819,11 @@
    sub = liftM2 LLVM.sub
    neg = liftM LLVM.neg
 
+instance Additive a => Additive (Tagged tag a) where
+   add = liftTaggedM2 add
+   sub = liftTaggedM2 sub
+   neg = liftTaggedM neg
+
 instance (Additive a) => A.Additive (T a) where
    zero = zero
    add = add
@@ -728,8 +832,8 @@
 
 inc, dec ::
    (Additive i, IntegerConstant i) => T i -> LLVM.CodeGenFunction r (T i)
-inc x = add x (fromInteger' 1)
-dec x = sub x (fromInteger' 1)
+inc x = add x A.one
+dec x = sub x A.one
 
 
 class (Additive a) => PseudoRing a where
@@ -746,6 +850,9 @@
 instance PseudoRing Int32 where mul = liftM2 LLVM.mul
 instance PseudoRing Int64 where mul = liftM2 LLVM.mul
 
+instance (PseudoRing a) => PseudoRing (Tagged tag a) where
+   mul = liftTaggedM2 mul
+
 instance (PseudoRing a) => A.PseudoRing (T a) where
    mul = mul
 
@@ -759,6 +866,9 @@
 instance Field Double where
    fdiv = liftM2 LLVM.fdiv
 
+instance (Field a) => Field (Tagged tag a) where
+   fdiv = liftTaggedM2 fdiv
+
 instance (Field a) => A.Field (T a) where
    fdiv = fdiv
 
@@ -766,6 +876,7 @@
 type family Scalar vector :: *
 type instance Scalar Float = Float
 type instance Scalar Double = Double
+type instance Scalar (Tagged tag a) = Tagged tag (Scalar a)
 type instance A.Scalar (T a) = T (Scalar a)
 
 class (PseudoRing (Scalar v), Additive v) => PseudoModule v where
@@ -777,6 +888,9 @@
 instance PseudoModule Double where
    scale = liftM2 A.mul
 
+instance (PseudoModule a) => PseudoModule (Tagged tag a) where
+   scale = liftTaggedM2 scale
+
 instance (PseudoModule a) => A.PseudoModule (T a) where
    scale = scale
 
@@ -859,6 +973,12 @@
    abs = liftM A.abs
    signum = liftM A.signum
 
+instance (Real a) => Real (Tagged tag a) where
+   min = liftTaggedM2 min
+   max = liftTaggedM2 max
+   abs = liftTaggedM abs
+   signum = liftTaggedM signum
+
 instance (Real a) => A.Real (T a) where
    min = min
    max = max
@@ -878,6 +998,10 @@
    truncate = liftM A.truncate
    fraction = liftM A.fraction
 
+instance (Fraction a) => Fraction (Tagged tag a) where
+   truncate = liftTaggedM truncate
+   fraction = liftTaggedM fraction
+
 instance (Fraction a) => A.Fraction (T a) where
    truncate = truncate
    fraction = fraction
@@ -933,6 +1057,9 @@
 instance Algebraic Double where
    sqrt = liftM A.sqrt
 
+instance (Algebraic a) => Algebraic (Tagged tag a) where
+   sqrt = liftTaggedM sqrt
+
 instance (Algebraic a) => A.Algebraic (T a) where
    sqrt = sqrt
 
@@ -958,6 +1085,14 @@
    log = liftM A.log
    pow = liftM2 A.pow
 
+instance (Transcendental a) => Transcendental (Tagged tag a) where
+   pi = fmap tag pi
+   sin = liftTaggedM sin
+   cos = liftTaggedM cos
+   exp = liftTaggedM exp
+   log = liftTaggedM log
+   pow = liftTaggedM2 pow
+
 instance (Transcendental a) => A.Transcendental (T a) where
    pi = pi
    sin = sin
@@ -1003,6 +1138,9 @@
             (select b b0 b1)
             (select b c0 c1)
 
+instance (Select a) => Select (Tagged tag a) where
+   select = liftTaggedM2 . select
+
 instance (Select a) => C.Select (T a) where
    select b = select (Cons b)
 
@@ -1034,6 +1172,9 @@
 instance (Dec.Positive n) => Comparison (IntN n) where cmp = liftM2 . LLVM.cmp
 instance (Dec.Positive n) => Comparison (WordN n) where cmp = liftM2 . LLVM.cmp
 
+instance (Comparison a) => Comparison (Tagged tag a) where
+   cmp p a b = cmp p (untag a) (untag b)
+
 instance (Comparison a) => A.Comparison (T a) where
    type CmpResult (T a) = T Bool
    cmp = cmp
@@ -1048,6 +1189,9 @@
 instance FloatingComparison Float where
    fcmp = liftM2 . LLVM.fcmp
 
+instance (FloatingComparison a) => FloatingComparison (Tagged tag a) where
+   fcmp p a b = fcmp p (untag a) (untag b)
+
 instance (FloatingComparison a) => A.FloatingComparison (T a) where
    fcmp = fcmp
 
@@ -1087,7 +1231,15 @@
    and = liftM2 LLVM.and; or = liftM2 LLVM.or
    xor = liftM2 LLVM.xor; inv = liftM LLVM.inv
 
+instance (LLVM.IsInteger w, LLVM.IsConst w) => Logic (EnumBitSet.T w i) where
+   and = liftM2 LLVM.and; or = liftM2 LLVM.or
+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv
 
+instance Logic a => Logic (Tagged tag a) where
+   and = liftTaggedM2 and; or = liftTaggedM2 or
+   xor = liftTaggedM2 xor; inv = liftTaggedM inv
+
+
 instance Logic a => A.Logic (T a) where
    and = and
    or = or
@@ -1145,6 +1297,10 @@
 instance Integral Int64 where
    idiv = liftM2 LLVM.idiv
    irem = liftM2 LLVM.irem
+
+instance (Integral a) => Integral (Tagged tag a) where
+   idiv = liftTaggedM2 idiv
+   irem = liftTaggedM2 irem
 
 
 fromIntegral ::