diff --git a/INSTALL.txt b/INSTALL.txt
--- a/INSTALL.txt
+++ b/INSTALL.txt
@@ -10,8 +10,15 @@
 -------------
 
 Firstly, you'll need to have LLVM.  I recommend installing LLVM
-version 2.4 which is what it's been tested with.
+version 2.4 (from llvm.org) which is what it's been tested with.
+Do A or B.
 
+A) Install from a binary package.  Follow the LLVM instructions.
+The binary package at llvm.org for Windows only contains executable
+files and no libraries.  You can find a complete Windows binary package
+at ???.
+
+B) Install from source.
 Build this and install it somewhere.  Follow the LLVM instructions,
 or use this:
 
@@ -26,8 +33,12 @@
 Building
 --------
 It's normal cabal package, but using a configure script as well to
-configure LLVM.  It can be build and installed with the usual
-three steps.
+configure LLVM.  Do A or B.
+
+A) If you have cabal-install just do
+  cabal install --configure-option --with-llvm-prefix=$SOMEWHERE
+
+B) If you don't have cabal-install:
 
 Configure the package.
   runhaskell Setup configure --configure-option --with-llvm-prefix=$SOMEWHERE
diff --git a/LLVM/Core.hs b/LLVM/Core.hs
--- a/LLVM/Core.hs
+++ b/LLVM/Core.hs
@@ -44,7 +44,7 @@
     zero, allOnes, undef,
     createString, createStringNul,
     constVector, constArray,
-    mkVector,
+    toVector, fromVector,
     -- * Code generation
     CodeGenFunction, CodeGenModule,
     -- * Functions
@@ -58,8 +58,10 @@
     Linkage(..),
     -- * Basic blocks
     BasicBlock, newBasicBlock, newNamedBasicBlock, defineBasicBlock, createBasicBlock, getCurrentBasicBlock,
+    -- * Misc
+    addAttributes, Attribute(..),
     -- * Debugging
-    dumpValue, dumpType,
+    dumpValue, dumpType, getValueName,
     -- * Transformations
     addCFGSimplificationPass, addConstantPropagationPass, addDemoteMemoryToRegisterPass,
     addGVNPass, addInstructionCombiningPass, addPromoteMemoryToRegisterPass, addReassociatePass,
@@ -79,8 +81,13 @@
 dumpValue :: Value a -> IO ()
 dumpValue (Value v) = FFI.dumpValue v
 
+-- |Print a type.
 dumpType :: Value a -> IO ()
 dumpType (Value v) = showTypeOf v >>= putStrLn
+
+-- |Get the name of a 'Value'.
+getValueName :: Value a -> IO String
+getValueName (Value a) = getValueNameU a
 
 -- TODO for types:
 -- Enforce free is only called on malloc memory.  (Enforce only one free?)
diff --git a/LLVM/Core/CodeGen.hs b/LLVM/Core/CodeGen.hs
--- a/LLVM/Core/CodeGen.hs
+++ b/LLVM/Core/CodeGen.hs
@@ -7,6 +7,8 @@
     Linkage(..),
     -- * Function creation
     Function, newFunction, newNamedFunction, defineFunction, createFunction, createNamedFunction,
+    addAttributes,
+    FFI.Attribute(..),
     externFunction,
     FunctionArgs, FunctionRet,
     TFunction,
@@ -72,6 +74,7 @@
 
 newtype ConstValue a = ConstValue FFI.ValueRef
 
+-- XXX merge with IsArithmetic?
 class (IsArithmetic a) => IsConst a where
     constOf :: a -> ConstValue a
 
@@ -186,6 +189,12 @@
     f <- newNamedFunction linkage name
     defineFunction f body
     return f
+
+-- | Add attributes to a value.  Beware, what attributes are allowed depends on
+-- what kind of value it is.
+addAttributes :: Value a -> Int -> [FFI.Attribute] -> CodeGenFunction r ()
+addAttributes (Value f) i as = do
+    liftIO $ FFI.addInstrAttribute f (fromIntegral i) (sum $ map FFI.fromAttribute as)
 
 -- XXX This is ugly, it must be possible to make it simpler
 -- Convert a function of type f = t1->t2->...-> IO r to
diff --git a/LLVM/Core/Instructions.hs b/LLVM/Core/Instructions.hs
--- a/LLVM/Core/Instructions.hs
+++ b/LLVM/Core/Instructions.hs
@@ -35,7 +35,8 @@
     ptrtoint, inttoptr,
     bitcast,
     -- * Comparison
-    IntPredicate(..), RealPredicate(..),
+    IntPredicate(..), FPPredicate(..),
+    CmpRet,
     icmp, fcmp,
     select,
     -- * Other
@@ -144,8 +145,6 @@
 
 --------------------------------------
 
--- XXX Vector ops not implemented
-
 type FFIBinOp = FFI.BuilderRef -> FFI.ValueRef -> FFI.ValueRef -> U.CString -> IO FFI.ValueRef
 type FFIConstBinOp = FFI.ValueRef -> FFI.ValueRef -> FFI.ValueRef
 
@@ -271,47 +270,48 @@
 
 -- XXX size a > size b not enforced
 -- | Truncate a value to a shorter bit width.
-trunc :: (IsInteger a, IsInteger b) => Value a -> CodeGenFunction r (Value b)
+trunc :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)
 trunc = convert FFI.buildTrunc
 
 -- XXX size a < size b not enforced
 -- | Zero extend a value to a wider width.
-zext :: (IsInteger a, IsInteger b) => Value a -> CodeGenFunction r (Value b)
+zext :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)
 zext = convert FFI.buildZExt
 
 -- XXX size a < size b not enforced
 -- | Sign extend a value to wider width.
-sext :: (IsInteger a, IsInteger b) => Value a -> CodeGenFunction r (Value b)
+sext :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)
 sext = convert FFI.buildSExt
 
 -- XXX size a > size b not enforced
 -- | Truncate a floating point value.
-fptrunc :: (IsFloating a, IsFloating b) => Value a -> CodeGenFunction r (Value b)
+fptrunc :: (IsFloating a, IsFloating b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)
 fptrunc = convert FFI.buildFPTrunc
 
 -- XXX size a < size b not enforced
 -- | Extend a floating point value.
-fpext :: (IsFloating a, IsFloating b) => Value a -> CodeGenFunction r (Value b)
+fpext :: (IsFloating a, IsFloating b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)
 fpext = convert FFI.buildFPExt
 
+-- XXX The fp<->i conversion can handle vectors.
 -- | Convert a floating point value to an unsigned integer.
-fptoui :: (IsFloating a, IsInteger b) => Value a -> CodeGenFunction r (Value b)
+fptoui :: (IsFloating a, IsInteger b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)
 fptoui = convert FFI.buildFPToUI
 
 -- | Convert a floating point value to a signed integer.
-fptosi :: (IsFloating a, IsInteger b) => Value a -> CodeGenFunction r (Value b)
+fptosi :: (IsFloating a, IsInteger b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)
 fptosi = convert FFI.buildFPToSI
 
 -- | Convert an unsigned integer to a floating point value.
-uitofp :: (IsInteger a, IsFloating b) => Value a -> CodeGenFunction r (Value b)
+uitofp :: (IsInteger a, IsFloating b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)
 uitofp = convert FFI.buildUIToFP
 
 -- | Convert a signed integer to a floating point value.
-sitofp :: (IsInteger a, IsFloating b) => Value a -> CodeGenFunction r (Value b)
+sitofp :: (IsInteger a, IsFloating b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)
 sitofp = convert FFI.buildSIToFP
 
 -- | Convert a pointer to an integer.
-ptrtoint :: (IsInteger b) => Value (Ptr a) -> CodeGenFunction r (Value b)
+ptrtoint :: (IsInteger b, IsPrimitive b) => Value (Ptr a) -> CodeGenFunction r (Value b)
 ptrtoint = convert FFI.buildPtrToInt
 
 -- | Convert an integer to a pointer.
@@ -349,56 +349,74 @@
 fromIntPredicate :: IntPredicate -> CInt
 fromIntPredicate p = fromIntegral (fromEnum p + 32)
 
-data RealPredicate =
-    RealFalse           -- ^ Always false (always folded)
-  | RealOEQ             -- ^ True if ordered and equal
-  | RealOGT             -- ^ True if ordered and greater than
-  | RealOGE             -- ^ True if ordered and greater than or equal
-  | RealOLT             -- ^ True if ordered and less than
-  | RealOLE             -- ^ True if ordered and less than or equal
-  | RealONE             -- ^ True if ordered and operands are unequal
-  | RealORD             -- ^ True if ordered (no nans)
-  | RealUNO             -- ^ True if unordered: isnan(X) | isnan(Y)
-  | RealUEQ             -- ^ True if unordered or equal
-  | RealUGT             -- ^ True if unordered or greater than
-  | RealUGE             -- ^ True if unordered, greater than, or equal
-  | RealULT             -- ^ True if unordered or less than
-  | RealULE             -- ^ True if unordered, less than, or equal
-  | RealUNE             -- ^ True if unordered or not equal
-  | RealT               -- ^ Always true (always folded)
+data FPPredicate =
+    FPFalse           -- ^ Always false (always folded)
+  | FPOEQ             -- ^ True if ordered and equal
+  | FPOGT             -- ^ True if ordered and greater than
+  | FPOGE             -- ^ True if ordered and greater than or equal
+  | FPOLT             -- ^ True if ordered and less than
+  | FPOLE             -- ^ True if ordered and less than or equal
+  | FPONE             -- ^ True if ordered and operands are unequal
+  | FPORD             -- ^ True if ordered (no nans)
+  | FPUNO             -- ^ True if unordered: isnan(X) | isnan(Y)
+  | FPUEQ             -- ^ True if unordered or equal
+  | FPUGT             -- ^ True if unordered or greater than
+  | FPUGE             -- ^ True if unordered, greater than, or equal
+  | FPULT             -- ^ True if unordered or less than
+  | FPULE             -- ^ True if unordered, less than, or equal
+  | FPUNE             -- ^ True if unordered or not equal
+  | FPT               -- ^ Always true (always folded)
     deriving (Eq, Ord, Enum, Show)
 
-fromRealPredicate :: RealPredicate -> CInt
-fromRealPredicate p = fromIntegral (fromEnum p)
+fromFPPredicate :: FPPredicate -> CInt
+fromFPPredicate p = fromIntegral (fromEnum p)
 
 -- |Acceptable operands to comparison instructions.
-class CmpOp a b c | a b -> c where
-    cmpop :: FFIBinOp -> a -> b -> CodeGenFunction r (Value Bool)
+class CmpOp a b c d | a b -> c where
+    cmpop :: FFIBinOp -> a -> b -> CodeGenFunction r (Value d)
 
-instance CmpOp (Value a) (Value a) a where
+instance CmpOp (Value a) (Value a) a d where
     cmpop op (Value a1) (Value a2) = buildBinOp op a1 a2
 
-instance (IsConst a) => CmpOp a (Value a) a where
+instance (IsConst a) => CmpOp a (Value a) a d where
     cmpop op a1 a2 = cmpop op (valueOf a1) a2
 
-instance (IsConst a) => CmpOp (Value a) a a where
+instance (IsConst a) => CmpOp (Value a) a a d where
     cmpop op a1 a2 = cmpop op a1 (valueOf a2)
 
+class CmpRet a b | a -> b
+instance CmpRet Float Bool
+instance CmpRet Double Bool
+instance CmpRet FP128 Bool
+instance CmpRet Bool Bool
+instance CmpRet Word8 Bool
+instance CmpRet Word16 Bool
+instance CmpRet Word32 Bool
+instance CmpRet Word64 Bool
+instance CmpRet Int8 Bool
+instance CmpRet Int16 Bool
+instance CmpRet Int32 Bool
+instance CmpRet Int64 Bool
+instance CmpRet (Vector n a) (Vector n Bool)
+
+-- XXX Vector
 -- | Compare integers.
-icmp :: (IsInteger c, CmpOp a b c) =>
-        IntPredicate -> a -> b -> CodeGenFunction r (Value Bool)
+icmp :: (IsInteger c, CmpOp a b c d, CmpRet c d) =>
+        IntPredicate -> a -> b -> CodeGenFunction r (Value d)
 icmp p = cmpop (flip FFI.buildICmp (fromIntPredicate p))
 
