diff --git a/Data/PrimitiveArray.hs b/Data/PrimitiveArray.hs
deleted file mode 100644
--- a/Data/PrimitiveArray.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-
-module Data.PrimitiveArray 
-  ( module Data.PrimitiveArray.Class
-  , module Data.PrimitiveArray.Dense
---  , module Data.PrimitiveArray.FillTables
-  , module Data.PrimitiveArray.Index
-  ) where
-
-import Data.PrimitiveArray.Class
-import Data.PrimitiveArray.Dense
---import Data.PrimitiveArray.FillTables
-import Data.PrimitiveArray.Index
-
diff --git a/Data/PrimitiveArray/Checked.hs b/Data/PrimitiveArray/Checked.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/Checked.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-
--- | This module exports everything that @Data.PrimitiveArray@ exports, but
--- it will do some bounds-checking on certain operations.
---
--- Checked are: @(!)@
-
-module Data.PrimitiveArray.Checked
-  ( module Data.PrimitiveArray
-  , (!)
-  ) where
-
-import qualified Data.Vector.Generic as VG
-
-import           Data.PrimitiveArray hiding ((!))
-
--- | Bounds-checked version of indexing.
---
--- First, we check via @inBounds@, second we check if the linear index is
--- outside of the allocated area.
-
---(!) :: PrimArrayOps arr sh elm => arr sh elm -> sh -> elm
-(!) arr@(Unboxed h v) idx
-  | not (inBounds (upperBound arr) idx) = error $ "(!) / inBounds: out of bounds! " ++ show (h,idx)
-  | li < 0 || li >= len = error $ "(!) / linearIndex: out of bounds! " ++ show (h,li,len,idx)
-  | otherwise = unsafeIndex arr idx
-  where li  = linearIndex h idx
-        len = VG.length v
-{-# Inline (!) #-}
-
diff --git a/Data/PrimitiveArray/Class.hs b/Data/PrimitiveArray/Class.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/Class.hs
+++ /dev/null
@@ -1,233 +0,0 @@
-
--- | Vastly extended primitive arrays. Some basic ideas are now modeled after
--- the vector package, especially the monadic mutable / pure immutable array
--- system.
---
--- NOTE all operations in MPrimArrayOps and PrimArrayOps are highly unsafe. No
--- bounds-checking is performed at all.
-
-module Data.PrimitiveArray.Class where
-
-import           Control.Applicative (Applicative, pure, (<$>), (<*>))
-import           Control.Exception (assert)
-import           Control.Monad.Except
-import           Control.Monad (forM_)
-import           Control.Monad.Primitive (PrimMonad, liftPrim)
-import           Control.Monad.ST (runST)
-import           Data.Proxy
-import           Data.Vector.Fusion.Util
-import           Debug.Trace
-import           GHC.Generics (Generic)
-import           Prelude as P
-import qualified Data.Vector.Fusion.Stream.Monadic as SM
-
-import           Data.PrimitiveArray.Index.Class
-
-
-
--- | Mutable version of an array.
-
-data family MutArr (m :: * -> *) (arr :: *) :: *
-
-
--- | The core set of operations for monadic arrays.
-
-class (Index sh) => MPrimArrayOps arr sh elm where
-
-  -- | Return the bounds of the array. All bounds are inclusive, as in
-  -- @[lb..ub]@
-
-  upperBoundM :: MutArr m (arr sh elm) -> LimitType sh
-
-  -- | Given lower and upper bounds and a list of /all/ elements, produce a
-  -- mutable array.
-
-  fromListM :: PrimMonad m => LimitType sh -> [elm] -> m (MutArr m (arr sh elm))
-
-  -- | Creates a new array with the given bounds with each element within the
-  -- array being in an undefined state.
-
-  newM :: PrimMonad m => LimitType sh -> m (MutArr m (arr sh elm))
-
-  -- | Creates a new array with all elements being equal to 'elm'.
-
-  newWithM :: PrimMonad m => LimitType sh -> elm -> m (MutArr m (arr sh elm))
-
-  -- | Reads a single element in the array.
-
-  readM :: PrimMonad m => MutArr m (arr sh elm) -> sh -> m elm
-
-  -- | Writes a single element in the array.
-
-  writeM :: PrimMonad m => MutArr m (arr sh elm) -> sh -> elm -> m ()
-
-
-
--- | The core set of functions on immutable arrays.
-
-class (Index sh) => PrimArrayOps arr sh elm where
-
-  -- | Returns the bounds of an immutable array, again inclusive bounds: @ [lb..ub] @.
-
-  upperBound :: arr sh elm -> LimitType sh
-
-  -- | Freezes a mutable array an returns its immutable version. This operation
-  -- is /O(1)/ and both arrays share the same memory. Do not use the mutable
-  -- array afterwards.
-
-  unsafeFreeze :: PrimMonad m => MutArr m (arr sh elm) -> m (arr sh elm)
-
-  -- | Thaw an immutable array into a mutable one. Both versions share
-  -- memory.
-
-  unsafeThaw :: PrimMonad m => arr sh elm -> m (MutArr m (arr sh elm))
-
-  -- | Extract a single element from the array. Generally unsafe as not
-  -- bounds-checking is performed.
-
-  unsafeIndex :: arr sh elm -> sh -> elm
-
-  -- | Savely transform the shape space of a table.
-
-  transformShape :: (Index sh') => (LimitType sh -> LimitType sh') -> arr sh elm -> arr sh' elm
-
-class (Index sh) => PrimArrayMap arr sh e e' where
-
-  -- | Map a function over each element, keeping the shape intact.
-
-  map :: (e -> e') -> arr sh e -> arr sh e'
-
-
-
-data PAErrors
-  = PAEUpperBound
-  deriving (Eq,Generic)
-
-instance Show PAErrors where
-  show (PAEUpperBound) = "Upper bound is too large for @Int@ size!"
-
-
-
--- | Infix index operator. Performs minimal bounds-checking using assert in
--- non-optimized code.
-
-(!) :: PrimArrayOps arr sh elm => arr sh elm -> sh -> elm
-(!) arr idx = assert (inBounds (upperBound arr) idx) $ unsafeIndex arr idx
-{-# INLINE (!) #-}
-
--- | Returns true if the index is valid for the array.
-
-inBoundsM :: (Monad m, MPrimArrayOps arr sh elm) => MutArr m (arr sh elm) -> sh -> Bool
-inBoundsM marr idx = inBounds (upperBoundM marr) idx
-{-# INLINE inBoundsM #-}
-
--- -- | Given two arrays with the same dimensionality, their respective starting
--- -- index, and how many steps to go in each dimension (in terms of a dimension
--- -- again), determine if the multidimensional slices have the same value at
--- -- all positions
--- --
--- -- TODO specialize for DIM1 (and maybe higher dim's) to use memcmp
--- 
--- sliceEq :: (Eq elm, PrimArrayOps arr sh elm) => arr sh elm -> sh -> arr sh elm -> sh -> sh -> Bool
--- sliceEq arr1 k1 arr2 k2 xtnd = assert ((inBounds arr1 k1) && (inBounds arr2 k2) && (inBounds arr1 $ k1 `addDim` xtnd) && (inBounds arr2 $ k2 `addDim` xtnd)) $ and res where
---   res = zipWith (==) xs ys
---   xs = P.map (unsafeIndex arr1) $ rangeList k1 xtnd
---   ys = P.map (unsafeIndex arr2) $ rangeList k2 xtnd
--- {-# INLINE sliceEq #-}
-
--- | Construct a mutable primitive array from a lower and an upper bound, a
--- default element, and a list of associations.
-
-fromAssocsM
-  :: (PrimMonad m, MPrimArrayOps arr sh elm)
-  => LimitType sh -> elm -> [(sh,elm)] -> m (MutArr m (arr sh elm))
-fromAssocsM ub def xs = do
-  ma <- newWithM ub def
---  let s = size ub
---  traceShow (s,length xs) $ when (s < length xs) $ error "bang"
-  forM_ xs $ \(k,v) -> writeM ma k v
-  return ma
-{-# INLINE fromAssocsM #-}
-
--- | Initialize an immutable array but stay within the primitive monad @m@.
-
-newWithPA
-  ∷ (PrimMonad m, MPrimArrayOps arr sh elm, PrimArrayOps arr sh elm)
-  ⇒ LimitType sh
-  → elm
-  → m (arr sh elm)
-newWithPA ub def = do
-  ma ← newWithM ub def
-  unsafeFreeze ma
-{-# Inlinable newWithPA #-}
-
--- | Safely prepare a primitive array.
---
--- TODO Check if having a 'MonadError' instance degrades performance. (We
--- should see this once the test with NeedlemanWunsch is under way).
-
-safeNewWithPA
-  ∷ forall m arr sh elm 
-  . (PrimMonad m, MonadError PAErrors m, MPrimArrayOps arr sh elm, PrimArrayOps arr sh elm)
-  ⇒ LimitType sh
-  → elm
-  → m (arr sh elm)
-safeNewWithPA ub def = do
-  case runExcept $ sizeIsValid maxBound [totalSize ub] of
-    Left  (SizeError _) → throwError PAEUpperBound
-    Right (CellSize  _) → newWithPA ub def
-{-# Inlinable safeNewWithPA #-}
-
-
--- | Return all associations from an array.
-
-assocs :: forall arr sh elm . (IndexStream sh, PrimArrayOps arr sh elm) => arr sh elm -> [(sh,elm)]
-assocs arr = P.map (\k -> (k,unsafeIndex arr k)) . unId . SM.toList $ streamUp zeroBound' (upperBound arr) where
-{-# INLINE assocs #-}
-
--- | Creates an immutable array from lower and upper bounds and a complete list
--- of elements.
-
-fromList :: (PrimArrayOps arr sh elm, MPrimArrayOps arr sh elm) => LimitType sh -> [elm] -> arr sh elm
-fromList ub xs = runST $ fromListM ub xs >>= unsafeFreeze
-{-# INLINE fromList #-}
-
--- | Creates an immutable array from lower and upper bounds, a default element,
--- and a list of associations.
-
-fromAssocs :: (PrimArrayOps arr sh elm, MPrimArrayOps arr sh elm) => LimitType sh -> elm -> [(sh,elm)] -> arr sh elm
-fromAssocs ub def xs = runST $ fromAssocsM ub def xs >>= unsafeFreeze
-{-# INLINE fromAssocs #-}
-
--- -- | Determines if an index is valid for a given immutable array.
--- 
--- inBounds :: PrimArrayOps arr sh elm => arr sh elm -> sh -> Bool
--- inBounds arr idx = let (lb,ub) = bounds arr in inShapeRange lb (ub `addDim` unitDim) idx
--- {-# INLINE inBounds #-}
-
--- | Returns all elements of an immutable array as a list.
-
-toList :: forall arr sh elm . (IndexStream sh, PrimArrayOps arr sh elm) => arr sh elm -> [elm]
-toList arr = let ub = upperBound arr in P.map ((!) arr) . unId . SM.toList $ streamUp zeroBound' ub
-{-# INLINE toList #-}
-
-
-
--- * Freeze an inductive stack of tables with a 'Z' at the bottom.
-
--- | 'freezeTables' freezes a stack of tables.
-
-class FreezeTables m t where
-    type Frozen t :: *
-    freezeTables :: t -> m (Frozen t)
-
-instance Applicative m => FreezeTables m Z where
-    type Frozen Z = Z
-    freezeTables Z = pure Z
-    {-# INLINE freezeTables #-}
-
-instance (Functor m, Applicative m, Monad m, PrimMonad m, FreezeTables m ts, PrimArrayOps arr sh elm) => FreezeTables m (ts:.MutArr m (arr sh elm)) where
-    type Frozen (ts:.MutArr m (arr sh elm)) = Frozen ts :. arr sh elm
-    freezeTables (ts:.t) = (:.) <$> freezeTables ts <*> unsafeFreeze t
-    {-# INLINE freezeTables #-}
-
diff --git a/Data/PrimitiveArray/Dense.hs b/Data/PrimitiveArray/Dense.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/Dense.hs
+++ /dev/null
@@ -1,220 +0,0 @@
-
--- | Dense primitive arrays where the lower index is zero (or the
--- equivalent of zero for newtypes and enumerations).
---
--- Actual @write@s to data structures use a more safe @write@ instead of
--- the unsafe @unsafeWrite@. Writes also tend to occur much less in DP
--- algorithms (say, N^2 writes for an N^3 time algorithm -- mostly reads
--- are being executed).
---
--- TODO consider if we want to force the lower index to be zero, or allow
--- non-zero lower indices. Will have to be considered together with the
--- @Index.Class@ module!
---
--- TODO while @Unboxed@ is, in princile, @Hashable@, we'd need the
--- corresponding @VU.Vector@ instances ...
-
-module Data.PrimitiveArray.Dense where
-
-import           Control.DeepSeq
-import           Control.Exception (assert)
-import           Control.Monad (liftM, forM_, zipWithM_)
-import           Control.Monad.Primitive (PrimState)
-import           Data.Aeson (ToJSON,FromJSON)
-import           Data.Binary (Binary)
-import           Data.Hashable (Hashable)
-import           Data.Serialize (Serialize)
-import           Data.Typeable (Typeable)
-import           Data.Vector.Binary
-import           Data.Vector.Generic.Mutable as GM hiding (length)
-import           Data.Vector.Serialize
-import           Data.Vector.Unboxed.Mutable (Unbox)
-import           Debug.Trace
-import           GHC.Generics (Generic)
-import qualified Data.Vector as V hiding (forM_, length, zipWithM_)
-import qualified Data.Vector.Generic as G
-import qualified Data.Vector.Unboxed as VU hiding (forM_, length, zipWithM_)
-import           Data.Data
-
-
-import           Data.PrimitiveArray.Class
-import           Data.PrimitiveArray.Index.Class
-
-
-
--- * Unboxed, multidimensional arrays.
-
-data Unboxed sh e = Unboxed !(LimitType sh) !(VU.Vector e)
-
-deriving instance (Eq      (LimitType sh), Eq e     , Unbox e) ⇒ Eq      (Unboxed sh e)
-deriving instance (Generic (LimitType sh), Generic e, Unbox e) ⇒ Generic (Unboxed sh e)
-deriving instance (Read    (LimitType sh), Read e   , Unbox e) ⇒ Read    (Unboxed sh e)
-deriving instance (Show    (LimitType sh), Show e   , Unbox e) ⇒ Show    (Unboxed sh e)
-deriving instance
-  ( Data sh, Data (LimitType sh)
-  , Data e, Unbox e
-  ) ⇒ Data    (Unboxed sh e)
-
-instance (Binary    (LimitType sh), Binary    e, Unbox e, Generic (LimitType sh), Generic e) => Binary    (Unboxed sh e)
-instance (Serialize (LimitType sh), Serialize e, Unbox e, Generic (LimitType sh), Generic e) => Serialize (Unboxed sh e)
-instance (ToJSON    (LimitType sh), ToJSON    e, Unbox e, Generic (LimitType sh), Generic e) => ToJSON    (Unboxed sh e)
-instance (FromJSON  (LimitType sh), FromJSON  e, Unbox e, Generic (LimitType sh), Generic e) => FromJSON  (Unboxed sh e)
-instance (Hashable  (LimitType sh), Hashable  e, Hashable (VU.Vector e), Unbox e, Generic (LimitType sh), Generic e) => Hashable  (Unboxed sh e)
-
-instance (NFData (LimitType sh)) => NFData (Unboxed sh e) where
-  rnf (Unboxed h xs) = rnf h `seq` rnf xs
-  {-# Inline rnf #-}
-
-data instance MutArr m (Unboxed sh e) = MUnboxed !(LimitType sh) !(VU.MVector (PrimState m) e)
-  deriving (Generic,Typeable)
-
-instance (NFData (LimitType sh)) => NFData (MutArr m (Unboxed sh e)) where
-  rnf (MUnboxed h xs) = rnf h `seq` rnf xs
-  {-# Inline rnf #-}
-
-instance
-  ( Index sh
-  , Unbox elm
-#if ADPFUSION_DEBUGOUTPUT
-  , Show sh, Show (LimitType sh), Show elm
-#endif
-  ) ⇒ MPrimArrayOps Unboxed sh elm where
-  upperBoundM (MUnboxed h _) = h
-  fromListM h xs = do
-    ma <- newM h
-    let (MUnboxed _ mba) = ma
-    zipWithM_ (\k x -> assert (length xs == size h) $ unsafeWrite mba k x) [0.. size h -1] xs
-    return ma
-  newM h = MUnboxed h `liftM` new (size h)
-  newWithM h def = do
-    ma <- newM h
-    let (MUnboxed _ mba) = ma
-    forM_ [0 .. size h -1] $ \k -> unsafeWrite mba k def
-    return ma
-  readM  (MUnboxed h mba) idx     = assert (inBounds h idx) $ unsafeRead  mba (linearIndex h idx)
-  writeM (MUnboxed h mba) idx elm =
-#if ADPFUSION_DEBUGOUTPUT
-    (if inBounds h idx then id else traceShow ("writeM", h, idx, elm, size h, linearIndex h idx, inBounds h idx))
-#endif
-    assert (inBounds h idx) $ unsafeWrite mba (linearIndex h idx) elm
-  {-# INLINE upperBoundM #-}
-  {-# INLINE fromListM #-}
-  {-# NoInline newM #-}
-  {-# INLINE newWithM #-}
-  {-# INLINE readM #-}
-  {-# INLINE writeM #-}
-
-instance (Index sh, Unbox elm) => PrimArrayOps Unboxed sh elm where
-  upperBound (Unboxed h _) = h
-  unsafeFreeze (MUnboxed h mba) = Unboxed h `liftM` G.unsafeFreeze mba
-  unsafeThaw   (Unboxed  h ba) = MUnboxed h `liftM` G.unsafeThaw ba
-  unsafeIndex  (Unboxed  h ba) idx = G.unsafeIndex ba (linearIndex h idx)
-  transformShape tr (Unboxed h ba) = Unboxed (tr h) ba
-  {-# INLINE upperBound #-}
-  {-# INLINE unsafeFreeze #-}
-  {-# INLINE unsafeThaw #-}
-  {-# INLINE unsafeIndex #-}
-  {-# INLINE transformShape #-}
-
-instance (Index sh, Unbox e, Unbox e') => PrimArrayMap Unboxed sh e e' where
-  map f (Unboxed h xs) = Unboxed h (VU.map f xs)
-  {-# INLINE map #-}
-
-
-
--- * Boxed, multidimensional arrays.
-
-data Boxed sh e = Boxed !(LimitType sh) !(V.Vector e)
-
-deriving instance (Read    (LimitType sh), Read e) ⇒ Read (Boxed sh e)
-deriving instance (Show    (LimitType sh), Show e) ⇒ Show (Boxed sh e)
-deriving instance (Eq      (LimitType sh), Eq   e) ⇒ Eq   (Boxed sh e)
-deriving instance (Generic (LimitType sh), Generic e) ⇒ Generic (Boxed sh e)
-deriving instance
-  ( Data sh, Data (LimitType sh)
-  , Data e
-  ) ⇒ Data    (Boxed sh e)
-
-
-instance (Binary    (LimitType sh), Binary    e, Unbox e, Generic (LimitType sh), Generic e) => Binary    (Boxed sh e)
-instance (Serialize (LimitType sh), Serialize e, Unbox e, Generic (LimitType sh), Generic e) => Serialize (Boxed sh e)
-instance (ToJSON    (LimitType sh), ToJSON    e, Unbox e, Generic (LimitType sh), Generic e) => ToJSON    (Boxed sh e)
-instance (FromJSON  (LimitType sh), FromJSON  e, Unbox e, Generic (LimitType sh), Generic e) => FromJSON  (Boxed sh e)
-instance (Hashable  (LimitType sh), Hashable  e, Hashable (V.Vector e), Unbox e, Generic (LimitType sh), Generic e) => Hashable  (Boxed sh e)
-
-instance (NFData (LimitType sh), NFData e) => NFData (Boxed sh e) where
-  rnf (Boxed h xs) = rnf h `seq` rnf xs
-  {-# Inline rnf #-}
-
-data instance MutArr m (Boxed sh e) = MBoxed !(LimitType sh) !(V.MVector (PrimState m) e)
-  deriving (Generic,Typeable)
-
-instance (NFData (LimitType sh)) => NFData (MutArr m (Boxed sh e)) where
-  rnf (MBoxed h xs) = rnf h -- no rnf for the data !
-  {-# Inline rnf #-}
-
-instance (Index sh) => MPrimArrayOps Boxed sh elm where
-  upperBoundM (MBoxed h _) = h
-  fromListM h xs = do
-    ma <- newM h
-    let (MBoxed _ mba) = ma
-    zipWithM_ (\k x -> assert (length xs == size h) $ unsafeWrite mba k x) [0 .. size h - 1] xs
-    return ma
-  newM h =
-    MBoxed h `liftM` new (size h)
-  newWithM h def = do
-    ma <- newM h
-    let (MBoxed _ mba) = ma
-    forM_ [0 .. size h -1] $ \k -> unsafeWrite mba k def
-    return ma
-  readM  (MBoxed h mba) idx     = assert (inBounds h idx) $ GM.unsafeRead  mba (linearIndex h idx)
-  writeM (MBoxed h mba) idx elm = assert (inBounds h idx) $ GM.unsafeWrite mba (linearIndex h idx) elm
-  {-# INLINE upperBoundM #-}
-  {-# INLINE fromListM #-}
-  {-# NoInline newM #-}
-  {-# INLINE newWithM #-}
-  {-# INLINE readM #-}
-  {-# INLINE writeM #-}
-
-instance (Index sh) => PrimArrayOps Boxed sh elm where
-  upperBound (Boxed h _) = h
-  unsafeFreeze (MBoxed h mba) = Boxed h `liftM` G.unsafeFreeze mba
-  unsafeThaw   (Boxed h ba) = MBoxed h `liftM` G.unsafeThaw ba
-  unsafeIndex (Boxed h ba) idx = assert (inBounds h idx) $ G.unsafeIndex ba (linearIndex h idx)
-  transformShape tr (Boxed h ba) = Boxed (tr h) ba
-  {-# INLINE upperBound #-}
-  {-# INLINE unsafeFreeze #-}
-  {-# INLINE unsafeThaw #-}
-  {-# INLINE unsafeIndex #-}
-  {-# INLINE transformShape #-}
-
-instance (Index sh) => PrimArrayMap Boxed sh e e' where
-  map f (Boxed h xs) = Boxed h (V.map f xs)
-  {-# INLINE map #-}
-
-
-
-{-
- -
- - This stuff tells us how to write efficient generics on large data
- - constructors like the Turner and Vienna ctors.
- -
-
-import qualified Data.Generics.TH as T
-
-data Unboxed sh e = Unboxed !sh !(VU.Vector e)
-  deriving (Show,Eq,Ord)
-
-data X e = X (Unboxed DIM1 e) (Unboxed DIM1 e)
-  deriving (Show,Eq,Ord)
-
-x :: X Int
-x = X z z where z = (Unboxed (Z:.10) (VU.fromList [ 0 .. 10] ))
-
-pot :: X Int -> X Double
-pot = $( T.thmapT (T.mkTs ['f]) [t| X Int |] ) where
-  f :: Unboxed DIM1 Int -> Unboxed DIM1 Double
-  f (Unboxed sh xs) = Unboxed sh (VU.map fromIntegral xs)
-
--}
-
diff --git a/Data/PrimitiveArray/Index.hs b/Data/PrimitiveArray/Index.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/Index.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-
-module Data.PrimitiveArray.Index
-  ( module Data.PrimitiveArray.Index.Class
-  , module Data.PrimitiveArray.Index.BitSet0
-  , module Data.PrimitiveArray.Index.BitSet1
-  , module Data.PrimitiveArray.Index.BitSetClasses
---  , module Data.PrimitiveArray.Index.EdgeBoundary
-  , module Data.PrimitiveArray.Index.Int
-  , module Data.PrimitiveArray.Index.IOC
-  , module Data.PrimitiveArray.Index.PhantomInt
-  , module Data.PrimitiveArray.Index.Point
---  , module Data.PrimitiveArray.Index.Set
-  , module Data.PrimitiveArray.Index.Subword
-  , module Data.PrimitiveArray.Index.Unit
-  ) where
-
-import Data.PrimitiveArray.Index.Class
---import Data.PrimitiveArray.Index.EdgeBoundary hiding (streamUpMk, streamUpStep, streamDownMk, streamDownStep)
-import Data.PrimitiveArray.Index.Int
-import Data.PrimitiveArray.Index.IOC
-import Data.PrimitiveArray.Index.PhantomInt hiding (streamUpMk, streamUpStep, streamDownMk, streamDownStep)
-import Data.PrimitiveArray.Index.Point hiding (streamUpMk, streamUpStep, streamDownMk, streamDownStep)
---import Data.PrimitiveArray.Index.Set hiding (streamUpBsMk, streamUpBsStep, streamDownBsMk, StreamDownBsStep, streamUpBsIMk, streamUpBsIStep, streamDownBsIMk, StreamDownBsIStep, streamUpBsIiMk, streamUpBsIiStep, streamDownBsIiMk, StreamDownBsIiStep)
-import Data.PrimitiveArray.Index.BitSet1 hiding (streamUpMk, streamUpStep, streamDownMk, streamDownStep)
-import Data.PrimitiveArray.Index.BitSet0 hiding (streamUpMk, streamUpStep, streamDownMk, streamDownStep)
-import Data.PrimitiveArray.Index.BitSetClasses
-import Data.PrimitiveArray.Index.Subword hiding (streamUpMk, streamUpStep, streamDownMk, streamDownStep)
-import Data.PrimitiveArray.Index.Unit
-
diff --git a/Data/PrimitiveArray/Index/BitSet0.hs b/Data/PrimitiveArray/Index/BitSet0.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/Index/BitSet0.hs
+++ /dev/null
@@ -1,139 +0,0 @@
-
--- | The most basic bitset structure. Alone, not particularly useful, because
--- two sets @{u,v},{v',w}@ have no way of annotating the connection between the
--- sets. Together with boundaries this yields sets for useful DP algorithms.
-
-module Data.PrimitiveArray.Index.BitSet0 where
-
-import           Control.DeepSeq (NFData(..))
-import           Control.Lens (makeLenses)
-import           Data.Aeson (FromJSON,ToJSON,FromJSONKey,ToJSONKey)
-import           Data.Binary (Binary)
-import           Data.Bits
-import           Data.Bits.Extras
-import           Data.Hashable (Hashable)
-import           Data.Serialize (Serialize)
-import           Data.Vector.Unboxed.Deriving
-import           Data.Vector.Unboxed (Unbox(..))
-import           Debug.Trace
-import           GHC.Generics (Generic)
-import qualified Data.Vector.Fusion.Stream.Monadic as SM
-import           Test.QuickCheck
-
-import           Data.Bits.Ordered
-import           Data.PrimitiveArray.Index.Class
-import           Data.PrimitiveArray.Index.IOC
-import           Data.PrimitiveArray.Index.BitSetClasses
-
-
-
--- | Newtype for a bitset.
---
--- @Int@ integrates better with the rest of the framework. But we should
--- consider moving to @Word@-based indexing, if possible.
-
-newtype BitSet t = BitSet { _bitSet :: Int }
-  deriving (Eq,Ord,Generic,FiniteBits,Ranked,Num,Bits)
-makeLenses ''BitSet
-
-instance FromJSON     (BitSet t)
-instance FromJSONKey  (BitSet t)
-instance ToJSON       (BitSet t)
-instance ToJSONKey    (BitSet t)
-instance Binary       (BitSet t)
-instance Serialize    (BitSet t)
-instance Hashable     (BitSet t)
-
-derivingUnbox "BitSet"
-  [t| forall t . BitSet t → Int |]
-  [| \(BitSet s) → s            |]
-  [| BitSet                     |]
-
-instance Show (BitSet t) where
-  show (BitSet s) = "<" ++ (show $ activeBitsL s) ++ ">(" ++ show s ++ ")"
-
-instance NFData (BitSet t) where
-  rnf (BitSet s) = rnf s
-  {-# Inline rnf #-}
-
-instance Index (BitSet t) where
-  newtype LimitType (BitSet t) = LtBitSet Int
-  linearIndex _ (BitSet z) = z
-  {-# Inline linearIndex #-}
-  size (LtBitSet pc) = 2 ^ pc -- 2 ^ popCount h - 2 ^ popCount l + 1
-  {-# Inline size #-}
-  inBounds (LtBitSet h) z = popCount z <= h
-  {-# Inline inBounds #-}
-  zeroBound = BitSet 0
-  {-# Inline zeroBound #-}
-  zeroBound' = LtBitSet 0
-  {-# Inline zeroBound' #-}
-  totalSize (LtBitSet n) = [2 ^ fromIntegral n]
-  {-# Inline totalSize #-}
-
-instance SetPredSucc (BitSet t) where
-  setSucc l h s
-    | cs > ch                        = Nothing
-    | Just s' <- popPermutation ch s = Just s'
-    | cs >= ch                       = Nothing
-    | cs < ch                        = Just . BitSet $ 2^(cs+1) -1
-    where ch = popCount h
-          cs = popCount s
-  {-# Inline setSucc #-}
-  setPred l h s
-    | cs < cl                        = Nothing
-    | Just s' <- popPermutation ch s = Just s'
-    | cs <= cl                       = Nothing
-    | cs > cl                        = Just . BitSet $ 2^(cs-1) -1
-    where cl = popCount l
-          ch = popCount h
-          cs = popCount s
-  {-# Inline setPred #-}
-
-instance IndexStream z => IndexStream (z:.BitSet I) where
-  streamUp   (ls:..LtBitSet l) (hs:..LtBitSet h) = SM.flatten (streamUpMk   l h) (streamUpStep   l h) $ streamUp   ls hs
-  streamDown (ls:..LtBitSet l) (hs:..LtBitSet h) = SM.flatten (streamDownMk l h) (streamDownStep l h) $ streamDown ls hs
-  {-# Inline streamUp   #-}
-  {-# Inline streamDown #-}
-
-instance IndexStream z ⇒ IndexStream (z:.BitSet O) where
-  streamUp   (ls:..LtBitSet l) (hs:..LtBitSet h) = SM.flatten (streamDownMk l h) (streamDownStep l h) $ streamUp   ls hs
-  streamDown (ls:..LtBitSet l) (hs:..LtBitSet h) = SM.flatten (streamUpMk   l h) (streamUpStep   l h) $ streamDown ls hs
-  {-# Inline streamUp   #-}
-  {-# Inline streamDown #-}
-
-instance IndexStream z ⇒ IndexStream (z:.BitSet C) where
-  streamUp   (ls:..LtBitSet l) (hs:..LtBitSet h) = SM.flatten (streamUpMk   l h) (streamUpStep   l h) $ streamUp   ls hs
-  streamDown (ls:..LtBitSet l) (hs:..LtBitSet h) = SM.flatten (streamDownMk l h) (streamDownStep l h) $ streamDown ls hs
-  {-# Inline streamUp   #-}
-  {-# Inline streamDown #-}
-
-instance IndexStream (Z:.BitSet t) ⇒ IndexStream (BitSet t) where
-  streamUp l h = SM.map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
-  {-# Inline streamUp #-}
-  streamDown l h = SM.map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
-  {-# Inline streamDown #-}
-
-streamUpMk ∷ Monad m ⇒ Int → Int → t → m (t, Maybe (BitSet ioc))
-streamUpMk l h z = return (z, if l <= h then Just (BitSet $ 2^l-1) else Nothing)
-{-# Inline [0] streamUpMk #-}
-
-streamUpStep ∷ Monad m ⇒ Int → Int → (t, Maybe (BitSet ioc)) → m (SM.Step (t, Maybe (BitSet ioc)) (t:.BitSet ioc))
-streamUpStep l h (z , Nothing) = return $ SM.Done
-streamUpStep l h (z , Just t ) = return $ SM.Yield (z:.t) (z, setSucc (2^l-1) (2^h-1) t)
-{-# Inline [0] streamUpStep #-}
-
-streamDownMk ∷ Monad m ⇒ Int → Int → t → m (t, Maybe (BitSet ioc))
-streamDownMk l h z = return (z, if l <=h then Just (BitSet $ 2^l-1) else Nothing)
-{-# Inline [0] streamDownMk #-}
-
-streamDownStep ∷ Monad m ⇒ Int → Int → (t, Maybe (BitSet ioc)) → m (SM.Step (t, Maybe (BitSet ioc)) (t:.BitSet ioc))
-streamDownStep l h (z , Nothing) = return $ SM.Done
-streamDownStep l h (z , Just t ) = return $ SM.Yield (z:.t) (z , setPred (2^l-1) (2^h-1) t)
-{-# Inline [0] streamDownStep #-}
-
-instance Arbitrary (BitSet t) where
-  arbitrary = BitSet <$> choose (0,2^arbitraryBitSetMax-1)
-  shrink s = let s' = [ s `clearBit` a | a <- activeBitsL s ]
-             in  s' ++ concatMap shrink s'
-
diff --git a/Data/PrimitiveArray/Index/BitSet1.hs b/Data/PrimitiveArray/Index/BitSet1.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/Index/BitSet1.hs
+++ /dev/null
@@ -1,165 +0,0 @@
-
--- | A bitset with one interface. This includes the often-encountered case
--- where @{u,v},{v}@, or sets with a single edge between the old set and a new
--- singleton set are required. Uses are Hamiltonian path problems, and TSP,
--- among others.
-
-module Data.PrimitiveArray.Index.BitSet1 where
-
-import           Control.DeepSeq (NFData(..))
-import           Control.Lens (makeLenses)
-import           Control.Monad.Except
-import           Data.Aeson (FromJSON,ToJSON,FromJSONKey,ToJSONKey)
-import           Data.Binary (Binary)
-import           Data.Bits
-import           Data.Bits.Extras
-import           Data.Hashable (Hashable)
-import           Data.Serialize (Serialize)
-import           Data.Vector.Unboxed.Deriving
-import           Data.Vector.Unboxed (Unbox(..))
-import           Debug.Trace
-import           GHC.Generics (Generic)
-import qualified Data.Vector.Fusion.Stream.Monadic as SM
-import           Test.QuickCheck
-
-import           Data.Bits.Ordered
-import           Data.PrimitiveArray.Index.BitSet0 (BitSet(..),LimitType(..))
-import           Data.PrimitiveArray.Index.BitSetClasses
-import           Data.PrimitiveArray.Index.Class
-import           Data.PrimitiveArray.Index.IOC
-
-
-
--- | The bitset with one interface or boundary.
-
-data BitSet1 i ioc = BitSet1 { _bitset ∷ !(BitSet ioc), _boundary ∷ !(Boundary i ioc) }
-  deriving (Eq,Ord,Generic,Show)
-makeLenses ''BitSet1
-
-derivingUnbox "BitSet1"
-  [t| forall i ioc . BitSet1 i ioc → (Int,Int)           |]
-  [| \ (BitSet1 (BitSet set) (Boundary bnd)) → (set,bnd) |]
-  [| \ (set,bnd) → BitSet1 (BitSet set) (Boundary bnd)   |]
-
-
--- |
---
--- NOTE We linearize a bitset as follows: we need @2^number-of-bits *
--- number-of-bits@ elements. The first is due to having a binary set structure.
--- The second is due to pointing to each of those elements as being the
--- boundary. This overcommits on memory since only those bits can be a boundary
--- bits that are actually set. Furthermore, in case no bit is set at all, then
--- there should be no boundary. This is currently rather awkwardly done by
--- restricting enumeration and mapping the 0-set to boundary 0.
---
--- | TODO The size calculations are off by a factor of two, exactly. Each
--- bitset (say) @00110@ has a mirror image @11001@, whose elements do not have
--- to be indexed. It has to be investigated if a version with exact memory
--- bounds is slower in indexing.
-
-instance Index (BitSet1 bnd ioc) where
-  -- This is the number of bits. Meaning that @LtNumBits1 3@ yields @[0,1,2]@.
-  -- TODO Should we rename this to @NumberOfBits1@? Or have a newtype @NumBits@?
-  newtype LimitType (BitSet1 bnd ioc) = LtNumBits1 Int
-  -- Calculate the linear index for a set. Spread out by the possible number of
-  -- bits to fit the actual boundary results. Add the boundary index.
-  linearIndex (LtNumBits1 pc) (BitSet1 set (Boundary bnd))
-    = linearIndex (LtBitSet pc) set * pc + bnd
-  {-# Inline linearIndex #-}
-  size (LtNumBits1 pc) = 2^pc * pc + 1
-  {-# Inline size #-}
-  inBounds (LtNumBits1 pc) (BitSet1 set bnd) = popCount set <= pc && 0 <= bnd && getBoundary bnd <= pc
-  {-# Inline inBounds #-}
-  zeroBound = BitSet1 zeroBound zeroBound
-  {-# Inline zeroBound #-}
-  zeroBound' = LtNumBits1 0
-  {-# Inline zeroBound' #-}
-  totalSize (LtNumBits1 pc) =
-    let z = fromIntegral pc
-    in  [z * 2 ^ z]
-
-deriving instance Show (LimitType (BitSet1 bnd ioc))
-
-instance IndexStream z ⇒ IndexStream (z:.BitSet1 i I) where
-  streamUp   (ls:..LtNumBits1 l) (hs:..LtNumBits1 h) = SM.flatten (streamUpMk   l h) (streamUpStep   l h) $ streamUp   ls hs
-  streamDown (ls:..LtNumBits1 l) (hs:..LtNumBits1 h) = SM.flatten (streamDownMk l h) (streamDownStep l h) $ streamDown ls hs
-  {-# Inline streamUp #-}
-  {-# Inline streamDown #-}
-
-instance IndexStream z ⇒ IndexStream (z:.BitSet1 i O) where
-  streamUp   (ls:..LtNumBits1 l) (hs:..LtNumBits1 h) = SM.flatten (streamDownMk l h) (streamDownStep l h) $ streamUp   ls hs
-  streamDown (ls:..LtNumBits1 l) (hs:..LtNumBits1 h) = SM.flatten (streamUpMk   l h) (streamUpStep   l h) $ streamDown ls hs
-  {-# Inline streamUp #-}
-  {-# Inline streamDown #-}
-
---instance IndexStream z => IndexStream (z:.BS1 i C) where
---  streamUp   (ls:..l) (hs:..h) = flatten (streamUpBsIMk   l h) (streamUpBsIStep   l h) $ streamUp   ls hs
---  streamDown (ls:..l) (hs:..h) = flatten (streamDownBsIMk l h) (streamDownBsIStep l h) $ streamDown ls hs
---  {-# Inline streamUp #-}
---  {-# Inline streamDown #-}
-
-instance IndexStream (Z:.BitSet1 i t) ⇒ IndexStream (BitSet1 i t) where
-  streamUp l h = SM.map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
-  {-# Inline streamUp #-}
-  streamDown l h = SM.map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
-  {-# Inline streamDown #-}
-
-streamUpMk ∷ Monad m ⇒ Int → Int → z → m (z, Maybe (BitSet1 c ioc))
-streamUpMk l h z =
-  let set = BitSet $ 2^l-1
-      -- lsbZ set == 0, or no active bits in which case we use 0
-      bnd = Boundary 0
-  in  return (z, if l <= h then Just (BitSet1 set bnd) else Nothing)
-{-# Inline [0] streamUpMk #-}
-
-streamUpStep ∷ Monad m ⇒ Int → Int → (t, Maybe (BitSet1 c ioc)) → m (SM.Step (t, Maybe (BitSet1 c ioc)) (t:.BitSet1 c ioc))
-streamUpStep l h (z, Nothing) = return $ SM.Done
-streamUpStep l h (z, Just t ) = return $ SM.Yield (z:.t) (z , setSucc l h t)
-{-# Inline [0] streamUpStep #-}
-
-streamDownMk ∷ Monad m ⇒ Int → Int → z → m (z, Maybe (BitSet1 c ioc))
-streamDownMk l h z =
-  let set = BitSet $ 2^h-1
-      bnd = Boundary 0
-  in  return (z, if l <= h then Just (BitSet1 set bnd) else Nothing)
-{-# Inline [0] streamDownMk #-}
-
-streamDownStep ∷ Monad m ⇒ Int → Int → (t, Maybe (BitSet1 c ioc)) → m (SM.Step (t, Maybe (BitSet1 c ioc)) (t:.BitSet1 c ioc))
-streamDownStep l h (z, Nothing) = return $ SM.Done
-streamDownStep l h (z, Just t ) = return $ SM.Yield (z:.t) (z , setPred l h t)
-{-# Inline [0] streamDownStep #-}
-
-instance SetPredSucc (BitSet1 t ioc) where
-  setSucc pcl pch (BitSet1 s (Boundary is))
-    | cs > pch                         = Nothing
-    | Just is' <- maybeNextActive is s = Just $ BitSet1 s  (Boundary is')
-    | Just s'  <- popPermutation pch s = Just $ BitSet1 s' (Boundary $ lsbZ s')
-    | cs >= pch                        = Nothing
-    | cs < pch                         = let s' = BitSet $ 2^(cs+1)-1
-                                         in  Just (BitSet1 s' (Boundary (lsbZ s')))
-    where cs = popCount s
-  {-# Inline setSucc #-}
-  setPred pcl pch (BitSet1 s (Boundary is))
-    | cs < pcl                          = Nothing
-    | Just is' <- maybeNextActive is s  = Just $ BitSet1 s  (Boundary is')
-    | Just s'  <- popPermutation pch s  = Just $ BitSet1 s' (Boundary $ lsbZ s')
-    | cs <= pcl                         = Nothing
-    | cs > pcl                          = let s' = BitSet $ 2^(cs-1)-1
-                                          in  Just (BitSet1 s' (Boundary (max 0 $ lsbZ s')))
-    where cs = popCount s
-  {-# Inline setPred #-}
-
-instance Arbitrary (BitSet1 t ioc) where
-  arbitrary = do
-    s <- arbitrary
-    if s==0
-      then return (BitSet1 s 0)
-      else do i <- elements $ activeBitsL s
-              return (BitSet1 s $ Boundary i)
-  shrink (BitSet1 s i) =
-    let s' = [ BitSet1 (s `clearBit` a) i
-             | a <- activeBitsL s
-             , Boundary a /= i ]
-             ++ [ BitSet1 0 0 | popCount s == 1 ]
-    in  s' ++ concatMap shrink s'
-
diff --git a/Data/PrimitiveArray/Index/BitSetClasses.hs b/Data/PrimitiveArray/Index/BitSetClasses.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/Index/BitSetClasses.hs
+++ /dev/null
@@ -1,164 +0,0 @@
-
--- | A collection of a number of data types and type classes shared by all
--- bitset variants.
-
-module Data.PrimitiveArray.Index.BitSetClasses where
-
-import           Control.DeepSeq (NFData(..))
-import           Data.Aeson (FromJSON,ToJSON,FromJSONKey,ToJSONKey)
-import           Data.Binary (Binary)
-import           Data.Hashable (Hashable)
-import           Data.Serialize (Serialize)
-import           Data.Vector.Unboxed.Deriving
-import           GHC.Generics (Generic)
-import qualified Data.Vector.Fusion.Stream.Monadic as SM
-import qualified Data.Vector.Unboxed as VU
-
-import           Data.Bits.Ordered
-import           Data.PrimitiveArray.Index.Class
-import           Data.PrimitiveArray.Index.IOC
-
-
-
--- * Boundaries, the interface(s) for bitsets.
-
--- | Certain sets have an interface, a particular element with special
--- meaning. In this module, certain ``meanings'' are already provided.
--- These include a @First@ element and a @Last@ element. We phantom-type
--- these to reduce programming overhead.
-
-newtype Boundary boundaryType ioc = Boundary { getBoundary ∷ Int }
-  deriving (Eq,Ord,Generic,Num)
-
-instance Show (Boundary i t) where
-  show (Boundary i) = "(I:" ++ show i ++ ")"
-
-derivingUnbox "Boundary"
-  [t| forall i t . Boundary i t → Int |]
-  [| \(Boundary i) → i                |]
-  [| Boundary                         |]
-
-instance Binary    (Boundary i t)
-instance Serialize (Boundary i t)
-instance ToJSON    (Boundary i t)
-instance FromJSON  (Boundary i t)
-instance Hashable  (Boundary i t)
-
-instance NFData (Boundary i t) where
-  rnf (Boundary i) = rnf i
-  {-# Inline rnf #-}
-
-instance Index (Boundary i t) where
-  newtype LimitType (Boundary i t) = LtBoundary Int
-  linearIndex _ (Boundary z) = z
-  {-# INLINE linearIndex #-}
-  size (LtBoundary h) = h + 1
-  {-# INLINE size #-}
-  inBounds (LtBoundary h) z = 0 <= z && getBoundary z <= h
-  {-# INLINE inBounds #-}
-  zeroBound = Boundary 0
-  {-# Inline zeroBound #-}
-  zeroBound' = LtBoundary 0
-  {-# Inline zeroBound' #-}
-  totalSize (LtBoundary n) = [fromIntegral n]
-  {-# Inline totalSize #-}
-
-instance IndexStream z ⇒ IndexStream (z:.Boundary k I) where
-  streamUp   (ls:..LtBoundary l) (hs:..LtBoundary h) = SM.flatten (streamUpBndMk   l h) (streamUpBndStep   l h) $ streamUp   ls hs
-  streamDown (ls:..LtBoundary l) (hs:..LtBoundary h) = SM.flatten (streamDownBndMk l h) (streamDownBndStep l h) $ streamDown ls hs
-  {-# Inline streamUp   #-}
-  {-# Inline streamDown #-}
-
-instance IndexStream (Z:.Boundary k I) ⇒ IndexStream (Boundary k I) where
-  streamUp l h = SM.map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
-  {-# Inline streamUp #-}
-  streamDown l h = SM.map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
-  {-# Inline streamDown #-}
-
-streamUpBndMk l h z = return (z, l)
-{-# Inline [0] streamUpBndMk #-}
-
-streamUpBndStep l h (z , k)
-  | k > h     = return $ SM.Done
-  | otherwise = return $ SM.Yield (z:.Boundary k) (z, k+1)
-{-# Inline [0] streamUpBndStep #-}
-
-streamDownBndMk l h z = return (z, h)
-{-# Inline [0] streamDownBndMk #-}
-
-streamDownBndStep l h (z , k)
-  | k < l     = return $ SM.Done
-  | otherwise = return $ SM.Yield (z:.Boundary k) (z,k-1)
-{-# Inline [0] streamDownBndStep #-}
-
--- | Declare the interface to be the start of a path.
-
-data First
-
--- | Declare the interface to be the end of a path.
-
-data Last
-
--- | Declare the interface to match anything.
---
--- TODO needed? want to use later in ADPfusion
-
-data Any
-
-
-
--- * Moving indices within sets.
-
--- | Successor and Predecessor for sets. Designed as a class to accomodate
--- sets with interfaces and without interfaces with one function.
---
--- The functions are not written recursively, as we currently only have
--- three cases, and we do not want to "reset" while generating successors
--- and predecessors.
---
--- Note that sets have a partial order. Within the group of element with
--- the same @popCount@, we use @popPermutation@ which has the same stepping
--- order for both, @setSucc@ and @setPred@.
-
-class SetPredSucc s where
-  -- | Set successor. The first argument is the lower set limit, the second
-  -- the upper set limit, the third the current set.
-  setSucc ∷ Int → Int → s → Maybe s
-  -- | Set predecessor. The first argument is the lower set limit, the
-  -- second the upper set limit, the third the current set.
-  setPred ∷ Int → Int → s → Maybe s
-
--- | Masks are used quite often for different types of bitsets. We liberate
--- them as a type family.
-
-type family Mask s ∷ *
-
--- | @Fixed@ allows us to fix some or all bits of a bitset, thereby
--- providing @succ/pred@ operations which are only partially free.
---
--- The mask is lazy, this allows us to have @undefined@ for @l@ and @h@.
---
--- @f = getFixedMask .&. getFixed@ are the fixed bits.
--- @n = getFixed .&. complement getFixedMask@ are the free bits.
--- @to = complement getFixed@ is the to move mask
--- @n' = popShiftR to n@ yields the population after the move
--- @p = popPermutation undefined n'@ yields the new population permutation
--- @p' = popShiftL to p@ yields the population moved back
--- @final = p' .|. f@
-
-data Fixed t = Fixed { getFixedMask :: (Mask t) , getFixed :: !t }
-
--- | Assuming a bitset on bits @[0 .. highbit]@, we can apply a mask that
--- stretches out those bits over @[0 .. higherBit]@ with @highbit <=
--- higherBit@. Any active interfaces are correctly set as well.
-
-class ApplyMask s where
-  applyMask :: Mask s -> s -> s
-
-
-
--- | for 'Test.QuickCheck.Arbitrary'
-
-arbitraryBitSetMax ∷ Int
-arbitraryBitSetMax = 6
-
diff --git a/Data/PrimitiveArray/Index/Class.hs b/Data/PrimitiveArray/Index/Class.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/Index/Class.hs
+++ /dev/null
@@ -1,292 +0,0 @@
-
-module Data.PrimitiveArray.Index.Class where
-
-import           Control.Applicative
-import           Control.DeepSeq (NFData(..))
-import           Control.Lens hiding (Index, (:>))
-import           Control.Monad.Except
-import           Control.Monad (liftM2)
-import           Data.Aeson
-import           Data.Binary
-import           Data.Data
-import           Data.Hashable (Hashable)
-import           Data.Proxy
-import           Data.Serialize
-import           Data.Typeable
-import           Data.Vector.Fusion.Stream.Monadic (Stream)
-import           Data.Vector.Unboxed.Deriving
-import           Data.Vector.Unboxed (Unbox(..))
-import           GHC.Generics
-import           GHC.TypeNats
-import qualified Data.Vector.Fusion.Stream.Monadic as SM
-import           Test.QuickCheck
-import           Text.Printf
-import           Data.Type.Equality
-
-
-
-infixl 3 :.
-
--- | Strict pairs -- as in @repa@.
-
-data a :. b = !a :. !b
-  deriving (Eq,Ord,Show,Generic,Data,Typeable)
-
-derivingUnbox "StrictPair"
-  [t| forall a b . (Unbox a, Unbox b) => (a:.b) -> (a,b) |]
-  [| \(a:.b) -> (a, b) |]
-  [| \(a,b)  -> (a:.b) |]
-
-instance (Binary    a, Binary    b) => Binary    (a:.b)
-instance (Serialize a, Serialize b) => Serialize (a:.b)
-instance (ToJSON    a, ToJSON    b) => ToJSON    (a:.b)
-instance (FromJSON  a, FromJSON  b) => FromJSON  (a:.b)
-instance (Hashable  a, Hashable  b) => Hashable  (a:.b)
-
-instance (ToJSON a  , ToJSONKey   a, ToJSON b  , ToJSONKey   b) => ToJSONKey   (a:.b)
-instance (FromJSON a, FromJSONKey a, FromJSON b, FromJSONKey b) => FromJSONKey (a:.b)
-
-deriving instance (Read a, Read b) => Read (a:.b)
-
-instance (NFData a, NFData b) => NFData (a:.b) where
-  rnf (a:.b) = rnf a `seq` rnf b
-  {-# Inline rnf #-}
-
-instance (Arbitrary a, Arbitrary b) => Arbitrary (a :. b) where
-  arbitrary     = liftM2 (:.) arbitrary arbitrary
-  shrink (a:.b) = [ (a':.b) | a' <- shrink a ] ++ [ (a:.b') | b' <- shrink b ]
-
-infixr 3 :>
-
--- | A different version of strict pairs. Makes for simpler type inference in
--- multi-tape grammars. We use @:>@ when we have special needs, like
--- non-recursive instances on inductives tuples, as used for set indices.
---
--- This one is @infixr@ so that in @a :> b@ we can have the main type in
--- @a@ and the specializing types in @b@ and then dispatch on @a :> ts@
--- with @ts@ maybe a chain of @:>@.
-
-data a :> b = !a :> !b
-  deriving (Eq,Ord,Show,Generic,Data,Typeable)
-
-derivingUnbox "StrictIxPair"
-  [t| forall a b . (Unbox a, Unbox b) => (a:>b) -> (a,b) |]
-  [| \(a:>b) -> (a, b) |]
-  [| \(a,b)  -> (a:>b) |]
-
-instance (Binary    a, Binary    b) => Binary    (a:>b)
-instance (Serialize a, Serialize b) => Serialize (a:>b)
-instance (ToJSON    a, ToJSON    b) => ToJSON    (a:>b)
-instance (FromJSON  a, FromJSON  b) => FromJSON  (a:>b)
-instance (Hashable  a, Hashable  b) => Hashable  (a:>b)
-
-deriving instance (Read a, Read b) => Read (a:>b)
-
-instance (NFData a, NFData b) => NFData (a:>b) where
-  rnf (a:>b) = rnf a `seq` rnf b
-  {-# Inline rnf #-}
-
---instance (Arbitrary a, Arbitrary b) => Arbitrary (a :> b) where
---  arbitrary = (:>) <$> arbitrary <*> arbitrary
---  shrink (a:>b) = (:>) <$> shrink a <*> shrink b
-
-
-
--- | Base data constructor for multi-dimensional indices.
-
-data Z = Z
-  deriving (Eq,Ord,Read,Show,Generic,Data,Typeable)
-
-derivingUnbox "Z"
-  [t| Z -> () |]
-  [| const () |]
-  [| const Z  |]
-
-instance Binary    Z
-instance Serialize Z
-instance ToJSON    Z
-instance FromJSON  Z
-instance Hashable  Z
-
-instance Arbitrary Z where
-  arbitrary = return Z
-
-instance NFData Z where
-  rnf Z = ()
-  {-# Inline rnf #-}
-
-
-
--- | Index structures for complex, heterogeneous indexing. Mostly designed for
--- indexing in DP grammars, where the indices work for linear and context-free
--- grammars on one or more tapes, for strings, sets, later on tree structures.
-
-class Index i where
-  -- | Data structure encoding the upper limit for each array.
-  data LimitType i ∷ *
-  -- | Given a maximal size, and a current index, calculate
-  -- the linear index.
-  linearIndex ∷ LimitType i → i → Int
-  -- | Given the 'LimitType', return the number of cells required for storage.
-  size ∷ LimitType i → Int
-  -- | Check if an index is within the bounds.
-  inBounds ∷ LimitType i → i → Bool
-  -- | A lower bound of @zero@
-  zeroBound ∷ i
-  -- | A lower bound of @zero@ but for a @LimitType i@.
-  zeroBound' ∷ LimitType i
-  -- | The list of cell sizes for each dimension. its product yields the total
-  -- size.
-  totalSize ∷ LimitType i → [Integer]
-
--- | Given the maximal number of cells (@Word@, because this is the pointer
--- limit for the machine), and the list of sizes, will check if this is still
--- legal. Consider dividing the @Word@ by the actual memory requirements for
--- each cell, to get better exception handling for too large arrays.
---
--- One list should be given for each array.
-
-sizeIsValid ∷ Monad m ⇒ Word → [[Integer]] → ExceptT SizeError m CellSize
-sizeIsValid maxCells cells = do
-  let ps = map product cells
-      s  = sum ps
-  when (fromIntegral maxCells <= s) $
-    throwError . SizeError
-               $ printf "PrimitiveArrays would be larger than maximal cell size. The given limit is %d, but the requested size is %d, with size %s for each array. (Debug hint: %s)"
-                  maxCells s (show ps) (show s)
-  return . CellSize $ fromIntegral s
-{-# Inlinable sizeIsValid #-}
-
--- | In case @totalSize@ or variants thereof produce a size that is too big to
--- handle.
-
-newtype SizeError = SizeError String
-  deriving (Eq,Ord,Show)
-
--- | The total number of cells that are allocated.
-
-newtype CellSize = CellSize Word
-  deriving (Eq,Ord,Show,Num,Bounded,Integral,Real,Enum)
-
-
-
--- | Generate a stream of indices in correct order for dynamic programming.
--- Since the stream generators require @concatMap@ / @flatten@ we have to
--- write more specialized code for @(z:.IX)@ stuff.
-
-class (Index i) ⇒ IndexStream i where
-  -- | Generate an index stream using 'LimitType's. This prevents having to
-  -- figure out how the actual limits for complicated index types (like @Set@)
-  -- would look like, since for @Set@, for example, the @LimitType Set == Int@
-  -- provides just the number of bits.
-  --
-  -- This generates an index stream suitable for @forward@ structure filling.
-  -- The first index is the smallest (or the first indices considered are all
-  -- equally small in partially ordered sets). Larger indices follow up until
-  -- the largest one.
-  streamUp ∷ Monad m ⇒ LimitType i → LimitType i → Stream m i
-  -- | If 'streamUp' generates indices from smallest to largest, then
-  -- 'streamDown' generates indices from largest to smallest. Outside grammars
-  -- make implicit use of this. Asking for an axiom in backtracking requests
-  -- the first element from this stream.
-  streamDown ∷ Monad m ⇒ LimitType i → LimitType i → Stream m i
-
-
-
-instance Index Z where
-  data LimitType Z = ZZ
-  linearIndex _ _ = 0
-  {-# INLINE linearIndex #-}
-  size _ = 1
-  {-# INLINE size #-}
-  inBounds _ _ = True
-  {-# INLINE inBounds #-}
-  zeroBound = Z
-  {-# Inline zeroBound #-}
-  zeroBound' = ZZ
-  {-# Inline zeroBound' #-}
-  totalSize ZZ = [1]
-  {-# Inline [1] totalSize #-}
-
-instance IndexStream Z where
-  streamUp ZZ ZZ = SM.singleton Z
-  {-# Inline streamUp #-}
-  streamDown ZZ ZZ = SM.singleton Z
-  {-# Inline streamDown #-}
-
-instance (Index zs, Index z) => Index (zs:.z) where
-  data LimitType (zs:.z) = !(LimitType zs) :.. !(LimitType z)
-  linearIndex (hs:..h) (zs:.z) = linearIndex hs zs * size h + linearIndex h z
-  {-# INLINE linearIndex #-}
-  size (hs:..h) = size hs * size h
-  {-# INLINE size #-}
-  inBounds (hs:..h) (zs:.z) = inBounds hs zs && inBounds h z
-  {-# INLINE inBounds #-}
-  zeroBound = zeroBound :. zeroBound
-  {-# Inline zeroBound #-}
-  zeroBound' = zeroBound' :.. zeroBound'
-  {-# Inline zeroBound' #-}
-  totalSize (hs:..h) =
-    let tshs = totalSize hs
-        tsh  = totalSize h
-    in tshs ++ tsh
-  {-# Inline totalSize #-}
-
-deriving instance Eq       (LimitType Z)
-deriving instance Generic  (LimitType Z)
-deriving instance Read     (LimitType Z)
-deriving instance Show     (LimitType Z)
-deriving instance Data     (LimitType Z)
-deriving instance Typeable (LimitType Z)
-
-deriving instance (Eq (LimitType zs)     , Eq (LimitType z)     ) ⇒ Eq      (LimitType (zs:.z))
-deriving instance (Generic (LimitType zs), Generic (LimitType z)) ⇒ Generic (LimitType (zs:.z))
-deriving instance (Read (LimitType zs)   , Read (LimitType z)   ) ⇒ Read    (LimitType (zs:.z))
-deriving instance (Show (LimitType zs)   , Show (LimitType z)   ) ⇒ Show    (LimitType (zs:.z))
-deriving instance
-  ( Data zs, Data (LimitType zs), Typeable zs
-  , Data z , Data (LimitType z) , Typeable z
-  ) ⇒ Data    (LimitType (zs:.z))
-
---instance (Index zs, Index z) => Index (zs:>z) where
---  type LimitType (zs:>z) = LimitType zs:>LimitType z
---  linearIndex (hs:>h) (zs:>z) = linearIndex hs zs * (size (Proxy ∷ Proxy z) h) + linearIndex h z
---  {-# INLINE linearIndex #-}
---  size Proxy (ss:>s) = size (Proxy ∷ Proxy zs) ss * (size (Proxy ∷ Proxy z) s)
---  {-# INLINE size #-}
---  inBounds (hs:>h) (zs:>z) = inBounds hs zs && inBounds h z
---  {-# INLINE inBounds #-}
-
-
-
--- * Somewhat experimental lens support.
---
--- The problem here is that tuples are n-ary, while inductive tuples are
--- binary, recursive.
-
-instance Field1 (Z:.a) (Z:.a') a a' where
-  {-# Inline _1 #-}
-  _1 = lens (\(Z:.a) → a) (\(Z:._) a → (Z:.a))
-
-instance Field1 (Z:.a:.b) (Z:.a':.b) a a' where
-  {-# Inline _1 #-}
-  _1 = lens (\(Z:.a:.b) → a) (\(Z:._:.b) a → (Z:.a:.b))
-
-instance Field1 (Z:.a:.b:.c) (Z:.a':.b:.c) a a' where
-  {-# Inline _1 #-}
-  _1 = lens (\(Z:.a:.b:.c) → a) (\(Z:._:.b:.c) a → (Z:.a:.b:.c))
-
-
-instance Field2 (Z:.a:.b) (Z:.a:.b') b b' where
-  {-# Inline _2 #-}
-  _2 = lens (\(Z:.a:.b) → b) (\(Z:.a:._) b → (Z:.a:.b))
-
-instance Field2 (Z:.a:.b:.c) (Z:.a:.b':.c) b b' where
-  {-# Inline _2 #-}
-  _2 = lens (\(Z:.a:.b:.c) → b) (\(Z:.a:._:.c) b → (Z:.a:.b:.c))
-
-
-instance Field3 (Z:.a:.b:.c) (Z:.a:.b:.c') c c' where
-  {-# Inline _3 #-}
-  _3 = lens (\(Z:.a:.b:.c) → c) (\(Z:.a:.b:._) c → (Z:.a:.b:.c))
-
diff --git a/Data/PrimitiveArray/Index/IOC.hs b/Data/PrimitiveArray/Index/IOC.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/Index/IOC.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-
-module Data.PrimitiveArray.Index.IOC where
-
-
-
--- | Phantom type for @Inside@ indices.
-
-data I
-
--- | Phantom type for @Outside@ indices.
-
-data O
-
--- | Phantom type for @Complement@ indices.
-
-data C
-
diff --git a/Data/PrimitiveArray/Index/Int.hs b/Data/PrimitiveArray/Index/Int.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/Index/Int.hs
+++ /dev/null
@@ -1,50 +0,0 @@
-
-module Data.PrimitiveArray.Index.Int where
-
-import qualified Data.Vector.Fusion.Stream.Monadic as SM
-
-import           Data.PrimitiveArray.Index.Class
-
-
-
-instance Index Int where
-  newtype LimitType Int = LtInt Int
-  linearIndex _ k = k
-  {-# Inline linearIndex #-}
-  size (LtInt h) = h+1
-  {-# Inline size #-}
-  inBounds (LtInt h) k = 0 <= k && k <= h
-  {-# Inline inBounds #-}
-  zeroBound = 0
-  {-# Inline [0] zeroBound #-}
-  zeroBound' = LtInt 0
-  {-# Inline [0] zeroBound' #-}
-  totalSize (LtInt h) = [fromIntegral $ h+1]
-  {-# Inline [0] totalSize #-}
-
-deriving instance Show (LimitType Int)
-
-instance IndexStream z => IndexStream (z:.Int) where
-  streamUp (ls:.. LtInt l) (hs:.. LtInt h) = SM.flatten mk step $ streamUp ls hs
-    where mk z = return (z,l)
-          step (z,k)
-            | k > h     = return $ SM.Done
-            | otherwise = return $ SM.Yield (z:.k) (z,k+1)
-          {-# Inline [0] mk   #-}
-          {-# Inline [0] step #-}
-  {-# Inline streamUp #-}
-  streamDown (ls:..LtInt l) (hs:..LtInt h) = SM.flatten mk step $ streamDown ls hs
-    where mk z = return (z,h)
-          step (z,k)
-            | k < l     = return $ SM.Done
-            | otherwise = return $ SM.Yield (z:.k) (z,k-1)
-          {-# Inline [0] mk   #-}
-          {-# Inline [0] step #-}
-  {-# Inline streamDown #-}
-
-instance IndexStream Int where
-  streamUp l h = SM.map (\(Z:.k) -> k) $ streamUp (ZZ:..l) (ZZ:..h)
-  {-# Inline streamUp #-}
-  streamDown l h = SM.map (\(Z:.k) -> k) $ streamDown (ZZ:..l) (ZZ:..h)
-  {-# Inline streamDown #-}
-
diff --git a/Data/PrimitiveArray/Index/PhantomInt.hs b/Data/PrimitiveArray/Index/PhantomInt.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/Index/PhantomInt.hs
+++ /dev/null
@@ -1,108 +0,0 @@
-
--- | A linear 0-based int-index with a phantom type.
-
-module Data.PrimitiveArray.Index.PhantomInt where
-
-import Control.DeepSeq (NFData(..))
-import Data.Aeson (FromJSON,FromJSONKey,ToJSON,ToJSONKey)
-import Data.Binary (Binary)
-import Data.Data
-import Data.Hashable (Hashable)
-import Data.Ix(Ix)
-import Data.Serialize (Serialize)
-import Data.Typeable
-import Data.Vector.Fusion.Stream.Monadic (map,Step(..),flatten)
-import Data.Vector.Unboxed.Deriving
-import GHC.Generics (Generic)
-import Prelude hiding (map)
-
-import Data.PrimitiveArray.Index.Class
-import Data.PrimitiveArray.Index.IOC
-
-
-
--- | A 'PInt' behaves exactly like an @Int@, but has an attached phantom
--- type @p@. In particular, the @Index@ and @IndexStream@ instances are the
--- same as for raw @Int@s.
-
-newtype PInt (ioc ∷ k) (p ∷ k) = PInt { getPInt :: Int }
-  deriving (Read,Show,Eq,Ord,Enum,Num,Integral,Real,Generic,Data,Typeable,Ix)
-
-pIntI :: Int -> PInt I p
-pIntI = PInt
-{-# Inline pIntI #-}
-
-pIntO :: Int -> PInt O p
-pIntO = PInt
-{-# Inline pIntO #-}
-
-pIntC :: Int -> PInt C p
-pIntC = PInt
-{-# Inline pIntC #-}
-
-derivingUnbox "PInt"
-  [t| forall t p . PInt t p -> Int |]  [| getPInt |]  [| PInt |]
-
-instance Binary       (PInt t p)
-instance Serialize    (PInt t p)
-instance FromJSON     (PInt t p)
-instance FromJSONKey  (PInt t p)
-instance ToJSON       (PInt t p)
-instance ToJSONKey    (PInt t p)
-instance Hashable     (PInt t p)
-instance NFData       (PInt t p)
-
-instance Index (PInt t p) where
-  newtype LimitType (PInt t p) = LtPInt Int
-  linearIndex _ (PInt k) = k
-  {-# Inline linearIndex #-}
-  size (LtPInt h) = h+1
-  {-# Inline size #-}
-  inBounds (LtPInt h) (PInt k) = 0 <= k && k <= h
-  {-# Inline inBounds #-}
-
-deriving instance Show    (LimitType (PInt t p))
-deriving instance Read    (LimitType (PInt t p))
-deriving instance Eq      (LimitType (PInt t p))
-deriving instance Generic (LimitType (PInt t p))
-
-instance IndexStream z => IndexStream (z:.PInt I p) where
-  streamUp   (ls:..LtPInt l) (hs:..LtPInt h) = flatten (streamUpMk   l h) (streamUpStep   l h) $ streamUp ls hs
-  streamDown (ls:..LtPInt l) (hs:..LtPInt h) = flatten (streamDownMk l h) (streamDownStep l h) $ streamDown ls hs
-  {-# Inline streamUp   #-}
-  {-# Inline streamDown #-}
-
-instance IndexStream z => IndexStream (z:.PInt O p) where
-  streamUp   (ls:..LtPInt l) (hs:..LtPInt h) = flatten (streamDownMk l h) (streamDownStep l h) $ streamUp ls hs
-  streamDown (ls:..LtPInt l) (hs:..LtPInt h) = flatten (streamUpMk   l h) (streamUpStep   l h) $ streamDown ls hs
-  {-# Inline streamUp   #-}
-  {-# Inline streamDown #-}
-
-instance IndexStream z => IndexStream (z:.PInt C p) where
-  streamUp   (ls:..LtPInt l) (hs:..LtPInt h) = flatten (streamUpMk   l h) (streamUpStep   l h) $ streamUp ls hs
-  streamDown (ls:..LtPInt l) (hs:..LtPInt h) = flatten (streamDownMk l h) (streamDownStep l h) $ streamDown ls hs
-  {-# Inline streamUp   #-}
-  {-# Inline streamDown #-}
-
-instance IndexStream (Z:.PInt ioc p) => IndexStream (PInt ioc p) where
-  streamUp l h = map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
-  {-# INLINE streamUp #-}
-  streamDown l h = map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
-  {-# INLINE streamDown #-}
-
-streamUpMk l h z = return (z,l)
-{-# Inline [0] streamUpMk #-}
-
-streamUpStep l h (z,k)
-  | k > h     = return $ Done
-  | otherwise = return $ Yield (z:.PInt k) (z,k+1)
-{-# Inline [0] streamUpStep #-}
-
-streamDownMk l h z = return (z,h)
-{-# Inline [0] streamDownMk #-}
-
-streamDownStep l h (z,k)
-  | k < l     = return $ Done
-  | otherwise = return $ Yield (z:.PInt k) (z,k-1)
-{-# Inline [0] streamDownStep #-}
-
diff --git a/Data/PrimitiveArray/Index/Point.hs b/Data/PrimitiveArray/Index/Point.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/Index/Point.hs
+++ /dev/null
@@ -1,229 +0,0 @@
-
-{-# Language MagicHash #-}
-
--- | @Point@ index structures are used for left- and right-linear grammars.
--- Such grammars have at most one syntactic symbol on each r.h.s. of a rule.
--- The syntactic symbol needs to be in an outermost position.
-
-module Data.PrimitiveArray.Index.Point where
-
-import           Control.Applicative
-import           Control.DeepSeq (NFData(..))
-import           Data.Aeson
-import           Data.Binary
-import           Data.Bits
-import           Data.Bits.Extras (Ranked)
-import           Data.Hashable (Hashable)
-import           Data.Serialize
-import           Data.Vector.Unboxed.Deriving
-import           Data.Vector.Unboxed (Unbox(..))
-import           GHC.Exts
-import           GHC.Generics (Generic)
-import qualified Data.Vector.Fusion.Stream.Monadic as SM
-import qualified Data.Vector.Unboxed as VU
-import           Test.QuickCheck as TQ
-import           Test.SmallCheck.Series as TS
-
-import           Data.PrimitiveArray.Index.Class
-import           Data.PrimitiveArray.Index.IOC
-
-
-
--- | A point in a left-linear grammar. The syntactic symbol is in left-most
--- position.
-
-newtype PointL t = PointL {fromPointL :: Int}
-  deriving (Eq,Ord,Read,Show,Generic)
-
-pointLI :: Int -> PointL I
-pointLI = PointL
-{-# Inline pointLI #-}
-
-pointLO :: Int -> PointL O
-pointLO = PointL
-{-# Inline pointLO #-}
-
-pointLC :: Int -> PointL C
-pointLC = PointL
-{-# Inline pointLC #-}
-
-
-
-derivingUnbox "PointL"
-  [t| forall t . PointL t -> Int    |]
-  [| \ (PointL i) -> i |]
-  [| \ i -> PointL i   |]
-
-instance Binary       (PointL t)
-instance Serialize    (PointL t)
-instance FromJSON     (PointL t)
-instance FromJSONKey  (PointL t)
-instance ToJSON       (PointL t)
-instance ToJSONKey    (PointL t)
-instance Hashable     (PointL t)
-
-instance NFData (PointL t) where
-  rnf (PointL l) = rnf l
-  {-# Inline rnf #-}
-
-instance Index (PointL t) where
-  newtype LimitType (PointL t) = LtPointL Int
-  linearIndex _ (PointL z) = z
-  {-# INLINE linearIndex #-}
-  size (LtPointL h) = h + 1
-  {-# INLINE size #-}
-  inBounds (LtPointL h) (PointL x) = 0<=x && x<=h
-  {-# INLINE inBounds #-}
-  zeroBound = PointL 0
-  {-# Inline [0] zeroBound #-}
-  zeroBound' = LtPointL 0
-  {-# Inline [0] zeroBound' #-}
-  totalSize (LtPointL h) = [fromIntegral $ h + 1]
-  {-# Inline [0] totalSize #-}
-
-deriving instance Eq      (LimitType (PointL t))
-deriving instance Generic (LimitType (PointL t))
-deriving instance Read    (LimitType (PointL t))
-deriving instance Show    (LimitType (PointL t))
-
-instance IndexStream z => IndexStream (z:.PointL I) where
-  streamUp   (ls:..LtPointL lf) (hs:..LtPointL ht) = SM.flatten (streamUpMk   lf) (streamUpStep   PointL ht) $ streamUp ls hs
-  streamDown (ls:..LtPointL lf) (hs:..LtPointL ht) = SM.flatten (streamDownMk ht) (streamDownStep PointL lf) $ streamDown ls hs
-  {-# Inline [0] streamUp #-}
-  {-# Inline [0] streamDown #-}
-
-instance IndexStream z => IndexStream (z:.PointL O) where
-  streamUp   (ls:..LtPointL lf) (hs:..LtPointL ht) = SM.flatten (streamDownMk ht) (streamDownStep PointL lf) $ streamUp   ls hs
-  streamDown (ls:..LtPointL lf) (hs:..LtPointL ht) = SM.flatten (streamUpMk   lf) (streamUpStep   PointL ht) $ streamDown ls hs
-  {-# Inline [0] streamUp #-}
-  {-# Inline [0] streamDown #-}
-
-instance IndexStream z => IndexStream (z:.PointL C) where
-  streamUp   (ls:..LtPointL lf) (hs:..LtPointL ht) = SM.flatten (streamUpMk   lf) (streamUpStep   PointL ht) $ streamUp ls hs
-  streamDown (ls:..LtPointL lf) (hs:..LtPointL ht) = SM.flatten (streamDownMk ht) (streamDownStep PointL lf) $ streamDown ls hs
-  {-# Inline [0] streamUp #-}
-  {-# Inline [0] streamDown #-}
-
-data SP z = SP !z !Int#
-
-streamUpMk (I# lf) z = return $ SP z lf
-{-# Inline [0] streamUpMk #-}
-
-streamUpStep wrapper (I# ht) (SP z k)
-  | 1# <- k ># ht = return $ SM.Done
-  | otherwise     = return $ SM.Yield (z:.wrapper (I# k)) (SP z (k +# 1#))
-{-# Inline [0] streamUpStep #-}
-
-streamDownMk (I# ht) z = return $ SP z ht
-{-# Inline [0] streamDownMk #-}
-
-streamDownStep wrapper (I# lf) (SP z k)
-  | 1# <- k <# lf = return $ SM.Done
-  | otherwise     = return $ SM.Yield (z:.wrapper (I# k)) (SP z (k -# 1#))
-{-# Inline [0] streamDownStep #-}
-
-instance IndexStream (Z:.PointL t) => IndexStream (PointL t) where
-  streamUp l h = SM.map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
-  {-# INLINE streamUp #-}
-  streamDown l h = SM.map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
-  {-# INLINE streamDown #-}
-
-
-instance Arbitrary (PointL t) where
-  arbitrary = do
-    b <- choose (0,100)
-    return $ PointL b
-  shrink (PointL j)
-    | 0<j = [PointL $ j-1]
-    | otherwise = []
-
-instance Monad m => Serial m (PointL t) where
-  series = PointL . TS.getNonNegative <$> series
-
-
-
--- * @PointR@
-
--- | A point in a right-linear grammars.
-
-newtype PointR t = PointR {fromPointR :: Int}
-  deriving (Eq,Ord,Read,Show,Generic)
-
-
-
-derivingUnbox "PointR"
-  [t| forall t . PointR t -> Int    |]
-  [| \ (PointR i) -> i |]
-  [| \ i -> PointR i   |]
-
-instance Binary       (PointR t)
-instance Serialize    (PointR t)
-instance FromJSON     (PointR t)
-instance FromJSONKey  (PointR t)
-instance ToJSON       (PointR t)
-instance ToJSONKey    (PointR t)
-instance Hashable     (PointR t)
-
-instance NFData (PointR t) where
-  rnf (PointR l) = rnf l
-  {-# Inline rnf #-}
-
-instance Index (PointR t) where
-  newtype LimitType (PointR t) = LtPointR Int
-  linearIndex _ (PointR z) = z
-  {-# INLINE linearIndex #-}
-  size (LtPointR h) = h + 1
-  {-# INLINE size #-}
-  inBounds (LtPointR h) (PointR x) = 0<=x && x<=h
-  {-# INLINE inBounds #-}
-  zeroBound = PointR 0
-  {-# Inline [0] zeroBound #-}
-  zeroBound' = LtPointR 0
-  {-# Inline [0] zeroBound' #-}
-  totalSize (LtPointR h) = [fromIntegral $ h + 1]
-  {-# Inline [0] totalSize #-}
-
-deriving instance Eq      (LimitType (PointR t))
-deriving instance Generic (LimitType (PointR t))
-deriving instance Read    (LimitType (PointR t))
-deriving instance Show    (LimitType (PointR t))
-
-instance IndexStream z => IndexStream (z:.PointR I) where
-  streamUp   (ls:..LtPointR lf) (hs:..LtPointR ht) = SM.flatten (streamDownMk ht) (streamDownStep PointR lf) $ streamUp ls hs
-  streamDown (ls:..LtPointR lf) (hs:..LtPointR ht) = SM.flatten (streamUpMk   lf) (streamUpStep   PointR ht) $ streamDown ls hs
-  {-# Inline [0] streamUp #-}
-  {-# Inline [0] streamDown #-}
-
-instance IndexStream z => IndexStream (z:.PointR O) where
-  streamUp   (ls:..LtPointR lf) (hs:..LtPointR ht) = SM.flatten (streamUpMk   lf) (streamUpStep   PointR ht) $ streamUp   ls hs
-  streamDown (ls:..LtPointR lf) (hs:..LtPointR ht) = SM.flatten (streamDownMk ht) (streamDownStep PointR lf) $ streamDown ls hs
-  {-# Inline [0] streamUp #-}
-  {-# Inline [0] streamDown #-}
-
---instance IndexStream z => IndexStream (z:.PointR C) where
---  streamUp   (ls:..LtPointR lf) (hs:..LtPointR ht) = SM.flatten (streamUpMkR   lf) (streamUpStepR   ht) $ streamUp ls hs
---  streamDown (ls:..LtPointR lf) (hs:..LtPointR ht) = SM.flatten (streamDownMkR ht) (streamDownStepR lf) $ streamDown ls hs
---  {-# Inline [0] streamUp #-}
---  {-# Inline [0] streamDown #-}
-
-instance IndexStream (Z:.PointR t) => IndexStream (PointR t) where
-  streamUp l h = SM.map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
-  {-# INLINE streamUp #-}
-  streamDown l h = SM.map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
-  {-# INLINE streamDown #-}
-
--- arbitrarily set maximum here to
-
-arbMaxPointR = 100
-
-instance Arbitrary (PointR t) where
-  arbitrary = do
-    b <- choose (0,arbMaxPointR)
-    return $ PointR b
-  shrink (PointR j)
-    | j<arbMaxPointR = [PointR $ j+1]
-    | otherwise = []
-
---instance Monad m => Serial m (PointR t) where
---  series = PointR . TS.getNonNegative <$> series
-
diff --git a/Data/PrimitiveArray/Index/Subword.hs b/Data/PrimitiveArray/Index/Subword.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/Index/Subword.hs
+++ /dev/null
@@ -1,178 +0,0 @@
-
--- | Index structure for context-free grammars on strings. A @Subword@ captures
--- a pair @(i,j)@ with @i<=j@.
-
-module Data.PrimitiveArray.Index.Subword where
-
-import Control.Applicative ((<$>))
-import Control.DeepSeq (NFData(..))
-import Control.Monad (filterM, guard)
-import Data.Aeson (FromJSON,FromJSONKey,ToJSON,ToJSONKey)
-import Data.Binary (Binary)
-import Data.Hashable (Hashable)
-import Data.Serialize (Serialize)
-import Data.Vector.Fusion.Stream.Monadic (Step(..), map,flatten)
-import Data.Vector.Unboxed.Deriving
-import GHC.Generics (Generic)
-import Prelude hiding (map)
-import Test.QuickCheck (Arbitrary(..), choose)
-import Test.SmallCheck.Series as TS
-
-import Math.TriangularNumbers
-
-import Data.PrimitiveArray.Index.Class
-import Data.PrimitiveArray.Index.IOC
-
-
-
--- | A subword wraps a pair of @Int@ indices @i,j@ with @i<=j@.
---
--- Subwords always yield the upper-triangular part of a rect-angular array.
--- This gives the quite curious effect that @(0,N)@ points to the
--- ``largest'' index, while @(0,0) ... (1,1) ... (k,k) ... (N,N)@ point to
--- the smallest. We do, however, use (0,0) as the smallest as (0,k) gives
--- successively smaller upper triangular parts.
-
-newtype Subword t = Subword {fromSubword :: (Int:.Int)}
-  deriving (Eq,Ord,Show,Generic,Read)
-
-fromSubwordFst :: Subword t -> Int
-fromSubwordFst (Subword (i:._)) = i
-{-# Inline fromSubwordFst #-}
-
-fromSubwordSnd :: Subword t -> Int
-fromSubwordSnd (Subword (_:.j)) = j
-{-# Inline fromSubwordSnd #-}
-
-derivingUnbox "Subword"
-  [t| forall t . Subword t -> (Int,Int) |]
-  [| \ (Subword (i:.j)) -> (i,j) |]
-  [| \ (i,j) -> Subword (i:.j) |]
-
-instance Binary       (Subword t)
-instance Serialize    (Subword t)
-instance FromJSON     (Subword t)
-instance FromJSONKey  (Subword t)
-instance ToJSON       (Subword t)
-instance ToJSONKey    (Subword t)
-instance Hashable     (Subword t)
-
-instance NFData (Subword t) where
-  rnf (Subword (i:.j)) = i `seq` rnf j
-  {-# Inline rnf #-}
-
--- | Create a @Subword t@ where @t@ is inferred.
-
-subword :: Int -> Int -> Subword t
-subword i j = Subword (i:.j)
-{-# INLINE subword #-}
-
-subwordI :: Int -> Int -> Subword I
-subwordI i j = Subword (i:.j)
-{-# INLINE subwordI #-}
-
-subwordO :: Int -> Int -> Subword O
-subwordO i j = Subword (i:.j)
-{-# INLINE subwordO #-}
-
-subwordC :: Int -> Int -> Subword C
-subwordC i j = Subword (i:.j)
-{-# INLINE subwordC #-}
-
-
-
-instance Index (Subword t) where
-  newtype LimitType (Subword t) = LtSubword Int
-  linearIndex (LtSubword n) (Subword (i:.j)) = toLinear n (i,j)
-  {-# Inline linearIndex #-}
-  size (LtSubword n) = linearizeUppertri (0,n)
-  {-# Inline size #-}
-  inBounds (LtSubword h) (Subword (i:.j)) = 0<=i && i<=j && j<=h
-  {-# Inline inBounds #-}
-  zeroBound = subword 0 0
-  {-# Inline zeroBound #-}
-  zeroBound' = LtSubword 0
-  {-# Inline zeroBound' #-}
-  totalSize (LtSubword n) = [fromIntegral (n+1) ^ 2 `div` 2]
-  {-# Inline totalSize #-}
-
-deriving instance Eq      (LimitType (Subword t))
-deriving instance Generic (LimitType (Subword t))
-deriving instance Read    (LimitType (Subword t))
-deriving instance Show    (LimitType (Subword t))
-
--- | @Subword I@ (inside)
-
-instance IndexStream z => IndexStream (z:.Subword I) where
-  streamUp   (ls:..LtSubword l) (hs:..LtSubword h) = flatten (streamUpMk     h) (streamUpStep   l h) $ streamUp   ls hs
-  streamDown (ls:..LtSubword l) (hs:..LtSubword h) = flatten (streamDownMk l h) (streamDownStep   h) $ streamDown ls hs
-  {-# Inline streamUp #-}
-  {-# Inline streamDown #-}
-
--- | @Subword O@ (outside).
---
--- Note: @streamUp@ really needs to use @streamDownMk@ / @streamDownStep@
--- for the right order of indices!
-
-instance IndexStream z => IndexStream (z:.Subword O) where
-  streamUp   (ls:..LtSubword l) (hs:..LtSubword h) = flatten (streamDownMk l h) (streamDownStep   h) $ streamUp   ls hs
-  streamDown (ls:..LtSubword l) (hs:..LtSubword h) = flatten (streamUpMk     h) (streamUpStep   l h) $ streamDown ls hs
-  {-# Inline streamUp #-}
-  {-# Inline streamDown #-}
-
--- | @Subword C@ (complement)
-
-instance IndexStream z => IndexStream (z:.Subword C) where
-  streamUp   (ls:..LtSubword l) (hs:..LtSubword h) = flatten (streamUpMk     h) (streamUpStep   l h) $ streamUp   ls hs
-  streamDown (ls:..LtSubword l) (hs:..LtSubword h) = flatten (streamDownMk l h) (streamDownStep   h) $ streamDown ls hs
-  {-# Inline streamUp #-}
-  {-# Inline streamDown #-}
-
--- | generic @mk@ for @streamUp@ / @streamDown@
-
-streamUpMk h z = return (z,h,h)
-{-# Inline [0] streamUpMk #-}
-
-streamUpStep l h (z,i,j)
-  | i < l     = return $ Done
-  | j > h     = return $ Skip (z,i-1,i-1)
-  | otherwise = return $ Yield (z:.subword i j) (z,i,j+1)
-{-# Inline [0] streamUpStep #-}
-
-streamDownMk l h z = return (z,l,h)
-{-# Inline [0] streamDownMk #-}
-
-streamDownStep h (z,i,j)
-  | i > h     = return $ Done
-  | j < i     = return $ Skip (z,i+1,h)
-  | otherwise = return $ Yield (z:.subword i j) (z,i,j-1)
-{-# Inline [0] streamDownStep #-}
-
-instance (IndexStream (Z:.Subword t)) => IndexStream (Subword t) where
-  streamUp l h = map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
-  {-# INLINE streamUp #-}
-  streamDown l h = map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
-  {-# INLINE streamDown #-}
-
-instance Arbitrary (Subword t) where
-  arbitrary = do
-    a <- choose (0,20)
-    b <- choose (0,20)
-    return $ Subword (min a b :. max a b)
-  shrink (Subword (i:.j))
-    | i<j       = [Subword (i:.j-1), Subword (i+1:.j)]
-    | otherwise = []
-
-instance Monad m => Serial m (Subword t) where
-  series = do
-    i <- TS.getNonNegative <$> series
-    j <- TS.getNonNegative <$> series
-    guard $ i<=j
-    return $ subword i j
-    {-
-    let nns :: Series m Int = TS.getNonNegative <$> series
-    ps <- nns >< nns
-    let qs = [ subword i j | (i,j) <- ps, i<=j ]
-    return qs
-    -}
-
diff --git a/Data/PrimitiveArray/Index/Unit.hs b/Data/PrimitiveArray/Index/Unit.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/Index/Unit.hs
+++ /dev/null
@@ -1,78 +0,0 @@
-
--- | Unit indices admit a single element to be memoized. We can't use @()@
--- because we want to attach phantom types.
-
-module Data.PrimitiveArray.Index.Unit where
-
-import Control.Applicative (pure)
-import Control.DeepSeq (NFData(..))
-import Data.Aeson (FromJSON,FromJSONKey,ToJSON,ToJSONKey)
-import Data.Binary (Binary)
-import Data.Hashable (Hashable)
-import Data.Serialize (Serialize)
-import Data.Vector.Fusion.Stream.Monadic (Step(..), map)
-import Data.Vector.Unboxed.Deriving
-import GHC.Generics (Generic)
-import Prelude hiding (map)
-import Test.QuickCheck (Arbitrary(..), choose)
-
-import Data.PrimitiveArray.Index.Class
-
-
-
-data Unit t = Unit
-  deriving (Eq,Ord,Show,Generic,Read)
-
-derivingUnbox "Unit"
-  [t| forall t . Unit t -> () |]
-  [| \ Unit -> ()   |]
-  [| \ ()   -> Unit |]
-
-instance Binary       (Unit t)
-instance Serialize    (Unit t)
-instance FromJSON     (Unit t)
-instance FromJSONKey  (Unit t)
-instance ToJSON       (Unit t)
-instance ToJSONKey    (Unit t)
-instance Hashable     (Unit t)
-
-instance NFData (Unit t) where
-  rnf Unit = ()
-  {-# Inline rnf #-}
-
-instance Index (Unit t) where
-  data LimitType (Unit t) = LtUnit
-  linearIndex _ _ = 0
-  {-# Inline linearIndex #-}
-  size _ = 1
-  {-# Inline size #-}
-  inBounds _ _ = True
-  {-# Inline inBounds #-}
-  zeroBound = Unit
-  {-# Inline zeroBound #-}
-  zeroBound' = LtUnit
-  {-# Inline zeroBound' #-}
-  totalSize LtUnit = return 1
-  {-# Inline [0] totalSize #-}
-
-deriving instance Eq      (LimitType (Unit t))
-deriving instance Generic (LimitType (Unit t))
-deriving instance Read    (LimitType (Unit t))
-deriving instance Show    (LimitType (Unit t))
-
-instance IndexStream z => IndexStream (z:.Unit t) where
-  streamUp (ls:..LtUnit) (hs:..LtUnit) = map (\z -> z:.Unit) $ streamUp ls hs
-  {-# Inline streamUp #-}
-  streamDown (ls:..LtUnit) (hs:..LtUnit) = map (\z -> z:.Unit) $ streamDown ls hs
-  {-# Inline streamDown #-}
-
-instance (IndexStream (Z:.Unit t)) => IndexStream (Unit t) where
-  streamUp l h = map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
-  {-# INLINE streamUp #-}
-  streamDown l h = map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
-  {-# INLINE streamDown #-}
-
-instance Arbitrary (Unit t) where
-  arbitrary = pure Unit
-  shrink Unit = []
-
diff --git a/Data/PrimitiveArray/ScoreMatrix.hs b/Data/PrimitiveArray/ScoreMatrix.hs
deleted file mode 100644
--- a/Data/PrimitiveArray/ScoreMatrix.hs
+++ /dev/null
@@ -1,123 +0,0 @@
-
--- | Simple score and distance matrices. These are two-dimensional tables
--- together with row and column vectors of names.
-
-module Data.PrimitiveArray.ScoreMatrix where
-
-import           Control.Monad (when,unless)
-import           Data.Text (Text)
-import           Data.Vector.Unboxed (Unbox)
-import           Numeric.Log
-import qualified Data.Text as T
-import qualified Data.Vector as V
-import           System.Exit (exitFailure)
-
-import           Data.PrimitiveArray hiding (map)
-import qualified Data.PrimitiveArray as PA
-
-
-
--- | NxN sized score matrices
---
--- TODO needs a vector with the column names!
-
-data ScoreMatrix t = ScoreMatrix
-  { scoreMatrix :: !(Unboxed (Z:.Int:.Int) t)
-  , scoreNodes  :: !(Unboxed Int t)
-  , rowNames    :: !(V.Vector Text)
-  , colNames    :: !(V.Vector Text)
-  } deriving (Show)
-
--- | Get the distance between edges @(From,To)@.
-
-(.!.) :: Unbox t => ScoreMatrix t -> (Int,Int) -> t
-ScoreMatrix mat _ _ _ .!. (f,t) = mat ! (Z:.f:.t)
-{-# Inline (.!.) #-}
-
--- | If the initial node has a "distance", it'll be here
-
-nodeDist :: Unbox t => ScoreMatrix t -> Int -> t
-nodeDist ScoreMatrix{..} k = scoreNodes ! k
-
--- | Get the name of the node at an row index
-
-rowNameOf :: ScoreMatrix t -> Int -> Text
-rowNameOf ScoreMatrix{..} k = rowNames V.! k
-{-# Inline rowNameOf #-}
-
--- | Get the name of the node at an column index
-
-colNameOf :: ScoreMatrix t -> Int -> Text
-colNameOf ScoreMatrix{..} k = colNames V.! k
-{-# Inline colNameOf #-}
-
--- | Number of rows in a score matrix.
-
-numRows :: Unbox t => ScoreMatrix t -> Int
-numRows ScoreMatrix{..} = let (_:..LtInt n':.._) = upperBound scoreMatrix in n' + 1
-{-# Inline numRows #-}
-
--- | Number of columns in a score matrix.
-
-numCols :: Unbox t => ScoreMatrix t -> Int
-numCols ScoreMatrix{..} = let (_:.._:..LtInt n') = upperBound scoreMatrix in n' + 1
-{-# Inline numCols #-}
-
-listOfRowNames :: ScoreMatrix t -> [Text]
-listOfRowNames ScoreMatrix{..} = V.toList rowNames
-
-listOfColNames :: ScoreMatrix t -> [Text]
-listOfColNames ScoreMatrix{..} = V.toList colNames
-
--- | Turns a @ScoreMatrix@ for distances into one scaled by "temperature" for
--- Inside/Outside calculations. Each value is scaled by
--- @\k -> exp $ negate k / r * t@ where
--- r = (n-1) * d
--- d = mean of genetic distance
---
--- Node scores are turned directly into probabilities.
---
--- TODO Again, there is overlap and we should really have @newtype
--- Distance@ and friends.
---
--- TODO @newtype Temperature = Temperature Double@
---
--- TODO fix for rows /= cols!!!
-
-toPartMatrix
-  :: Double
-  -- ^ temperature
-  -> ScoreMatrix Double
-  -> ScoreMatrix (Log Double)
-toPartMatrix t scoreMat@(ScoreMatrix mat sn rns cns) = ScoreMatrix p psn rns cns
-  where p = PA.map (\k -> Exp {- . log . exp -} $ negate k / (r * t)) mat
-        psn = PA.map (\k -> Exp $ negate k) sn
-        n = numRows scoreMat
-        d = Prelude.sum [ mat ! (Z:.i:.j) | i <- [0..n-1], j <- [i+1..n-1] ] / fromIntegral (n*(n-1))
-        r = fromIntegral (n-1) * d
-
--- | Import data.
---
--- TODO Should be generalized because @Lib-BiobaseBlast@ does almost the
--- same thing.
-
-fromFile :: FilePath -> IO (ScoreMatrix Double)
-fromFile fp = do
-  ls <- lines <$> readFile fp
-  when (null ls) $ do
-    putStrLn $ fp ++ " is empty"
-    exitFailure
-  let mat' = map (map read . tail . words) $ tail ls
-  let n = length mat'
-  unless (all ((==n) . length) mat') $ do
-    putStrLn $ fp ++ " is not a NxN matrix"
-    print mat'
-    exitFailure
-  let scoreMatrix = PA.fromAssocs (ZZ:..LtInt (n-1):..LtInt (n-1)) 0
-          $ concatMap (\(r,es) -> [ ((Z:.r:.c),e) | (c,e) <- zip [0..] es ])
-          $ zip [0..] mat' -- rows
-  let scoreNodes = PA.fromAssocs (LtInt $ n-1) 0 []
-  let rowNames = V.fromList . map T.pack . drop 1 . words $ head ls
-  let colNames = V.fromList . map (T.pack . head . words) $ tail ls
-  return $ ScoreMatrix{..} -- mat rowNames colNames (V.fromList $ replicate n 0)
-
diff --git a/PrimitiveArray.cabal b/PrimitiveArray.cabal
--- a/PrimitiveArray.cabal
+++ b/PrimitiveArray.cabal
@@ -1,6 +1,6 @@
 Cabal-version:  2.2
 Name:           PrimitiveArray
-Version:        0.9.1.0
+Version:        0.9.1.1
 License:        BSD-3-Clause
 License-file:   LICENSE
 Maintainer:     choener@bioinf.uni-leipzig.de
@@ -80,7 +80,7 @@
                , vector-th-unbox          >= 0.2
                --
                , DPutils                  == 0.1.0.*
-               , OrderedBits              == 0.0.1.*
+               , OrderedBits              == 0.0.2.*
   default-extensions: BangPatterns
                     , CPP
                     , DataKinds
@@ -93,6 +93,7 @@
                     , GADTs
                     , GeneralizedNewtypeDeriving
                     , MultiParamTypeClasses
+                    , PatternSynonyms
                     , PolyKinds
                     , RankNTypes
                     , RecordWildCards
@@ -111,7 +112,7 @@
     -funbox-strict-fields
   if flag(debug)
     cpp-options: -DADPFUSION_CHECKS
-    ghc-options: -fno-ignore-asserts -O0
+    ghc-options: -fno-ignore-asserts --disable-optimizations
   if flag(debugoutput)
     cpp-options: -DADPFUSION_DEBUGOUTPUT
 
@@ -125,24 +126,20 @@
     Data.PrimitiveArray.Checked
     Data.PrimitiveArray.Class
     Data.PrimitiveArray.Dense
---    Data.PrimitiveArray.FillTables
     Data.PrimitiveArray.Index
     Data.PrimitiveArray.Index.BitSet0
     Data.PrimitiveArray.Index.BitSet1
     Data.PrimitiveArray.Index.BitSetClasses
---    Data.PrimitiveArray.Index.BS0
---    Data.PrimitiveArray.Index.BS2
     Data.PrimitiveArray.Index.Class
---    Data.PrimitiveArray.Index.EdgeBoundary
     Data.PrimitiveArray.Index.Int
     Data.PrimitiveArray.Index.IOC
     Data.PrimitiveArray.Index.PhantomInt
     Data.PrimitiveArray.Index.Point
---    Data.PrimitiveArray.Index.Set
     Data.PrimitiveArray.Index.Subword
---    Data.PrimitiveArray.Index.TernarySet
     Data.PrimitiveArray.Index.Unit
     Data.PrimitiveArray.ScoreMatrix
+  hs-source-dirs:
+    lib
 
 
 
diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,3 +1,8 @@
+0.9.1.1
+-------
+
+- OrderedBits version bump
+
 0.9.1.0
 -------
 
diff --git a/lib/Data/PrimitiveArray.hs b/lib/Data/PrimitiveArray.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray.hs
@@ -0,0 +1,13 @@
+
+module Data.PrimitiveArray 
+  ( module Data.PrimitiveArray.Class
+  , module Data.PrimitiveArray.Dense
+--  , module Data.PrimitiveArray.FillTables
+  , module Data.PrimitiveArray.Index
+  ) where
+
+import Data.PrimitiveArray.Class
+import Data.PrimitiveArray.Dense
+--import Data.PrimitiveArray.FillTables
+import Data.PrimitiveArray.Index
+
diff --git a/lib/Data/PrimitiveArray/Checked.hs b/lib/Data/PrimitiveArray/Checked.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/Checked.hs
@@ -0,0 +1,29 @@
+
+-- | This module exports everything that @Data.PrimitiveArray@ exports, but
+-- it will do some bounds-checking on certain operations.
+--
+-- Checked are: @(!)@
+
+module Data.PrimitiveArray.Checked
+  ( module Data.PrimitiveArray
+  , (!)
+  ) where
+
+import qualified Data.Vector.Generic as VG
+
+import           Data.PrimitiveArray hiding ((!))
+
+-- | Bounds-checked version of indexing.
+--
+-- First, we check via @inBounds@, second we check if the linear index is
+-- outside of the allocated area.
+
+--(!) :: PrimArrayOps arr sh elm => arr sh elm -> sh -> elm
+(!) arr@(Unboxed h v) idx
+  | not (inBounds (upperBound arr) idx) = error $ "(!) / inBounds: out of bounds! " ++ show (h,idx)
+  | li < 0 || li >= len = error $ "(!) / linearIndex: out of bounds! " ++ show (h,li,len,idx)
+  | otherwise = unsafeIndex arr idx
+  where li  = linearIndex h idx
+        len = VG.length v
+{-# Inline (!) #-}
+
diff --git a/lib/Data/PrimitiveArray/Class.hs b/lib/Data/PrimitiveArray/Class.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/Class.hs
@@ -0,0 +1,233 @@
+
+-- | Vastly extended primitive arrays. Some basic ideas are now modeled after
+-- the vector package, especially the monadic mutable / pure immutable array
+-- system.
+--
+-- NOTE all operations in MPrimArrayOps and PrimArrayOps are highly unsafe. No
+-- bounds-checking is performed at all.
+
+module Data.PrimitiveArray.Class where
+
+import           Control.Applicative (Applicative, pure, (<$>), (<*>))
+import           Control.Exception (assert)
+import           Control.Monad.Except
+import           Control.Monad (forM_)
+import           Control.Monad.Primitive (PrimMonad, liftPrim)
+import           Control.Monad.ST (runST)
+import           Data.Proxy
+import           Data.Vector.Fusion.Util
+import           Debug.Trace
+import           GHC.Generics (Generic)
+import           Prelude as P
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+
+import           Data.PrimitiveArray.Index.Class
+
+
+
+-- | Mutable version of an array.
+
+data family MutArr (m :: * -> *) (arr :: *) :: *
+
+
+-- | The core set of operations for monadic arrays.
+
+class (Index sh) => MPrimArrayOps arr sh elm where
+
+  -- | Return the bounds of the array. All bounds are inclusive, as in
+  -- @[lb..ub]@
+
+  upperBoundM :: MutArr m (arr sh elm) -> LimitType sh
+
+  -- | Given lower and upper bounds and a list of /all/ elements, produce a
+  -- mutable array.
+
+  fromListM :: PrimMonad m => LimitType sh -> [elm] -> m (MutArr m (arr sh elm))
+
+  -- | Creates a new array with the given bounds with each element within the
+  -- array being in an undefined state.
+
+  newM :: PrimMonad m => LimitType sh -> m (MutArr m (arr sh elm))
+
+  -- | Creates a new array with all elements being equal to 'elm'.
+
+  newWithM :: PrimMonad m => LimitType sh -> elm -> m (MutArr m (arr sh elm))
+
+  -- | Reads a single element in the array.
+
+  readM :: PrimMonad m => MutArr m (arr sh elm) -> sh -> m elm
+
+  -- | Writes a single element in the array.
+
+  writeM :: PrimMonad m => MutArr m (arr sh elm) -> sh -> elm -> m ()
+
+
+
+-- | The core set of functions on immutable arrays.
+
+class (Index sh) => PrimArrayOps arr sh elm where
+
+  -- | Returns the bounds of an immutable array, again inclusive bounds: @ [lb..ub] @.
+
+  upperBound :: arr sh elm -> LimitType sh
+
+  -- | Freezes a mutable array an returns its immutable version. This operation
+  -- is /O(1)/ and both arrays share the same memory. Do not use the mutable
+  -- array afterwards.
+
+  unsafeFreeze :: PrimMonad m => MutArr m (arr sh elm) -> m (arr sh elm)
+
+  -- | Thaw an immutable array into a mutable one. Both versions share
+  -- memory.
+
+  unsafeThaw :: PrimMonad m => arr sh elm -> m (MutArr m (arr sh elm))
+
+  -- | Extract a single element from the array. Generally unsafe as not
+  -- bounds-checking is performed.
+
+  unsafeIndex :: arr sh elm -> sh -> elm
+
+  -- | Savely transform the shape space of a table.
+
+  transformShape :: (Index sh') => (LimitType sh -> LimitType sh') -> arr sh elm -> arr sh' elm
+
+class (Index sh) => PrimArrayMap arr sh e e' where
+
+  -- | Map a function over each element, keeping the shape intact.
+
+  map :: (e -> e') -> arr sh e -> arr sh e'
+
+
+
+data PAErrors
+  = PAEUpperBound
+  deriving (Eq,Generic)
+
+instance Show PAErrors where
+  show (PAEUpperBound) = "Upper bound is too large for @Int@ size!"
+
+
+
+-- | Infix index operator. Performs minimal bounds-checking using assert in
+-- non-optimized code.
+
+(!) :: PrimArrayOps arr sh elm => arr sh elm -> sh -> elm
+(!) arr idx = assert (inBounds (upperBound arr) idx) $ unsafeIndex arr idx
+{-# INLINE (!) #-}
+
+-- | Returns true if the index is valid for the array.
+
+inBoundsM :: (Monad m, MPrimArrayOps arr sh elm) => MutArr m (arr sh elm) -> sh -> Bool
+inBoundsM marr idx = inBounds (upperBoundM marr) idx
+{-# INLINE inBoundsM #-}
+
+-- -- | Given two arrays with the same dimensionality, their respective starting
+-- -- index, and how many steps to go in each dimension (in terms of a dimension
+-- -- again), determine if the multidimensional slices have the same value at
+-- -- all positions
+-- --
+-- -- TODO specialize for DIM1 (and maybe higher dim's) to use memcmp
+-- 
+-- sliceEq :: (Eq elm, PrimArrayOps arr sh elm) => arr sh elm -> sh -> arr sh elm -> sh -> sh -> Bool
+-- sliceEq arr1 k1 arr2 k2 xtnd = assert ((inBounds arr1 k1) && (inBounds arr2 k2) && (inBounds arr1 $ k1 `addDim` xtnd) && (inBounds arr2 $ k2 `addDim` xtnd)) $ and res where
+--   res = zipWith (==) xs ys
+--   xs = P.map (unsafeIndex arr1) $ rangeList k1 xtnd
+--   ys = P.map (unsafeIndex arr2) $ rangeList k2 xtnd
+-- {-# INLINE sliceEq #-}
+
+-- | Construct a mutable primitive array from a lower and an upper bound, a
+-- default element, and a list of associations.
+
+fromAssocsM
+  :: (PrimMonad m, MPrimArrayOps arr sh elm)
+  => LimitType sh -> elm -> [(sh,elm)] -> m (MutArr m (arr sh elm))
+fromAssocsM ub def xs = do
+  ma <- newWithM ub def
+--  let s = size ub
+--  traceShow (s,length xs) $ when (s < length xs) $ error "bang"
+  forM_ xs $ \(k,v) -> writeM ma k v
+  return ma
+{-# INLINE fromAssocsM #-}
+
+-- | Initialize an immutable array but stay within the primitive monad @m@.
+
+newWithPA
+  ∷ (PrimMonad m, MPrimArrayOps arr sh elm, PrimArrayOps arr sh elm)
+  ⇒ LimitType sh
+  → elm
+  → m (arr sh elm)
+newWithPA ub def = do
+  ma ← newWithM ub def
+  unsafeFreeze ma
+{-# Inlinable newWithPA #-}
+
+-- | Safely prepare a primitive array.
+--
+-- TODO Check if having a 'MonadError' instance degrades performance. (We
+-- should see this once the test with NeedlemanWunsch is under way).
+
+safeNewWithPA
+  ∷ forall m arr sh elm 
+  . (PrimMonad m, MonadError PAErrors m, MPrimArrayOps arr sh elm, PrimArrayOps arr sh elm)
+  ⇒ LimitType sh
+  → elm
+  → m (arr sh elm)
+safeNewWithPA ub def = do
+  case runExcept $ sizeIsValid maxBound [totalSize ub] of
+    Left  (SizeError _) → throwError PAEUpperBound
+    Right (CellSize  _) → newWithPA ub def
+{-# Inlinable safeNewWithPA #-}
+
+
+-- | Return all associations from an array.
+
+assocs :: forall arr sh elm . (IndexStream sh, PrimArrayOps arr sh elm) => arr sh elm -> [(sh,elm)]
+assocs arr = P.map (\k -> (k,unsafeIndex arr k)) . unId . SM.toList $ streamUp zeroBound' (upperBound arr) where
+{-# INLINE assocs #-}
+
+-- | Creates an immutable array from lower and upper bounds and a complete list
+-- of elements.
+
+fromList :: (PrimArrayOps arr sh elm, MPrimArrayOps arr sh elm) => LimitType sh -> [elm] -> arr sh elm
+fromList ub xs = runST $ fromListM ub xs >>= unsafeFreeze
+{-# INLINE fromList #-}
+
+-- | Creates an immutable array from lower and upper bounds, a default element,
+-- and a list of associations.
+
+fromAssocs :: (PrimArrayOps arr sh elm, MPrimArrayOps arr sh elm) => LimitType sh -> elm -> [(sh,elm)] -> arr sh elm
+fromAssocs ub def xs = runST $ fromAssocsM ub def xs >>= unsafeFreeze
+{-# INLINE fromAssocs #-}
+
+-- -- | Determines if an index is valid for a given immutable array.
+-- 
+-- inBounds :: PrimArrayOps arr sh elm => arr sh elm -> sh -> Bool
+-- inBounds arr idx = let (lb,ub) = bounds arr in inShapeRange lb (ub `addDim` unitDim) idx
+-- {-# INLINE inBounds #-}
+
+-- | Returns all elements of an immutable array as a list.
+
+toList :: forall arr sh elm . (IndexStream sh, PrimArrayOps arr sh elm) => arr sh elm -> [elm]
+toList arr = let ub = upperBound arr in P.map ((!) arr) . unId . SM.toList $ streamUp zeroBound' ub
+{-# INLINE toList #-}
+
+
+
+-- * Freeze an inductive stack of tables with a 'Z' at the bottom.
+
+-- | 'freezeTables' freezes a stack of tables.
+
+class FreezeTables m t where
+    type Frozen t :: *
+    freezeTables :: t -> m (Frozen t)
+
+instance Applicative m => FreezeTables m Z where
+    type Frozen Z = Z
+    freezeTables Z = pure Z
+    {-# INLINE freezeTables #-}
+
+instance (Functor m, Applicative m, Monad m, PrimMonad m, FreezeTables m ts, PrimArrayOps arr sh elm) => FreezeTables m (ts:.MutArr m (arr sh elm)) where
+    type Frozen (ts:.MutArr m (arr sh elm)) = Frozen ts :. arr sh elm
+    freezeTables (ts:.t) = (:.) <$> freezeTables ts <*> unsafeFreeze t
+    {-# INLINE freezeTables #-}
+
diff --git a/lib/Data/PrimitiveArray/Dense.hs b/lib/Data/PrimitiveArray/Dense.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/Dense.hs
@@ -0,0 +1,220 @@
+
+-- | Dense primitive arrays where the lower index is zero (or the
+-- equivalent of zero for newtypes and enumerations).
+--
+-- Actual @write@s to data structures use a more safe @write@ instead of
+-- the unsafe @unsafeWrite@. Writes also tend to occur much less in DP
+-- algorithms (say, N^2 writes for an N^3 time algorithm -- mostly reads
+-- are being executed).
+--
+-- TODO consider if we want to force the lower index to be zero, or allow
+-- non-zero lower indices. Will have to be considered together with the
+-- @Index.Class@ module!
+--
+-- TODO while @Unboxed@ is, in princile, @Hashable@, we'd need the
+-- corresponding @VU.Vector@ instances ...
+
+module Data.PrimitiveArray.Dense where
+
+import           Control.DeepSeq
+import           Control.Exception (assert)
+import           Control.Monad (liftM, forM_, zipWithM_)
+import           Control.Monad.Primitive (PrimState)
+import           Data.Aeson (ToJSON,FromJSON)
+import           Data.Binary (Binary)
+import           Data.Hashable (Hashable)
+import           Data.Serialize (Serialize)
+import           Data.Typeable (Typeable)
+import           Data.Vector.Binary
+import           Data.Vector.Generic.Mutable as GM hiding (length)
+import           Data.Vector.Serialize
+import           Data.Vector.Unboxed.Mutable (Unbox)
+import           Debug.Trace
+import           GHC.Generics (Generic)
+import qualified Data.Vector as V hiding (forM_, length, zipWithM_)
+import qualified Data.Vector.Generic as G
+import qualified Data.Vector.Unboxed as VU hiding (forM_, length, zipWithM_)
+import           Data.Data
+
+
+import           Data.PrimitiveArray.Class
+import           Data.PrimitiveArray.Index.Class
+
+
+
+-- * Unboxed, multidimensional arrays.
+
+data Unboxed sh e = Unboxed !(LimitType sh) !(VU.Vector e)
+
+deriving instance (Eq      (LimitType sh), Eq e     , Unbox e) ⇒ Eq      (Unboxed sh e)
+deriving instance (Generic (LimitType sh), Generic e, Unbox e) ⇒ Generic (Unboxed sh e)
+deriving instance (Read    (LimitType sh), Read e   , Unbox e) ⇒ Read    (Unboxed sh e)
+deriving instance (Show    (LimitType sh), Show e   , Unbox e) ⇒ Show    (Unboxed sh e)
+deriving instance
+  ( Data sh, Data (LimitType sh)
+  , Data e, Unbox e
+  ) ⇒ Data    (Unboxed sh e)
+
+instance (Binary    (LimitType sh), Binary    e, Unbox e, Generic (LimitType sh), Generic e) => Binary    (Unboxed sh e)
+instance (Serialize (LimitType sh), Serialize e, Unbox e, Generic (LimitType sh), Generic e) => Serialize (Unboxed sh e)
+instance (ToJSON    (LimitType sh), ToJSON    e, Unbox e, Generic (LimitType sh), Generic e) => ToJSON    (Unboxed sh e)
+instance (FromJSON  (LimitType sh), FromJSON  e, Unbox e, Generic (LimitType sh), Generic e) => FromJSON  (Unboxed sh e)
+instance (Hashable  (LimitType sh), Hashable  e, Hashable (VU.Vector e), Unbox e, Generic (LimitType sh), Generic e) => Hashable  (Unboxed sh e)
+
+instance (NFData (LimitType sh)) => NFData (Unboxed sh e) where
+  rnf (Unboxed h xs) = rnf h `seq` rnf xs
+  {-# Inline rnf #-}
+
+data instance MutArr m (Unboxed sh e) = MUnboxed !(LimitType sh) !(VU.MVector (PrimState m) e)
+  deriving (Generic,Typeable)
+
+instance (NFData (LimitType sh)) => NFData (MutArr m (Unboxed sh e)) where
+  rnf (MUnboxed h xs) = rnf h `seq` rnf xs
+  {-# Inline rnf #-}
+
+instance
+  ( Index sh
+  , Unbox elm
+#if ADPFUSION_DEBUGOUTPUT
+  , Show sh, Show (LimitType sh), Show elm
+#endif
+  ) ⇒ MPrimArrayOps Unboxed sh elm where
+  upperBoundM (MUnboxed h _) = h
+  fromListM h xs = do
+    ma <- newM h
+    let (MUnboxed _ mba) = ma
+    zipWithM_ (\k x -> assert (length xs == size h) $ unsafeWrite mba k x) [0.. size h -1] xs
+    return ma
+  newM h = MUnboxed h `liftM` new (size h)
+  newWithM h def = do
+    ma <- newM h
+    let (MUnboxed _ mba) = ma
+    forM_ [0 .. size h -1] $ \k -> unsafeWrite mba k def
+    return ma
+  readM  (MUnboxed h mba) idx     = assert (inBounds h idx) $ unsafeRead  mba (linearIndex h idx)
+  writeM (MUnboxed h mba) idx elm =
+#if ADPFUSION_DEBUGOUTPUT
+    (if inBounds h idx then id else traceShow ("writeM", h, idx, elm, size h, linearIndex h idx, inBounds h idx))
+#endif
+    assert (inBounds h idx) $ unsafeWrite mba (linearIndex h idx) elm
+  {-# INLINE upperBoundM #-}
+  {-# INLINE fromListM #-}
+  {-# NoInline newM #-}
+  {-# INLINE newWithM #-}
+  {-# INLINE readM #-}
+  {-# INLINE writeM #-}
+
+instance (Index sh, Unbox elm) => PrimArrayOps Unboxed sh elm where
+  upperBound (Unboxed h _) = h
+  unsafeFreeze (MUnboxed h mba) = Unboxed h `liftM` G.unsafeFreeze mba
+  unsafeThaw   (Unboxed  h ba) = MUnboxed h `liftM` G.unsafeThaw ba
+  unsafeIndex  (Unboxed  h ba) idx = G.unsafeIndex ba (linearIndex h idx)
+  transformShape tr (Unboxed h ba) = Unboxed (tr h) ba
+  {-# INLINE upperBound #-}
+  {-# INLINE unsafeFreeze #-}
+  {-# INLINE unsafeThaw #-}
+  {-# INLINE unsafeIndex #-}
+  {-# INLINE transformShape #-}
+
+instance (Index sh, Unbox e, Unbox e') => PrimArrayMap Unboxed sh e e' where
+  map f (Unboxed h xs) = Unboxed h (VU.map f xs)
+  {-# INLINE map #-}
+
+
+
+-- * Boxed, multidimensional arrays.
+
+data Boxed sh e = Boxed !(LimitType sh) !(V.Vector e)
+
+deriving instance (Read    (LimitType sh), Read e) ⇒ Read (Boxed sh e)
+deriving instance (Show    (LimitType sh), Show e) ⇒ Show (Boxed sh e)
+deriving instance (Eq      (LimitType sh), Eq   e) ⇒ Eq   (Boxed sh e)
+deriving instance (Generic (LimitType sh), Generic e) ⇒ Generic (Boxed sh e)
+deriving instance
+  ( Data sh, Data (LimitType sh)
+  , Data e
+  ) ⇒ Data    (Boxed sh e)
+
+
+instance (Binary    (LimitType sh), Binary    e, Unbox e, Generic (LimitType sh), Generic e) => Binary    (Boxed sh e)
+instance (Serialize (LimitType sh), Serialize e, Unbox e, Generic (LimitType sh), Generic e) => Serialize (Boxed sh e)
+instance (ToJSON    (LimitType sh), ToJSON    e, Unbox e, Generic (LimitType sh), Generic e) => ToJSON    (Boxed sh e)
+instance (FromJSON  (LimitType sh), FromJSON  e, Unbox e, Generic (LimitType sh), Generic e) => FromJSON  (Boxed sh e)
+instance (Hashable  (LimitType sh), Hashable  e, Hashable (V.Vector e), Unbox e, Generic (LimitType sh), Generic e) => Hashable  (Boxed sh e)
+
+instance (NFData (LimitType sh), NFData e) => NFData (Boxed sh e) where
+  rnf (Boxed h xs) = rnf h `seq` rnf xs
+  {-# Inline rnf #-}
+
+data instance MutArr m (Boxed sh e) = MBoxed !(LimitType sh) !(V.MVector (PrimState m) e)
+  deriving (Generic,Typeable)
+
+instance (NFData (LimitType sh)) => NFData (MutArr m (Boxed sh e)) where
+  rnf (MBoxed h xs) = rnf h -- no rnf for the data !
+  {-# Inline rnf #-}
+
+instance (Index sh) => MPrimArrayOps Boxed sh elm where
+  upperBoundM (MBoxed h _) = h
+  fromListM h xs = do
+    ma <- newM h
+    let (MBoxed _ mba) = ma
+    zipWithM_ (\k x -> assert (length xs == size h) $ unsafeWrite mba k x) [0 .. size h - 1] xs
+    return ma
+  newM h =
+    MBoxed h `liftM` new (size h)
+  newWithM h def = do
+    ma <- newM h
+    let (MBoxed _ mba) = ma
+    forM_ [0 .. size h -1] $ \k -> unsafeWrite mba k def
+    return ma
+  readM  (MBoxed h mba) idx     = assert (inBounds h idx) $ GM.unsafeRead  mba (linearIndex h idx)
+  writeM (MBoxed h mba) idx elm = assert (inBounds h idx) $ GM.unsafeWrite mba (linearIndex h idx) elm
+  {-# INLINE upperBoundM #-}
+  {-# INLINE fromListM #-}
+  {-# NoInline newM #-}
+  {-# INLINE newWithM #-}
+  {-# INLINE readM #-}
+  {-# INLINE writeM #-}
+
+instance (Index sh) => PrimArrayOps Boxed sh elm where
+  upperBound (Boxed h _) = h
+  unsafeFreeze (MBoxed h mba) = Boxed h `liftM` G.unsafeFreeze mba
+  unsafeThaw   (Boxed h ba) = MBoxed h `liftM` G.unsafeThaw ba
+  unsafeIndex (Boxed h ba) idx = assert (inBounds h idx) $ G.unsafeIndex ba (linearIndex h idx)
+  transformShape tr (Boxed h ba) = Boxed (tr h) ba
+  {-# INLINE upperBound #-}
+  {-# INLINE unsafeFreeze #-}
+  {-# INLINE unsafeThaw #-}
+  {-# INLINE unsafeIndex #-}
+  {-# INLINE transformShape #-}
+
+instance (Index sh) => PrimArrayMap Boxed sh e e' where
+  map f (Boxed h xs) = Boxed h (V.map f xs)
+  {-# INLINE map #-}
+
+
+
+{-
+ -
+ - This stuff tells us how to write efficient generics on large data
+ - constructors like the Turner and Vienna ctors.
+ -
+
+import qualified Data.Generics.TH as T
+
+data Unboxed sh e = Unboxed !sh !(VU.Vector e)
+  deriving (Show,Eq,Ord)
+
+data X e = X (Unboxed DIM1 e) (Unboxed DIM1 e)
+  deriving (Show,Eq,Ord)
+
+x :: X Int
+x = X z z where z = (Unboxed (Z:.10) (VU.fromList [ 0 .. 10] ))
+
+pot :: X Int -> X Double
+pot = $( T.thmapT (T.mkTs ['f]) [t| X Int |] ) where
+  f :: Unboxed DIM1 Int -> Unboxed DIM1 Double
+  f (Unboxed sh xs) = Unboxed sh (VU.map fromIntegral xs)
+
+-}
+
diff --git a/lib/Data/PrimitiveArray/Index.hs b/lib/Data/PrimitiveArray/Index.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/Index.hs
@@ -0,0 +1,29 @@
+
+module Data.PrimitiveArray.Index
+  ( module Data.PrimitiveArray.Index.Class
+  , module Data.PrimitiveArray.Index.BitSet0
+  , module Data.PrimitiveArray.Index.BitSet1
+  , module Data.PrimitiveArray.Index.BitSetClasses
+--  , module Data.PrimitiveArray.Index.EdgeBoundary
+  , module Data.PrimitiveArray.Index.Int
+  , module Data.PrimitiveArray.Index.IOC
+  , module Data.PrimitiveArray.Index.PhantomInt
+  , module Data.PrimitiveArray.Index.Point
+--  , module Data.PrimitiveArray.Index.Set
+  , module Data.PrimitiveArray.Index.Subword
+  , module Data.PrimitiveArray.Index.Unit
+  ) where
+
+import Data.PrimitiveArray.Index.Class
+--import Data.PrimitiveArray.Index.EdgeBoundary hiding (streamUpMk, streamUpStep, streamDownMk, streamDownStep)
+import Data.PrimitiveArray.Index.Int
+import Data.PrimitiveArray.Index.IOC
+import Data.PrimitiveArray.Index.PhantomInt hiding (streamUpMk, streamUpStep, streamDownMk, streamDownStep)
+import Data.PrimitiveArray.Index.Point hiding (streamUpMk, streamUpStep, streamDownMk, streamDownStep)
+--import Data.PrimitiveArray.Index.Set hiding (streamUpBsMk, streamUpBsStep, streamDownBsMk, StreamDownBsStep, streamUpBsIMk, streamUpBsIStep, streamDownBsIMk, StreamDownBsIStep, streamUpBsIiMk, streamUpBsIiStep, streamDownBsIiMk, StreamDownBsIiStep)
+import Data.PrimitiveArray.Index.BitSet1 hiding (streamUpMk, streamUpStep, streamDownMk, streamDownStep)
+import Data.PrimitiveArray.Index.BitSet0 hiding (streamUpMk, streamUpStep, streamDownMk, streamDownStep)
+import Data.PrimitiveArray.Index.BitSetClasses
+import Data.PrimitiveArray.Index.Subword hiding (streamUpMk, streamUpStep, streamDownMk, streamDownStep)
+import Data.PrimitiveArray.Index.Unit
+
diff --git a/lib/Data/PrimitiveArray/Index/BitSet0.hs b/lib/Data/PrimitiveArray/Index/BitSet0.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/Index/BitSet0.hs
@@ -0,0 +1,139 @@
+
+-- | The most basic bitset structure. Alone, not particularly useful, because
+-- two sets @{u,v},{v',w}@ have no way of annotating the connection between the
+-- sets. Together with boundaries this yields sets for useful DP algorithms.
+
+module Data.PrimitiveArray.Index.BitSet0 where
+
+import           Control.DeepSeq (NFData(..))
+import           Control.Lens (makeLenses)
+import           Data.Aeson (FromJSON,ToJSON,FromJSONKey,ToJSONKey)
+import           Data.Binary (Binary)
+import           Data.Bits
+import           Data.Bits.Extras
+import           Data.Hashable (Hashable)
+import           Data.Serialize (Serialize)
+import           Data.Vector.Unboxed.Deriving
+import           Data.Vector.Unboxed (Unbox(..))
+import           Debug.Trace
+import           GHC.Generics (Generic)
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import           Test.QuickCheck
+
+import           Data.Bits.Ordered
+import           Data.PrimitiveArray.Index.Class
+import           Data.PrimitiveArray.Index.IOC
+import           Data.PrimitiveArray.Index.BitSetClasses
+
+
+
+-- | Newtype for a bitset.
+--
+-- @Int@ integrates better with the rest of the framework. But we should
+-- consider moving to @Word@-based indexing, if possible.
+
+newtype BitSet t = BitSet { _bitSet :: Int }
+  deriving (Eq,Ord,Generic,FiniteBits,Ranked,Num,Bits)
+makeLenses ''BitSet
+
+instance FromJSON     (BitSet t)
+instance FromJSONKey  (BitSet t)
+instance ToJSON       (BitSet t)
+instance ToJSONKey    (BitSet t)
+instance Binary       (BitSet t)
+instance Serialize    (BitSet t)
+instance Hashable     (BitSet t)
+
+derivingUnbox "BitSet"
+  [t| forall t . BitSet t → Int |]
+  [| \(BitSet s) → s            |]
+  [| BitSet                     |]
+
+instance Show (BitSet t) where
+  show (BitSet s) = "<" ++ (show $ activeBitsL s) ++ ">(" ++ show s ++ ")"
+
+instance NFData (BitSet t) where
+  rnf (BitSet s) = rnf s
+  {-# Inline rnf #-}
+
+instance Index (BitSet t) where
+  newtype LimitType (BitSet t) = LtBitSet Int
+  linearIndex _ (BitSet z) = z
+  {-# Inline linearIndex #-}
+  size (LtBitSet pc) = 2 ^ pc -- 2 ^ popCount h - 2 ^ popCount l + 1
+  {-# Inline size #-}
+  inBounds (LtBitSet h) z = popCount z <= h
+  {-# Inline inBounds #-}
+  zeroBound = BitSet 0
+  {-# Inline zeroBound #-}
+  zeroBound' = LtBitSet 0
+  {-# Inline zeroBound' #-}
+  totalSize (LtBitSet n) = [2 ^ fromIntegral n]
+  {-# Inline totalSize #-}
+
+instance SetPredSucc (BitSet t) where
+  setSucc l h s
+    | cs > ch                        = Nothing
+    | Just s' <- popPermutation ch s = Just s'
+    | cs >= ch                       = Nothing
+    | cs < ch                        = Just . BitSet $ 2^(cs+1) -1
+    where ch = popCount h
+          cs = popCount s
+  {-# Inline setSucc #-}
+  setPred l h s
+    | cs < cl                        = Nothing
+    | Just s' <- popPermutation ch s = Just s'
+    | cs <= cl                       = Nothing
+    | cs > cl                        = Just . BitSet $ 2^(cs-1) -1
+    where cl = popCount l
+          ch = popCount h
+          cs = popCount s
+  {-# Inline setPred #-}
+
+instance IndexStream z => IndexStream (z:.BitSet I) where
+  streamUp   (ls:..LtBitSet l) (hs:..LtBitSet h) = SM.flatten (streamUpMk   l h) (streamUpStep   l h) $ streamUp   ls hs
+  streamDown (ls:..LtBitSet l) (hs:..LtBitSet h) = SM.flatten (streamDownMk l h) (streamDownStep l h) $ streamDown ls hs
+  {-# Inline streamUp   #-}
+  {-# Inline streamDown #-}
+
+instance IndexStream z ⇒ IndexStream (z:.BitSet O) where
+  streamUp   (ls:..LtBitSet l) (hs:..LtBitSet h) = SM.flatten (streamDownMk l h) (streamDownStep l h) $ streamUp   ls hs
+  streamDown (ls:..LtBitSet l) (hs:..LtBitSet h) = SM.flatten (streamUpMk   l h) (streamUpStep   l h) $ streamDown ls hs
+  {-# Inline streamUp   #-}
+  {-# Inline streamDown #-}
+
+instance IndexStream z ⇒ IndexStream (z:.BitSet C) where
+  streamUp   (ls:..LtBitSet l) (hs:..LtBitSet h) = SM.flatten (streamUpMk   l h) (streamUpStep   l h) $ streamUp   ls hs
+  streamDown (ls:..LtBitSet l) (hs:..LtBitSet h) = SM.flatten (streamDownMk l h) (streamDownStep l h) $ streamDown ls hs
+  {-# Inline streamUp   #-}
+  {-# Inline streamDown #-}
+
+instance IndexStream (Z:.BitSet t) ⇒ IndexStream (BitSet t) where
+  streamUp l h = SM.map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
+  {-# Inline streamUp #-}
+  streamDown l h = SM.map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
+  {-# Inline streamDown #-}
+
+streamUpMk ∷ Monad m ⇒ Int → Int → t → m (t, Maybe (BitSet ioc))
+streamUpMk l h z = return (z, if l <= h then Just (BitSet $ 2^l-1) else Nothing)
+{-# Inline [0] streamUpMk #-}
+
+streamUpStep ∷ Monad m ⇒ Int → Int → (t, Maybe (BitSet ioc)) → m (SM.Step (t, Maybe (BitSet ioc)) (t:.BitSet ioc))
+streamUpStep l h (z , Nothing) = return $ SM.Done
+streamUpStep l h (z , Just t ) = return $ SM.Yield (z:.t) (z, setSucc (2^l-1) (2^h-1) t)
+{-# Inline [0] streamUpStep #-}
+
+streamDownMk ∷ Monad m ⇒ Int → Int → t → m (t, Maybe (BitSet ioc))
+streamDownMk l h z = return (z, if l <=h then Just (BitSet $ 2^l-1) else Nothing)
+{-# Inline [0] streamDownMk #-}
+
+streamDownStep ∷ Monad m ⇒ Int → Int → (t, Maybe (BitSet ioc)) → m (SM.Step (t, Maybe (BitSet ioc)) (t:.BitSet ioc))
+streamDownStep l h (z , Nothing) = return $ SM.Done
+streamDownStep l h (z , Just t ) = return $ SM.Yield (z:.t) (z , setPred (2^l-1) (2^h-1) t)
+{-# Inline [0] streamDownStep #-}
+
+instance Arbitrary (BitSet t) where
+  arbitrary = BitSet <$> choose (0,2^arbitraryBitSetMax-1)
+  shrink s = let s' = [ s `clearBit` a | a <- activeBitsL s ]
+             in  s' ++ concatMap shrink s'
+
diff --git a/lib/Data/PrimitiveArray/Index/BitSet1.hs b/lib/Data/PrimitiveArray/Index/BitSet1.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/Index/BitSet1.hs
@@ -0,0 +1,168 @@
+
+-- | A bitset with one interface. This includes the often-encountered case
+-- where @{u,v},{v}@, or sets with a single edge between the old set and a new
+-- singleton set are required. Uses are Hamiltonian path problems, and TSP,
+-- among others.
+
+module Data.PrimitiveArray.Index.BitSet1 where
+
+import           Control.DeepSeq (NFData(..))
+import           Control.Lens (makeLenses)
+import           Control.Monad.Except
+import           Data.Aeson (FromJSON,ToJSON,FromJSONKey,ToJSONKey)
+import           Data.Binary (Binary)
+import           Data.Bits
+import           Data.Bits.Extras
+import           Data.Hashable (Hashable)
+import           Data.Serialize (Serialize)
+import           Data.Vector.Unboxed.Deriving
+import           Data.Vector.Unboxed (Unbox(..))
+import           Debug.Trace
+import           GHC.Generics (Generic)
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import           Test.QuickCheck
+
+import           Data.Bits.Ordered
+import           Data.PrimitiveArray.Index.BitSet0 (BitSet(..),LimitType(..))
+import           Data.PrimitiveArray.Index.BitSetClasses
+import           Data.PrimitiveArray.Index.Class
+import           Data.PrimitiveArray.Index.IOC
+
+
+
+-- | The bitset with one interface or boundary.
+
+data BitSet1 i ioc = BitSet1 { _bitset ∷ !(BitSet ioc), _boundary ∷ !(Boundary i ioc) }
+  deriving (Eq,Ord,Generic,Show)
+makeLenses ''BitSet1
+
+derivingUnbox "BitSet1"
+  [t| forall i ioc . BitSet1 i ioc → (Int,Int)           |]
+  [| \ (BitSet1 (BitSet set) (Boundary bnd)) → (set,bnd) |]
+  [| \ (set,bnd) → BitSet1 (BitSet set) (Boundary bnd)   |]
+
+
+-- |
+--
+-- NOTE We linearize a bitset as follows: we need @2^number-of-bits *
+-- number-of-bits@ elements. The first is due to having a binary set structure.
+-- The second is due to pointing to each of those elements as being the
+-- boundary. This overcommits on memory since only those bits can be a boundary
+-- bits that are actually set. Furthermore, in case no bit is set at all, then
+-- there should be no boundary. This is currently rather awkwardly done by
+-- restricting enumeration and mapping the 0-set to boundary 0.
+--
+-- | TODO The size calculations are off by a factor of two, exactly. Each
+-- bitset (say) @00110@ has a mirror image @11001@, whose elements do not have
+-- to be indexed. It has to be investigated if a version with exact memory
+-- bounds is slower in indexing.
+
+instance Index (BitSet1 bnd ioc) where
+  -- This is the number of bits. Meaning that @LtNumBits1 3@ yields @[0,1,2]@.
+  -- TODO Should we rename this to @NumberOfBits1@? Or have a newtype @NumBits@?
+  newtype LimitType (BitSet1 bnd ioc) = LtNumBits1 Int
+  -- Calculate the linear index for a set. Spread out by the possible number of
+  -- bits to fit the actual boundary results. Add the boundary index.
+  linearIndex (LtNumBits1 pc) (BitSet1 set (Boundary bnd))
+    = linearIndex (LtBitSet pc) set * pc + bnd
+  {-# Inline linearIndex #-}
+  size (LtNumBits1 pc) = 2^pc * pc + 1
+  {-# Inline size #-}
+  inBounds (LtNumBits1 pc) (BitSet1 set bnd) = popCount set <= pc && 0 <= bnd && getBoundary bnd <= pc
+  {-# Inline inBounds #-}
+  zeroBound = BitSet1 zeroBound zeroBound
+  {-# Inline zeroBound #-}
+  zeroBound' = LtNumBits1 0
+  {-# Inline zeroBound' #-}
+  totalSize (LtNumBits1 pc) =
+    let z = fromIntegral pc
+    in  [z * 2 ^ z]
+
+deriving instance Show (LimitType (BitSet1 bnd ioc))
+
+instance IndexStream z ⇒ IndexStream (z:.BitSet1 i I) where
+  streamUp   (ls:..LtNumBits1 l) (hs:..LtNumBits1 h) = SM.flatten (streamUpMk   l h) (streamUpStep   l h) $ streamUp   ls hs
+  streamDown (ls:..LtNumBits1 l) (hs:..LtNumBits1 h) = SM.flatten (streamDownMk l h) (streamDownStep l h) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+instance IndexStream z ⇒ IndexStream (z:.BitSet1 i O) where
+  streamUp   (ls:..LtNumBits1 l) (hs:..LtNumBits1 h) = SM.flatten (streamDownMk l h) (streamDownStep l h) $ streamUp   ls hs
+  streamDown (ls:..LtNumBits1 l) (hs:..LtNumBits1 h) = SM.flatten (streamUpMk   l h) (streamUpStep   l h) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+--instance IndexStream z => IndexStream (z:.BS1 i C) where
+--  streamUp   (ls:..l) (hs:..h) = flatten (streamUpBsIMk   l h) (streamUpBsIStep   l h) $ streamUp   ls hs
+--  streamDown (ls:..l) (hs:..h) = flatten (streamDownBsIMk l h) (streamDownBsIStep l h) $ streamDown ls hs
+--  {-# Inline streamUp #-}
+--  {-# Inline streamDown #-}
+
+instance IndexStream (Z:.BitSet1 i t) ⇒ IndexStream (BitSet1 i t) where
+  streamUp l h = SM.map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
+  {-# Inline streamUp #-}
+  streamDown l h = SM.map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
+  {-# Inline streamDown #-}
+
+streamUpMk ∷ Monad m ⇒ Int → Int → z → m (z, Maybe (BitSet1 c ioc))
+streamUpMk l h z =
+  let set = BitSet $ 2^l-1
+      -- lsbZ set == 0, or no active bits in which case we use 0
+      bnd = UndefBoundary
+  in  return (z, if l <= h then Just (BitSet1 set bnd) else Nothing)
+{-# Inline [0] streamUpMk #-}
+
+streamUpStep ∷ Monad m ⇒ Int → Int → (t, Maybe (BitSet1 c ioc)) → m (SM.Step (t, Maybe (BitSet1 c ioc)) (t:.BitSet1 c ioc))
+streamUpStep l h (z, Nothing) = return $ SM.Done
+streamUpStep l h (z, Just t ) = return $ SM.Yield (z:.t) (z , setSucc l h t)
+{-# Inline [0] streamUpStep #-}
+
+streamDownMk ∷ Monad m ⇒ Int → Int → z → m (z, Maybe (BitSet1 c ioc))
+streamDownMk l h z =
+  let set = BitSet $ 2^h-1
+      bnd = Boundary 0 -- this is the actual boundary at zero
+  in  return (z, if l <= h then Just (BitSet1 set bnd) else Nothing)
+{-# Inline [0] streamDownMk #-}
+
+streamDownStep ∷ Monad m ⇒ Int → Int → (t, Maybe (BitSet1 c ioc)) → m (SM.Step (t, Maybe (BitSet1 c ioc)) (t:.BitSet1 c ioc))
+streamDownStep l h (z, Nothing) = return $ SM.Done
+streamDownStep l h (z, Just t ) = return $ SM.Yield (z:.t) (z , setPred l h t)
+{-# Inline [0] streamDownStep #-}
+
+instance SetPredSucc (BitSet1 t ioc) where
+  setSucc pcl pch (BitSet1 s (Boundary is))
+    | cs > pch                         = Nothing
+    | Just is' <- maybeNextActive is s = Just $ BitSet1 s  (Boundary is')
+    | Just s'  <- popPermutation pch s = Just $ BitSet1 s' (Boundary $ lsbZ s')
+    | cs >= pch                        = Nothing
+    | cs < pch                         = let s' = BitSet $ 2^(cs+1)-1
+                                         in  Just (BitSet1 s' (Boundary (lsbZ s')))
+    where cs = popCount s
+  {-# Inline setSucc #-}
+  setPred pcl pch (BitSet1 s (Boundary is))
+    | cs < pcl                          = Nothing
+    | Just is' <- maybeNextActive is s  = Just $ BitSet1 s  (Boundary is')
+    | Just s'  <- popPermutation pch s  = Just $ BitSet1 s' (Boundary $ lsbZ s')
+    | cs <= pcl                         = Nothing
+    | cs > pcl                          = let s' = BitSet $ 2^(cs-1)-1
+                                          in  Just (BitSet1 s' (Boundary (max 0 $ lsbZ s')))
+    where cs = popCount s
+  {-# Inline setPred #-}
+
+instance SetPredSucc (FixedMask (BitSet1 t ioc)) where
+  setSucc pcl pch (FixedMask mask bs1) = undefined
+
+instance Arbitrary (BitSet1 t ioc) where
+  arbitrary = do
+    s <- arbitrary
+    if s==0
+      then return (BitSet1 s 0)
+      else do i <- elements $ activeBitsL s
+              return (BitSet1 s $ Boundary i)
+  shrink (BitSet1 s i) =
+    let s' = [ BitSet1 (s `clearBit` a) i
+             | a <- activeBitsL s
+             , Boundary a /= i ]
+             ++ [ BitSet1 0 0 | popCount s == 1 ]
+    in  s' ++ concatMap shrink s'
+
diff --git a/lib/Data/PrimitiveArray/Index/BitSetClasses.hs b/lib/Data/PrimitiveArray/Index/BitSetClasses.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/Index/BitSetClasses.hs
@@ -0,0 +1,170 @@
+
+-- | A collection of a number of data types and type classes shared by all
+-- bitset variants.
+
+module Data.PrimitiveArray.Index.BitSetClasses where
+
+import           Control.DeepSeq (NFData(..))
+import           Data.Aeson (FromJSON,ToJSON,FromJSONKey,ToJSONKey)
+import           Data.Binary (Binary)
+import           Data.Hashable (Hashable)
+import           Data.Serialize (Serialize)
+import           Data.Vector.Unboxed.Deriving
+import           GHC.Generics (Generic)
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import qualified Data.Vector.Unboxed as VU
+
+import           Data.Bits.Ordered
+import           Data.PrimitiveArray.Index.Class
+import           Data.PrimitiveArray.Index.IOC
+
+
+
+-- * Boundaries, the interface(s) for bitsets.
+
+-- | Certain sets have an interface, a particular element with special
+-- meaning. In this module, certain ``meanings'' are already provided.
+-- These include a @First@ element and a @Last@ element. We phantom-type
+-- these to reduce programming overhead.
+
+newtype Boundary boundaryType ioc = Boundary { getBoundary ∷ Int }
+  deriving (Eq,Ord,Generic,Num)
+
+-- | Whenever we can not set the boundary we should have for a set, we use this
+-- pattern. All legal boundaries are @>=0@. We also need to set the undefined
+-- boundary to @0@, since the @linearIndex@ will use this value to add, which
+-- for empty sets would reduce to @0 - UndefBoundary === 0@.
+
+pattern UndefBoundary ∷ Boundary boundaryType ioc
+pattern UndefBoundary = Boundary 0
+
+instance Show (Boundary i t) where
+  show (Boundary i) = "(I:" ++ show i ++ ")"
+
+derivingUnbox "Boundary"
+  [t| forall i t . Boundary i t → Int |]
+  [| \(Boundary i) → i                |]
+  [| Boundary                         |]
+
+instance Binary    (Boundary i t)
+instance Serialize (Boundary i t)
+instance ToJSON    (Boundary i t)
+instance FromJSON  (Boundary i t)
+instance Hashable  (Boundary i t)
+
+instance NFData (Boundary i t) where
+  rnf (Boundary i) = rnf i
+  {-# Inline rnf #-}
+
+instance Index (Boundary i t) where
+  newtype LimitType (Boundary i t) = LtBoundary Int
+  linearIndex _ (Boundary z) = z
+  {-# INLINE linearIndex #-}
+  size (LtBoundary h) = h + 1
+  {-# INLINE size #-}
+  inBounds (LtBoundary h) z = 0 <= z && getBoundary z <= h
+  {-# INLINE inBounds #-}
+  zeroBound = Boundary 0
+  {-# Inline zeroBound #-}
+  zeroBound' = LtBoundary 0
+  {-# Inline zeroBound' #-}
+  totalSize (LtBoundary n) = [fromIntegral n]
+  {-# Inline totalSize #-}
+
+instance IndexStream z ⇒ IndexStream (z:.Boundary k I) where
+  streamUp   (ls:..LtBoundary l) (hs:..LtBoundary h) = SM.flatten (streamUpBndMk   l h) (streamUpBndStep   l h) $ streamUp   ls hs
+  streamDown (ls:..LtBoundary l) (hs:..LtBoundary h) = SM.flatten (streamDownBndMk l h) (streamDownBndStep l h) $ streamDown ls hs
+  {-# Inline streamUp   #-}
+  {-# Inline streamDown #-}
+
+instance IndexStream (Z:.Boundary k I) ⇒ IndexStream (Boundary k I) where
+  streamUp l h = SM.map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
+  {-# Inline streamUp #-}
+  streamDown l h = SM.map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
+  {-# Inline streamDown #-}
+
+streamUpBndMk l h z = return (z, l)
+{-# Inline [0] streamUpBndMk #-}
+
+streamUpBndStep l h (z , k)
+  | k > h     = return $ SM.Done
+  | otherwise = return $ SM.Yield (z:.Boundary k) (z, k+1)
+{-# Inline [0] streamUpBndStep #-}
+
+streamDownBndMk l h z = return (z, h)
+{-# Inline [0] streamDownBndMk #-}
+
+streamDownBndStep l h (z , k)
+  | k < l     = return $ SM.Done
+  | otherwise = return $ SM.Yield (z:.Boundary k) (z,k-1)
+{-# Inline [0] streamDownBndStep #-}
+
+-- | Declare the interface to be the start of a path.
+
+data First
+
+-- | Declare the interface to be the end of a path.
+
+data Last
+
+-- | Declare the interface to match anything.
+--
+-- TODO needed? want to use later in ADPfusion
+
+data Any
+
+
+
+-- * Moving indices within sets.
+
+-- | Successor and Predecessor for sets. Designed as a class to accomodate
+-- sets with interfaces and without interfaces with one function.
+--
+-- The functions are not written recursively, as we currently only have
+-- three cases, and we do not want to "reset" while generating successors
+-- and predecessors.
+--
+-- Note that sets have a partial order. Within the group of element with
+-- the same @popCount@, we use @popPermutation@ which has the same stepping
+-- order for both, @setSucc@ and @setPred@.
+
+class SetPredSucc s where
+  -- | Set successor. The first argument is the lower set limit, the second
+  -- the upper set limit, the third the current set.
+  setSucc ∷ Int → Int → s → Maybe s
+  -- | Set predecessor. The first argument is the lower set limit, the
+  -- second the upper set limit, the third the current set.
+  setPred ∷ Int → Int → s → Maybe s
+
+-- | Masks are used quite often for different types of bitsets. We liberate
+-- them as a type family.
+
+type family Mask s ∷ *
+
+-- | @Fixed@ allows us to fix some or all bits of a bitset, thereby
+-- providing @succ/pred@ operations which are only partially free.
+--
+-- @f = getFixedMask .&. getFixed@ are the fixed bits.
+-- @n = getFixed .&. complement getFixedMask@ are the free bits.
+-- @to = complement getFixed@ is the to move mask
+-- @n' = popShiftR to n@ yields the population after the move
+-- @p = popPermutation undefined n'@ yields the new population permutation
+-- @p' = popShiftL to p@ yields the population moved back
+-- @final = p' .|. f@
+
+data FixedMask t = FixedMask { getMask ∷ (Mask t) , getFixed ∷ !t }
+
+-- | Assuming a bitset on bits @[0 .. highbit]@, we can apply a mask that
+-- stretches out those bits over @[0 .. higherBit]@ with @highbit <=
+-- higherBit@. Any active interfaces are correctly set as well.
+
+class ApplyMask s where
+  applyMask :: Mask s → s → s
+
+
+
+-- | for 'Test.QuickCheck.Arbitrary'
+
+arbitraryBitSetMax ∷ Int
+arbitraryBitSetMax = 6
+
diff --git a/lib/Data/PrimitiveArray/Index/Class.hs b/lib/Data/PrimitiveArray/Index/Class.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/Index/Class.hs
@@ -0,0 +1,292 @@
+
+module Data.PrimitiveArray.Index.Class where
+
+import           Control.Applicative
+import           Control.DeepSeq (NFData(..))
+import           Control.Lens hiding (Index, (:>))
+import           Control.Monad.Except
+import           Control.Monad (liftM2)
+import           Data.Aeson
+import           Data.Binary
+import           Data.Data
+import           Data.Hashable (Hashable)
+import           Data.Proxy
+import           Data.Serialize
+import           Data.Typeable
+import           Data.Vector.Fusion.Stream.Monadic (Stream)
+import           Data.Vector.Unboxed.Deriving
+import           Data.Vector.Unboxed (Unbox(..))
+import           GHC.Generics
+import           GHC.TypeNats
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import           Test.QuickCheck
+import           Text.Printf
+import           Data.Type.Equality
+
+
+
+infixl 3 :.
+
+-- | Strict pairs -- as in @repa@.
+
+data a :. b = !a :. !b
+  deriving (Eq,Ord,Show,Generic,Data,Typeable)
+
+derivingUnbox "StrictPair"
+  [t| forall a b . (Unbox a, Unbox b) => (a:.b) -> (a,b) |]
+  [| \(a:.b) -> (a, b) |]
+  [| \(a,b)  -> (a:.b) |]
+
+instance (Binary    a, Binary    b) => Binary    (a:.b)
+instance (Serialize a, Serialize b) => Serialize (a:.b)
+instance (ToJSON    a, ToJSON    b) => ToJSON    (a:.b)
+instance (FromJSON  a, FromJSON  b) => FromJSON  (a:.b)
+instance (Hashable  a, Hashable  b) => Hashable  (a:.b)
+
+instance (ToJSON a  , ToJSONKey   a, ToJSON b  , ToJSONKey   b) => ToJSONKey   (a:.b)
+instance (FromJSON a, FromJSONKey a, FromJSON b, FromJSONKey b) => FromJSONKey (a:.b)
+
+deriving instance (Read a, Read b) => Read (a:.b)
+
+instance (NFData a, NFData b) => NFData (a:.b) where
+  rnf (a:.b) = rnf a `seq` rnf b
+  {-# Inline rnf #-}
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (a :. b) where
+  arbitrary     = liftM2 (:.) arbitrary arbitrary
+  shrink (a:.b) = [ (a':.b) | a' <- shrink a ] ++ [ (a:.b') | b' <- shrink b ]
+
+infixr 3 :>
+
+-- | A different version of strict pairs. Makes for simpler type inference in
+-- multi-tape grammars. We use @:>@ when we have special needs, like
+-- non-recursive instances on inductives tuples, as used for set indices.
+--
+-- This one is @infixr@ so that in @a :> b@ we can have the main type in
+-- @a@ and the specializing types in @b@ and then dispatch on @a :> ts@
+-- with @ts@ maybe a chain of @:>@.
+
+data a :> b = !a :> !b
+  deriving (Eq,Ord,Show,Generic,Data,Typeable)
+
+derivingUnbox "StrictIxPair"
+  [t| forall a b . (Unbox a, Unbox b) => (a:>b) -> (a,b) |]
+  [| \(a:>b) -> (a, b) |]
+  [| \(a,b)  -> (a:>b) |]
+
+instance (Binary    a, Binary    b) => Binary    (a:>b)
+instance (Serialize a, Serialize b) => Serialize (a:>b)
+instance (ToJSON    a, ToJSON    b) => ToJSON    (a:>b)
+instance (FromJSON  a, FromJSON  b) => FromJSON  (a:>b)
+instance (Hashable  a, Hashable  b) => Hashable  (a:>b)
+
+deriving instance (Read a, Read b) => Read (a:>b)
+
+instance (NFData a, NFData b) => NFData (a:>b) where
+  rnf (a:>b) = rnf a `seq` rnf b
+  {-# Inline rnf #-}
+
+--instance (Arbitrary a, Arbitrary b) => Arbitrary (a :> b) where
+--  arbitrary = (:>) <$> arbitrary <*> arbitrary
+--  shrink (a:>b) = (:>) <$> shrink a <*> shrink b
+
+
+
+-- | Base data constructor for multi-dimensional indices.
+
+data Z = Z
+  deriving (Eq,Ord,Read,Show,Generic,Data,Typeable)
+
+derivingUnbox "Z"
+  [t| Z -> () |]
+  [| const () |]
+  [| const Z  |]
+
+instance Binary    Z
+instance Serialize Z
+instance ToJSON    Z
+instance FromJSON  Z
+instance Hashable  Z
+
+instance Arbitrary Z where
+  arbitrary = return Z
+
+instance NFData Z where
+  rnf Z = ()
+  {-# Inline rnf #-}
+
+
+
+-- | Index structures for complex, heterogeneous indexing. Mostly designed for
+-- indexing in DP grammars, where the indices work for linear and context-free
+-- grammars on one or more tapes, for strings, sets, later on tree structures.
+
+class Index i where
+  -- | Data structure encoding the upper limit for each array.
+  data LimitType i ∷ *
+  -- | Given a maximal size, and a current index, calculate
+  -- the linear index.
+  linearIndex ∷ LimitType i → i → Int
+  -- | Given the 'LimitType', return the number of cells required for storage.
+  size ∷ LimitType i → Int
+  -- | Check if an index is within the bounds.
+  inBounds ∷ LimitType i → i → Bool
+  -- | A lower bound of @zero@
+  zeroBound ∷ i
+  -- | A lower bound of @zero@ but for a @LimitType i@.
+  zeroBound' ∷ LimitType i
+  -- | The list of cell sizes for each dimension. its product yields the total
+  -- size.
+  totalSize ∷ LimitType i → [Integer]
+
+-- | Given the maximal number of cells (@Word@, because this is the pointer
+-- limit for the machine), and the list of sizes, will check if this is still
+-- legal. Consider dividing the @Word@ by the actual memory requirements for
+-- each cell, to get better exception handling for too large arrays.
+--
+-- One list should be given for each array.
+
+sizeIsValid ∷ Monad m ⇒ Word → [[Integer]] → ExceptT SizeError m CellSize
+sizeIsValid maxCells cells = do
+  let ps = map product cells
+      s  = sum ps
+  when (fromIntegral maxCells <= s) $
+    throwError . SizeError
+               $ printf "PrimitiveArrays would be larger than maximal cell size. The given limit is %d, but the requested size is %d, with size %s for each array. (Debug hint: %s)"
+                  maxCells s (show ps) (show s)
+  return . CellSize $ fromIntegral s
+{-# Inlinable sizeIsValid #-}
+
+-- | In case @totalSize@ or variants thereof produce a size that is too big to
+-- handle.
+
+newtype SizeError = SizeError String
+  deriving (Eq,Ord,Show)
+
+-- | The total number of cells that are allocated.
+
+newtype CellSize = CellSize Word
+  deriving (Eq,Ord,Show,Num,Bounded,Integral,Real,Enum)
+
+
+
+-- | Generate a stream of indices in correct order for dynamic programming.
+-- Since the stream generators require @concatMap@ / @flatten@ we have to
+-- write more specialized code for @(z:.IX)@ stuff.
+
+class (Index i) ⇒ IndexStream i where
+  -- | Generate an index stream using 'LimitType's. This prevents having to
+  -- figure out how the actual limits for complicated index types (like @Set@)
+  -- would look like, since for @Set@, for example, the @LimitType Set == Int@
+  -- provides just the number of bits.
+  --
+  -- This generates an index stream suitable for @forward@ structure filling.
+  -- The first index is the smallest (or the first indices considered are all
+  -- equally small in partially ordered sets). Larger indices follow up until
+  -- the largest one.
+  streamUp ∷ Monad m ⇒ LimitType i → LimitType i → Stream m i
+  -- | If 'streamUp' generates indices from smallest to largest, then
+  -- 'streamDown' generates indices from largest to smallest. Outside grammars
+  -- make implicit use of this. Asking for an axiom in backtracking requests
+  -- the first element from this stream.
+  streamDown ∷ Monad m ⇒ LimitType i → LimitType i → Stream m i
+
+
+
+instance Index Z where
+  data LimitType Z = ZZ
+  linearIndex _ _ = 0
+  {-# INLINE linearIndex #-}
+  size _ = 1
+  {-# INLINE size #-}
+  inBounds _ _ = True
+  {-# INLINE inBounds #-}
+  zeroBound = Z
+  {-# Inline zeroBound #-}
+  zeroBound' = ZZ
+  {-# Inline zeroBound' #-}
+  totalSize ZZ = [1]
+  {-# Inline [1] totalSize #-}
+
+instance IndexStream Z where
+  streamUp ZZ ZZ = SM.singleton Z
+  {-# Inline streamUp #-}
+  streamDown ZZ ZZ = SM.singleton Z
+  {-# Inline streamDown #-}
+
+instance (Index zs, Index z) => Index (zs:.z) where
+  data LimitType (zs:.z) = !(LimitType zs) :.. !(LimitType z)
+  linearIndex (hs:..h) (zs:.z) = linearIndex hs zs * size h + linearIndex h z
+  {-# INLINE linearIndex #-}
+  size (hs:..h) = size hs * size h
+  {-# INLINE size #-}
+  inBounds (hs:..h) (zs:.z) = inBounds hs zs && inBounds h z
+  {-# INLINE inBounds #-}
+  zeroBound = zeroBound :. zeroBound
+  {-# Inline zeroBound #-}
+  zeroBound' = zeroBound' :.. zeroBound'
+  {-# Inline zeroBound' #-}
+  totalSize (hs:..h) =
+    let tshs = totalSize hs
+        tsh  = totalSize h
+    in tshs ++ tsh
+  {-# Inline totalSize #-}
+
+deriving instance Eq       (LimitType Z)
+deriving instance Generic  (LimitType Z)
+deriving instance Read     (LimitType Z)
+deriving instance Show     (LimitType Z)
+deriving instance Data     (LimitType Z)
+deriving instance Typeable (LimitType Z)
+
+deriving instance (Eq (LimitType zs)     , Eq (LimitType z)     ) ⇒ Eq      (LimitType (zs:.z))
+deriving instance (Generic (LimitType zs), Generic (LimitType z)) ⇒ Generic (LimitType (zs:.z))
+deriving instance (Read (LimitType zs)   , Read (LimitType z)   ) ⇒ Read    (LimitType (zs:.z))
+deriving instance (Show (LimitType zs)   , Show (LimitType z)   ) ⇒ Show    (LimitType (zs:.z))
+deriving instance
+  ( Data zs, Data (LimitType zs), Typeable zs
+  , Data z , Data (LimitType z) , Typeable z
+  ) ⇒ Data    (LimitType (zs:.z))
+
+--instance (Index zs, Index z) => Index (zs:>z) where
+--  type LimitType (zs:>z) = LimitType zs:>LimitType z
+--  linearIndex (hs:>h) (zs:>z) = linearIndex hs zs * (size (Proxy ∷ Proxy z) h) + linearIndex h z
+--  {-# INLINE linearIndex #-}
+--  size Proxy (ss:>s) = size (Proxy ∷ Proxy zs) ss * (size (Proxy ∷ Proxy z) s)
+--  {-# INLINE size #-}
+--  inBounds (hs:>h) (zs:>z) = inBounds hs zs && inBounds h z
+--  {-# INLINE inBounds #-}
+
+
+
+-- * Somewhat experimental lens support.
+--
+-- The problem here is that tuples are n-ary, while inductive tuples are
+-- binary, recursive.
+
+instance Field1 (Z:.a) (Z:.a') a a' where
+  {-# Inline _1 #-}
+  _1 = lens (\(Z:.a) → a) (\(Z:._) a → (Z:.a))
+
+instance Field1 (Z:.a:.b) (Z:.a':.b) a a' where
+  {-# Inline _1 #-}
+  _1 = lens (\(Z:.a:.b) → a) (\(Z:._:.b) a → (Z:.a:.b))
+
+instance Field1 (Z:.a:.b:.c) (Z:.a':.b:.c) a a' where
+  {-# Inline _1 #-}
+  _1 = lens (\(Z:.a:.b:.c) → a) (\(Z:._:.b:.c) a → (Z:.a:.b:.c))
+
+
+instance Field2 (Z:.a:.b) (Z:.a:.b') b b' where
+  {-# Inline _2 #-}
+  _2 = lens (\(Z:.a:.b) → b) (\(Z:.a:._) b → (Z:.a:.b))
+
+instance Field2 (Z:.a:.b:.c) (Z:.a:.b':.c) b b' where
+  {-# Inline _2 #-}
+  _2 = lens (\(Z:.a:.b:.c) → b) (\(Z:.a:._:.c) b → (Z:.a:.b:.c))
+
+
+instance Field3 (Z:.a:.b:.c) (Z:.a:.b:.c') c c' where
+  {-# Inline _3 #-}
+  _3 = lens (\(Z:.a:.b:.c) → c) (\(Z:.a:.b:._) c → (Z:.a:.b:.c))
+
diff --git a/lib/Data/PrimitiveArray/Index/IOC.hs b/lib/Data/PrimitiveArray/Index/IOC.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/Index/IOC.hs
@@ -0,0 +1,17 @@
+
+module Data.PrimitiveArray.Index.IOC where
+
+
+
+-- | Phantom type for @Inside@ indices.
+
+data I
+
+-- | Phantom type for @Outside@ indices.
+
+data O
+
+-- | Phantom type for @Complement@ indices.
+
+data C
+
diff --git a/lib/Data/PrimitiveArray/Index/Int.hs b/lib/Data/PrimitiveArray/Index/Int.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/Index/Int.hs
@@ -0,0 +1,50 @@
+
+module Data.PrimitiveArray.Index.Int where
+
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+
+import           Data.PrimitiveArray.Index.Class
+
+
+
+instance Index Int where
+  newtype LimitType Int = LtInt Int
+  linearIndex _ k = k
+  {-# Inline linearIndex #-}
+  size (LtInt h) = h+1
+  {-# Inline size #-}
+  inBounds (LtInt h) k = 0 <= k && k <= h
+  {-# Inline inBounds #-}
+  zeroBound = 0
+  {-# Inline [0] zeroBound #-}
+  zeroBound' = LtInt 0
+  {-# Inline [0] zeroBound' #-}
+  totalSize (LtInt h) = [fromIntegral $ h+1]
+  {-# Inline [0] totalSize #-}
+
+deriving instance Show (LimitType Int)
+
+instance IndexStream z => IndexStream (z:.Int) where
+  streamUp (ls:.. LtInt l) (hs:.. LtInt h) = SM.flatten mk step $ streamUp ls hs
+    where mk z = return (z,l)
+          step (z,k)
+            | k > h     = return $ SM.Done
+            | otherwise = return $ SM.Yield (z:.k) (z,k+1)
+          {-# Inline [0] mk   #-}
+          {-# Inline [0] step #-}
+  {-# Inline streamUp #-}
+  streamDown (ls:..LtInt l) (hs:..LtInt h) = SM.flatten mk step $ streamDown ls hs
+    where mk z = return (z,h)
+          step (z,k)
+            | k < l     = return $ SM.Done
+            | otherwise = return $ SM.Yield (z:.k) (z,k-1)
+          {-# Inline [0] mk   #-}
+          {-# Inline [0] step #-}
+  {-# Inline streamDown #-}
+
+instance IndexStream Int where
+  streamUp l h = SM.map (\(Z:.k) -> k) $ streamUp (ZZ:..l) (ZZ:..h)
+  {-# Inline streamUp #-}
+  streamDown l h = SM.map (\(Z:.k) -> k) $ streamDown (ZZ:..l) (ZZ:..h)
+  {-# Inline streamDown #-}
+
diff --git a/lib/Data/PrimitiveArray/Index/PhantomInt.hs b/lib/Data/PrimitiveArray/Index/PhantomInt.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/Index/PhantomInt.hs
@@ -0,0 +1,108 @@
+
+-- | A linear 0-based int-index with a phantom type.
+
+module Data.PrimitiveArray.Index.PhantomInt where
+
+import Control.DeepSeq (NFData(..))
+import Data.Aeson (FromJSON,FromJSONKey,ToJSON,ToJSONKey)
+import Data.Binary (Binary)
+import Data.Data
+import Data.Hashable (Hashable)
+import Data.Ix(Ix)
+import Data.Serialize (Serialize)
+import Data.Typeable
+import Data.Vector.Fusion.Stream.Monadic (map,Step(..),flatten)
+import Data.Vector.Unboxed.Deriving
+import GHC.Generics (Generic)
+import Prelude hiding (map)
+
+import Data.PrimitiveArray.Index.Class
+import Data.PrimitiveArray.Index.IOC
+
+
+
+-- | A 'PInt' behaves exactly like an @Int@, but has an attached phantom
+-- type @p@. In particular, the @Index@ and @IndexStream@ instances are the
+-- same as for raw @Int@s.
+
+newtype PInt (ioc ∷ k) (p ∷ k) = PInt { getPInt :: Int }
+  deriving (Read,Show,Eq,Ord,Enum,Num,Integral,Real,Generic,Data,Typeable,Ix)
+
+pIntI :: Int -> PInt I p
+pIntI = PInt
+{-# Inline pIntI #-}
+
+pIntO :: Int -> PInt O p
+pIntO = PInt
+{-# Inline pIntO #-}
+
+pIntC :: Int -> PInt C p
+pIntC = PInt
+{-# Inline pIntC #-}
+
+derivingUnbox "PInt"
+  [t| forall t p . PInt t p -> Int |]  [| getPInt |]  [| PInt |]
+
+instance Binary       (PInt t p)
+instance Serialize    (PInt t p)
+instance FromJSON     (PInt t p)
+instance FromJSONKey  (PInt t p)
+instance ToJSON       (PInt t p)
+instance ToJSONKey    (PInt t p)
+instance Hashable     (PInt t p)
+instance NFData       (PInt t p)
+
+instance Index (PInt t p) where
+  newtype LimitType (PInt t p) = LtPInt Int
+  linearIndex _ (PInt k) = k
+  {-# Inline linearIndex #-}
+  size (LtPInt h) = h+1
+  {-# Inline size #-}
+  inBounds (LtPInt h) (PInt k) = 0 <= k && k <= h
+  {-# Inline inBounds #-}
+
+deriving instance Show    (LimitType (PInt t p))
+deriving instance Read    (LimitType (PInt t p))
+deriving instance Eq      (LimitType (PInt t p))
+deriving instance Generic (LimitType (PInt t p))
+
+instance IndexStream z => IndexStream (z:.PInt I p) where
+  streamUp   (ls:..LtPInt l) (hs:..LtPInt h) = flatten (streamUpMk   l h) (streamUpStep   l h) $ streamUp ls hs
+  streamDown (ls:..LtPInt l) (hs:..LtPInt h) = flatten (streamDownMk l h) (streamDownStep l h) $ streamDown ls hs
+  {-# Inline streamUp   #-}
+  {-# Inline streamDown #-}
+
+instance IndexStream z => IndexStream (z:.PInt O p) where
+  streamUp   (ls:..LtPInt l) (hs:..LtPInt h) = flatten (streamDownMk l h) (streamDownStep l h) $ streamUp ls hs
+  streamDown (ls:..LtPInt l) (hs:..LtPInt h) = flatten (streamUpMk   l h) (streamUpStep   l h) $ streamDown ls hs
+  {-# Inline streamUp   #-}
+  {-# Inline streamDown #-}
+
+instance IndexStream z => IndexStream (z:.PInt C p) where
+  streamUp   (ls:..LtPInt l) (hs:..LtPInt h) = flatten (streamUpMk   l h) (streamUpStep   l h) $ streamUp ls hs
+  streamDown (ls:..LtPInt l) (hs:..LtPInt h) = flatten (streamDownMk l h) (streamDownStep l h) $ streamDown ls hs
+  {-# Inline streamUp   #-}
+  {-# Inline streamDown #-}
+
+instance IndexStream (Z:.PInt ioc p) => IndexStream (PInt ioc p) where
+  streamUp l h = map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
+  {-# INLINE streamUp #-}
+  streamDown l h = map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
+  {-# INLINE streamDown #-}
+
+streamUpMk l h z = return (z,l)
+{-# Inline [0] streamUpMk #-}
+
+streamUpStep l h (z,k)
+  | k > h     = return $ Done
+  | otherwise = return $ Yield (z:.PInt k) (z,k+1)
+{-# Inline [0] streamUpStep #-}
+
+streamDownMk l h z = return (z,h)
+{-# Inline [0] streamDownMk #-}
+
+streamDownStep l h (z,k)
+  | k < l     = return $ Done
+  | otherwise = return $ Yield (z:.PInt k) (z,k-1)
+{-# Inline [0] streamDownStep #-}
+
diff --git a/lib/Data/PrimitiveArray/Index/Point.hs b/lib/Data/PrimitiveArray/Index/Point.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/Index/Point.hs
@@ -0,0 +1,229 @@
+
+{-# Language MagicHash #-}
+
+-- | @Point@ index structures are used for left- and right-linear grammars.
+-- Such grammars have at most one syntactic symbol on each r.h.s. of a rule.
+-- The syntactic symbol needs to be in an outermost position.
+
+module Data.PrimitiveArray.Index.Point where
+
+import           Control.Applicative
+import           Control.DeepSeq (NFData(..))
+import           Data.Aeson
+import           Data.Binary
+import           Data.Bits
+import           Data.Bits.Extras (Ranked)
+import           Data.Hashable (Hashable)
+import           Data.Serialize
+import           Data.Vector.Unboxed.Deriving
+import           Data.Vector.Unboxed (Unbox(..))
+import           GHC.Exts
+import           GHC.Generics (Generic)
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import qualified Data.Vector.Unboxed as VU
+import           Test.QuickCheck as TQ
+import           Test.SmallCheck.Series as TS
+
+import           Data.PrimitiveArray.Index.Class
+import           Data.PrimitiveArray.Index.IOC
+
+
+
+-- | A point in a left-linear grammar. The syntactic symbol is in left-most
+-- position.
+
+newtype PointL t = PointL {fromPointL :: Int}
+  deriving (Eq,Ord,Read,Show,Generic)
+
+pointLI :: Int -> PointL I
+pointLI = PointL
+{-# Inline pointLI #-}
+
+pointLO :: Int -> PointL O
+pointLO = PointL
+{-# Inline pointLO #-}
+
+pointLC :: Int -> PointL C
+pointLC = PointL
+{-# Inline pointLC #-}
+
+
+
+derivingUnbox "PointL"
+  [t| forall t . PointL t -> Int    |]
+  [| \ (PointL i) -> i |]
+  [| \ i -> PointL i   |]
+
+instance Binary       (PointL t)
+instance Serialize    (PointL t)
+instance FromJSON     (PointL t)
+instance FromJSONKey  (PointL t)
+instance ToJSON       (PointL t)
+instance ToJSONKey    (PointL t)
+instance Hashable     (PointL t)
+
+instance NFData (PointL t) where
+  rnf (PointL l) = rnf l
+  {-# Inline rnf #-}
+
+instance Index (PointL t) where
+  newtype LimitType (PointL t) = LtPointL Int
+  linearIndex _ (PointL z) = z
+  {-# INLINE linearIndex #-}
+  size (LtPointL h) = h + 1
+  {-# INLINE size #-}
+  inBounds (LtPointL h) (PointL x) = 0<=x && x<=h
+  {-# INLINE inBounds #-}
+  zeroBound = PointL 0
+  {-# Inline [0] zeroBound #-}
+  zeroBound' = LtPointL 0
+  {-# Inline [0] zeroBound' #-}
+  totalSize (LtPointL h) = [fromIntegral $ h + 1]
+  {-# Inline [0] totalSize #-}
+
+deriving instance Eq      (LimitType (PointL t))
+deriving instance Generic (LimitType (PointL t))
+deriving instance Read    (LimitType (PointL t))
+deriving instance Show    (LimitType (PointL t))
+
+instance IndexStream z => IndexStream (z:.PointL I) where
+  streamUp   (ls:..LtPointL lf) (hs:..LtPointL ht) = SM.flatten (streamUpMk   lf) (streamUpStep   PointL ht) $ streamUp ls hs
+  streamDown (ls:..LtPointL lf) (hs:..LtPointL ht) = SM.flatten (streamDownMk ht) (streamDownStep PointL lf) $ streamDown ls hs
+  {-# Inline [0] streamUp #-}
+  {-# Inline [0] streamDown #-}
+
+instance IndexStream z => IndexStream (z:.PointL O) where
+  streamUp   (ls:..LtPointL lf) (hs:..LtPointL ht) = SM.flatten (streamDownMk ht) (streamDownStep PointL lf) $ streamUp   ls hs
+  streamDown (ls:..LtPointL lf) (hs:..LtPointL ht) = SM.flatten (streamUpMk   lf) (streamUpStep   PointL ht) $ streamDown ls hs
+  {-# Inline [0] streamUp #-}
+  {-# Inline [0] streamDown #-}
+
+instance IndexStream z => IndexStream (z:.PointL C) where
+  streamUp   (ls:..LtPointL lf) (hs:..LtPointL ht) = SM.flatten (streamUpMk   lf) (streamUpStep   PointL ht) $ streamUp ls hs
+  streamDown (ls:..LtPointL lf) (hs:..LtPointL ht) = SM.flatten (streamDownMk ht) (streamDownStep PointL lf) $ streamDown ls hs
+  {-# Inline [0] streamUp #-}
+  {-# Inline [0] streamDown #-}
+
+data SP z = SP !z !Int#
+
+streamUpMk (I# lf) z = return $ SP z lf
+{-# Inline [0] streamUpMk #-}
+
+streamUpStep wrapper (I# ht) (SP z k)
+  | 1# <- k ># ht = return $ SM.Done
+  | otherwise     = return $ SM.Yield (z:.wrapper (I# k)) (SP z (k +# 1#))
+{-# Inline [0] streamUpStep #-}
+
+streamDownMk (I# ht) z = return $ SP z ht
+{-# Inline [0] streamDownMk #-}
+
+streamDownStep wrapper (I# lf) (SP z k)
+  | 1# <- k <# lf = return $ SM.Done
+  | otherwise     = return $ SM.Yield (z:.wrapper (I# k)) (SP z (k -# 1#))
+{-# Inline [0] streamDownStep #-}
+
+instance IndexStream (Z:.PointL t) => IndexStream (PointL t) where
+  streamUp l h = SM.map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
+  {-# INLINE streamUp #-}
+  streamDown l h = SM.map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
+  {-# INLINE streamDown #-}
+
+
+instance Arbitrary (PointL t) where
+  arbitrary = do
+    b <- choose (0,100)
+    return $ PointL b
+  shrink (PointL j)
+    | 0<j = [PointL $ j-1]
+    | otherwise = []
+
+instance Monad m => Serial m (PointL t) where
+  series = PointL . TS.getNonNegative <$> series
+
+
+
+-- * @PointR@
+
+-- | A point in a right-linear grammars.
+
+newtype PointR t = PointR {fromPointR :: Int}
+  deriving (Eq,Ord,Read,Show,Generic)
+
+
+
+derivingUnbox "PointR"
+  [t| forall t . PointR t -> Int    |]
+  [| \ (PointR i) -> i |]
+  [| \ i -> PointR i   |]
+
+instance Binary       (PointR t)
+instance Serialize    (PointR t)
+instance FromJSON     (PointR t)
+instance FromJSONKey  (PointR t)
+instance ToJSON       (PointR t)
+instance ToJSONKey    (PointR t)
+instance Hashable     (PointR t)
+
+instance NFData (PointR t) where
+  rnf (PointR l) = rnf l
+  {-# Inline rnf #-}
+
+instance Index (PointR t) where
+  newtype LimitType (PointR t) = LtPointR Int
+  linearIndex _ (PointR z) = z
+  {-# INLINE linearIndex #-}
+  size (LtPointR h) = h + 1
+  {-# INLINE size #-}
+  inBounds (LtPointR h) (PointR x) = 0<=x && x<=h
+  {-# INLINE inBounds #-}
+  zeroBound = PointR 0
+  {-# Inline [0] zeroBound #-}
+  zeroBound' = LtPointR 0
+  {-# Inline [0] zeroBound' #-}
+  totalSize (LtPointR h) = [fromIntegral $ h + 1]
+  {-# Inline [0] totalSize #-}
+
+deriving instance Eq      (LimitType (PointR t))
+deriving instance Generic (LimitType (PointR t))
+deriving instance Read    (LimitType (PointR t))
+deriving instance Show    (LimitType (PointR t))
+
+instance IndexStream z => IndexStream (z:.PointR I) where
+  streamUp   (ls:..LtPointR lf) (hs:..LtPointR ht) = SM.flatten (streamDownMk ht) (streamDownStep PointR lf) $ streamUp ls hs
+  streamDown (ls:..LtPointR lf) (hs:..LtPointR ht) = SM.flatten (streamUpMk   lf) (streamUpStep   PointR ht) $ streamDown ls hs
+  {-# Inline [0] streamUp #-}
+  {-# Inline [0] streamDown #-}
+
+instance IndexStream z => IndexStream (z:.PointR O) where
+  streamUp   (ls:..LtPointR lf) (hs:..LtPointR ht) = SM.flatten (streamUpMk   lf) (streamUpStep   PointR ht) $ streamUp   ls hs
+  streamDown (ls:..LtPointR lf) (hs:..LtPointR ht) = SM.flatten (streamDownMk ht) (streamDownStep PointR lf) $ streamDown ls hs
+  {-# Inline [0] streamUp #-}
+  {-# Inline [0] streamDown #-}
+
+--instance IndexStream z => IndexStream (z:.PointR C) where
+--  streamUp   (ls:..LtPointR lf) (hs:..LtPointR ht) = SM.flatten (streamUpMkR   lf) (streamUpStepR   ht) $ streamUp ls hs
+--  streamDown (ls:..LtPointR lf) (hs:..LtPointR ht) = SM.flatten (streamDownMkR ht) (streamDownStepR lf) $ streamDown ls hs
+--  {-# Inline [0] streamUp #-}
+--  {-# Inline [0] streamDown #-}
+
+instance IndexStream (Z:.PointR t) => IndexStream (PointR t) where
+  streamUp l h = SM.map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
+  {-# INLINE streamUp #-}
+  streamDown l h = SM.map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
+  {-# INLINE streamDown #-}
+
+-- arbitrarily set maximum here to
+
+arbMaxPointR = 100
+
+instance Arbitrary (PointR t) where
+  arbitrary = do
+    b <- choose (0,arbMaxPointR)
+    return $ PointR b
+  shrink (PointR j)
+    | j<arbMaxPointR = [PointR $ j+1]
+    | otherwise = []
+
+--instance Monad m => Serial m (PointR t) where
+--  series = PointR . TS.getNonNegative <$> series
+
diff --git a/lib/Data/PrimitiveArray/Index/Subword.hs b/lib/Data/PrimitiveArray/Index/Subword.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/Index/Subword.hs
@@ -0,0 +1,178 @@
+
+-- | Index structure for context-free grammars on strings. A @Subword@ captures
+-- a pair @(i,j)@ with @i<=j@.
+
+module Data.PrimitiveArray.Index.Subword where
+
+import Control.Applicative ((<$>))
+import Control.DeepSeq (NFData(..))
+import Control.Monad (filterM, guard)
+import Data.Aeson (FromJSON,FromJSONKey,ToJSON,ToJSONKey)
+import Data.Binary (Binary)
+import Data.Hashable (Hashable)
+import Data.Serialize (Serialize)
+import Data.Vector.Fusion.Stream.Monadic (Step(..), map,flatten)
+import Data.Vector.Unboxed.Deriving
+import GHC.Generics (Generic)
+import Prelude hiding (map)
+import Test.QuickCheck (Arbitrary(..), choose)
+import Test.SmallCheck.Series as TS
+
+import Math.TriangularNumbers
+
+import Data.PrimitiveArray.Index.Class
+import Data.PrimitiveArray.Index.IOC
+
+
+
+-- | A subword wraps a pair of @Int@ indices @i,j@ with @i<=j@.
+--
+-- Subwords always yield the upper-triangular part of a rect-angular array.
+-- This gives the quite curious effect that @(0,N)@ points to the
+-- ``largest'' index, while @(0,0) ... (1,1) ... (k,k) ... (N,N)@ point to
+-- the smallest. We do, however, use (0,0) as the smallest as (0,k) gives
+-- successively smaller upper triangular parts.
+
+newtype Subword t = Subword {fromSubword :: (Int:.Int)}
+  deriving (Eq,Ord,Show,Generic,Read)
+
+fromSubwordFst :: Subword t -> Int
+fromSubwordFst (Subword (i:._)) = i
+{-# Inline fromSubwordFst #-}
+
+fromSubwordSnd :: Subword t -> Int
+fromSubwordSnd (Subword (_:.j)) = j
+{-# Inline fromSubwordSnd #-}
+
+derivingUnbox "Subword"
+  [t| forall t . Subword t -> (Int,Int) |]
+  [| \ (Subword (i:.j)) -> (i,j) |]
+  [| \ (i,j) -> Subword (i:.j) |]
+
+instance Binary       (Subword t)
+instance Serialize    (Subword t)
+instance FromJSON     (Subword t)
+instance FromJSONKey  (Subword t)
+instance ToJSON       (Subword t)
+instance ToJSONKey    (Subword t)
+instance Hashable     (Subword t)
+
+instance NFData (Subword t) where
+  rnf (Subword (i:.j)) = i `seq` rnf j
+  {-# Inline rnf #-}
+
+-- | Create a @Subword t@ where @t@ is inferred.
+
+subword :: Int -> Int -> Subword t
+subword i j = Subword (i:.j)
+{-# INLINE subword #-}
+
+subwordI :: Int -> Int -> Subword I
+subwordI i j = Subword (i:.j)
+{-# INLINE subwordI #-}
+
+subwordO :: Int -> Int -> Subword O
+subwordO i j = Subword (i:.j)
+{-# INLINE subwordO #-}
+
+subwordC :: Int -> Int -> Subword C
+subwordC i j = Subword (i:.j)
+{-# INLINE subwordC #-}
+
+
+
+instance Index (Subword t) where
+  newtype LimitType (Subword t) = LtSubword Int
+  linearIndex (LtSubword n) (Subword (i:.j)) = toLinear n (i,j)
+  {-# Inline linearIndex #-}
+  size (LtSubword n) = linearizeUppertri (0,n)
+  {-# Inline size #-}
+  inBounds (LtSubword h) (Subword (i:.j)) = 0<=i && i<=j && j<=h
+  {-# Inline inBounds #-}
+  zeroBound = subword 0 0
+  {-# Inline zeroBound #-}
+  zeroBound' = LtSubword 0
+  {-# Inline zeroBound' #-}
+  totalSize (LtSubword n) = [fromIntegral (n+1) ^ 2 `div` 2]
+  {-# Inline totalSize #-}
+
+deriving instance Eq      (LimitType (Subword t))
+deriving instance Generic (LimitType (Subword t))
+deriving instance Read    (LimitType (Subword t))
+deriving instance Show    (LimitType (Subword t))
+
+-- | @Subword I@ (inside)
+
+instance IndexStream z => IndexStream (z:.Subword I) where
+  streamUp   (ls:..LtSubword l) (hs:..LtSubword h) = flatten (streamUpMk     h) (streamUpStep   l h) $ streamUp   ls hs
+  streamDown (ls:..LtSubword l) (hs:..LtSubword h) = flatten (streamDownMk l h) (streamDownStep   h) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+-- | @Subword O@ (outside).
+--
+-- Note: @streamUp@ really needs to use @streamDownMk@ / @streamDownStep@
+-- for the right order of indices!
+
+instance IndexStream z => IndexStream (z:.Subword O) where
+  streamUp   (ls:..LtSubword l) (hs:..LtSubword h) = flatten (streamDownMk l h) (streamDownStep   h) $ streamUp   ls hs
+  streamDown (ls:..LtSubword l) (hs:..LtSubword h) = flatten (streamUpMk     h) (streamUpStep   l h) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+-- | @Subword C@ (complement)
+
+instance IndexStream z => IndexStream (z:.Subword C) where
+  streamUp   (ls:..LtSubword l) (hs:..LtSubword h) = flatten (streamUpMk     h) (streamUpStep   l h) $ streamUp   ls hs
+  streamDown (ls:..LtSubword l) (hs:..LtSubword h) = flatten (streamDownMk l h) (streamDownStep   h) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+-- | generic @mk@ for @streamUp@ / @streamDown@
+
+streamUpMk h z = return (z,h,h)
+{-# Inline [0] streamUpMk #-}
+
+streamUpStep l h (z,i,j)
+  | i < l     = return $ Done
+  | j > h     = return $ Skip (z,i-1,i-1)
+  | otherwise = return $ Yield (z:.subword i j) (z,i,j+1)
+{-# Inline [0] streamUpStep #-}
+
+streamDownMk l h z = return (z,l,h)
+{-# Inline [0] streamDownMk #-}
+
+streamDownStep h (z,i,j)
+  | i > h     = return $ Done
+  | j < i     = return $ Skip (z,i+1,h)
+  | otherwise = return $ Yield (z:.subword i j) (z,i,j-1)
+{-# Inline [0] streamDownStep #-}
+
+instance (IndexStream (Z:.Subword t)) => IndexStream (Subword t) where
+  streamUp l h = map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
+  {-# INLINE streamUp #-}
+  streamDown l h = map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
+  {-# INLINE streamDown #-}
+
+instance Arbitrary (Subword t) where
+  arbitrary = do
+    a <- choose (0,20)
+    b <- choose (0,20)
+    return $ Subword (min a b :. max a b)
+  shrink (Subword (i:.j))
+    | i<j       = [Subword (i:.j-1), Subword (i+1:.j)]
+    | otherwise = []
+
+instance Monad m => Serial m (Subword t) where
+  series = do
+    i <- TS.getNonNegative <$> series
+    j <- TS.getNonNegative <$> series
+    guard $ i<=j
+    return $ subword i j
+    {-
+    let nns :: Series m Int = TS.getNonNegative <$> series
+    ps <- nns >< nns
+    let qs = [ subword i j | (i,j) <- ps, i<=j ]
+    return qs
+    -}
+
diff --git a/lib/Data/PrimitiveArray/Index/Unit.hs b/lib/Data/PrimitiveArray/Index/Unit.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/Index/Unit.hs
@@ -0,0 +1,78 @@
+
+-- | Unit indices admit a single element to be memoized. We can't use @()@
+-- because we want to attach phantom types.
+
+module Data.PrimitiveArray.Index.Unit where
+
+import Control.Applicative (pure)
+import Control.DeepSeq (NFData(..))
+import Data.Aeson (FromJSON,FromJSONKey,ToJSON,ToJSONKey)
+import Data.Binary (Binary)
+import Data.Hashable (Hashable)
+import Data.Serialize (Serialize)
+import Data.Vector.Fusion.Stream.Monadic (Step(..), map)
+import Data.Vector.Unboxed.Deriving
+import GHC.Generics (Generic)
+import Prelude hiding (map)
+import Test.QuickCheck (Arbitrary(..), choose)
+
+import Data.PrimitiveArray.Index.Class
+
+
+
+data Unit t = Unit
+  deriving (Eq,Ord,Show,Generic,Read)
+
+derivingUnbox "Unit"
+  [t| forall t . Unit t -> () |]
+  [| \ Unit -> ()   |]
+  [| \ ()   -> Unit |]
+
+instance Binary       (Unit t)
+instance Serialize    (Unit t)
+instance FromJSON     (Unit t)
+instance FromJSONKey  (Unit t)
+instance ToJSON       (Unit t)
+instance ToJSONKey    (Unit t)
+instance Hashable     (Unit t)
+
+instance NFData (Unit t) where
+  rnf Unit = ()
+  {-# Inline rnf #-}
+
+instance Index (Unit t) where
+  data LimitType (Unit t) = LtUnit
+  linearIndex _ _ = 0
+  {-# Inline linearIndex #-}
+  size _ = 1
+  {-# Inline size #-}
+  inBounds _ _ = True
+  {-# Inline inBounds #-}
+  zeroBound = Unit
+  {-# Inline zeroBound #-}
+  zeroBound' = LtUnit
+  {-# Inline zeroBound' #-}
+  totalSize LtUnit = return 1
+  {-# Inline [0] totalSize #-}
+
+deriving instance Eq      (LimitType (Unit t))
+deriving instance Generic (LimitType (Unit t))
+deriving instance Read    (LimitType (Unit t))
+deriving instance Show    (LimitType (Unit t))
+
+instance IndexStream z => IndexStream (z:.Unit t) where
+  streamUp (ls:..LtUnit) (hs:..LtUnit) = map (\z -> z:.Unit) $ streamUp ls hs
+  {-# Inline streamUp #-}
+  streamDown (ls:..LtUnit) (hs:..LtUnit) = map (\z -> z:.Unit) $ streamDown ls hs
+  {-# Inline streamDown #-}
+
+instance (IndexStream (Z:.Unit t)) => IndexStream (Unit t) where
+  streamUp l h = map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
+  {-# INLINE streamUp #-}
+  streamDown l h = map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
+  {-# INLINE streamDown #-}
+
+instance Arbitrary (Unit t) where
+  arbitrary = pure Unit
+  shrink Unit = []
+
diff --git a/lib/Data/PrimitiveArray/ScoreMatrix.hs b/lib/Data/PrimitiveArray/ScoreMatrix.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/PrimitiveArray/ScoreMatrix.hs
@@ -0,0 +1,123 @@
+
+-- | Simple score and distance matrices. These are two-dimensional tables
+-- together with row and column vectors of names.
+
+module Data.PrimitiveArray.ScoreMatrix where
+
+import           Control.Monad (when,unless)
+import           Data.Text (Text)
+import           Data.Vector.Unboxed (Unbox)
+import           Numeric.Log
+import qualified Data.Text as T
+import qualified Data.Vector as V
+import           System.Exit (exitFailure)
+
+import           Data.PrimitiveArray hiding (map)
+import qualified Data.PrimitiveArray as PA
+
+
+
+-- | NxN sized score matrices
+--
+-- TODO needs a vector with the column names!
+
+data ScoreMatrix t = ScoreMatrix
+  { scoreMatrix :: !(Unboxed (Z:.Int:.Int) t)
+  , scoreNodes  :: !(Unboxed Int t)
+  , rowNames    :: !(V.Vector Text)
+  , colNames    :: !(V.Vector Text)
+  } deriving (Show)
+
+-- | Get the distance between edges @(From,To)@.
+
+(.!.) :: Unbox t => ScoreMatrix t -> (Int,Int) -> t
+ScoreMatrix mat _ _ _ .!. (f,t) = mat ! (Z:.f:.t)
+{-# Inline (.!.) #-}
+
+-- | If the initial node has a "distance", it'll be here
+
+nodeDist :: Unbox t => ScoreMatrix t -> Int -> t
+nodeDist ScoreMatrix{..} k = scoreNodes ! k
+
+-- | Get the name of the node at an row index
+
+rowNameOf :: ScoreMatrix t -> Int -> Text
+rowNameOf ScoreMatrix{..} k = rowNames V.! k
+{-# Inline rowNameOf #-}
+
+-- | Get the name of the node at an column index
+
+colNameOf :: ScoreMatrix t -> Int -> Text
+colNameOf ScoreMatrix{..} k = colNames V.! k
+{-# Inline colNameOf #-}
+
+-- | Number of rows in a score matrix.
+
+numRows :: Unbox t => ScoreMatrix t -> Int
+numRows ScoreMatrix{..} = let (_:..LtInt n':.._) = upperBound scoreMatrix in n' + 1
+{-# Inline numRows #-}
+
+-- | Number of columns in a score matrix.
+
+numCols :: Unbox t => ScoreMatrix t -> Int
+numCols ScoreMatrix{..} = let (_:.._:..LtInt n') = upperBound scoreMatrix in n' + 1
+{-# Inline numCols #-}
+
+listOfRowNames :: ScoreMatrix t -> [Text]
+listOfRowNames ScoreMatrix{..} = V.toList rowNames
+
+listOfColNames :: ScoreMatrix t -> [Text]
+listOfColNames ScoreMatrix{..} = V.toList colNames
+
+-- | Turns a @ScoreMatrix@ for distances into one scaled by "temperature" for
+-- Inside/Outside calculations. Each value is scaled by
+-- @\k -> exp $ negate k / r * t@ where
+-- r = (n-1) * d
+-- d = mean of genetic distance
+--
+-- Node scores are turned directly into probabilities.
+--
+-- TODO Again, there is overlap and we should really have @newtype
+-- Distance@ and friends.
+--
+-- TODO @newtype Temperature = Temperature Double@
+--
+-- TODO fix for rows /= cols!!!
+
+toPartMatrix
+  :: Double
+  -- ^ temperature
+  -> ScoreMatrix Double
+  -> ScoreMatrix (Log Double)
+toPartMatrix t scoreMat@(ScoreMatrix mat sn rns cns) = ScoreMatrix p psn rns cns
+  where p = PA.map (\k -> Exp {- . log . exp -} $ negate k / (r * t)) mat
+        psn = PA.map (\k -> Exp $ negate k) sn
+        n = numRows scoreMat
+        d = Prelude.sum [ mat ! (Z:.i:.j) | i <- [0..n-1], j <- [i+1..n-1] ] / fromIntegral (n*(n-1))
+        r = fromIntegral (n-1) * d
+
+-- | Import data.
+--
+-- TODO Should be generalized because @Lib-BiobaseBlast@ does almost the
+-- same thing.
+
+fromFile :: FilePath -> IO (ScoreMatrix Double)
+fromFile fp = do
+  ls <- lines <$> readFile fp
+  when (null ls) $ do
+    putStrLn $ fp ++ " is empty"
+    exitFailure
+  let mat' = map (map read . tail . words) $ tail ls
+  let n = length mat'
+  unless (all ((==n) . length) mat') $ do
+    putStrLn $ fp ++ " is not a NxN matrix"
+    print mat'
+    exitFailure
+  let scoreMatrix = PA.fromAssocs (ZZ:..LtInt (n-1):..LtInt (n-1)) 0
+          $ concatMap (\(r,es) -> [ ((Z:.r:.c),e) | (c,e) <- zip [0..] es ])
+          $ zip [0..] mat' -- rows
+  let scoreNodes = PA.fromAssocs (LtInt $ n-1) 0 []
+  let rowNames = V.fromList . map T.pack . drop 1 . words $ head ls
+  let colNames = V.fromList . map (T.pack . head . words) $ tail ls
+  return $ ScoreMatrix{..} -- mat rowNames colNames (V.fromList $ replicate n 0)
+