diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2008-2009, Roman Leshchinskiy
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+ 
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+ 
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission. 
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
+
diff --git a/NoSlow.cabal b/NoSlow.cabal
new file mode 100644
--- /dev/null
+++ b/NoSlow.cabal
@@ -0,0 +1,116 @@
+Name:           NoSlow
+Version:        0.1
+License:        BSD3
+License-File:   LICENSE
+Author:         Roman Leshchinskiy <rl@cse.unsw.edu.au>
+Maintainer:     Roman Leshchinskiy <rl@cse.unsw.edu.au>
+Copyright:      Roman Leshchinskiy 2009
+Homepage:       http://www.cse.unsw.edu.au/~rl/code/darcs/NoSlow
+Category:       Development, Profiling
+Synopsis:       Microbenchmarks for various array libraries
+Description:
+        .
+        NoSlow is a benchmark suite for several Haskell array libraries:
+        standard lists, primitive sequential arrays from the DPH project,
+        uvector, vector (primitive, storable and boxed arrays) and
+        storablevector. At the moment, it implements a bunch of fairly random
+        loop micro-kernels but will include many more benchmarks in the future.
+        .
+        In its present state, NoSlow /cannot/ be used to reliably compare the
+        performance of the benchmarked libraries. It can be quite helpful for
+        identifying cases where a closer inspection of the generated code
+        might be warranted, however.
+        .
+        The package builds two binaries.
+        .
+        [@noslow -u log@] runs the benchmarks and writes the results to 'log'
+        .
+        [@noslow-table log > table.html@] outputs the results as a HTML table.
+        It also supports the following options.
+        .
+        [@noslow-table log --type=Double@] only outputs the results of 'Double'
+        benchmarks.
+        .
+        [@noslow-table --diff log1 log2@] produces a table comparing the
+        results from 'log1' and 'log2' (2 means the first run was 2x slower
+        than the second; 0.5 means 2x faster).
+        .
+        NoSlow is described in more detail here:
+        <http://unlines.wordpress.com/2009/11/27/noslow/>.
+        .
+
+Build-Type:     Simple
+Cabal-Version:  >= 1.2
+
+Flag dph-prim-seq
+Flag vector
+Flag uvector
+Flag storablevector
+
+Executable noslow
+  Main-Is: NoSlow/Main.hs
+
+  Build-Depends:
+    base >= 3 && < 5,
+    template-haskell,
+    criterion >= 0.2
+
+  if flag(dph-prim-seq)
+    build-depends: dph-prim-seq, dph-base
+    cpp-options: -DUSE_DPH_PRIM_SEQ
+
+  if flag(vector)
+    build-depends: vector
+    cpp-options: -DUSE_VECTOR
+
+  if flag(uvector)
+    build-depends: uvector
+    cpp-options: -DUSE_UVECTOR
+
+  if flag(storablevector)
+    build-depends: storablevector
+    cpp-options: -DUSE_STORABLEVECTOR
+
+  Ghc-Options:
+    -O2
+
+  Other-Modules:
+        NoSlow.Backend.DPH.Prim.Seq
+        NoSlow.Backend.Interface
+        NoSlow.Backend.List
+        NoSlow.Backend.StorableVector
+        NoSlow.Backend.TH
+        NoSlow.Backend.Uvector
+        NoSlow.Backend.Vector.Primitive
+        NoSlow.Backend.Vector.Storable
+        NoSlow.Backend.Vector
+        NoSlow.Main.TH
+        NoSlow.Main.Tree
+        NoSlow.Main.Util
+        NoSlow.Micro.DPH.Prim.Seq.Double
+        NoSlow.Micro.DPH.Prim.Seq
+        NoSlow.Micro.Kernels
+        NoSlow.Micro.List.Double
+        NoSlow.Micro.List
+        NoSlow.Micro.StorableVector.Double
+        NoSlow.Micro.StorableVector
+        NoSlow.Micro.Uvector.Double
+        NoSlow.Micro.Uvector
+        NoSlow.Micro.Vector.Boxed.Double
+        NoSlow.Micro.Vector.Boxed
+        NoSlow.Micro.Vector.Primitive.Double
+        NoSlow.Micro.Vector.Primitive
+        NoSlow.Micro.Vector.Storable.Double
+        NoSlow.Micro.Vector.Storable
+        NoSlow.Util.Base
+        NoSlow.Util.Computation
+        
+
+Executable noslow-table
+  Main-Is: Table.hs
+
+  Build-Depends:
+    base >= 3 && < 5,
+    containers,
+    criterion >=0.2
+
diff --git a/NoSlow/Backend/DPH/Prim/Seq.hs b/NoSlow/Backend/DPH/Prim/Seq.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Backend/DPH/Prim/Seq.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE TypeFamilies, TypeSynonymInstances, TypeOperators, PackageImports, CPP #-}
+module NoSlow.Backend.DPH.Prim.Seq (
+  module U,
+  enumFromTo_Int,
+  pair, fst, snd
+
+#if __GLASGOW_HASKELL__ < 612
+  , filter
+#endif
+) where
+
+import NoSlow.Util.Computation
+
+import "dph-prim-seq" Data.Array.Parallel.Unlifted as U
+import Data.Array.Parallel.Unlifted.Sequential
+import Data.Array.Parallel.Base ( (:*:)(..), fstS, sndS )
+import qualified Prelude
+import Prelude ( Int, Num, Bool )
+
+instance DeepSeq (U.Array a)
+
+instance (TestData a, U.Elt a) => TestData (U.Array a) where
+  testData n = U.fromList (testData n)
+
+instance Computation (U.Array a) where
+  type Arg (U.Array a) = Nil
+  type Res (U.Array a) = U.Array a
+  apply x _ = x
+
+#if __GLASGOW_HASKELL__ < 612
+filter :: Elt a => (a -> Bool) -> Array a -> Array a
+{-# INLINE filter #-}
+filter = filterU
+#endif
+
+enumFromTo_Int :: Int -> Int -> Array Int
+{-# INLINE enumFromTo_Int #-}
+enumFromTo_Int = U.enumFromTo
+
+pair :: a -> b -> a :*: b
+{-# INLINE pair #-}
+pair = (:*:)
+
+fst :: a :*: b -> a
+{-# INLINE fst #-}
+fst = fstS
+
+snd :: a :*: b -> b
+{-# INLINE snd #-}
+snd = sndS
+
diff --git a/NoSlow/Backend/Interface.hs b/NoSlow/Backend/Interface.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Backend/Interface.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE MultiParamTypeClasses, KindSignatures #-}
+module NoSlow.Backend.Interface
+where
+
+import qualified Prelude
+import Prelude ( Num, Int, Bool, undefined )
+
+class Vector (v :: * -> *) a
+
+length         :: Vector v a => v a -> Int
+replicate      :: Vector v a => Int -> a -> v a
+map            :: (Vector v a, Vector v b) => (a -> b) -> v a -> v b
+zip            :: (Vector v a, Vector v b) => v a -> v b -> v (Pair a b)
+zipWith        :: (Vector v a, Vector v b, Vector v c)
+                    => (a -> b -> c) -> v a -> v b -> v c
+sum            :: (Num a, Vector v a) => v a -> a
+enumFromTo_Int :: Int -> Int -> v Int
+filter         :: Vector v a => (a -> Bool) -> v a -> v a
+
+type Pair a b = (a,b)
+
+pair :: a -> b -> Pair a b
+fst  :: Pair a b -> a
+snd  :: Pair a b -> b
+
+
+length = undefined
+replicate = undefined
+map = undefined
+zip = undefined
+zipWith = undefined
+sum = undefined
+enumFromTo_Int = undefined
+filter = undefined
+
+pair = undefined
+fst = undefined
+snd = undefined
+
diff --git a/NoSlow/Backend/List.hs b/NoSlow/Backend/List.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Backend/List.hs
@@ -0,0 +1,15 @@
+module NoSlow.Backend.List (
+  length, replicate, map, zip, zipWith, sum,
+  enumFromTo_Int, filter,
+  pair, fst, snd
+) where
+
+import NoSlow.Util.Base
+
+enumFromTo_Int :: Int -> Int -> [Int]
+{-# INLINE enumFromTo_Int #-}
+enumFromTo_Int = enumFromTo
+
+pair :: a -> b -> (a,b)
+pair = (,)
+
diff --git a/NoSlow/Backend/StorableVector.hs b/NoSlow/Backend/StorableVector.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Backend/StorableVector.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE TypeFamilies #-}
+module NoSlow.Backend.StorableVector (
+  module Data.StorableVector,
+  sum, enumFromTo_Int, zip,
+  pair, fst, snd
+) where
+
+import NoSlow.Util.Computation
+import NoSlow.Util.Base ( Unsupported(..) )
+
+import qualified Data.StorableVector as V
+import Data.StorableVector hiding ( zip )
+import Foreign ( Storable )
+import Prelude hiding ( sum, fst, snd, zip )
+
+instance DeepSeq (V.Vector a)
+
+instance (TestData a, Storable a) => TestData (V.Vector a) where
+  testData n = V.pack (testData n)
+
+instance Computation (V.Vector a) where
+  type Arg (V.Vector a) = Nil
+  type Res (V.Vector a) = V.Vector a
+  apply x _ = x
+
+sum :: (Num a, Storable a) => V.Vector a -> a
+{-# INLINE sum #-}
+sum xs = V.foldl' (+) 0 xs
+
+enumFromTo_Int :: Int -> Int -> V.Vector Int
+{-# INLINE enumFromTo_Int #-}
+enumFromTo_Int m n = V.sample len (\i -> i+m)
+  where
+    len = max 0 (n-m+1)
+
+zip = Unsupported
+pair = Unsupported
+fst = Unsupported
+snd = Unsupported
+
diff --git a/NoSlow/Backend/TH.hs b/NoSlow/Backend/TH.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Backend/TH.hs
@@ -0,0 +1,270 @@
+{-# LANGUAGE TemplateHaskell, PatternGuards, CPP #-}
+module NoSlow.Backend.TH ( Spec(..), specialise, calls ) where
+
+import NoSlow.Util.Base ( named, Unsupported(..) )
+
+import qualified NoSlow.Backend.Interface as I
+import Language.Haskell.TH
+
+import Control.Monad ( liftM, liftM2, liftM3 )
+import Data.Maybe    ( isJust )
+import qualified Data.Map as M
+
+interface_module :: String
+interface_module = case nameModule ''I.Vector of
+                     Just s -> s
+
+type Context = (Name, [Type])
+
+data Spec = Spec {
+              specModule  :: String
+            , specContext :: Name -> Name -> [Context]
+            , specVars    :: [(String, Type)]
+            }
+
+newtype SM a = SM { runSM :: Spec -> [Name] -> (a, [Name]) }
+
+instance Monad SM where
+  return x = SM $ \_ ns -> (x, ns)
+
+  SM p >>= q = SM $ \s ns ->
+               case p s ns of
+                 (x, ns') -> runSM (q x) s ns'
+
+instance Functor SM where
+  fmap = liftM
+
+getSpec :: SM Spec
+getSpec = SM $ \s ns -> (s,ns)
+
+reference :: Name -> SM ()
+reference name = SM $ \s ns -> ((), name : ns)
+
+specialise :: Spec -> Q [Dec] -> Q [Dec]
+specialise spec decsq
+  = do
+      decs <- decsq
+      scs  <- mapM (specialiseTopDec spec) decs
+      let bad_names = [name | Right name <- scs]
+          good_decs = [dec  | Left  dec  <- scs
+                            , decName dec `notElem` bad_names]
+
+      return $ vector_type : good_decs
+               ++ noinline good_decs
+               ++ [SigD name (ConT ''Unsupported) | name <- bad_names]
+               ++ [ValD (VarP name) (NormalB (ConE 'Unsupported)) []
+                                                  | name <- bad_names]
+  where
+    vector_type = TySynD (mkName "Vector_Type") ty_vars (ty_con `AppT` elem_ty)
+
+    ty_con | Just ty <- lookup "v" (specVars spec) = ty
+
+    (ty_vars, elem_ty)
+      | Just ty <- lookup "a" (specVars spec) = ([], ty)
+      | otherwise                             = ([binder a], VarT a)
+      where
+        a = mkName "a"
+#if __GLASGOW_HASKELL__ > 610
+        binder = PlainTV
+#else
+        binder = id
+#endif
+
+#if __GLASGOW_HASKELL__ > 610
+    noinline decs = [PragmaD $ InlineP name $ InlineSpec False False Nothing
+                      | SigD name _ <- decs]
+#else
+    noinline decs = []
+#endif
+
+specialiseTopDec :: Spec -> Dec -> Q (Either Dec Name)
+specialiseTopDec spec dec
+  = case runSM (specialiseDec dec) spec [] of
+      (dec', names) ->
+        do
+          ss <- mapM isSupported names
+          return $ if and ss
+                    then Left dec'
+                    else Right (decName dec)
+  where
+
+decName (SigD name _) = name
+decName (FunD name _) = name
+decName (ValD (VarP name) _ _) = name
+
+isSupported :: Name -> Q Bool
+isSupported name
+  = liftM supported (reify name)
+  where
+    supported (VarI _ (ConT c) _ _)
+      | c == ''Unsupported = False
+    supported _ = True
+
+specialiseDec :: Dec -> SM Dec
+specialiseDec (SigD name ty)
+  = SigD name `liftM` specialiseTy ty
+specialiseDec (FunD name clauses)
+  = FunD name `liftM` mapM specialiseClause clauses
+specialiseDec (ValD pat body decs)
+  = liftM2 (ValD pat) (specialiseBody body)
+                      (mapM specialiseDec decs)
+
+specialiseTy :: Type -> SM Type
+specialiseTy ty
+  = do
+      spec <- getSpec
+      return $ specialiseTy' spec ty
+
+specialiseTy' :: Spec -> Type -> Type
+specialiseTy' spec pty
+  | ForallT vars cxt ty <- pty
+    = mk_forall (map rename_bndr $ filter keep_bndr vars)
+                (spec_cxt cxt)
+                (spec_ty ty)
+
+  | otherwise = spec_ty pty
+  where
+#if __GLASGOW_HASKELL__ > 610
+    rename_bndr (PlainTV v) = PlainTV (rename v)
+    rename_bndr (KindedTV v k) = KindedTV (rename v) k
+
+    keep_bndr (PlainTV v) = keep_var v
+    keep_bndr (KindedTV v _) = keep_var v
+#else
+    rename_bndr = rename
+    keep_bndr   = keep_var
+#endif
+
+    keep_var v = not $ isJust $ lookup (nameBase v) (specVars spec)
+    rename = mkName . nameBase
+
+    mk_forall [] _     ty = ty
+    mk_forall vars cxt ty = ForallT vars cxt ty
+
+    spec_cxt = filter var_pred . concatMap spec_pred
+
+#if __GLASGOW_HASKELL__ > 610
+    spec_pred (ClassP cls [VarT v, VarT a])
+      | cls == ''I.Vector = map (uncurry ClassP)
+                          $ specContext spec (rename v) (rename a)
+
+    spec_pred (ClassP cls tys) = [ClassP cls $ map spec_ty tys]
+
+    var_pred (ClassP _ tys) = any var_ty tys
+#else
+    spec_pred (AppT (AppT (ConT cls) (VarT v)) (VarT a))
+      | cls == ''I.Vector = map mk_pred
+                          $ specContext spec (rename v) (rename a)
+
+    spec_pred pred = [spec_ty pred]
+
+    var_pred = var_ty
+
+    mk_pred (cls, tys) = foldl AppT (ConT cls) tys
+#endif
+
+    spec_ty (VarT v)
+      | Just ty <- lookup (nameBase v) (specVars spec) = ty
+      | otherwise                                      = VarT (rename v)
+
+    spec_ty (AppT t u) = spec_ty t `AppT` spec_ty u
+    spec_ty ty = ty
+
+    var_ty (VarT v) = True
+    var_ty (AppT t u) = var_ty t || var_ty u
+    var_ty _ = False
+
+specialiseClause :: Clause -> SM Clause
+specialiseClause (Clause pats body decs)
+  = liftM2 (Clause pats) (specialiseBody body)
+                         (mapM specialiseDec decs)
+
+specialiseBody :: Body -> SM Body
+specialiseBody (NormalB exp)
+  = liftM NormalB
+  $ specialiseExp (snd $ removeNamed exp)
+
+specialiseExp :: Exp -> SM Exp
+specialiseExp (VarE v)
+  | Just mod <- nameModule v
+  , mod == interface_module
+    = do
+        mod <- specModule `fmap` getSpec
+        let name = qualify mod v
+        reference name
+        return $ VarE name
+
+specialiseExp (AppE e1 e2) = liftM2 AppE (specialiseExp e1)
+                                         (specialiseExp e2)
+
+specialiseExp (InfixE me1 e2 me3)
+  = liftM3 InfixE (mspec me1) (specialiseExp e2) (mspec me3)
+  where
+    mspec Nothing = return Nothing
+    mspec (Just e) = liftM Just (specialiseExp e)
+    
+specialiseExp (LamE pats e) = LamE pats `liftM` specialiseExp e
+    
+specialiseExp (TupE es) = TupE `liftM` mapM specialiseExp es
+    
+specialiseExp (CondE e1 e2 e3)
+  = liftM3 CondE (specialiseExp e1) (specialiseExp e2) (specialiseExp e3)
+
+specialiseExp (LetE decs e)
+  = liftM2 LetE (mapM specialiseDec decs)
+                (specialiseExp e)
+
+specialiseExp (CaseE _ _) = error "specialiseExp: case"
+specialiseExp (DoE _)     = error "specialiseExp: do"
+specialiseExp (CompE _)   = error "specialiseExp: comp"
+specialiseExp (ArithSeqE _) = error "specialiseExp: seq"
+
+specialiseExp (ListE es) = ListE `liftM` mapM specialiseExp es
+
+specialiseExp (SigE e ty)
+  = liftM2 SigE (specialiseExp e) (specialiseTy ty) 
+
+specialiseExp (RecConE _ _) = error "specialiseExp: rec_con"
+specialiseExp (RecUpdE _ _) = error "specialiseExp: rec_upd"
+
+specialiseExp e = return e
+
+calls :: Name -> String -> Q [Dec] -> ExpQ
+calls fn mod qdecs
+  = do
+      decs <- qdecs
+      let env = M.fromList (collectNames decs)
+      cs <- mapM (call env) [name | SigD name _ <- decs]
+      return $ ListE [c | Just c <- cs]
+  where
+    call env name
+      = do
+          ok <- isSupported name'
+          return $ if ok
+            then Just (VarE fn `AppE` LitE (StringL tag) `AppE` VarE name')
+            else Nothing
+      where
+        name' = qualify mod name
+        tag = M.findWithDefault (nameBase name) (nameBase name) env
+
+qualify :: String -> Name -> Name
+qualify mod name = mkName $ mod ++ '.' : nameBase name
+
+collectNames :: [Dec] -> [(String, String)]
+collectNames = foldr collect1 []
+  where
+    collect1 (FunD name [Clause _ (NormalB exp) _]) xs
+      | (Just s, _) <- removeNamed exp = (nameBase name, s) : xs
+
+    collect1 _ xs = xs
+
+removeNamed :: Exp -> (Maybe String, Exp)
+removeNamed (VarE f `AppE` LitE (StringL s) `AppE` e)
+  | f == 'named = (Just s, e)
+removeNamed (InfixE (Just (VarE f `AppE` LitE (StringL s)))
+                    (VarE apply)
+                    (Just e))
+  | f == 'named
+  , apply == '($) = (Just s, e)
+removeNamed e = (Nothing, e)
+
diff --git a/NoSlow/Backend/Uvector.hs b/NoSlow/Backend/Uvector.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Backend/Uvector.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE TypeFamilies, TypeOperators #-}
+module NoSlow.Backend.Uvector (
+  UA, UArr,
+
+  length, replicate, map, zip, zipWith, sum, enumFromTo_Int, filter,
+  pair, fst, snd
+) where
+
+import NoSlow.Util.Computation
+
+import Data.Array.Vector
+import qualified Prelude
+import Prelude ( Int, Num, Bool )
+
+instance DeepSeq (UArr a)
+
+instance (TestData a, UA a) => TestData (UArr a) where
+  testData n = toU (testData n)
+
+instance Computation (UArr a) where
+  type Arg (UArr a) = Nil
+  type Res (UArr a) = UArr a
+  apply x _ = x
+
+length :: UA a => UArr a -> Int
+{-# INLINE length #-}
+length = lengthU
+
+replicate :: UA a => Int -> a -> UArr a
+{-# INLINE replicate #-}
+replicate = replicateU
+
+map :: (UA a, UA b) => (a -> b) -> UArr a -> UArr b
+{-# INLINE map #-}
+map = mapU
+
+zip :: (UA a, UA b) => UArr a -> UArr b -> UArr (a :*: b)
+{-# INLINE zip #-}
+zip = zipU
+
+zipWith :: (UA a, UA b, UA c) => (a -> b -> c) -> UArr a -> UArr b -> UArr c
+{-# INLINE zipWith #-}
+zipWith = zipWithU
+
+sum :: (Num a, UA a) => UArr a -> a
+{-# INLINE sum #-}
+sum = sumU
+
+enumFromTo_Int :: Int -> Int -> UArr Int
+{-# INLINE enumFromTo_Int #-}
+enumFromTo_Int = enumFromToU
+
+filter :: UA a => (a -> Bool) -> UArr a -> UArr a
+{-# INLINE filter #-}
+filter = filterU
+
+pair :: a -> b -> a :*: b
+{-# INLINE pair #-}
+pair = (:*:)
+
+fst :: a :*: b -> a
+{-# INLINE fst #-}
+fst = fstS
+
+snd :: a :*: b -> b
+{-# INLINE snd #-}
+snd = sndS
+
diff --git a/NoSlow/Backend/Vector.hs b/NoSlow/Backend/Vector.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Backend/Vector.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE TypeFamilies #-}
+module NoSlow.Backend.Vector (
+  module Data.Vector,
+
+  enumFromTo_Int,
+  pair, fst, snd
+) where
+
+import NoSlow.Util.Computation
+
+import qualified Data.Vector as V
+import Data.Vector
+
+instance DeepSeq a => DeepSeq (V.Vector a) where
+  deepSeq xs b = V.foldr deepSeq b xs
+
+instance TestData a => TestData (V.Vector a) where
+  testData n = V.fromList (testData n)
+
+instance DeepSeq a => Computation (V.Vector a) where
+  type Arg (V.Vector a) = Nil
+  type Res (V.Vector a) = V.Vector a
+  apply x _ = x
+
+enumFromTo_Int :: Int -> Int -> V.Vector Int
+{-# INLINE enumFromTo_Int #-}
+enumFromTo_Int = V.enumFromTo
+
+pair :: a -> b -> (a,b)
+{-# INLINE pair #-}
+pair = (,)
+
diff --git a/NoSlow/Backend/Vector/Primitive.hs b/NoSlow/Backend/Vector/Primitive.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Backend/Vector/Primitive.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE TypeFamilies #-}
+module NoSlow.Backend.Vector.Primitive (
+  module Data.Vector.Primitive,
+
+  enumFromTo_Int, zip,
+  pair, fst, snd
+) where
+
+import NoSlow.Util.Computation
+import NoSlow.Util.Base ( Unsupported(..) )
+import qualified Data.Vector.Primitive as V
+import Data.Vector.Primitive
+
+import Prelude hiding ( fst, snd, zip )
+
+instance DeepSeq (V.Vector a)
+
+instance (TestData a, V.Prim a) => TestData (V.Vector a) where
+  testData n = V.fromList (testData n)
+
+instance Computation (V.Vector a) where
+  type Arg (V.Vector a) = Nil
+  type Res (V.Vector a) = V.Vector a
+  apply x _ = x
+
+enumFromTo_Int :: Int -> Int -> V.Vector Int
+{-# INLINE enumFromTo_Int #-}
+enumFromTo_Int = V.enumFromTo
+
+zip = Unsupported
+pair = Unsupported
+fst = Unsupported
+snd = Unsupported
+
diff --git a/NoSlow/Backend/Vector/Storable.hs b/NoSlow/Backend/Vector/Storable.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Backend/Vector/Storable.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE TypeFamilies #-}
+module NoSlow.Backend.Vector.Storable (
+  module Data.Vector.Storable,
+
+  enumFromTo_Int, zip,
+  pair, fst, snd
+) where
+
+import NoSlow.Util.Computation
+import NoSlow.Util.Base ( Unsupported(..) )
+import qualified Data.Vector.Storable as V
+import Data.Vector.Storable
+
+import Prelude hiding ( fst, snd, zip )
+
+instance DeepSeq (V.Vector a)
+
+instance (TestData a, V.Storable a) => TestData (V.Vector a) where
+  testData n = V.fromList (testData n)
+
+instance Computation (V.Vector a) where
+  type Arg (V.Vector a) = Nil
+  type Res (V.Vector a) = V.Vector a
+  apply x _ = x
+
+enumFromTo_Int :: Int -> Int -> V.Vector Int
+{-# INLINE enumFromTo_Int #-}
+enumFromTo_Int = V.enumFromTo
+
+zip = Unsupported
+pair = Unsupported
+fst = Unsupported
+snd = Unsupported
+
diff --git a/NoSlow/Main.hs b/NoSlow/Main.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Main.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE TemplateHaskell, CPP #-}
+module Main where
+
+import NoSlow.Main.TH
+import NoSlow.Main.Tree
+import NoSlow.Main.Util ( (>++<) )
+
+import Criterion.Main
+import Criterion.Config
+
+import qualified NoSlow.Micro.List
+import qualified NoSlow.Micro.List.Double
+
+#ifdef USE_DPH_PRIM_SEQ
+import qualified NoSlow.Micro.DPH.Prim.Seq
+import qualified NoSlow.Micro.DPH.Prim.Seq.Double
+#endif
+
+#ifdef USE_VECTOR
+import qualified NoSlow.Micro.Vector.Primitive
+import qualified NoSlow.Micro.Vector.Primitive.Double
+import qualified NoSlow.Micro.Vector.Storable
+import qualified NoSlow.Micro.Vector.Storable.Double
+import qualified NoSlow.Micro.Vector.Boxed
+import qualified NoSlow.Micro.Vector.Boxed.Double
+#endif
+
+#ifdef USE_UVECTOR
+import qualified NoSlow.Micro.Uvector
+import qualified NoSlow.Micro.Uvector.Double
+#endif
+
+#ifdef USE_STORABLEVECTOR
+import qualified NoSlow.Micro.StorableVector
+import qualified NoSlow.Micro.StorableVector.Double
+#endif
+
+all_kernels = $(benchtrees Poly [t|Double|] kernel_tree)
+         >++< $(benchtrees Mono [t|Double|] kernel_tree)
+
+main = defaultMainWith (defaultConfig { cfgPerformGC = ljust True })
+       (all_kernels 10000)
+
diff --git a/NoSlow/Main/TH.hs b/NoSlow/Main/TH.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Main/TH.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Main.TH
+where
+
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Main.Util
+import NoSlow.Backend.TH ( calls )
+import NoSlow.Util.Base
+
+import Language.Haskell.TH
+
+data Sort = Poly | Mono
+
+benchtrees :: Sort -> TypeQ -> [KTree] -> ExpQ
+benchtrees sort tyq ts
+  = do
+      ty <- tyq
+      varE 'klist `appE` listE (map (benchtree sort ty) ts)
+
+benchtree :: Sort -> Type -> KTree -> ExpQ
+benchtree sort ty (KGroup s ts)
+  = mk_kgroup s (map (benchtree sort ty) ts)
+benchtree sort ty@(ConT c) (KModule s poly_mod)
+  = do
+      TyConI (TySynD t [_] _) <- reify $ mkName $ poly_mod ++ ".Vector_Type"
+
+      let tag = case sort of
+                  Poly -> '*' : nameBase c
+                  Mono -> nameBase c
+
+          real_mod = case sort of
+                       Poly -> poly_mod
+                       Mono -> poly_mod ++ '.' : nameBase c
+
+          vec_ty = conT t `appT` return ty
+          ty_tag = conE 'Ty `sigE` appT (conT ''Ty) vec_ty
+
+      mk_kgroup s [mk_kernels tag ty_tag real_mod]
+  where
+    mk_kernels tag ty mod = varE 'kernels `appE` litE (StringL tag)
+                                          `appE` ty
+                                          `appE` calls 'kernel mod K.kernels
+
+mk_kgroup :: String -> [ExpQ] -> ExpQ
+mk_kgroup s exps = varE 'kgroup `appE` litE (StringL s) `appE` listE exps
+
diff --git a/NoSlow/Main/Tree.hs b/NoSlow/Main/Tree.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Main/Tree.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE CPP #-}
+module NoSlow.Main.Tree
+where
+
+import NoSlow.Main.Util
+
+kernel_tree
+  = [ KModule "list"           "NoSlow.Micro.List"
+
+#ifdef USE_DPH_PRIM_SEQ
+    , KGroup "dph-prim" [
+        KModule "seq"          "NoSlow.Micro.DPH.Prim.Seq"
+      ]
+#endif
+
+#ifdef USE_VECTOR
+    , KGroup "vector" [
+        KModule "Primitive"    "NoSlow.Micro.Vector.Primitive"
+      , KModule "Storable"     "NoSlow.Micro.Vector.Storable"
+      , KModule "boxed"        "NoSlow.Micro.Vector.Boxed"
+      ]
+#endif
+
+#ifdef USE_UVECTOR
+    , KModule "uvector"        "NoSlow.Micro.Uvector"
+#endif
+
+#ifdef USE_STORABLEVECTOR
+    , KModule "storablevector" "NoSlow.Micro.StorableVector"
+#endif
+    ]
+
diff --git a/NoSlow/Main/Util.hs b/NoSlow/Main/Util.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Main/Util.hs
@@ -0,0 +1,30 @@
+module NoSlow.Main.Util ( kernel, kernels, kgroup, klist, KTree(..), (>++<) )
+where
+
+import NoSlow.Util.Base
+import NoSlow.Util.Computation
+
+import Criterion.Main ( Benchmark, B(..), bench, bgroup ) 
+
+kernel :: Computation b => String -> (Ty a -> b) -> Ty a -> Int -> Benchmark
+kernel s a t n = let x = testData n
+                 in x `deepSeq` bench s $ B run x
+  where
+    run x = apply (a t) x `deepSeq` ()
+
+kernels :: String -> Ty a -> [Ty a -> Int -> Benchmark] -> Int -> Benchmark
+kernels s t bs n = bgroup s [b t n | b <- bs]
+
+data KTree = KGroup  String [KTree]
+           | KModule String String
+
+kgroup :: String -> [Int -> Benchmark] -> Int -> Benchmark
+kgroup s fs n = bgroup s [f n | f <- fs]
+
+klist :: [Int -> Benchmark] -> Int -> [Benchmark]
+klist fs n = [f n | f <- fs]
+
+infixr 5 >++<
+(>++<) :: (Int -> [Benchmark]) -> (Int -> [Benchmark]) -> Int -> [Benchmark]
+(>++<) f g n = f n ++ g n
+
diff --git a/NoSlow/Micro/DPH/Prim/Seq.hs b/NoSlow/Micro/DPH/Prim/Seq.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/DPH/Prim/Seq.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.DPH.Prim.Seq
+where
+
+import qualified NoSlow.Backend.DPH.Prim.Seq as Impl
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Backend.TH
+
+import Language.Haskell.TH
+
+$(specialise (Spec {
+                specModule = "Impl"
+              , specContext = \_ a -> [(''Impl.Elt, [VarT a])]
+              , specVars    = [("v", ConT ''Impl.Array)]
+              })
+  K.kernels)
+
diff --git a/NoSlow/Micro/DPH/Prim/Seq/Double.hs b/NoSlow/Micro/DPH/Prim/Seq/Double.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/DPH/Prim/Seq/Double.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.DPH.Prim.Seq.Double
+where
+
+import qualified NoSlow.Backend.DPH.Prim.Seq as Impl
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Backend.TH
+
+import Language.Haskell.TH
+
+$(specialise (Spec {
+                specModule = "Impl"
+              , specContext = \_ _ -> []
+              , specVars    = [("v", ConT ''Impl.Array),
+                               ("a", ConT ''Double)]
+              })
+  K.kernels)
+
diff --git a/NoSlow/Micro/Kernels.hs b/NoSlow/Micro/Kernels.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/Kernels.hs
@@ -0,0 +1,172 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.Kernels ( kernels ) where
+
+import qualified NoSlow.Backend.Interface as I
+import NoSlow.Util.Base
+
+kernels = [d|
+
+  -- ---------------------------
+  --   map, zipWith, replicate
+  -- ---------------------------
+
+  -- Add a constant to every element
+  --
+  -- Doesn't say much on its own but is useful for evaluating the performance
+  -- of splus
+  splus1 :: (Num a, I.Vector v a) => Ty (v a) -> v a -> v a
+  splus1 _ as = named "$a+1" $
+                I.map (+1) as
+
+  -- Add a constant to every element (version 2)
+  --
+  -- No intermediate array should be created, performance should be
+  -- similar to splus1
+  splus1_r :: (Num a, I.Vector v a) => Ty (v a) -> v a -> v a
+  splus1_r _ as = named "$a+^1" $
+                  I.zipWith (+) as (I.replicate (I.length as) 1)
+
+  -- Add a number to every element
+  --
+  -- The x should only be inspected once outside the loop. Performance should
+  -- be similar to splus1
+  splus :: (Num a, I.Vector v a) => Ty (v a) -> v a -> a -> v a
+  splus _ as x = named "$a+x" $
+                 I.map (+x) as
+
+  -- Add a number to every element (version 2)
+  --
+  -- No intermediate array should be created, performance should be
+  -- similar to splus and splus1_r
+  splus_r :: (Num a, I.Vector v a) => Ty (v a) -> v a -> a -> v a
+  splus_r _ as x = named "$a+^x" $
+                   I.zipWith (+) as (I.replicate (I.length as) x)
+
+  -- Do these maps get fused?
+  splus4 :: (Num a, I.Vector v a) => Ty (v a) -> v a -> a -> v a
+  splus4 _ as x = named "$a+x+x+x+x" $
+        I.map (+x) $ I.map (+x) $ I.map (+x) $ I.map (+x) as
+
+  -- Elementwise addition
+  --
+  -- Lower bound on the execution time of the following benchmarks
+  plus :: (Num a, I.Vector v a) => Ty (v a) -> v a -> v a -> v a
+  plus _ as bs = named "$a+$b" $
+                 I.zipWith (+) as bs
+
+  -- Checks speed of map/zip compared to zipWith
+  plus_zip :: (Num a, I.Vector v a) => Ty (v a) -> v a -> v a -> v a
+  plus_zip _ as bs = named "$a+$b(zip)" $
+        I.map (\p -> I.fst p + I.snd p) (I.zip as bs)
+
+  -- x should only be inspected once outside the loop
+  axpy :: (Num a, I.Vector v a) => Ty (v a) -> a -> v a -> v a -> v a
+  axpy _ x as bs = named "x*$a+$b" $
+                   I.zipWith (+) (I.map (x*) as) bs
+
+  -- Lots of zips can be inefficient with stream fusion.
+  mpp :: (Num a, I.Vector v a) => Ty (v a) -> v a -> v a -> v a -> v a -> v a
+  mpp _ as bs cs ds = named "($a+$b)*($c+$d)" $
+      I.zipWith (*) (I.zipWith (+) as bs) (I.zipWith (+) cs ds)
+
+  -- How does this compare to mpp?
+  mpp_zip :: (Num a, I.Vector v a)
+                => Ty (v a) -> v a -> v a -> v a -> v a -> v a
+  mpp_zip _ as bs cs ds = named "($a+$b)*($c+$d)(zip)" $
+        I.map (\p -> (I.fst (I.fst p) + I.snd (I.fst p))
+                   * (I.fst (I.snd p) + I.snd (I.snd p)))
+              (I.zip (I.zip as bs) (I.zip cs ds))
+
+  -- Both x and y should be inspected once.
+  mspsp :: (Num a, I.Vector v a) => Ty (v a) -> a -> v a -> a -> v a -> v a
+  mspsp _ x as y bs = named "(x+$a)*(y+$b)" $
+                      I.zipWith (*) (I.map (x+) as) (I.map (y+) bs)
+
+  -- Do we get rid of the replicates?
+  mspsp_r :: (Num a, I.Vector v a) => Ty (v a) -> a -> v a -> a -> v a -> v a
+  mspsp_r _ x as y bs = named "(^x+$a)*(^y+$b)" $
+      I.zipWith (*) (I.zipWith (+) (I.replicate (I.length as) x) as)
+                    (I.zipWith (+) (I.replicate (I.length bs) y) bs)
+
+  -- -----------
+  --   Filters
+  -- -----------
+
+  -- Removes all elements from the list, basic test of filter fusion
+  filterout :: (Num a, Eq a, I.Vector v a) => Ty (v a) -> v a -> v a
+  filterout _ as = named "filter(neq0)(map0)" $
+        I.filter (/=0) $ I.map (\x -> x-x) as
+
+  -- Only do the test once, no loop should be executed
+  filterout_r :: (Num a, Eq a, I.Vector v a) => Ty (v a) -> Len -> v a
+  filterout_r _ (Len n) = named "filter(neq0)(^0)" $
+       I.filter (/=0) $ I.replicate n 0
+
+  -- Retain all elements in a list
+  filterin :: (Num a, Eq a, I.Vector v a) => Ty (v a) -> v a -> v a
+  filterin _ as = named "filter(eq0)(map0)" $
+        I.filter (==0) $ I.map (\x -> x-x) as
+
+  -- Only do the test once, should be faster than filterin
+  filterin_r :: (Num a, Eq a, I.Vector v a) => Ty (v a) -> Len -> v a
+  filterin_r _ (Len n) = named "filter(eq0)(^0)" $
+       I.filter (==0) $ I.replicate n 0
+
+  -- Compute x outside of the loop
+  zip_filter :: (Num a, Ord a, I.Vector v a)
+                   => Ty (v a) -> Len -> v a -> v a -> v a
+  zip_filter _ (Len n) as bs =
+        let x = fromIntegral (n `div` 2)
+        in
+        I.zipWith (+) (I.filter (<x) as) (I.filter (<x) bs)
+
+  -- Compute (fromIntegral n) outside of the loop
+  filter_zip :: (Num a, Ord a, I.Vector v a)
+                  => Ty (v a) -> Len -> v a -> v a -> v a
+  filter_zip _ (Len n) as bs =
+       I.filter (< fromIntegral n) (I.zipWith (+) as bs)
+
+  filter_evens :: I.Vector v a => Ty (v a) -> Len -> v a -> v a
+  filter_evens _ (Len n) as =
+        I.map I.snd
+        $ I.filter (even . I.fst)
+        $ I.zip (I.enumFromTo_Int 0 (n-1)) as
+
+  -- --------
+  --   Sums
+  -- --------
+
+  -- Dot product
+  dotp :: (Num a, I.Vector v a) => Ty (v a) -> v a -> v a -> a
+  dotp _ as bs = named "sum($a*$b)" $
+                 I.sum (I.zipWith (*) as bs)
+
+  dotp_zip :: (Num a, I.Vector v a) => Ty (v a) -> v a -> v a -> a
+  dotp_zip _ as bs = named "sum($a*$b)(zip)" $
+        I.sum (I.map (\p -> I.fst p * I.snd p) (I.zip as bs))
+
+  -- sum [1 .. n]
+  sumn :: (Num a, I.Vector v a) => Ty (v a) -> Len -> a
+  sumn ty (Len n) = named "sum[m..n]" $
+       I.sum $ I.map fromIntegral (I.enumFromTo_Int 1 n) `ofType` ty
+
+  sumsq_map :: (Num a, I.Vector v a) => Ty (v a) -> Len -> a
+  sumsq_map ty (Len n) = named "sumsq(map)" $
+       I.sum $ I.map (\x -> x*x)
+             $ I.map fromIntegral (I.enumFromTo_Int 1 n) `ofType` ty
+
+  sumsq_zip :: (Num a, I.Vector v a) => Ty (v a) -> Len -> a
+  sumsq_zip ty (Len n) = named "sumsq(zip)" $
+       let as = I.map fromIntegral (I.enumFromTo_Int 1 n) `ofType` ty
+       in
+       I.sum $ I.zipWith (*) as as
+
+  sum_evens :: (Num a, I.Vector v a) => Ty (v a) -> Len -> v a -> a
+  sum_evens _ (Len n) as =
+        I.sum
+        $ I.map I.snd
+        $ I.filter (even . I.fst)
+        $ I.zip (I.enumFromTo_Int 0 (n-1)) as
+
+  |]
+
diff --git a/NoSlow/Micro/List.hs b/NoSlow/Micro/List.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/List.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.List
+where
+
+import qualified NoSlow.Backend.List as Impl
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Backend.TH
+
+import Language.Haskell.TH
+
+type V a = [a]
+
+$(specialise (Spec {
+                specModule = "Impl"
+              , specContext = \_ _ -> []
+              , specVars    = [("v", ConT ''[])]
+              })
+  K.kernels)
+
diff --git a/NoSlow/Micro/List/Double.hs b/NoSlow/Micro/List/Double.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/List/Double.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.List.Double
+where
+
+import qualified NoSlow.Backend.List as Impl
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Backend.TH
+
+import Language.Haskell.TH
+
+$(specialise (Spec {
+                specModule = "Impl"
+              , specContext = \_ _ -> []
+              , specVars    = [("v", ConT ''[]),
+                               ("a", ConT ''Double)]
+              })
+  K.kernels)
+
diff --git a/NoSlow/Micro/StorableVector.hs b/NoSlow/Micro/StorableVector.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/StorableVector.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.StorableVector
+where
+
+import Foreign ( Storable )
+import qualified NoSlow.Backend.StorableVector as Impl
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Backend.TH
+
+import Language.Haskell.TH
+
+$(specialise (Spec {
+                specModule = "Impl"
+              , specContext = \_ a -> [(''Storable, [VarT a])]
+              , specVars    = [("v", ConT ''Impl.Vector)]
+              })
+  K.kernels)
+
diff --git a/NoSlow/Micro/StorableVector/Double.hs b/NoSlow/Micro/StorableVector/Double.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/StorableVector/Double.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.StorableVector.Double
+where
+
+import qualified NoSlow.Backend.StorableVector as Impl
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Backend.TH
+
+import Language.Haskell.TH
+
+$(specialise (Spec {
+                specModule = "Impl"
+              , specContext = \_ _ -> []
+              , specVars    = [("v", ConT ''Impl.Vector),
+                               ("a", ConT ''Double)]
+              })
+  K.kernels)
+
diff --git a/NoSlow/Micro/Uvector.hs b/NoSlow/Micro/Uvector.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/Uvector.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.Uvector
+where
+
+import qualified NoSlow.Backend.Uvector as Impl
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Backend.TH
+
+import Language.Haskell.TH
+
+$(specialise (Spec {
+                specModule = "Impl"
+              , specContext = \_ a -> [(''Impl.UA, [VarT a])]
+              , specVars    = [("v", ConT ''Impl.UArr)]
+              })
+  K.kernels)
+
diff --git a/NoSlow/Micro/Uvector/Double.hs b/NoSlow/Micro/Uvector/Double.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/Uvector/Double.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.Uvector.Double
+where
+
+import qualified NoSlow.Backend.Uvector as Impl
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Backend.TH
+
+import Language.Haskell.TH
+
+$(specialise (Spec {
+                specModule = "Impl"
+              , specContext = \_ _ -> []
+              , specVars    = [("v", ConT ''Impl.UArr),
+                               ("a", ConT ''Double)]
+              })
+  K.kernels)
+
diff --git a/NoSlow/Micro/Vector/Boxed.hs b/NoSlow/Micro/Vector/Boxed.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/Vector/Boxed.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.Vector.Boxed
+where
+
+import qualified NoSlow.Backend.Vector as Impl
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Backend.TH
+
+import Language.Haskell.TH
+
+$(specialise (Spec {
+                specModule = "Impl"
+              , specContext = \_ _ -> []
+              , specVars    = [("v", ConT ''Impl.Vector)]
+              })
+  K.kernels)
+
diff --git a/NoSlow/Micro/Vector/Boxed/Double.hs b/NoSlow/Micro/Vector/Boxed/Double.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/Vector/Boxed/Double.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.Vector.Boxed.Double
+where
+
+import qualified NoSlow.Backend.Vector as Impl
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Backend.TH
+
+import Language.Haskell.TH
+
+$(specialise (Spec {
+                specModule = "Impl"
+              , specContext = \_ _ -> []
+              , specVars    = [("v", ConT ''Impl.Vector),
+                               ("a", ConT ''Double)]
+              })
+  K.kernels)
+
diff --git a/NoSlow/Micro/Vector/Primitive.hs b/NoSlow/Micro/Vector/Primitive.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/Vector/Primitive.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.Vector.Primitive
+where
+
+import qualified NoSlow.Backend.Vector.Primitive as Impl
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Backend.TH
+
+import Language.Haskell.TH
+
+$(specialise (Spec {
+                specModule = "Impl"
+              , specContext = \_ a -> [(''Impl.Prim, [VarT a])]
+              , specVars    = [("v", ConT ''Impl.Vector)]
+              })
+  K.kernels)
+
diff --git a/NoSlow/Micro/Vector/Primitive/Double.hs b/NoSlow/Micro/Vector/Primitive/Double.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/Vector/Primitive/Double.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.Vector.Primitive.Double
+where
+
+import qualified NoSlow.Backend.Vector.Primitive as Impl
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Backend.TH
+
+import Language.Haskell.TH
+
+$(specialise (Spec {
+                specModule = "Impl"
+              , specContext = \_ _ -> []
+              , specVars    = [("v", ConT ''Impl.Vector),
+                               ("a", ConT ''Double)]
+              })
+  K.kernels)
+
diff --git a/NoSlow/Micro/Vector/Storable.hs b/NoSlow/Micro/Vector/Storable.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/Vector/Storable.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.Vector.Storable
+where
+
+import qualified NoSlow.Backend.Vector.Storable as Impl
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Backend.TH
+
+import Language.Haskell.TH
+
+$(specialise (Spec {
+                specModule = "Impl"
+              , specContext = \_ a -> [(''Impl.Storable, [VarT a])]
+              , specVars    = [("v", ConT ''Impl.Vector)]
+              })
+  K.kernels)
+
diff --git a/NoSlow/Micro/Vector/Storable/Double.hs b/NoSlow/Micro/Vector/Storable/Double.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Micro/Vector/Storable/Double.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+module NoSlow.Micro.Vector.Storable.Double
+where
+
+import qualified NoSlow.Backend.Vector.Storable as Impl
+import qualified NoSlow.Micro.Kernels as K
+import NoSlow.Backend.TH
+
+import Language.Haskell.TH
+
+$(specialise (Spec {
+                specModule = "Impl"
+              , specContext = \_ _ -> []
+              , specVars    = [("v", ConT ''Impl.Vector),
+                               ("a", ConT ''Double)]
+              })
+  K.kernels)
+
diff --git a/NoSlow/Util/Base.hs b/NoSlow/Util/Base.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Util/Base.hs
@@ -0,0 +1,20 @@
+module NoSlow.Util.Base (
+  Ty(..), ofType, named, Unsupported(..),
+
+  Len(..)
+) where
+
+data Ty a = Ty
+
+ofType :: a -> Ty a -> a
+{-# INLINE ofType #-}
+x `ofType` _ = x
+
+named :: String -> a -> a
+{-# INLINE named #-}
+named s x = x
+
+data Unsupported = Unsupported
+
+newtype Len = Len { unLen :: Int }
+
diff --git a/NoSlow/Util/Computation.hs b/NoSlow/Util/Computation.hs
new file mode 100644
--- /dev/null
+++ b/NoSlow/Util/Computation.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE TypeOperators, TypeFamilies, FlexibleContexts, CPP #-}
+module NoSlow.Util.Computation (
+  DeepSeq(..), TestData(..), Computation(..),
+
+  Nil(..), (:>)(..)
+) where
+
+import NoSlow.Util.Base ( Len(..) )
+
+class DeepSeq a where
+  deepSeq :: a -> b -> b
+  deepSeq = seq
+
+instance DeepSeq Len
+instance DeepSeq Int
+instance DeepSeq Float
+instance DeepSeq Double
+
+instance DeepSeq a => DeepSeq [a] where
+  deepSeq xs b = foldr deepSeq b xs
+
+class DeepSeq a => TestData a where
+  testData :: Int -> a
+  testList :: Int -> [a]
+
+  testList n = replicate n (testData n)
+
+instance TestData Len where
+  testData n = Len n
+
+instance TestData Int where
+  testData _ = 1
+  testList n = [1..n]
+
+instance TestData Float where
+  testData _ = 1
+  testList n = [1..fromIntegral n]
+
+instance TestData Double where
+  testData _ = 1
+  testList n = [1..fromIntegral n]
+
+instance TestData a => TestData [a] where
+  testData = testList
+
+data x :> xs = x :> xs
+data Nil = Nil
+
+instance DeepSeq Nil where
+  deepSeq Nil x = x
+
+instance TestData Nil where
+  testData _ = Nil
+
+instance (DeepSeq x, DeepSeq xs) => DeepSeq (x :> xs) where
+  deepSeq (x :> xs) y = deepSeq x $ deepSeq xs y
+
+instance (TestData x, TestData xs) => TestData (x :> xs) where
+  testData n = testData n :> testData n
+
+class (TestData (Arg a), DeepSeq (Res a)) => Computation a where
+  type Arg a
+  type Res a
+
+  apply :: a -> Arg a -> Res a
+
+#define ComputationResult(ty) \
+instance Computation (ty) where { \
+  type Arg (ty) = Nil       \
+; type Res (ty) = ty        \
+; apply x _ = x             }
+
+ComputationResult(Len)
+ComputationResult(Int)
+ComputationResult(Float)
+ComputationResult(Double)
+
+instance DeepSeq a => Computation [a] where
+  type Arg [a] = Nil
+  type Res [a] = [a]
+  apply x _ = x
+
+instance (TestData a, Computation b) => Computation (a -> b) where
+  type Arg (a -> b) = a :> Arg b
+  type Res (a -> b) = Res b
+
+  apply f (x :> xs) = apply (f x) xs
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+import Distribution.Simple
+main = defaultMain
+
diff --git a/Table.hs b/Table.hs
new file mode 100644
--- /dev/null
+++ b/Table.hs
@@ -0,0 +1,254 @@
+{-# LANGUAGE PatternGuards #-}
+module Main where
+
+import Criterion.Measurement ( secs )
+import qualified Data.Map as M
+import Data.List ( nub, intersect, sort, groupBy )
+import Text.Read
+import System.Environment ( getArgs )
+import Control.Monad ( liftM, foldM )
+import Text.Printf ( printf )
+
+main = do
+         (arg : args) <- getArgs
+         if arg == "--diff"
+           then doDiff  args
+           else doTable arg args
+
+doTable file args
+  = do
+      bs <- readLog file
+      table <- foldM procArg (mkTable secs bs) args
+      outputHTML table
+
+doDiff (file1 : file2 : args)
+  = do
+      bs1 <- readLog file1
+      bs2 <- readLog file2
+      let t = intersectTable ratio cmp (mkTable secs bs1) (mkTable secs bs2)
+      table <- foldM procArg t args
+      outputHTML table
+  where
+    ratio d = printf "%.3f" d
+
+    cmp d1 d2 = d1 / d2
+
+
+dropPrefix :: String -> String -> Maybe String
+dropPrefix "" cs  = Just cs
+dropPrefix (p : ps) (c : cs)
+  | p == c    = dropPrefix ps cs
+  | otherwise = Nothing
+
+procArg t arg
+  | Just s <- dropPrefix "--type=" arg
+     = return $ filterColumns (\cfg -> cfgDatatype cfg == s) t
+
+data Cfg = Cfg {
+             cfgLibrary   :: String
+           , cfgSubsystem :: String
+           , cfgDatatype  :: String
+           }
+ deriving ( Eq, Ord )
+
+data Library = Library String Int [Subsystem]
+data Subsystem = Subsystem String Int [String]
+
+on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
+on f g x y = f (g x) (g y)
+
+eqOn :: Eq b => (a -> b) -> a -> a -> Bool
+eqOn = on (==)
+
+groupCfgs :: [Cfg] -> [Library]
+groupCfgs = map mk_library . groupBy (eqOn cfgLibrary)
+  where
+    mk_library cfgs@(c:_)
+      = let subs = map mk_subsystem $ groupBy (eqOn cfgSubsystem) cfgs
+        in
+        Library (cfgLibrary c) (sum [n | Subsystem _ n _ <- subs]) subs
+    mk_subsystem cfgs@(c:_)
+      = let cols = map cfgDatatype cfgs
+        in
+        Subsystem (cfgSubsystem c) (length cols) cols
+
+instance Show Cfg where
+  showsPrec _ cfg = showString (cfgLibrary cfg)
+                  . sub (cfgSubsystem cfg)
+                  . showChar '.' . showString (cfgDatatype cfg)
+    where
+      sub "" = id
+      sub s  = showChar '.' . showString s
+
+data Entry a = Entry {
+                 eCfg  :: Cfg
+               , eName :: String
+               , eData :: a
+               }
+
+data Table = Table {
+               tRows     :: [String]
+             , tColumns  :: [Cfg]
+             , tCells    :: M.Map String Row
+             , tShowCell :: Double -> String
+             }
+type Row = M.Map Cfg Double
+
+mkTable :: (Double -> String) -> [Entry Double] -> Table
+mkTable show es
+  = Table {
+      tRows     = nub $ map eName es
+    , tColumns  = sort $ nub $ map eCfg es
+    , tCells    = M.fromListWith M.union [(eName e, unit e) | e <- es]
+    , tShowCell = show
+    }
+  where
+    unit e = M.singleton (eCfg e) (eData e)
+
+structure :: Table -> [Library]
+structure = groupCfgs . tColumns
+
+cells :: Table -> [(String, [Maybe Double])]
+cells (Table { tRows    = names
+             , tColumns = cfgs
+             , tCells   = t }) = concatMap row_cells names
+  where
+    row_cells name = case M.lookup name t of
+                       Just row -> [(name, map (cell row) cfgs)]
+                       Nothing  -> []
+
+    cell row cfg = M.lookup cfg row
+
+outputHTML :: Table -> IO ()
+outputHTML t
+  = do
+      putStrLn "<html><body>"
+      putStrLn $ htmlTable t
+      putStrLn "</body></html>"
+
+htmlTable :: Table -> String
+htmlTable t = unlines
+  [ "<table border=\"1\">"
+  , header (structure t) -- tr $ concatMap th ("" : map show (tColumns t))
+  , unlines $ map (tr . row) (cells t)
+  , "</table>"
+  ]
+  where
+    row (s, cs) = th (concatMap escape s) ++ concatMap cell cs
+    cell Nothing = td ""
+    cell (Just s) = td (tShowCell t s)
+
+    tr s = "<tr>" ++ s ++ "</tr>"
+
+    th s = "<th>" ++ s ++ "</th>"
+    td s = "<td>" ++ s ++ "</td>"
+
+    th' n s = "<th colspan=\"" ++ show n ++ "\">" ++ s ++ "</th>"
+
+    header :: [Library] -> String
+    header libs =  unlines [
+                    tr $ th "" ++ concat [th' n lib | Library lib n _ <- libs]
+                  , tr $ th "" ++ concat [th' n sub | Library _ _ subs <- libs
+                                                    , Subsystem sub n _ <- subs]
+                  ,               types  [s         | Library _ _ subs <- libs
+                                                    , Subsystem _ _ ss <- subs
+                                                    , s <- ss]
+                  ]
+
+    types (s : ss)
+      | all (s==) ss = ""
+      | otherwise    = tr $ th "" ++ concatMap th (s:ss)
+
+    escape '<' = "&lt;"
+    escape '>' = "&gt;"
+    escape '&' = "&amp;"
+    escape c   = [c]
+
+filterRows :: (String -> Bool) -> Table -> Table
+filterRows f t@(Table { tRows = tRows, tCells = tCells })
+  = t { tRows  = filter f tRows
+      , tCells = M.filterWithKey (\s _ -> f s) tCells }
+
+filterColumns :: (Cfg -> Bool) -> Table -> Table
+filterColumns f t@(Table { tColumns = tColumns, tCells = tCells })
+  = t { tColumns = filter f tColumns
+      , tCells   = M.map (M.filterWithKey (\cfg _ -> f cfg)) tCells
+      }
+
+intersectTable :: (Double -> String) -> (Double -> Double -> Double)
+                    -> Table -> Table -> Table
+intersectTable show f t1 t2
+  = Table { tRows     = intersect (tRows t1) (tRows t2)
+          , tColumns  = intersect (tColumns t1) (tColumns t2)
+          , tCells    = M.intersectionWith (M.intersectionWith f)
+                                           (tCells t1) (tCells t2)
+          , tShowCell = show
+          }
+
+{-
+data State = State {
+               stOriginal :: Table Double
+             , stResult   :: Table Double
+             }
+
+mapOriginal :: (Table Double -> Table Double) -> State -> State
+mapOriginal f st@(State { stOriginal = t }) = st { stOriginal = f t }
+
+mapResult :: (Table Double -> Table Double) -> State -> State
+mapResult f st@(State { stResult = t }) = st { stResult = f t }
+-}
+
+
+newtype Benchmark = Benchmark { unBenchmark :: Entry Double }
+
+readLog :: FilePath -> IO [Entry Double]
+readLog file = (proc_lines . lines) `liftM` readFile file
+  where
+    proc_lines (h : r)
+      | h == header = map (unBenchmark . read) r
+      | otherwise = error "Invalid file"
+
+    header = "Name,Mean,MeanLB,MeanUB,Stddev,StddevLB,StddevUB"
+
+
+instance Read Benchmark where
+  readPrec = do
+               tag <- readPrec
+               comma
+               mean <- readPrec
+               comma
+               readPrec :: ReadPrec Double -- meanlb
+               comma
+               readPrec :: ReadPrec Double -- meanub
+               comma
+               readPrec :: ReadPrec Double -- stddev
+               comma
+               readPrec :: ReadPrec Double -- stddevlb
+               comma
+               readPrec :: ReadPrec Double -- stddevub
+               case split_tag tag of
+                 (library, subsystem, datatype, name)
+                    -> return $ Benchmark
+                              $ Entry {
+                                  eCfg = Cfg { cfgLibrary   = library
+                                             , cfgSubsystem = subsystem
+                                             , cfgDatatype  = datatype
+                                             }
+                                , eName = name
+                                , eData = mean
+                                }
+    where
+      comma = do
+                c <- get
+                if c == ',' then return () else pfail
+
+      split_tag s = case split '/' s of
+                     [library,subsystem,datatype,benchmark]
+                        -> (library,subsystem,datatype,benchmark)
+                     [library,datatype,benchmark]
+                        -> (library,"",datatype,benchmark)
+    
+      split c xs = case span (/= c) xs of
+                     (ys,[]) -> [ys]
+                     (ys, _ : zs) -> ys : split c zs
+