+-- XXX Vector
 -- | Compare floating point values.
-fcmp :: (IsFloating c, CmpOp a b c) =>
-        RealPredicate -> a -> b -> CodeGenFunction r (Value Bool)
-fcmp p = cmpop (flip FFI.buildFCmp (fromRealPredicate p))
+fcmp :: (IsFloating c, CmpOp a b c d, CmpRet c d) =>
+        FPPredicate -> a -> b -> CodeGenFunction r (Value d)
+fcmp p = cmpop (flip FFI.buildFCmp (fromFPPredicate p))
 
 --------------------------------------
 
+-- XXX can handle vectors, needs bool vector args
 -- XXX could do const song and dance
 -- | Select between two values depending on a boolean.
-select :: (IsFirstClass a) => Value Bool -> Value a -> Value a -> CodeGenFunction r (Value a)
+select :: (IsFirstClass a, CmpRet a b) => Value b -> Value a -> Value a -> CodeGenFunction r (Value a)
 select (Value cnd) (Value thn) (Value els) =
     liftM Value $
       withCurrentBuilder $ \ bldPtr ->
@@ -632,25 +650,25 @@
 {-
 instance (IsConst a) => Eq (ConstValue a) where
     ConstValue x == ConstValue y  =
-        if isFloating x then ConstValue (FFI.constFCmp (fromRealPredicate RealOEQ) x y)
-                        else ConstValue (FFI.constICmp (fromIntPredicate    IntEQ) x y)
+        if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate  FPOEQ) x y)
+                        else ConstValue (FFI.constICmp (fromIntPredicate IntEQ) x y)
     ConstValue x /= ConstValue y  =
-        if isFloating x then ConstValue (FFI.constFCmp (fromRealPredicate RealONE) x y)
-                        else ConstValue (FFI.constICmp (fromIntPredicate    IntNE) x y)
+        if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate  FPONE) x y)
+                        else ConstValue (FFI.constICmp (fromIntPredicate IntNE) x y)
 
 instance (IsConst a) => Ord (ConstValue a) where
     ConstValue x <  ConstValue y  =
-        if isFloating x then ConstValue (FFI.constFCmp (fromRealPredicate RealOLT) x y)
-                        else ConstValue (FFI.constICmp (fromIntPredicate    IntLT) x y)
+        if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate  FPOLT) x y)
+                        else ConstValue (FFI.constICmp (fromIntPredicate IntLT) x y)
     ConstValue x <= ConstValue y  =
-        if isFloating x then ConstValue (FFI.constFCmp (fromRealPredicate RealOLE) x y)
-                        else ConstValue (FFI.constICmp (fromIntPredicate    IntLE) x y)
+        if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate  FPOLE) x y)
+                        else ConstValue (FFI.constICmp (fromIntPredicate IntLE) x y)
     ConstValue x >  ConstValue y  =
-        if isFloating x then ConstValue (FFI.constFCmp (fromRealPredicate RealOGT) x y)
-                        else ConstValue (FFI.constICmp (fromIntPredicate    IntGT) x y)
+        if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate  FPOGT) x y)
+                        else ConstValue (FFI.constICmp (fromIntPredicate IntGT) x y)
     ConstValue x >= ConstValue y  =
-        if isFloating x then ConstValue (FFI.constFCmp (fromRealPredicate RealOGE) x y)
-                        else ConstValue (FFI.constICmp (fromIntPredicate    IntGE) x y)
+        if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate  FPOGE) x y)
+                        else ConstValue (FFI.constICmp (fromIntPredicate IntGE) x y)
 -}
 
 instance (Num a, IsConst a) => Num (ConstValue a) where
diff --git a/LLVM/Core/Type.hs b/LLVM/Core/Type.hs
--- a/LLVM/Core/Type.hs
+++ b/LLVM/Core/Type.hs
@@ -8,18 +8,23 @@
     -- * Type classifier
     IsType(..),
     -- ** Special type classifiers
-    IsArithmetic(..),
-    IsInteger(..),
+    IsArithmetic,
+    IsInteger,
     IsFloating,
     IsPrimitive,
     IsFirstClass,
     IsSized,
     IsFunction,
---    IsFunctionRet,
-    IsSequence,
     -- ** Others
-    IsPowerOf2
+    IsPowerOf2,
+    -- ** Type tests
+    TypeDesc(..),
+    isFloating,
+    isSigned,
+    typeRef,
+    typeName
     ) where
+import Data.List(intercalate)
 import Data.Int
 import Data.Word
 import Data.TypeNumbers
@@ -27,6 +32,10 @@
 import LLVM.Core.Data
 import qualified LLVM.FFI.Core as FFI
 
+-- XXX
+-- IsSized should have two parameters, the second being the size and computed from the first
+
+-- Usage: vector precondition
 -- XXX This could defined inductively, but this is good enough for LLVM
 class (IsTypeNumber n) => IsPowerOf2 n
 instance IsPowerOf2 (D1 End)
@@ -49,123 +58,178 @@
 
 -- |The 'IsType' class classifies all types that have an LLVM representation.
 class IsType a where
-    typeRef :: a -> FFI.TypeRef  -- ^The argument is never evaluated
+    typeDesc :: a -> TypeDesc
 
--- |Arithmetic types, i.e., integral and floating types.
-class IsFirstClass a => IsArithmetic a where
-    isFloating :: a -> Bool
-    isFloating _ = False
-    typeName :: a -> String -- XXX could be in IsType
+typeRef :: (IsType a) => a -> FFI.TypeRef  -- ^The argument is never evaluated
+typeRef = code . typeDesc
+  where code TDFloat  = FFI.floatType
+  	code TDDouble = FFI.doubleType
+	code TDFP128  = FFI.fp128Type
+	code TDVoid   = FFI.voidType
+	code (TDInt _ n)  = FFI.integerType (fromInteger n)
+	code (TDArray n a) = FFI.arrayType (code a) (fromInteger n)
+	code (TDVector n a) = FFI.vectorType (code a) (fromInteger n)
+	code (TDPtr a) = FFI.pointerType (code a) 0
+	code (TDFunction as b) = functionType False (code b) (map code as)
 
+typeName :: (IsType a) => a -> String
+typeName = code . typeDesc
+  where code TDFloat  = "f32"
+  	code TDDouble = "f64"
+	code TDFP128  = "f128"
+	code TDVoid   = "void"
+	code (TDInt _ n)  = "i" ++ show n
+	code (TDArray n a) = "[" ++ show n ++ " x " ++ code a ++ "]"
+	code (TDVector n a) = "<" ++ show n ++ " x " ++ code a ++ ">"
+	code (TDPtr a) = code a ++ "*"
+	code (TDFunction as b) = code b ++ "(" ++ intercalate "," (map code as) ++ ")"
 
+-- |Type descriptor, used to convey type information through the LLVM API.
+data TypeDesc = TDFloat | TDDouble | TDFP128 | TDVoid | TDInt Bool Integer
+              | TDArray Integer TypeDesc | TDVector Integer TypeDesc
+	      | TDPtr TypeDesc | TDFunction [TypeDesc] TypeDesc
+    deriving (Eq, Ord, Show)
+
+-- XXX isFloating and typeName could be extracted from typeRef
+-- Usage:
+--   superclass of IsConst
+--   add, sub, mul, neg context
+--   used to get type name to call intrinsic
+-- |Arithmetic types, i.e., integral and floating types.
+class IsFirstClass a => IsArithmetic a
+
+-- Usage:
+--  constI, allOnes
+--  many instructions.  XXX some need vector
+--  used to find signedness in Arithmetic
 -- |Integral types.
-class IsArithmetic a => IsInteger a where
-    isSigned :: a -> Bool
+class IsArithmetic a => IsInteger a
 
+isSigned :: (IsInteger a) => a -> Bool
+isSigned = is . typeDesc
+  where is (TDInt s _) = s
+  	is (TDVector _ a) = is a
+	is _ = error "isSigned got impossible input"
+
+-- Usage:
+--  constF
+--  many instructions
 -- |Floating types.
 class IsArithmetic a => IsFloating a
 
+isFloating :: (IsArithmetic a) => a -> Bool
+isFloating = is . typeDesc
+  where is TDFloat = True
+  	is TDDouble = True
+	is TDFP128 = True
+	is (TDVector _ a) = is a
+	is _ = False
+
+-- Usage:
+--  Precondition for Vector
 -- |Primitive types.
 class IsType a => IsPrimitive a
 
+-- Usage:
+--  Precondition for function args and result.
+--  Used by some instructions, like ret and phi.
+--  XXX IsSized as precondition?
 -- |First class types, i.e., the types that can be passed as arguments, etc.
 class IsType a => IsFirstClass a
 
--- XXX use kind annotation
--- |Sequence types, i.e., vectors and arrays
-class IsSequence c where dummy__ :: c a -> a; dummy__ = undefined
-
+-- Usage:
+--  Context for Array being a type
+--  thus, allocation instructions
 -- |Types with a fixed size.
 class (IsType a) => IsSized a
 
 -- |Function type.
 class (IsType a) => IsFunction a where
-    funcType :: [FFI.TypeRef] -> a -> FFI.TypeRef
+    funcType :: [TypeDesc] -> a -> TypeDesc
 
 -- Only make instances for types that make sense in Haskell
 -- (i.e., some floating types are excluded).
 
 -- Floating point types.
-instance IsType Float  where typeRef _ = FFI.floatType
-instance IsType Double where typeRef _ = FFI.doubleType
-instance IsType FP128  where typeRef _ = FFI.fp128Type
+instance IsType Float  where typeDesc _ = TDFloat
+instance IsType Double where typeDesc _ = TDDouble
+instance IsType FP128  where typeDesc _ = TDFP128
 
 -- Void type
-instance IsType ()     where typeRef _ = FFI.voidType
-
--- Label type
---data Label
---instance IsType Label  where typeRef _ = FFI.labelType
+instance IsType ()     where typeDesc _ = TDVoid
 
 -- Variable size integer types
 instance (IsTypeNumber n) => IsType (IntN n)
-    where typeRef _ = FFI.integerType (typeNumber (undefined :: n))
+    where typeDesc _ = TDInt True  (typeNumber (undefined :: n))
 
 instance (IsTypeNumber n) => IsType (WordN n)
-    where typeRef _ = FFI.integerType (typeNumber (undefined :: n))
+    where typeDesc _ = TDInt False (typeNumber (undefined :: n))
 
 -- Fixed size integer types.
-instance IsType Bool   where typeRef _ = FFI.int1Type
-instance IsType Word8  where typeRef _ = FFI.int8Type
-instance IsType Word16 where typeRef _ = FFI.int16Type
-instance IsType Word32 where typeRef _ = FFI.int32Type
-instance IsType Word64 where typeRef _ = FFI.int64Type
-instance IsType Int8   where typeRef _ = FFI.int8Type
-instance IsType Int16  where typeRef _ = FFI.int16Type
-instance IsType Int32  where typeRef _ = FFI.int32Type
-instance IsType Int64  where typeRef _ = FFI.int64Type
+instance IsType Bool   where typeDesc _ = TDInt False  1
+instance IsType Word8  where typeDesc _ = TDInt False  8
+instance IsType Word16 where typeDesc _ = TDInt False 16
+instance IsType Word32 where typeDesc _ = TDInt False 32
+instance IsType Word64 where typeDesc _ = TDInt False 64
+instance IsType Int8   where typeDesc _ = TDInt True   8
+instance IsType Int16  where typeDesc _ = TDInt True  16
+instance IsType Int32  where typeDesc _ = TDInt True  32
+instance IsType Int64  where typeDesc _ = TDInt True  64
 
 -- Sequence types
 instance (IsTypeNumber n, IsSized a) => IsType (Array n a)
-    where typeRef _ = FFI.arrayType (typeRef (undefined :: a))
-    	  	      		    (typeNumber (undefined :: n))
-
+    where typeDesc _ = TDArray (typeNumber (undefined :: n))
+    	  	               (typeDesc (undefined :: a))
 instance (IsPowerOf2 n, IsPrimitive a) => IsType (Vector n a)
-    where typeRef _ = FFI.vectorType (typeRef (undefined :: a))
-    	  	      		     (typeNumber (undefined :: n))
+    where typeDesc _ = TDVector (typeNumber (undefined :: n))
+    	  	       		(typeDesc (undefined :: a))
 
+-- Pointer type.
 instance (IsType a) => IsType (Ptr a) where
-    typeRef _ = FFI.pointerType (typeRef (undefined :: a)) 0
+    typeDesc _ = TDPtr (typeDesc (undefined :: a))
 
 -- Functions.
 instance (IsFirstClass a, IsFunction b) => IsType (a->b) where
-    typeRef = funcType []
+    typeDesc = funcType []
 
+-- Function base type, always IO.
 instance (IsFirstClass a) => IsType (IO a) where
-    typeRef = funcType []
+    typeDesc = funcType []
 
 --- Instances to classify types
-instance IsArithmetic Float where isFloating _ = True; typeName _ = "f32"
-instance IsArithmetic Double where isFloating _ = True; typeName _ = "f64"
-instance IsArithmetic FP128 where isFloating _ = True; typeName _ = "f128"
-instance (IsTypeNumber n) => IsArithmetic (IntN n) where typeName _ = "i" ++ show (typeNumber (undefined :: n) :: Int)
-instance (IsTypeNumber n) => IsArithmetic (WordN n) where typeName _ = "i" ++ show (typeNumber (undefined :: n) :: Int)
-instance IsArithmetic Bool where typeName _ = "i1"
-instance IsArithmetic Int8 where typeName _ = "i8"
-instance IsArithmetic Int16 where typeName _ = "i16"
-instance IsArithmetic Int32 where typeName _ = "i32"
-instance IsArithmetic Int64 where typeName _ = "i64"
-instance IsArithmetic Word8 where typeName _ = "i8"
-instance IsArithmetic Word16 where typeName _ = "i16"
-instance IsArithmetic Word32 where typeName _ = "i32"
-instance IsArithmetic Word64 where typeName _ = "i64"
-instance (IsPowerOf2 n, IsPrimitive a, IsArithmetic a) => IsArithmetic (Vector n a) where typeName _ = error "vector type name"
+instance IsArithmetic Float
+instance IsArithmetic Double
+instance IsArithmetic FP128
+instance (IsTypeNumber n) => IsArithmetic (IntN n)
+instance (IsTypeNumber n) => IsArithmetic (WordN n)
+instance IsArithmetic Bool
+instance IsArithmetic Int8
+instance IsArithmetic Int16
+instance IsArithmetic Int32
+instance IsArithmetic Int64
+instance IsArithmetic Word8
+instance IsArithmetic Word16
+instance IsArithmetic Word32
+instance IsArithmetic Word64
+instance (IsPowerOf2 n, IsPrimitive a, IsArithmetic a) => IsArithmetic (Vector n a)
 
 instance IsFloating Float
 instance IsFloating Double
 instance IsFloating FP128
+instance (IsPowerOf2 n, IsPrimitive a, IsFloating a) => IsFloating (Vector n a)
 
-instance (IsTypeNumber n) => IsInteger (IntN n) where isSigned _ = True
-instance (IsTypeNumber n) => IsInteger (WordN n) where isSigned _ = False
-instance IsInteger Bool where isSigned _ = False
-instance IsInteger Int8 where isSigned _ = True
-instance IsInteger Int16 where isSigned _ = True
-instance IsInteger Int32 where isSigned _ = True
-instance IsInteger Int64 where isSigned _ = True
-instance IsInteger Word8 where isSigned _ = False
-instance IsInteger Word16 where isSigned _ = False
-instance IsInteger Word32 where isSigned _ = False
-instance IsInteger Word64 where isSigned _ = False
+instance (IsTypeNumber n) => IsInteger (IntN n)
+instance (IsTypeNumber n) => IsInteger (WordN n)
+instance IsInteger Bool
+instance IsInteger Int8
+instance IsInteger Int16
+instance IsInteger Int32
+instance IsInteger Int64
+instance IsInteger Word8
+instance IsInteger Word16
+instance IsInteger Word32
+instance IsInteger Word64
+instance (IsPowerOf2 n, IsPrimitive a, IsInteger a) => IsInteger (Vector n a)
 
 instance IsFirstClass Float
 instance IsFirstClass Double
@@ -185,9 +249,6 @@
 instance (IsType a) => IsFirstClass (Ptr a)
 instance IsFirstClass () -- XXX This isn't right, but () can be returned
 
-instance (IsTypeNumber n) => IsSequence (Array n)
---instance (IsPowerOf2 n, IsPrimitive a) => IsSequence (Vector n) a
-
 instance IsSized Float
 instance IsSized Double
 instance IsSized FP128
@@ -225,9 +286,9 @@
 
 -- Functions.
 instance (IsFirstClass a, IsFunction b) => IsFunction (a->b) where
-    funcType ts _ = funcType (typeRef (undefined :: a) : ts) (undefined :: b)
+    funcType ts _ = funcType (typeDesc (undefined :: a) : ts) (undefined :: b)
 instance (IsFirstClass a) => IsFunction (IO a) where
-    funcType ts _ = functionType False (typeRef (undefined :: a)) (reverse ts)
+    funcType ts _ = TDFunction (reverse ts) (typeDesc (undefined :: a))
 
 -- XXX Structures not implemented.  Tuples is probably an easy way.
 
diff --git a/LLVM/Core/Util.hs b/LLVM/Core/Util.hs
--- a/LLVM/Core/Util.hs
+++ b/LLVM/Core/Util.hs
@@ -25,7 +25,7 @@
     CString, withArrayLen,
     withEmptyCString,
     functionType, buildEmptyPhi, addPhiIns,
-    showTypeOf,
+    showTypeOf, getValueNameU,
     -- * Transformation passes
     addCFGSimplificationPass, addConstantPropagationPass, addDemoteMemoryToRegisterPass,
     addGVNPass, addInstructionCombiningPass, addPromoteMemoryToRegisterPass, addReassociatePass,
@@ -34,7 +34,7 @@
 import Data.List(intercalate)
 import Control.Monad(liftM, when)
 import Foreign.C.String (withCString, withCStringLen, CString, peekCString)
-import Foreign.ForeignPtr (ForeignPtr, FinalizerPtr, newForeignPtr, withForeignPtr)
+import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr)
 import Foreign.Ptr (nullPtr)
 import Foreign.Marshal.Array (withArrayLen, withArray, allocaArray, peekArray)
 import Foreign.Marshal.Alloc (alloca)
@@ -72,11 +72,7 @@
 createModule name =
     withCString name $ \namePtr -> do
       ptr <- FFI.moduleCreateWithName namePtr
-      final <- h2c_module FFI.disposeModule
-      liftM Module $ newForeignPtr final ptr
-
-foreign import ccall "wrapper" h2c_module
-    :: (FFI.ModuleRef -> IO ()) -> IO (FinalizerPtr a)
+      liftM Module $ newForeignPtr FFI.ptrDisposeModule ptr
 -}
 
 -- Don't use a finalizer for the module, but instead provide an
@@ -136,8 +132,7 @@
                 ptr <- peek modPtr
                 return $ Module ptr
 {-
-                final <- h2c_module FFI.disposeModule
-                liftM Module $ newForeignPtr final ptr
+                liftM Module $ newForeignPtr FFI.ptrDisposeModule ptr
 -}
 
 getModuleValues :: Module -> IO [(String, Value)]
@@ -214,11 +209,7 @@
 createModuleProviderForExistingModule modul =
     withModule modul $ \modulPtr -> do
         ptr <- FFI.createModuleProviderForExistingModule modulPtr
-        final <- h2c_moduleProvider FFI.disposeModuleProvider
-        liftM ModuleProvider $ newForeignPtr final ptr
-
-foreign import ccall "wrapper" h2c_moduleProvider
-    :: (FFI.ModuleProviderRef -> IO ()) -> IO (FinalizerPtr a)
+        liftM ModuleProvider $ newForeignPtr FFI.ptrDisposeModuleProvider ptr
 
 
 --------------------------------------
@@ -233,12 +224,8 @@
 
 createBuilder :: IO Builder
 createBuilder = do
-    final <- h2c_builder FFI.disposeBuilder
     ptr <- FFI.createBuilder
-    liftM Builder $ newForeignPtr final ptr
-
-foreign import ccall "wrapper" h2c_builder
-    :: (FFI.BuilderRef -> IO ()) -> IO (FinalizerPtr a)
+    liftM Builder $ newForeignPtr FFI.ptrDisposeBuilder ptr
 
 positionAtEnd :: Builder -> FFI.BasicBlockRef -> IO ()
 positionAtEnd bld bblk =
@@ -351,19 +338,14 @@
 createPassManager :: IO PassManager
 createPassManager = do
     ptr <- FFI.createPassManager
-    final <- h2c_passManager FFI.disposePassManager
-    liftM PassManager $ newForeignPtr final ptr
+    liftM PassManager $ newForeignPtr FFI.ptrDisposePassManager ptr
 
 -- | Create a pass manager for a module.
 createFunctionPassManager :: ModuleProvider -> IO PassManager
 createFunctionPassManager modul =
     withModuleProvider modul $ \modulPtr -> do
         ptr <- FFI.createFunctionPassManager modulPtr
-        final <- h2c_passManager FFI.disposePassManager
-        liftM PassManager $ newForeignPtr final ptr
-
-foreign import ccall "wrapper" h2c_passManager
-    :: (FFI.PassManagerRef -> IO ()) -> IO (FinalizerPtr a)
+        liftM PassManager $ newForeignPtr FFI.ptrDisposePassManager ptr
 
 -- | Add a control flow graph simplification pass to the manager.
 addCFGSimplificationPass :: PassManager -> IO ()
@@ -417,3 +399,9 @@
     withArrayLen xs' $ \ len ptr ->
         return $ FFI.constArray t ptr (fromIntegral len)
 
+--------------------------------------
+
+getValueNameU :: Value -> IO String
+getValueNameU a = do
+    cs <- FFI.getValueName a
+    peekCString cs
diff --git a/LLVM/Core/Vector.hs b/LLVM/Core/Vector.hs
--- a/LLVM/Core/Vector.hs
+++ b/LLVM/Core/Vector.hs
@@ -1,6 +1,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, ScopedTypeVariables #-}
 module LLVM.Core.Vector(MkVector(..)) where
+import Data.Function
 import Data.TypeNumbers
 import LLVM.Core.Type
 import LLVM.Core.Data
@@ -13,21 +14,28 @@
 
 -- XXX Should these really be here?
 class (IsPowerOf2 n, IsPrimitive a) => MkVector va n a | va -> n a, n a -> va where
-    mkVector :: va -> Vector n a
+    toVector :: va -> Vector n a
+    fromVector :: Vector n a -> va
 
 {-
 instance (IsPrimitive a) => MkVector (Value a) (D1 End) (Value a) where
-    mkVector a = Vector [a]
+    toVector a = Vector [a]
 -}
 
 instance (IsPrimitive a) => MkVector (a, a) (D2 End) a where
-    mkVector (a1, a2) = Vector [a1, a2]
+    toVector (a1, a2) = Vector [a1, a2]
+    fromVector (Vector [a1, a2]) = (a1, a2)
+    fromVector _ = error "fromVector: impossible"
 
 instance (IsPrimitive a) => MkVector (a, a, a, a) (D4 End) a where
-    mkVector (a1, a2, a3, a4) = Vector [a1, a2, a3, a4]
+    toVector (a1, a2, a3, a4) = Vector [a1, a2, a3, a4]
+    fromVector (Vector [a1, a2, a3, a4]) = (a1, a2, a3, a4)
+    fromVector _ = error "fromVector: impossible"
 
 instance (IsPrimitive a) => MkVector (a, a, a, a, a, a, a, a) (D8 End) a where
-    mkVector (a1, a2, a3, a4, a5, a6, a7, a8) = Vector [a1, a2, a3, a4, a5, a6, a7, a8]
+    toVector (a1, a2, a3, a4, a5, a6, a7, a8) = Vector [a1, a2, a3, a4, a5, a6, a7, a8]
+    fromVector (Vector [a1, a2, a3, a4, a5, a6, a7, a8]) = (a1, a2, a3, a4, a5, a6, a7, a8)
+    fromVector _ = error "fromVector: impossible"
 
 instance (Storable a, IsTypeNumber n) => Storable (Vector n a) where
     sizeOf _ = sizeOf (undefined :: a) * typeNumber (undefined :: n)
@@ -40,3 +48,89 @@
         unsafePerformIO $
         withArrayLen [ c | v <- vs, let ConstValue c = constOf v ]  $ \ len ptr ->
         return $ ConstValue $ constVector ptr (fromIntegral len)
+
+--------------------------------------
+
+unVector :: Vector n a -> [a]
+unVector (Vector xs) = xs
+
+binop :: (a -> b -> c) -> Vector n a -> Vector n b -> Vector n c
+binop op xs ys = Vector $ zipWith op (unVector xs) (unVector ys)
+
+unop :: (a -> b) -> Vector n a -> Vector n b
+unop op = Vector . map op . unVector
+
+instance (Eq a) => Eq (Vector n a) where
+    (==) = (==) `on` unVector
+
+instance (Ord a) => Ord (Vector n a) where
+    compare = compare `on` unVector
+
+instance (Num a, IsTypeNumber n) => Num (Vector n a) where
+    (+) = binop (+)
+    (-) = binop (-)
+    (*) = binop (*)
+    negate = unop negate
+    abs = unop abs
+    signum = unop signum
+    fromInteger = Vector . replicate (typeNumber (undefined :: n)) . fromInteger
+
+instance (Enum a, IsTypeNumber n) => Enum (Vector n a) where
+    succ = unop succ
+    pred = unop pred
+    fromEnum = error "Vector fromEnum"
+    toEnum = Vector . map toEnum . replicate (typeNumber (undefined :: n))
+
+instance (Real a, IsTypeNumber n) => Real (Vector n a) where
+    toRational = error "Vector toRational"
+
+instance (Integral a, IsTypeNumber n) => Integral (Vector n a) where
+    quot = binop quot
+    rem  = binop rem
+    div  = binop div
+    mod  = binop mod
+    quotRem (Vector xs) (Vector ys) = (Vector qs, Vector rs) where (qs, rs) = unzip $ zipWith quotRem xs ys
+    divMod  (Vector xs) (Vector ys) = (Vector qs, Vector rs) where (qs, rs) = unzip $ zipWith divMod  xs ys
+    toInteger = error "Vector toInteger"
+
+instance (Fractional a, IsTypeNumber n) => Fractional (Vector n a) where
+    (/) = binop (/)
+    fromRational = Vector . replicate (typeNumber (undefined :: n)) . fromRational
+
+instance (RealFrac a, IsTypeNumber n) => RealFrac (Vector n a) where
+    properFraction = error "Vector properFraction"
+
+instance (Floating a, IsTypeNumber n) => Floating (Vector n a) where
+    pi = Vector $ replicate (typeNumber (undefined :: n)) pi
+    sqrt = unop sqrt
+    log = unop log
+    logBase = binop logBase
+    (**) = binop (**)
+    exp = unop exp
+    sin = unop sin
+    cos = unop cos
+    tan = unop tan
+    asin = unop asin
+    acos = unop acos
+    atan = unop atan
+    sinh = unop sinh
+    cosh = unop cosh
+    tanh = unop tanh
+    asinh = unop asinh
+    acosh = unop acosh
+    atanh = unop atanh
+
+instance (RealFloat a, IsTypeNumber n) => RealFloat (Vector n a) where
+    floatRadix = floatRadix . head . unVector
+    floatDigits = floatDigits . head . unVector
+    floatRange = floatRange . head . unVector
+    decodeFloat = error "Vector decodeFloat"
+    encodeFloat = error "Vector encodeFloat"
+    exponent _ = 0
+    scaleFloat 0 x = x
+    scaleFloat _ _ = error "Vector scaleFloat"
+    isNaN = error "Vector isNaN"
+    isInfinite = error "Vector isInfinite"
+    isDenormalized = error "Vector isDenormalized"
+    isNegativeZero = error "Vector isNegativeZero"
+    isIEEE = isIEEE . head . unVector
diff --git a/LLVM/ExecutionEngine/Engine.hs b/LLVM/ExecutionEngine/Engine.hs
--- a/LLVM/ExecutionEngine/Engine.hs
+++ b/LLVM/ExecutionEngine/Engine.hs
@@ -20,8 +20,7 @@
 import Data.Word
 import Foreign.Marshal.Alloc (alloca, free)
 import Foreign.Marshal.Array (withArrayLen)
-import Foreign.ForeignPtr (FinalizerPtr, ForeignPtr, newForeignPtr,
-                           withForeignPtr)
+import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr)
 import Foreign.Marshal.Utils (fromBool)
 import Foreign.C.String (peekCString)
 import Foreign.Ptr (Ptr)
@@ -36,7 +35,7 @@
 import qualified LLVM.FFI.ExecutionEngine as FFI
 import qualified LLVM.FFI.Target as FFI
 import qualified LLVM.Core.Util(Function)
-import LLVM.Core.Type(IsFirstClass, IsType(..))
+import LLVM.Core.Type(IsFirstClass, typeRef)
 
 {-
 -- |The type of the JITer.
@@ -62,11 +61,7 @@
                     free err
                     ioError . userError $ errStr
             else do ptr <- peek eePtr
-                    final <- h2c_ee FFI.disposeExecutionEngine
-                    liftM ExecutionEngine $ newForeignPtr final ptr
-
-foreign import ccall "wrapper" h2c_ee
-    :: (Ptr FFI.ExecutionEngine -> IO ()) -> IO (FinalizerPtr a)
+                    liftM ExecutionEngine $ newForeignPtr FFI.ptrDisposeExecutionEngine ptr
 
 addModuleProvider :: ExecutionEngine -> ModuleProvider -> IO ()
 addModuleProvider ee prov =
@@ -155,7 +150,7 @@
     liftIO $ FFI.getExecutionEngineTargetData eePtr
 
 #if HAS_GETPOINTERTOGLOBAL
-getPointerToFunction :: Function f -> IO (FunPtr f)
+getPointerToFunction :: Function f -> EngineAccess (FunPtr f)
 getPointerToFunction (Value f) = do
     eePtr <- gets ea_engine
     liftIO $ FFI.getPointerToGlobal eePtr f
@@ -177,12 +172,8 @@
 
 createGenericValueWith :: IO FFI.GenericValueRef -> IO GenericValue
 createGenericValueWith f = do
-  final <- h2c_genericValue FFI.disposeGenericValue
   ptr <- f
-  liftM GenericValue $ newForeignPtr final ptr
-
-foreign import ccall "wrapper" h2c_genericValue
-    :: (FFI.GenericValueRef -> IO ()) -> IO (FinalizerPtr a)
+  liftM GenericValue $ newForeignPtr FFI.ptrDisposeGenericValue ptr
 
 withAll :: [GenericValue] -> (Int -> Ptr FFI.GenericValueRef -> IO a) -> IO a
 withAll ps a = go [] ps
diff --git a/LLVM/FFI/Core.hsc b/LLVM/FFI/Core.hsc
--- a/LLVM/FFI/Core.hsc
+++ b/LLVM/FFI/Core.hsc
@@ -18,6 +18,7 @@
     , ModuleRef
     , moduleCreateWithName
     , disposeModule
+    , ptrDisposeModule
 
     , getDataLayout
     , setDataLayout
@@ -29,7 +30,7 @@
     , ModuleProvider
     , ModuleProviderRef
     , createModuleProviderForExistingModule
-    , disposeModuleProvider
+    , ptrDisposeModuleProvider
 
     -- * Types
     , Type
@@ -246,7 +247,7 @@
     , Builder
     , BuilderRef
     , createBuilder
-    , disposeBuilder
+    , ptrDisposeBuilder
     , positionBuilder
     , positionBefore
     , positionAtEnd
@@ -342,13 +343,16 @@
     , removeAttribute
     , setInstrParamAlignment
     , setParamAlignment
+    , Attribute(..)
+    , fromAttribute
+    , toAttribute
 
     -- * Pass manager
     , PassManager
     , PassManagerRef
     , createFunctionPassManager
     , createPassManager
-    , disposePassManager
+    , ptrDisposePassManager
     , finalizeFunctionPassManager
     , initializeFunctionPassManager
     , runFunctionPassManager
@@ -359,7 +363,7 @@
 
 import Foreign.C.String (CString)
 import Foreign.C.Types (CDouble, CInt, CUInt, CULLong)
-import Foreign.Ptr (Ptr)
+import Foreign.Ptr (Ptr, FunPtr)
 
 #include <llvm-c/Core.h>
 
@@ -372,6 +376,9 @@
 foreign import ccall unsafe "LLVMDisposeModule" disposeModule
     :: ModuleRef -> IO ()
 
+foreign import ccall unsafe "&LLVMDisposeModule" ptrDisposeModule
+    :: FunPtr (ModuleRef -> IO ())
+
 foreign import ccall unsafe "LLVMGetDataLayout" getDataLayout
     :: ModuleRef -> IO CString
 
@@ -386,8 +393,8 @@
     createModuleProviderForExistingModule
     :: ModuleRef -> IO ModuleProviderRef
 
-foreign import ccall unsafe "LLVMDisposeModuleProvider" disposeModuleProvider
-    :: ModuleProviderRef -> IO ()
+foreign import ccall unsafe "&LLVMDisposeModuleProvider" ptrDisposeModuleProvider
+    :: FunPtr (ModuleProviderRef -> IO ())
 
 
 data Type
@@ -572,7 +579,7 @@
                        | Cold
                        | X86StdCall
                        | X86FastCall
-                         deriving (Eq, Show)
+                         deriving (Show, Eq, Ord, Enum, Bounded)
 
 fromCallingConvention :: CallingConvention -> CUInt
 fromCallingConvention C = (#const LLVMCCallConv)
@@ -805,8 +812,8 @@
 foreign import ccall unsafe "LLVMCreateBuilder" createBuilder
     :: IO BuilderRef
 
-foreign import ccall unsafe "LLVMDisposeBuilder" disposeBuilder
-    :: BuilderRef -> IO ()
+foreign import ccall unsafe "&LLVMDisposeBuilder" ptrDisposeBuilder
+    :: FunPtr (BuilderRef -> IO ())
 
 foreign import ccall unsafe "LLVMPositionBuilderBefore" positionBefore
     :: BuilderRef -> ValueRef -> IO ()
@@ -1019,23 +1026,49 @@
 foreign import ccall unsafe "LLVMSizeOf" sizeOf
     :: TypeRef -> IO ValueRef
 
-{-
-typedef enum {
-    LLVMZExtAttribute       = 1<<0,
-    LLVMSExtAttribute       = 1<<1,
-    LLVMNoReturnAttribute   = 1<<2,
-    LLVMInRegAttribute      = 1<<3,
-    LLVMStructRetAttribute  = 1<<4,
-    LLVMNoUnwindAttribute   = 1<<5,
-    LLVMNoAliasAttribute    = 1<<6,
-    LLVMByValAttribute      = 1<<7,
-    LLVMNestAttribute       = 1<<8,
-    LLVMReadNoneAttribute   = 1<<9,
-    LLVMReadOnlyAttribute   = 1<<10
-} LLVMAttribute;
--}
-type Attribute = CInt
+data Attribute
+    = ZExtAttribute
+    | SExtAttribute
+    | NoReturnAttribute
+    | InRegAttribute
+    | StructRetAttribute
+    | NoUnwindAttribute
+    | NoAliasAttribute
+    | ByValAttribute
+    | NestAttribute
+    | ReadNoneAttribute
+    | ReadOnlyAttribute
+    deriving (Show, Eq, Ord, Enum, Bounded)
 
+fromAttribute :: Attribute -> CAttribute
+fromAttribute ZExtAttribute = (#const LLVMZExtAttribute)
+fromAttribute SExtAttribute = (#const LLVMSExtAttribute)
+fromAttribute NoReturnAttribute = (#const LLVMNoReturnAttribute)
+fromAttribute InRegAttribute = (#const LLVMInRegAttribute)
+fromAttribute StructRetAttribute = (#const LLVMStructRetAttribute)
+fromAttribute NoUnwindAttribute = (#const LLVMNoUnwindAttribute)
+fromAttribute NoAliasAttribute = (#const LLVMNoAliasAttribute)
+fromAttribute ByValAttribute = (#const LLVMByValAttribute)
+fromAttribute NestAttribute = (#const LLVMNestAttribute)
+fromAttribute ReadNoneAttribute = (#const LLVMReadNoneAttribute)
+fromAttribute ReadOnlyAttribute = (#const LLVMReadOnlyAttribute)
+
+toAttribute :: CAttribute -> Attribute
+toAttribute c | c == (#const LLVMZExtAttribute) = ZExtAttribute
+toAttribute c | c == (#const LLVMSExtAttribute) = SExtAttribute
+toAttribute c | c == (#const LLVMNoReturnAttribute) = NoReturnAttribute
+toAttribute c | c == (#const LLVMInRegAttribute) = InRegAttribute
+toAttribute c | c == (#const LLVMStructRetAttribute) = StructRetAttribute
+toAttribute c | c == (#const LLVMNoUnwindAttribute) = NoUnwindAttribute
+toAttribute c | c == (#const LLVMNoAliasAttribute) = NoAliasAttribute
+toAttribute c | c == (#const LLVMByValAttribute) = ByValAttribute
+toAttribute c | c == (#const LLVMNestAttribute) = NestAttribute
+toAttribute c | c == (#const LLVMReadNoneAttribute) = ReadNoneAttribute
+toAttribute c | c == (#const LLVMReadOnlyAttribute) = ReadOnlyAttribute
+toAttribute _ = error "toAttribute: bad value"
+
+type CAttribute = CInt
+
 data PassManager
 type PassManagerRef = Ptr PassManager
 
@@ -1045,8 +1078,8 @@
     :: ModuleProviderRef -> IO PassManagerRef
 foreign import ccall unsafe "LLVMCreatePassManager" createPassManager
     :: IO PassManagerRef
-foreign import ccall unsafe "LLVMDisposePassManager" disposePassManager
-    :: PassManagerRef -> IO ()
+foreign import ccall unsafe "&LLVMDisposePassManager" ptrDisposePassManager
+    :: FunPtr (PassManagerRef -> IO ())
 foreign import ccall unsafe "LLVMDumpModule" dumpModule
     :: ModuleRef -> IO ()
 foreign import ccall unsafe "LLVMFinalizeFunctionPassManager" finalizeFunctionPassManager
@@ -1118,15 +1151,15 @@
 foreign import ccall unsafe "LLVMSetParamAlignment" setParamAlignment
     :: ValueRef -> CUInt -> IO ()
 foreign import ccall unsafe "LLVMAddAttribute" addAttribute
-    :: ValueRef -> Attribute -> IO ()
+    :: ValueRef -> CAttribute -> IO ()
 foreign import ccall unsafe "LLVMAddInstrAttribute" addInstrAttribute
-    :: ValueRef -> CUInt -> Attribute -> IO ()
+    :: ValueRef -> CUInt -> CAttribute -> IO ()
 foreign import ccall unsafe "LLVMIsTailCall" isTailCall
     :: ValueRef -> IO CInt
 foreign import ccall unsafe "LLVMRemoveAttribute" removeAttribute
-    :: ValueRef -> Attribute -> IO ()
+    :: ValueRef -> CAttribute -> IO ()
 foreign import ccall unsafe "LLVMRemoveInstrAttribute" removeInstrAttribute
-    :: ValueRef -> CUInt -> Attribute -> IO ()
+    :: ValueRef -> CUInt -> CAttribute -> IO ()
 foreign import ccall unsafe "LLVMSetTailCall" setTailCall
     :: ValueRef -> CInt -> IO ()
 {-
diff --git a/LLVM/FFI/ExecutionEngine.hsc b/LLVM/FFI/ExecutionEngine.hsc
--- a/LLVM/FFI/ExecutionEngine.hsc
+++ b/LLVM/FFI/ExecutionEngine.hsc
@@ -5,7 +5,7 @@
     -- * Execution engines
       ExecutionEngine
     , createExecutionEngine
-    , disposeExecutionEngine
+    , ptrDisposeExecutionEngine
     , createInterpreter
     , createJITCompiler
     , addModuleProvider
@@ -32,12 +32,12 @@
     , genericValueToFloat
     , createGenericValueOfPointer
     , genericValueToPointer
-    , disposeGenericValue
+    , ptrDisposeGenericValue
     ) where
 
 import Foreign.C.String (CString)
 import Foreign.C.Types (CDouble, CInt, CUInt, CULLong)
-import Foreign.Ptr (Ptr)
+import Foreign.Ptr (Ptr, FunPtr)
 #if HAS_GETPOINTERTOGLOBAL
 import Foreign.Ptr (FunPtr)
 #endif
@@ -52,8 +52,8 @@
     :: Ptr ExecutionEngineRef -> ModuleProviderRef -> Ptr CString
     -> IO CInt
 
-foreign import ccall unsafe "LLVMDisposeExecutionEngine" disposeExecutionEngine
-    :: ExecutionEngineRef -> IO ()
+foreign import ccall unsafe "&LLVMDisposeExecutionEngine" ptrDisposeExecutionEngine
+    :: FunPtr (ExecutionEngineRef -> IO ())
 
 foreign import ccall unsafe "LLVMRunStaticConstructors" runStaticConstructors
     :: ExecutionEngineRef -> IO ()
@@ -78,8 +78,8 @@
 foreign import ccall unsafe "LLVMGenericValueToFloat" genericValueToFloat
     :: TypeRef -> GenericValueRef -> CDouble
 
-foreign import ccall unsafe "LLVMDisposeGenericValue" disposeGenericValue
-    :: GenericValueRef -> IO ()
+foreign import ccall unsafe "&LLVMDisposeGenericValue" ptrDisposeGenericValue
+    :: FunPtr (GenericValueRef -> IO ())
 
 foreign import ccall unsafe "LLVMRunFunction" runFunction
     :: ExecutionEngineRef -> ValueRef -> CUInt
diff --git a/LLVM/Util/Arithmetic.hs b/LLVM/Util/Arithmetic.hs
--- a/LLVM/Util/Arithmetic.hs
+++ b/LLVM/Util/Arithmetic.hs
@@ -1,35 +1,53 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, FlexibleContexts, UndecidableInstances, TypeSynonymInstances, MultiParamTypeClasses, FunctionalDependencies #-}
+{-# LANGUAGE CPP, FlexibleInstances, ScopedTypeVariables, FlexibleContexts, UndecidableInstances, TypeSynonymInstances, MultiParamTypeClasses, FunctionalDependencies, OverlappingInstances #-}
 module LLVM.Util.Arithmetic(
     TValue,
     Cmp,
     (%==), (%/=), (%<), (%<=), (%>), (%>=),
     (%&&), (%||),
-    (?),
-    retrn,
-    ArithFunction(..), UnwrapArgs, toArithFunction, recursiveFunction
+    (?), (??),
+    retrn, set,
+    ArithFunction, arithFunction,
+    UnwrapArgs, toArithFunction,
+    recursiveFunction,
+    CallIntrinsic,
     ) where
+import Data.TypeNumbers
 import Data.Word
 import Data.Int
 import LLVM.Core
+import LLVM.Util.Loop(mapVector, mapVector2)
 
+-- |Synonym for @CodeGenFunction r (Value a)@.
 type TValue r a = CodeGenFunction r (Value a)
 
-class Cmp a where
-    cmp :: IntPredicate -> Value a -> Value a -> TValue r Bool
+class (CmpRet a b) => Cmp a b | a -> b where
+    cmp :: IntPredicate -> Value a -> Value a -> TValue r b
 
-instance Cmp Bool where cmp = icmp
-instance Cmp Word8 where cmp = icmp
-instance Cmp Word16 where cmp = icmp
-instance Cmp Word32 where cmp = icmp
-instance Cmp Word64 where cmp = icmp
-instance Cmp Int8 where cmp = icmp . adjSigned
-instance Cmp Int16 where cmp = icmp . adjSigned
-instance Cmp Int32 where cmp = icmp . adjSigned
-instance Cmp Int64 where cmp = icmp . adjSigned
-instance Cmp Float where cmp = fcmp . adjFloat
-instance Cmp Double where cmp = fcmp . adjFloat
-instance Cmp FP128 where cmp = fcmp . adjFloat
+instance Cmp Bool Bool where cmp = icmp
+instance Cmp Word8 Bool where cmp = icmp
+instance Cmp Word16 Bool where cmp = icmp
+instance Cmp Word32 Bool where cmp = icmp
+instance Cmp Word64 Bool where cmp = icmp
+instance Cmp Int8 Bool where cmp = icmp . adjSigned
+instance Cmp Int16 Bool where cmp = icmp . adjSigned
+instance Cmp Int32 Bool where cmp = icmp . adjSigned
+instance Cmp Int64 Bool where cmp = icmp . adjSigned
+instance Cmp Float Bool where cmp = fcmp . adjFloat
+instance Cmp Double Bool where cmp = fcmp . adjFloat
+instance Cmp FP128 Bool where cmp = fcmp . adjFloat
+instance (IsPowerOf2 n) => Cmp (Vector n Bool) (Vector n Bool) where cmp = icmp
+instance (IsPowerOf2 n) => Cmp (Vector n Word8) (Vector n Bool) where cmp = icmp
+instance (IsPowerOf2 n) => Cmp (Vector n Word16) (Vector n Bool) where cmp = icmp
+instance (IsPowerOf2 n) => Cmp (Vector n Word32) (Vector n Bool) where cmp = icmp
+instance (IsPowerOf2 n) => Cmp (Vector n Word64) (Vector n Bool) where cmp = icmp
+instance (IsPowerOf2 n) => Cmp (Vector n Int8) (Vector n Bool) where cmp = icmp . adjSigned
+instance (IsPowerOf2 n) => Cmp (Vector n Int16) (Vector n Bool) where cmp = icmp . adjSigned
+instance (IsPowerOf2 n) => Cmp (Vector n Int32) (Vector n Bool) where cmp = icmp . adjSigned
+instance (IsPowerOf2 n) => Cmp (Vector n Int64) (Vector n Bool) where cmp = icmp . adjSigned
+instance (IsPowerOf2 n) => Cmp (Vector n Float) (Vector n Bool) where cmp = fcmp . adjFloat
+instance (IsPowerOf2 n) => Cmp (Vector n Double) (Vector n Bool) where cmp = fcmp . adjFloat
+instance (IsPowerOf2 n) => Cmp (Vector n FP128) (Vector n Bool) where cmp = fcmp . adjFloat
 
 adjSigned :: IntPredicate -> IntPredicate
 adjSigned IntUGT = IntSGT
@@ -38,17 +56,18 @@
 adjSigned IntULE = IntSLE
 adjSigned p = p
 
-adjFloat :: IntPredicate -> RealPredicate
-adjFloat IntEQ  = RealOEQ
-adjFloat IntNE  = RealONE
-adjFloat IntUGT = RealOGT
-adjFloat IntUGE = RealOGE
-adjFloat IntULT = RealOLT
-adjFloat IntULE = RealOLE
+adjFloat :: IntPredicate -> FPPredicate
+adjFloat IntEQ  = FPOEQ
+adjFloat IntNE  = FPONE
+adjFloat IntUGT = FPOGT
+adjFloat IntUGE = FPOGE
+adjFloat IntULT = FPOLT
+adjFloat IntULE = FPOLE
 adjFloat _ = error "adjFloat"
 
 infix  4  %==, %/=, %<, %<=, %>=, %>
-(%==), (%/=), (%<), (%<=), (%>), (%>=) :: (Cmp a) => TValue r a -> TValue r a -> TValue r Bool
+-- |Comparison functions.
+(%==), (%/=), (%<), (%<=), (%>), (%>=) :: (Cmp a b) => TValue r a -> TValue r a -> TValue r b
 (%==) = binop $ cmp IntEQ
 (%/=) = binop $ cmp IntNE
 (%>)  = binop $ cmp IntUGT
@@ -58,12 +77,15 @@
 
 infixr 3  %&&
 infixr 2  %||
+-- |Lazy and.
 (%&&) :: TValue r Bool -> TValue r Bool -> TValue r Bool
 a %&& b = a ? (b, return (valueOf False))
+-- |Lazy or.
 (%||) :: TValue r Bool -> TValue r Bool -> TValue r Bool
 a %|| b = a ? (return (valueOf True), b)
 
 infix  0 ?
+-- |Conditional, returns first element of the pair when condition is true, otherwise second.
 (?) :: (IsFirstClass a) => TValue r Bool -> (TValue r a, TValue r a) -> TValue r a
 c ? (t, f) = do
     lt <- newBasicBlock
@@ -82,45 +104,58 @@
     defineBasicBlock lj
     phi [(rt, lt'), (rf, lf')]
 
+infix 0 ??
+(??) :: (IsFirstClass a, CmpRet a b) => TValue r b -> (TValue r a, TValue r a) -> TValue r a
+c ?? (t, f) = do
+    c' <- c
+    t' <- t
+    f' <- f
+    select c' t' f'
+
+-- | Return a value from an 'arithFunction'.
 retrn :: (Ret (Value a) r) => TValue r a -> CodeGenFunction r ()
 retrn x = x >>= ret
 
+-- | Use @x <- set $ ...@ to make a binding.
+set :: TValue r a -> (CodeGenFunction r (TValue r a))
+set x = do x' <- x; return (return x')
+
 instance (Show (TValue r a))
 instance (Eq (TValue r a))
 instance (Ord (TValue r a))
 
-instance (Cmp a, Num a, IsArithmetic a, IsConst a) => Num (TValue r a) where
+instance (Cmp a b, Num a, IsConst a) => Num (TValue r a) where
     (+) = binop add
     (-) = binop sub
     (*) = binop mul
     negate = (>>= neg)
-    abs x = x %< 0 ? (-x, x)
-    signum x = x %< 0 ? (-1, x %> 0 ? (1, 0))
+    abs x = x %< 0 ?? (-x, x)
+    signum x = x %< 0 ?? (-1, x %> 0 ?? (1, 0))
     fromInteger = return . valueOf . fromInteger
 
-instance (Cmp a, Num a, IsConst a, IsArithmetic a) => Enum (TValue r a) where
+instance (Cmp a b, Num a, IsConst a) => Enum (TValue r a) where
     succ x = x + 1
     pred x = x - 1
     fromEnum _ = error "CodeGenFunction Value: fromEnum"
     toEnum = fromIntegral
 
-instance (Cmp a, Num a, IsConst a, IsArithmetic a) => Real (TValue r a) where
+instance (Cmp a b, Num a, IsConst a) => Real (TValue r a) where
     toRational _ = error "CodeGenFunction Value: toRational"
 
-instance (Cmp a, Num a, IsConst a, IsInteger a) => Integral (TValue r a) where
+instance (Cmp a b, Num a, IsConst a, IsInteger a) => Integral (TValue r a) where
     quot = binop (if (isSigned (undefined :: a)) then sdiv else udiv)
     rem  = binop (if (isSigned (undefined :: a)) then srem else urem)
     quotRem x y = (quot x y, rem x y)
     toInteger _ = error "CodeGenFunction Value: toInteger"
 
-instance (Cmp a, Fractional a, IsConst a, IsFloating a) => Fractional (TValue r a) where
+instance (Cmp a b, Fractional a, IsConst a, IsFloating a) => Fractional (TValue r a) where
     (/) = binop fdiv
     fromRational = return . valueOf . fromRational
 
-instance (Cmp a, Fractional a, IsConst a, IsFloating a) => RealFrac (TValue r a) where
+instance (Cmp a b, Fractional a, IsConst a, IsFloating a) => RealFrac (TValue r a) where
     properFraction _ = error "CodeGenFunction Value: properFraction"
 
-instance (Cmp a, Floating a, IsConst a, IsFloating a) => Floating (TValue r a) where
+instance (Cmp a b, CallIntrinsic a, Floating a, IsConst a, IsFloating a) => Floating (TValue r a) where
     pi = return $ valueOf pi
     sqrt = callIntrinsic1 "sqrt"
     sin = callIntrinsic1 "sin"
@@ -139,7 +174,7 @@
     acosh x          = log (x + sqrt (x*x - 1))
     atanh x          = (log (1 + x) - log (1 - x)) / 2
 
-instance (Cmp a, RealFloat a, IsConst a, IsFloating a) => RealFloat (TValue r a) where
+instance (Cmp a b, CallIntrinsic a, RealFloat a, IsConst a, IsFloating a) => RealFloat (TValue r a) where
     floatRadix _ = floatRadix (undefined :: a)
     floatDigits _ = floatDigits (undefined :: a)
     floatRange _ = floatRange (undefined :: a)
@@ -161,34 +196,37 @@
     y' <- y
     op x' y'
 
-callIntrinsic1 :: forall a b r . (IsArithmetic a, IsFirstClass b) =>
-	          String -> TValue r a -> TValue r b
-callIntrinsic1 fn x = do
-    x' <- x
-    op <- externFunction ("llvm." ++ fn ++ "." ++ typeName (undefined :: a))
-    let _ = op :: Function (a -> IO b)
-    call op x'
+callIntrinsicP1 :: forall a b r . (IsFirstClass a, IsFirstClass b, IsPrimitive a) =>
+	           String -> Value a -> TValue r b
+callIntrinsicP1 fn x = do
+    op :: Function (a -> IO b) <- externFunction ("llvm." ++ fn ++ "." ++ typeName (undefined :: a))
+    r <- call op x
+    addAttributes r 0 [ReadNoneAttribute]
+    return r
 
-callIntrinsic2 :: forall a b c r . (IsArithmetic a, IsFirstClass b, IsFirstClass c) =>
-	          String -> TValue r a -> TValue r b -> TValue r c
-callIntrinsic2 fn x y = do
-    x' <- x
-    y' <- y
-    op <- externFunction ("llvm." ++ fn ++ "." ++ typeName (undefined :: a))
-    let _ = op :: Function (a -> b -> IO c)
-    call op x' y'
+callIntrinsicP2 :: forall a b c r . (IsFirstClass a, IsFirstClass b, IsFirstClass c, IsPrimitive a) =>
+	           String -> Value a -> Value b -> TValue r c
+callIntrinsicP2 fn x y = do
+    op :: Function (a -> b -> IO c) <- externFunction ("llvm." ++ fn ++ "." ++ typeName (undefined :: a))
+    r <- call op x y
+    addAttributes r 0 [ReadNoneAttribute]
+    return r
 
 -------------------------------------------
 
 class ArithFunction a b | a -> b, b -> a where
-    arithFunction :: a -> b
+    arithFunction' :: a -> b
 
 instance (Ret a r) => ArithFunction (CodeGenFunction r a) (CodeGenFunction r ()) where
-    arithFunction x = x >>= ret
+    arithFunction' x = x >>= ret
 
 instance (ArithFunction b b') => ArithFunction (CodeGenFunction r a -> b) (a -> b') where
-    arithFunction f = arithFunction . f . return
+    arithFunction' f = arithFunction' . f . return
 
+-- |Unlift a function with @TValue@ to have @Value@ arguments.
+arithFunction :: ArithFunction a b => a -> b
+arithFunction = arithFunction'
+
 -------------------------------------------
 
 class UncurryN a b | a -> b, b -> a where
@@ -213,18 +251,20 @@
     liftTuple (a, b) = do a' <- a; b' <- liftTuple b; return (a', b')
 
 class (UncurryN a (a1 -> CodeGenFunction r b1), LiftTuple r a1 b, UncurryN a2 (b -> CodeGenFunction r b1)) =>
-      UnwrapArgs a a1 b1 b a2 r | a -> a1 b1, a1 b1 -> a, a1 -> b, b -> a1, a2 -> b b1, b b -> a where
+      UnwrapArgs a a1 b1 b a2 r | a -> a1 b1, a1 b1 -> a, a1 -> b, b -> a1, a2 -> b b1, b b1 -> a2 where
     unwrapArgs :: a2 -> a
 instance (UncurryN a (a1 -> CodeGenFunction r b1), LiftTuple r a1 b, UncurryN a2 (b -> CodeGenFunction r b1)) =>
          UnwrapArgs a a1 b1 b a2 r where
     unwrapArgs f = curryN $ \ x -> do x' <- liftTuple x; uncurryN f x'
 
+-- |Lift a function from having @Value@ arguments to having @TValue@ arguments.
 toArithFunction :: (CallArgs f g, UnwrapArgs a a1 b1 b g r) =>
                     Function f -> a
 toArithFunction f = unwrapArgs (call f)
 
 -------------------------------------------
 
+-- |Define a recursive 'arithFunction', gets pased itself as the first argument.
 recursiveFunction ::
         (CallArgs a g,
          UnwrapArgs a11 a1 b1 b g r,
@@ -237,4 +277,39 @@
     let f' = toArithFunction f
     defineFunction f $ arithFunction (af f')
     return f
+
+-------------------------------------------
+
+class CallIntrinsic a where
+    callIntrinsic1' :: String -> Value a -> TValue r a
+    callIntrinsic2' :: String -> Value a -> Value a -> TValue r a
+
+instance CallIntrinsic Float where
+    callIntrinsic1' = callIntrinsicP1
+    callIntrinsic2' = callIntrinsicP2
+
+instance CallIntrinsic Double where
+    callIntrinsic1' = callIntrinsicP1
+    callIntrinsic2' = callIntrinsicP2
+
+instance (IsPowerOf2 n, IsPrimitive a, CallIntrinsic a) => CallIntrinsic (Vector n a) where
+    callIntrinsic1' s = mapVector (callIntrinsic1' s)
+    callIntrinsic2' s = mapVector2 (callIntrinsic2' s)
+
+callIntrinsic1 :: (CallIntrinsic a) => String -> TValue r a -> TValue r a
+callIntrinsic1 s x = do x' <- x; callIntrinsic1' s x'
+
+callIntrinsic2 :: (CallIntrinsic a) => String -> TValue r a -> TValue r a -> TValue r a
+callIntrinsic2 s x y = do x' <- x; y' <- y; callIntrinsic2' s x' y'
+
+#if defined(__MACOS__)
+instance CallIntrinsic (Vector (D4 End) Float) where
+    callIntrinsic1' s x | hasVFun   = do op <- externFunction ("v" ++ s ++ "f")
+    		      	  	         r <- call op x
+					 addAttributes r 0 [ReadNoneAttribute]
+					 return r
+    		        | otherwise = mapVector (callIntrinsic1' s) x
+      where hasVFun = s `elem` ["sqrt", "log", "exp", "sin", "cos", "tan"]
+    callIntrinsic2' s = mapVector2 (callIntrinsic2' s)
+#endif
 
diff --git a/LLVM/Util/File.hs b/LLVM/Util/File.hs
new file mode 100644
--- /dev/null
+++ b/LLVM/Util/File.hs
@@ -0,0 +1,48 @@
+module LLVM.Util.File(writeCodeGenModule, optimizeFunction, optimizeFunctionCG) where
+import System.Directory
+import System.Process
+
+import LLVM.Core
+import LLVM.ExecutionEngine
+
+writeCodeGenModule :: String -> CodeGenModule a -> IO ()
+writeCodeGenModule name f = do
+    m <- newModule
+    defineModule m f
+    writeBitcodeToFile name m
+
+optimize :: String -> IO ()
+optimize name = do
+    _rc <- system $ "opt -std-compile-opts " ++ name ++ " -f -o " ++ name
+    return ()
+
+optimizeFunction :: (IsType t, Translatable t) => CodeGenModule (Function t) -> IO (Function t)
+optimizeFunction = fmap snd . optimizeFunction'
+
+optimizeFunction' :: (IsType t, Translatable t) => CodeGenModule (Function t) -> IO (Module, Function t)
+optimizeFunction' mdl = do
+    m <- newModule
+    mf <- defineModule m mdl
+    fName <- getValueName mf
+
+    let name = "__tmp__" ++ fName ++ ".bc"
+    writeBitcodeToFile name m
+
+    optimize name
+
+    m' <- readBitcodeFromFile name
+    funcs <- getModuleValues m'
+
+--    removeFile name
+
+    let Just mf' = castModuleValue =<< lookup fName funcs
+
+    return (m', mf')
+
+optimizeFunctionCG :: (IsType t, Translatable t) => CodeGenModule (Function t) -> IO t
+optimizeFunctionCG mdl = do
+    (m', mf') <- optimizeFunction' mdl
+    rf <- runEngineAccess $ do
+        addModule m'
+        generateFunction mf'
+    return rf
diff --git a/LLVM/Util/Foreign.hs b/LLVM/Util/Foreign.hs
new file mode 100644
--- /dev/null
+++ b/LLVM/Util/Foreign.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+-- These are replacements for the broken equivalents in Foreign.*.
+-- The functions in Foreign.* do not obey the required alignment.
+module LLVM.Util.Foreign where
+
+import Foreign.Ptr(alignPtr, Ptr)
+import Foreign.Storable(Storable(poke, sizeOf, alignment))
+import Foreign.Marshal.Alloc(allocaBytes)
+import Foreign.Marshal.Array(allocaArray, pokeArray)
+
+with :: Storable a => a -> (Ptr a -> IO b) -> IO b
+with x act =
+    alloca $ \ p -> do
+    poke p x
+    act p
+
+alloca :: forall a b . Storable a => (Ptr a -> IO b) -> IO b
+alloca act =
+    allocaBytes (2 * sizeOf (undefined :: a)) $ \ p ->
+       act $ alignPtr p (alignment (undefined :: a))
+
+withArrayLen :: (Storable a) => [a] -> (Int -> Ptr a -> IO b) -> IO b
+withArrayLen xs act =
+    let l = length xs in
+    allocaArray (l+1) $ \ p -> do
+    let p' = alignPtr p (alignment (head xs))
+    pokeArray p' xs
+    act l p'
+
diff --git a/LLVM/Util/Loop.hs b/LLVM/Util/Loop.hs
new file mode 100644
--- /dev/null
+++ b/LLVM/Util/Loop.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, TypeOperators, FlexibleContexts #-}
+module LLVM.Util.Loop(Phi, forLoop, mapVector, mapVector2) where
+import Data.TypeNumbers
+import LLVM.Core
+
+class Phi a where
+    phis :: BasicBlock -> a -> CodeGenFunction r a
+    addPhis :: BasicBlock -> a -> a -> CodeGenFunction r ()
+
+{-
+infixr 1 :*
+-- XXX should use HList if it was packaged in a nice way.
+data a :* b = a :* b
+    deriving (Eq, Ord, Show, Read)
+
+instance (IsFirstClass a, Phi b) => Phi (Value a :* b) where
+    phis bb (a :* b) = do
+        a' <- phi [(a, bb)]
+        b' <- phis bb b
+        return (a' :* b')
+    addPhis bb (a :* b) (a' :* b') = do
+        addPhiInputs a [(a', bb)]
+        addPhis bb b b'
+-}
+
+instance Phi () where
+    phis _ _ = return ()
+    addPhis _ _ _ = return ()
+
+instance (IsFirstClass a) => Phi (Value a) where
+    phis bb a = do
+        a' <- phi [(a, bb)]
+        return a'
+    addPhis bb a a' = do
+        addPhiInputs a [(a', bb)]
+
+instance (Phi a, Phi b) => Phi (a, b) where
+    phis bb (a, b) = do
+        a' <- phis bb a
+        b' <- phis bb b
+        return (a', b')
+    addPhis bb (a, b) (a', b') = do
+        addPhis bb a a'
+        addPhis bb b b'
+
+instance (Phi a, Phi b, Phi c) => Phi (a, b, c) where
+    phis bb (a, b, c) = do
+        a' <- phis bb a
+        b' <- phis bb b
+        c' <- phis bb c
+        return (a', b', c')
+    addPhis bb (a, b, c) (a', b', c') = do
+        addPhis bb a a'
+        addPhis bb b b'
+        addPhis bb c c'
+
+-- Loop the index variable from low to high.  The state in the loop starts as start, and is modified
+-- by incr in each iteration.
+forLoop :: forall i a r . (Phi a, Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i Bool) =>
+           Value i -> Value i -> a -> (Value i -> a -> CodeGenFunction r a) -> CodeGenFunction r a
+forLoop low high start incr = do
+    top <- getCurrentBasicBlock
+    loop <- newBasicBlock
+    body <- newBasicBlock
+    exit <- newBasicBlock
+
+    br loop
+
+    defineBasicBlock loop
+    i <- phi [(low, top)]
+    vars <- phis top start
+    t <- icmp IntNE i high
+    condBr t body exit
+
+    defineBasicBlock body
+
+    vars' <- incr i vars
+    i' <- add i (valueOf 1 :: Value i)
+
+    body' <- getCurrentBasicBlock
+    addPhis body' vars vars'
+    addPhiInputs i [(i', body')]
+    br loop
+    defineBasicBlock exit
+
+    return vars
+
+--------------------------------------
+
+mapVector :: forall a b n r .
+             (IsPowerOf2 n, IsPrimitive b) =>
+             (Value a -> CodeGenFunction r (Value b)) ->
+             Value (Vector n a) -> CodeGenFunction r (Value (Vector n b))
+mapVector f v =
+    forLoop (valueOf 0) (valueOf (typeNumber (undefined :: n))) (value undef) $ \ i w -> do
+        x <- extractelement v i
+        y <- f x
+        insertelement w y i
+
+mapVector2 :: forall a b c n r .
+             (IsPowerOf2 n, IsPrimitive c) =>
+             (Value a -> Value b -> CodeGenFunction r (Value c)) ->
+             Value (Vector n a) -> Value (Vector n b) -> CodeGenFunction r (Value (Vector n c))
+mapVector2 f v1 v2 =
+    forLoop (valueOf 0) (valueOf (typeNumber (undefined :: n))) (value undef) $ \ i w -> do
+        x <- extractelement v1 i
+        y <- extractelement v2 i
+        z <- f x y
+        insertelement w z i
diff --git a/Makefile b/Makefile
--- a/Makefile
+++ b/Makefile
@@ -49,7 +49,8 @@
 	-$(MAKE) -C tests clean
 	-rm -f Setup.hi Setup.o
 	-./setup clean
-	-rm setup
+	-rm -f setup setup.exe setup.exe.manifest
+	-rm *~
 
 distclean: clean
 	-rm -f setup configure
diff --git a/Setup.lhs b/Setup.lhs
--- a/Setup.lhs
+++ b/Setup.lhs
@@ -1,3 +1,28 @@
 #!/usr/bin/env runhaskell
+> {-# LANGUAGE PatternGuards #-}
+> import System.Environment
+> import System.Info
+> import Control.Monad
+> import Data.List
 > import Distribution.Simple
-> main = defaultMainWithHooks autoconfUserHooks
+> import Distribution.Simple.Setup
+> 
+> main = do
+>     let hooks = if os == "mingw32" then autoconfUserHooks{ postConf = generateBuildInfo }
+>                 else autoconfUserHooks
+>     defaultMainWithHooks hooks
+> 
+> -- On Windows we can't count on the configure script, so generate the
+> -- llvm.buildinfo from a template.
+> generateBuildInfo _ conf _ _ = do
+>     let args = configConfigureArgs conf
+>     let pref = "--with-llvm-prefix="
+>     let path = case [ p | arg <- args, Just p <- [stripPrefix pref arg] ] of
+>                [p] -> p
+>                _ -> error $ "Use '--configure-option " ++ pref ++ "PATH' to give LLVM installation path"
+>     info <- readFile "llvm.buildinfo.windows.in"
+>     writeFile "llvm.buildinfo" $ subst "@llvm_path@" path info
+> 
+> subst from to [] = []
+> subst from to xs | Just r <- stripPrefix from xs = to ++ subst from to r
+> subst from to (x:xs) = x : subst from to xs
diff --git a/examples/Arith.hs b/examples/Arith.hs
--- a/examples/Arith.hs
+++ b/examples/Arith.hs
@@ -2,29 +2,52 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Arith where
 import Data.Int
+import Data.TypeNumbers
 import LLVM.Core
 import LLVM.ExecutionEngine
 import LLVM.Util.Arithmetic
+import LLVM.Util.Foreign as F
 
-mSomeFn :: forall a . (IsConst a, Floating a, IsFloating a, Cmp a,
-	      FunctionRet a
-	     ) => CodeGenModule (Function (a -> IO a))
+import Foreign.Storable
+{-
+import Foreign.Ptr
+import Foreign.Marshal.Utils
+import Foreign.Marshal.Alloc as F
+-}
+
+mSomeFn :: forall a b . (IsConst a, Floating a, IsFloating a, CallIntrinsic a,
+	                 FunctionRet a, Cmp a b
+                        ) => CodeGenModule (Function (a -> IO a))
 mSomeFn = do
     foo <- createFunction InternalLinkage $ arithFunction $ \ x y -> exp (sin x) + y
-    createFunction ExternalLinkage $ arithFunction $ \ x ->
-        sqrt (x^2 - 5 * x + 6) + toArithFunction foo x x
+    let foo' = toArithFunction foo
+    createFunction ExternalLinkage $ arithFunction $ \ x -> do
+        y <- set $ x^3
+        sqrt (x^2 - 5 * x + 6) + foo' x x + y + log y
 
 mFib :: CodeGenModule (Function (Int32 -> IO Int32))
 mFib = recursiveFunction $ \ rfib n -> n %< 2 ? (1, rfib (n-1) + rfib (n-2))
 
+type V = Vector (D4 End) Float
+
+mVFun :: CodeGenModule (Function (Ptr V -> Ptr V -> IO ()))
+mVFun = do
+    fn :: Function (V -> IO V)
+       <- createFunction ExternalLinkage $ arithFunction $ \ x ->
+            log x * exp x * x - 16
+
+    vectorToPtr fn
+
 writeFunction :: String -> CodeGenModule a -> IO ()
 writeFunction name f = do
     m <- newModule
     defineModule m f
     writeBitcodeToFile name m
 
+
 main :: IO ()
 main = do
+
     let mSomeFn' = mSomeFn
     ioSomeFn <- simpleFunction mSomeFn'
     let someFn :: Double -> Double
@@ -39,3 +62,27 @@
 
     fib <- simpleFunction mFib
     fib 22 >>= print
+
+
+    writeFunction "VArith.bc" mVFun
+
+    ioVFun <- simpleFunction mVFun
+    let v = toVector (1,2,3,4)
+
+    r <- vectorPtrWrap ioVFun v
+    print r
+
+vectorToPtr :: Function (V -> IO V) -> CodeGenModule (Function (Ptr V -> Ptr V -> IO ()))
+vectorToPtr f =
+    createFunction ExternalLinkage $ \ px py -> do
+        x <- load px
+        y <- call f x
+        store y py
+	ret ()
+
+vectorPtrWrap :: (Ptr V -> Ptr V -> IO ()) -> V -> IO V
+vectorPtrWrap f v =
+    with v $ \ aPtr ->
+        F.alloca $ \ bPtr -> do
+             f aPtr bPtr
+             peek bPtr
diff --git a/examples/Array.hs b/examples/Array.hs
--- a/examples/Array.hs
+++ b/examples/Array.hs
@@ -3,8 +3,7 @@
 
 import LLVM.Core
 --import LLVM.ExecutionEngine
-
-import Loop
+import LLVM.Util.Loop
 
 cg :: CodeGenModule (Function (Double -> IO (Ptr Double)))
 cg = do
diff --git a/examples/BrainF.hs b/examples/BrainF.hs
--- a/examples/BrainF.hs
+++ b/examples/BrainF.hs
@@ -14,7 +14,6 @@
 -- ]         }               End loop
 --
 import Control.Monad(when)
-import Control.Monad.Trans
 import Data.Word
 import Data.Int
 import System.Environment(getArgs)
@@ -36,13 +35,22 @@
                "++++++++++."
     prog <- if length args == 1 then readFile (head args) else return text
 
+    when (debug) $
+        writeFunction "BrainF.bc" $ brainCompile debug prog 65536
+
     bfprog <- simpleFunction $ brainCompile debug prog 65536
     when (prog == text) $
         putStrLn "Should print '!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGH' on the next line:"
     bfprog
 
+writeFunction :: String -> CodeGenModule a -> IO ()
+writeFunction name f = do
+    m <- newModule
+    defineModule m f
+    writeBitcodeToFile name m
+
 brainCompile :: Bool -> String -> Word32 -> CodeGenModule (Function (IO ()))
-brainCompile debug instrs wmemtotal = do
+brainCompile _debug instrs wmemtotal = do
     -- LLVM functions
     memset    <- newNamedFunction ExternalLinkage "llvm.memset.i32"
               :: TFunction (Ptr Word8 -> Word8 -> Word32 -> Word32 -> IO ())
@@ -124,7 +132,7 @@
         gen _ c = error $ "Bad character in program: " ++ show c
 
 
-    brainf <- createFunction InternalLinkage $ do
+    brainf <- createFunction ExternalLinkage $ do
         ptr_arr <- arrayMalloc wmemtotal
         call memset ptr_arr (valueOf 0) (valueOf wmemtotal) (valueOf 0)
 --        _ptr_arrmax <- getElementPtr ptr_arr (wmemtotal, ())
@@ -136,8 +144,5 @@
 
         free ptr_arr
         ret ()
-
-    when (debug) $
-        liftIO $ dumpValue brainf
 
     return brainf
diff --git a/examples/DotProd.hs b/examples/DotProd.hs
--- a/examples/DotProd.hs
+++ b/examples/DotProd.hs
@@ -2,13 +2,10 @@
 module DotProd where
 import Data.Word
 import Data.TypeNumbers
-import Foreign.Marshal.Array(allocaArray, pokeArray)
-import Foreign.Ptr
-import Foreign.Storable
 import LLVM.Core
 import LLVM.ExecutionEngine
-
-import Loop
+import LLVM.Util.Loop
+import LLVM.Util.Foreign
 
 mDotProd :: forall n a . (IsPowerOf2 n, IsTypeNumber n,
 	                  IsPrimitive a, IsArithmetic a, IsFirstClass a, IsConst a, Num a,
@@ -46,8 +43,6 @@
          unsafePurify $
          withArrayLen a $ \ aLen aPtr ->
          withArrayLen b $ \ bLen bPtr ->
--- XXX something weird is going on here.  Without that putStr the result is wrong.
-         putStr "" >>
          ioDotProd (fromIntegral (aLen `min` bLen)) aPtr bPtr
 
 
@@ -62,34 +57,26 @@
     defineModule m f
     writeBitcodeToFile name m
 
-withArrayLen :: (Storable a) => [a] -> (Int -> Ptr a -> IO b) -> IO b
-withArrayLen xs act =
-    let l = length xs in
-    allocaArray (l+1) $ \ p -> do
-    let p' = alignPtr p (alignment (head xs))
-    pokeArray p' xs
-    act l p'
-
 class Vectorize n a where
     vectorize :: a -> [a] -> [Vector n a]
 
 {-
 instance (IsPrimitive a) => Vectorize (D1 End) a where
     vectorize _ [] = []
-    vectorize x (x1:xs) = mkVector x1 : vectorize x xs
+    vectorize x (x1:xs) = toVector x1 : vectorize x xs
 -}
 
 instance (IsPrimitive a) => Vectorize (D2 End) a where
     vectorize _ [] = []
-    vectorize x (x1:x2:xs) = mkVector (x1, x2) : vectorize x xs
+    vectorize x (x1:x2:xs) = toVector (x1, x2) : vectorize x xs
     vectorize x xs = vectorize x $ xs ++ [x]
 
 instance (IsPrimitive a) => Vectorize (D4 End) a where
     vectorize _ [] = []
-    vectorize x (x1:x2:x3:x4:xs) = mkVector (x1, x2, x3, x4) : vectorize x xs
+    vectorize x (x1:x2:x3:x4:xs) = toVector (x1, x2, x3, x4) : vectorize x xs
     vectorize x xs = vectorize x $ xs ++ [x]
 
 instance (IsPrimitive a) => Vectorize (D8 End) a where
     vectorize _ [] = []
-    vectorize x (x1:x2:x3:x4:x5:x6:x7:x8:xs) = mkVector (x1, x2, x3, x4, x5, x6, x7, x8) : vectorize x xs
+    vectorize x (x1:x2:x3:x4:x5:x6:x7:x8:xs) = toVector (x1, x2, x3, x4, x5, x6, x7, x8) : vectorize x xs
     vectorize x xs = vectorize x $ xs ++ [x]
diff --git a/examples/Loop.hs b/examples/Loop.hs
deleted file mode 100644
--- a/examples/Loop.hs
+++ /dev/null
@@ -1,83 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, TypeOperators #-}
-module Loop(Phi, (:*)(..), forLoop) where
-import LLVM.Core
-
-class Phi a where
-    phis :: BasicBlock -> a -> CodeGenFunction r a
-    addPhis :: BasicBlock -> a -> a -> CodeGenFunction r ()
-
-infixr 1 :*
--- XXX should use HList if it was packaged in a nice way.
-data a :* b = a :* b
-    deriving (Eq, Ord, Show, Read)
-
-instance (IsFirstClass a, Phi b) => Phi (Value a :* b) where
-    phis bb (a :* b) = do
-        a' <- phi [(a, bb)]
-        b' <- phis bb b
-        return (a' :* b')
-    addPhis bb (a :* b) (a' :* b') = do
-        addPhiInputs a [(a', bb)]
-        addPhis bb b b'
-
-instance Phi () where
-    phis _ _ = return ()
-    addPhis _ _ _ = return ()
-
-instance (IsFirstClass a) => Phi (Value a) where
-    phis bb a = do
-        a' <- phi [(a, bb)]
-        return a'
-    addPhis bb a a' = do
-        addPhiInputs a [(a', bb)]
-
-instance (Phi a, Phi b) => Phi (a, b) where
-    phis bb (a, b) = do
-        a' <- phis bb a
-        b' <- phis bb b
-        return (a', b')
-    addPhis bb (a, b) (a', b') = do
-        addPhis bb a a'
-        addPhis bb b b'
-
-instance (Phi a, Phi b, Phi c) => Phi (a, b, c) where
-    phis bb (a, b, c) = do
-        a' <- phis bb a
-        b' <- phis bb b
-        c' <- phis bb c
-        return (a', b', c')
-    addPhis bb (a, b, c) (a', b', c') = do
-        addPhis bb a a'
-        addPhis bb b b'
-        addPhis bb c c'
-
--- Loop the index variable from low to high.  The state in the loop starts as start, and is modified
--- by incr in each iteration.
-forLoop :: forall i a r . (Phi a, Num i, IsConst i, IsInteger i, IsFirstClass i) =>
-           Value i -> Value i -> a -> (Value i -> a -> CodeGenFunction r a) -> CodeGenFunction r a
-forLoop low high start incr = do
-    top <- getCurrentBasicBlock
-    loop <- newBasicBlock
-    body <- newBasicBlock
-    exit <- newBasicBlock
-
-    br loop
-
-    defineBasicBlock loop
-    i <- phi [(low, top)]
-    vars <- phis top start
-    t <- icmp IntNE i high
-    condBr t body exit
-
-    defineBasicBlock body
-
-    vars' <- incr i vars
-    i' <- add i (valueOf 1 :: Value i)
-
-    body' <- getCurrentBasicBlock
-    addPhis body' vars vars'
-    addPhiInputs i [(i', body')]
-    br loop
-    defineBasicBlock exit
-
-    return vars
diff --git a/examples/Makefile b/examples/Makefile
--- a/examples/Makefile
+++ b/examples/Makefile
@@ -5,8 +5,7 @@
 
 all: $(examples)
 
-Vector:	Loop.hs Convert.hs
-Array: Loop.hs
+Vector:	Convert.hs
 
 %: %.hs
 	$(ghc) $(ghcflags) --make -o $@ -main-is $(basename $<).main $<
@@ -27,4 +26,4 @@
 	@echo Have a look at Fib.s if you like to see clever code.
 
 clean:
-	rm -f $(examples) *.o *.hi *.s *.bc Fib
+	rm -f $(examples) *.o *.hi *.s *.bc Fib *.exe *.exe.manifest
diff --git a/examples/Vector.hs b/examples/Vector.hs
--- a/examples/Vector.hs
+++ b/examples/Vector.hs
@@ -7,8 +7,8 @@
 
 import LLVM.Core
 import LLVM.ExecutionEngine
+import LLVM.Util.Loop
 
-import Loop
 import Convert
 
 -- Type of vector elements.
diff --git a/llvm.buildinfo.windows.in b/llvm.buildinfo.windows.in
new file mode 100644
--- /dev/null
+++ b/llvm.buildinfo.windows.in
@@ -0,0 +1,4 @@
+ghc-options: -I@llvm_path@/include  -D_DEBUG  -D_GNU_SOURCE -D__STDC_LIMIT_MACROS -pgml g++
+ld-options: -L@llvm_path@/lib @llvm_path@/lib/LLVMX86AsmPrinter.o -lLLVMAsmPrinter @llvm_path@/lib/LLVMX86CodeGen.o -lLLVMSelectionDAG @llvm_path@/lib/LLVMExecutionEngine.o @llvm_path@/lib/LLVMInterpreter.o @llvm_path@/lib/LLVMJIT.o -lLLVMCodeGen -lLLVMipo -lLLVMScalarOpts -lLLVMTransformUtils -lLLVMipa -lLLVMAnalysis -lLLVMTarget -lLLVMCore -lLLVMSupport -lLLVMSystem -lpsapi -limagehlp -lstdc++
+include-dirs: @llvm_path@/include
+extra-libraries: LLVMAnalysis LLVMBitWriter LLVMBitReader LLVMCore LLVMTarget LLVMSupport LLVMSystem
diff --git a/llvm.cabal b/llvm.cabal
--- a/llvm.cabal
+++ b/llvm.cabal
@@ -1,5 +1,5 @@
 name: llvm
-version: 0.5.0.1
+version: 0.6.0.2
 license: BSD3
 license-file: LICENSE
 synopsis: Bindings to the LLVM compiler toolkit
@@ -11,7 +11,7 @@
 category: Compilers/Interpreters, Code Generation
 tested-with: GHC == 6.8.2, GHC == 6.10.1
 cabal-version: >= 1.2.3
-build-type: Configure
+build-type: Custom
 
 extra-source-files:
     INSTALL.txt
@@ -27,7 +27,6 @@
     examples/DotProd.hs
     examples/Fibonacci.hs
     examples/HelloJIT.hs
-    examples/Loop.hs
     examples/Vector.hs
     examples/Makefile
     examples/mainfib.c
@@ -36,6 +35,7 @@
     tools/Makefile
     tools/IntrinsicMangler.hs
     llvm.buildinfo.in
+    llvm.buildinfo.windows.in
 
 extra-tmp-files:
     autom4te.cache
@@ -55,11 +55,16 @@
     build-depends: base >= 2.0 && < 2.2
     cpp-options:   -DBYTESTRING_IN_BASE
   else
-    build-depends: base < 2.0 || >= 2.2, bytestring >= 0.9, mtl
+    build-depends: base < 2.0 || >= 2.2, bytestring >= 0.9, mtl, directory, process
 
   ghc-options: -Wall
---  cpp-options: -DHAS_GETPOINTERTOGLOBAL=1
+  cpp-options: -DHAS_GETPOINTERTOGLOBAL=1
 
+  if os(darwin)
+    ld-options: -w /System/Library/Frameworks/vecLib.framework/Versions/A/vecLib
+    cpp-options: -D__MACOS__
+
+
   exposed-modules:
       Data.TypeNumbers
       LLVM.Core
@@ -72,6 +77,9 @@
       LLVM.FFI.Target
       LLVM.FFI.Transforms.Scalar
       LLVM.Util.Arithmetic
+      LLVM.Util.File
+      LLVM.Util.Foreign
+      LLVM.Util.Loop
 
   other-modules:
       LLVM.Core.CodeGen
