PrimitiveArray 0.6.1.0 → 0.7.0.0

raw patch · 20 files changed

+679/−354 lines, 20 filesdep +hashabledep ~OrderedBitsdep ~aesondep ~vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable

Dependency ranges changed: OrderedBits, aeson, vector

API changes (from Hackage documentation)

Files

• Data/PrimitiveArray.hs +2/−0
• Data/PrimitiveArray/Class.hs +4/−3
• Data/PrimitiveArray/Dense.hs +7/−1
• Data/PrimitiveArray/FillTables.hs +2/−2
• Data/PrimitiveArray/Index.hs +8/−8
• Data/PrimitiveArray/Index/Class.hs +9/−1
• Data/PrimitiveArray/Index/Complement.hs +0/−60
• Data/PrimitiveArray/Index/IOC.hs +17/−0
• Data/PrimitiveArray/Index/Int.hs +4/−4
• Data/PrimitiveArray/Index/Outside.hs +0/−62
• Data/PrimitiveArray/Index/PhantomInt.hs +68/−13
• Data/PrimitiveArray/Index/Point.hs +76/−20
• Data/PrimitiveArray/Index/Set.hs +272/−147
• Data/PrimitiveArray/Index/Subword.hs +89/−21
• Data/PrimitiveArray/Index/Unit.hs +62/−0
• Data/PrimitiveArray/QuickCheck/Index/Set.hs +2/−1
• Data/PrimitiveArray/Vector/Compat.hs +25/−0
• PrimitiveArray.cabal +18/−10
• README.md +1/−1
• changelog.md +13/−0

@@ -4,10 +4,12 @@   , module Data.PrimitiveArray.Dense   , module Data.PrimitiveArray.FillTables   , module Data.PrimitiveArray.Index+  , module Data.PrimitiveArray.Vector.Compat   ) where  import Data.PrimitiveArray.Class import Data.PrimitiveArray.Dense import Data.PrimitiveArray.FillTables import Data.PrimitiveArray.Index+import Data.PrimitiveArray.Vector.Compat 

@@ -14,7 +14,8 @@ import           Control.Monad.Primitive (PrimMonad) import           Control.Monad.ST (runST) import           Prelude as P-import qualified Data.Vector.Fusion.Stream as S+import qualified Data.Vector.Fusion.Stream.Monadic as SM+import           Data.Vector.Fusion.Util  import Data.PrimitiveArray.Index @@ -136,7 +137,7 @@ -- | Return all associations from an array.  assocs :: (IndexStream sh, PrimArrayOps arr sh elm) => arr sh elm -> [(sh,elm)]-assocs arr = P.map (\k -> (k,unsafeIndex arr k)) . S.toList $ streamUp lb ub where+assocs arr = P.map (\k -> (k,unsafeIndex arr k)) . unId . SM.toList $ streamUp lb ub where   (lb,ub) = bounds arr {-# INLINE assocs #-} @@ -163,7 +164,7 @@ -- | Returns all elements of an immutable array as a list.  toList :: (IndexStream sh, PrimArrayOps arr sh elm) => arr sh elm -> [elm]-toList arr = let (lb,ub) = bounds arr in P.map ((!) arr) . S.toList $ streamUp lb ub+toList arr = let (lb,ub) = bounds arr in P.map ((!) arr) . unId . SM.toList $ streamUp lb ub {-# INLINE toList #-}  

@@ -10,6 +10,9 @@ -- 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 @@ -28,6 +31,7 @@ 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.Hashable (Hashable)   import           Data.PrimitiveArray.Class@@ -44,6 +48,7 @@ instance (Serialize sh, Serialize e, Unbox e) => Serialize (Unboxed sh e) instance (ToJSON    sh, ToJSON    e, Unbox e) => ToJSON    (Unboxed sh e) instance (FromJSON  sh, FromJSON  e, Unbox e) => FromJSON  (Unboxed sh e)+instance (Hashable  sh, Hashable  e, Hashable (VU.Vector e), Unbox e) => Hashable  (Unboxed sh e)  instance (NFData sh) => NFData (Unboxed sh e) where   rnf (Unboxed l h xs) = rnf l `seq` rnf h `seq` rnf xs@@ -104,6 +109,7 @@ instance (Serialize sh, Serialize e)  => Serialize (Boxed sh e) instance (ToJSON    sh, ToJSON    e)  => ToJSON    (Boxed sh e) instance (FromJSON  sh, FromJSON  e)  => FromJSON  (Boxed sh e)+instance (Hashable  sh, Hashable  e, Hashable (V.Vector e)) => Hashable  (Boxed sh e)  instance (NFData sh, NFData e) => NFData (Boxed sh e) where   rnf (Boxed l h xs) = rnf l `seq` rnf h `seq` rnf xs@@ -138,7 +144,7 @@   {-# INLINE readM #-}   {-# INLINE writeM #-} -instance (Index sh, Unbox elm) => PrimArrayOps Boxed sh elm where+instance (Index sh) => PrimArrayOps Boxed sh elm where   bounds (Boxed l h _) = (l,h)   unsafeFreeze (MBoxed l h mba) = Boxed l h `liftM` G.unsafeFreeze mba   unsafeThaw   (Boxed l h ba) = MBoxed l h `liftM` G.unsafeThaw ba

@@ -8,9 +8,9 @@  import Control.Monad.Primitive import Control.Monad (when)-import Data.Vector.Fusion.Stream as S+--import Data.Vector.Fusion.Stream as S import Data.Vector.Fusion.Stream.Monadic as M-import Data.Vector.Fusion.Stream.Size+--import Data.Vector.Fusion.Stream.Size  import Data.PrimitiveArray.Class import Data.PrimitiveArray.Index

@@ -1,21 +1,21 @@  module Data.PrimitiveArray.Index   ( module Data.PrimitiveArray.Index.Class-  , module Data.PrimitiveArray.Index.Complement   , module Data.PrimitiveArray.Index.Int-  , module Data.PrimitiveArray.Index.Outside+  , 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.Complement import Data.PrimitiveArray.Index.Int-import Data.PrimitiveArray.Index.Outside-import Data.PrimitiveArray.Index.PhantomInt-import Data.PrimitiveArray.Index.Point-import Data.PrimitiveArray.Index.Set-import Data.PrimitiveArray.Index.Subword+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.Subword hiding (streamUpMk, streamUpStep, streamDownMk, streamDownStep)+import Data.PrimitiveArray.Index.Unit 

@@ -6,6 +6,7 @@ import           Control.Monad (liftM2) import           Data.Aeson import           Data.Binary+import           Data.Hashable (Hashable) import           Data.Serialize import           Data.Vector.Fusion.Stream.Monadic (Stream) import           Data.Vector.Unboxed.Deriving@@ -32,6 +33,7 @@ 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) @@ -45,11 +47,15 @@   -infixl 3 :>+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)@@ -63,6 +69,7 @@ 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) @@ -90,6 +97,7 @@ instance Serialize Z instance ToJSON    Z instance FromJSON  Z+instance Hashable  Z  instance Arbitrary Z where   arbitrary = return Z

@@ -1,60 +0,0 @@--module Data.PrimitiveArray.Index.Complement where--import Control.Applicative-import Control.DeepSeq (NFData(..))-import Data.Aeson-import Data.Binary-import Data.Serialize-import Data.Vector.Unboxed.Deriving-import Data.Vector.Unboxed (Unbox(..))-import GHC.Generics-import Test.QuickCheck--import Data.PrimitiveArray.Index.Class------ | A special index wrapper -- like @Outside@. @Complement@ allows combining--- inside and outside symbols which complement each other. This then yields--- ensemble results for each index (you need @ADPfusion@ for this).--newtype Complement z = C { unC :: z }-  deriving (Eq,Ord,Read,Show,Generic)--derivingUnbox "Complement"-  [t| forall z . Unbox z => Complement z -> z |]-  [| unC |]-  [| C   |]--instance Binary    z => Binary    (Complement z)-instance Serialize z => Serialize (Complement z)-instance ToJSON    z => ToJSON    (Complement z)-instance FromJSON  z => FromJSON  (Complement z)--instance NFData z => NFData (Complement z) where-  rnf (C z) = rnf z-  {-# Inline rnf #-}--instance Index i => Index (Complement i) where-  linearIndex (C l) (C h) (C i) = linearIndex l h i-  {-# INLINE linearIndex #-}-  smallestLinearIndex (C i) = smallestLinearIndex i-  {-# INLINE smallestLinearIndex #-}-  largestLinearIndex (C i) = largestLinearIndex i-  {-# INLINE largestLinearIndex #-}-  size (C l) (C h) = size l h-  {-# INLINE size #-}-  inBounds (C l) (C h) (C z) = inBounds l h z-  {-# INLINE inBounds #-}--instance IndexStream i => IndexStream (Complement i) where-  streamUp   (C l) (C h) = fmap C $ streamUp l h-  {-# INLINE streamUp #-}-  streamDown (C l) (C h) = fmap C $ streamDown l h-  {-# INLINE streamDown #-}--instance Arbitrary z => Arbitrary (Complement z) where-  arbitrary    = C <$> arbitrary-  shrink (C z) = C <$> shrink z-

@@ -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+

@@ -1,11 +1,11 @@  module Data.PrimitiveArray.Index.Int where -import Data.Vector.Fusion.Stream.Monadic (flatten,map,Step(..))-import Data.Vector.Fusion.Stream.Size+import Data.Vector.Fusion.Stream.Monadic (map,Step(..)) import Prelude hiding (map)  import Data.PrimitiveArray.Index.Class+import Data.PrimitiveArray.Vector.Compat   @@ -22,7 +22,7 @@   {-# Inline inBounds #-}  instance IndexStream z => IndexStream (z:.Int) where-  streamUp (ls:.l) (hs:.h) = flatten mk step Unknown $ streamUp ls hs+  streamUp (ls:.l) (hs:.h) = flatten mk step $ streamUp ls hs     where mk z = return (z,l)           step (z,k)             | k > h     = return $ Done@@ -30,7 +30,7 @@           {-# Inline [0] mk   #-}           {-# Inline [0] step #-}   {-# Inline streamUp #-}-  streamDown (ls:.l) (hs:.h) = flatten mk step Unknown $ streamDown ls hs+  streamDown (ls:.l) (hs:.h) = flatten mk step $ streamDown ls hs     where mk z = return (z,h)           step (z,k)             | k < l     = return $ Done

@@ -1,62 +0,0 @@--module Data.PrimitiveArray.Index.Outside where--import Control.Applicative-import Control.DeepSeq (NFData(..))-import Data.Aeson-import Data.Binary-import Data.Serialize-import Data.Vector.Unboxed.Deriving-import Data.Vector.Unboxed (Unbox(..))-import GHC.Generics-import Test.QuickCheck--import Data.PrimitiveArray.Index.Class------ | The 'Outside' wrapper takes an index structure, and provides--- 'IndexStream' functions 'streamUp' and 'streamDown' that work the other--- way around. In particular, for @Outside z@ @streamUp (Outside z) = fmap--- Outside $ streamDown z@ and vice versa. @Index@ functions are unwrapped--- but otherwise work as before.--newtype Outside z = O { unO :: z }-  deriving (Eq,Ord,Read,Show,Generic)--derivingUnbox "Outside"-  [t| forall z . Unbox z => Outside z -> z |]-  [| unO |]-  [| O   |]--instance Binary    z => Binary    (Outside z)-instance Serialize z => Serialize (Outside z)-instance ToJSON    z => ToJSON    (Outside z)-instance FromJSON  z => FromJSON  (Outside z)--instance NFData z => NFData (Outside z) where-  rnf (O z) = rnf z-  {-# Inline rnf #-}--instance Index i => Index (Outside i) where-  linearIndex (O l) (O h) (O i) = linearIndex l h i-  {-# INLINE linearIndex #-}-  smallestLinearIndex (O i) = smallestLinearIndex i-  {-# INLINE smallestLinearIndex #-}-  largestLinearIndex (O i) = largestLinearIndex i-  {-# INLINE largestLinearIndex #-}-  size (O l) (O h) = size l h-  {-# INLINE size #-}-  inBounds (O l) (O h) (O z) = inBounds l h z-  {-# INLINE inBounds #-}--instance IndexStream i => IndexStream (Outside i) where-  streamUp (O l) (O h) = fmap O $ streamDown l h-  {-# INLINE streamUp #-}-  streamDown (O l) (O h) = fmap O $ streamUp l h-  {-# INLINE streamDown #-}--instance Arbitrary z => Arbitrary (Outside z) where-  arbitrary = O <$> arbitrary-  shrink (O z) = O <$> shrink z-

@@ -7,16 +7,18 @@ import Data.Aeson (FromJSON,ToJSON) 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 (flatten,map,Step(..))-import Data.Vector.Fusion.Stream.Size+import Data.Vector.Fusion.Stream.Monadic (map,Step(..)) import Data.Vector.Unboxed.Deriving import GHC.Generics (Generic) import Prelude hiding (map)  import Data.PrimitiveArray.Index.Class+import Data.PrimitiveArray.Index.IOC+import Data.PrimitiveArray.Vector.Compat   @@ -24,21 +26,32 @@ -- type @p@. In particular, the @Index@ and @IndexStream@ instances are the -- same as for raw @Int@s. -newtype PInt p = PInt { getPInt :: Int }+newtype PInt t p = 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 #-} -derivingUnbox "PInt"-  [t| forall p . PInt p -> Int |]  [| getPInt |]  [| PInt |]+pIntO :: Int -> PInt O p+pIntO = PInt+{-# Inline pIntO #-} -instance Binary    (PInt p)-instance Serialize (PInt p)-instance FromJSON  (PInt p)-instance ToJSON    (PInt p)+pIntC :: Int -> PInt C p+pIntC = PInt+{-# Inline pIntC #-} -instance NFData (PInt p)+derivingUnbox "PInt"+  [t| forall t p . PInt t p -> Int |]  [| getPInt |]  [| PInt |] -instance Index (PInt p) where+instance Binary    (PInt t p)+instance Serialize (PInt t p)+instance FromJSON  (PInt t p)+instance ToJSON    (PInt t p)+instance Hashable  (PInt t p)+instance NFData    (PInt t p)++instance Index (PInt t p) where   linearIndex _ _ (PInt k) = k   {-# Inline linearIndex #-}   smallestLinearIndex _ = error "still needed?"@@ -50,8 +63,49 @@   inBounds l h k = l <= k && k <= h   {-# Inline inBounds #-} +instance IndexStream z => IndexStream (z:.PInt I p) where+  streamUp   (ls:.l) (hs:.h) = flatten (streamUpMk   l h) (streamUpStep   l h) $ streamUp ls hs+  streamDown (ls:.l) (hs:.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:.l) (hs:.h) = flatten (streamDownMk l h) (streamDownStep l h) $ streamUp ls hs+  streamDown (ls:.l) (hs:.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:.l) (hs:.h) = flatten (streamUpMk   l h) (streamUpStep   l h) $ streamUp ls hs+  streamDown (ls:.l) (hs:.h) = flatten (streamDownMk l h) (streamDownStep l h) $ streamDown ls hs+  {-# Inline streamUp   #-}+  {-# 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:.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:.k) (z,k-1)+{-# Inline [0] streamDownStep #-}++instance IndexStream (PInt I p)++instance IndexStream (PInt O p)++instance IndexStream (PInt C p)++{- instance IndexStream z => IndexStream (z:.(PInt p)) where-  streamUp (ls:.l) (hs:.h) = flatten mk step Unknown $ streamUp ls hs+  streamUp (ls:.l) (hs:.h) = flatten mk step $ streamUp ls hs     where mk z = return (z,l)           step (z,k)             | k > h     = return $ Done@@ -59,7 +113,7 @@           {-# Inline [0] mk   #-}           {-# Inline [0] step #-}   {-# Inline streamUp #-}-  streamDown (ls:.l) (hs:.h) = flatten mk step Unknown $ streamDown ls hs+  streamDown (ls:.l) (hs:.h) = flatten mk step $ streamDown ls hs     where mk z = return (z,h)           step (z,k)             | k < l     = return $ Done@@ -73,4 +127,5 @@   {-# Inline streamUp #-}   streamDown l h = map (\(Z:.k) -> k) $ streamDown (Z:.l) (Z:.h)   {-# Inline streamDown #-}+-} 

@@ -11,47 +11,62 @@ import           Data.Binary import           Data.Bits import           Data.Bits.Extras (Ranked)+import           Data.Hashable (Hashable) import           Data.Serialize-import           Data.Vector.Fusion.Stream.Size import           Data.Vector.Unboxed.Deriving import           Data.Vector.Unboxed (Unbox(..))-import           GHC.Generics+import           GHC.Generics (Generic) import qualified Data.Vector.Fusion.Stream.Monadic as SM import qualified Data.Vector.Unboxed as VU import           Test.QuickCheck  import           Data.PrimitiveArray.Index.Class+import           Data.PrimitiveArray.Index.IOC+import           Data.PrimitiveArray.Vector.Compat    -- | A point in a left-linear grammar. The syntactic symbol is in left-most -- position. -newtype PointL = PointL {fromPointL :: Int}+newtype PointL t = PointL {fromPointL :: Int}   deriving (Eq,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 #-}+ -- | A point in a right-linear grammars. -newtype PointR = PointR {fromPointR :: Int}+newtype PointR t = PointR {fromPointR :: Int}   deriving (Eq,Read,Show,Generic)    derivingUnbox "PointL"-  [t| PointL -> Int    |]+  [t| forall t . PointL t -> Int    |]   [| \ (PointL i) -> i |]   [| \ i -> PointL i   |] -instance Binary    PointL-instance Serialize PointL-instance FromJSON  PointL-instance ToJSON    PointL+instance Binary    (PointL t)+instance Serialize (PointL t)+instance FromJSON  (PointL t)+instance ToJSON    (PointL t)+instance Hashable  (PointL t) -instance NFData PointL where+instance NFData (PointL t) where   rnf (PointL l) = rnf l   {-# Inline rnf #-} -instance Index PointL where+instance Index (PointL t) where   linearIndex _ _ (PointL z) = z   {-# INLINE linearIndex #-}   smallestLinearIndex (PointL l) = error "still needed?"@@ -63,6 +78,41 @@   inBounds (_) (PointL h) (PointL x) = 0<=x && x<=h   {-# INLINE inBounds #-} +instance IndexStream z => IndexStream (z:.PointL I) where+  streamUp   (ls:.PointL lf) (hs:.PointL ht) = flatten (streamUpMk   lf) (streamUpStep   ht) $ streamUp ls hs+  streamDown (ls:.PointL lf) (hs:.PointL ht) = flatten (streamDownMk ht) (streamDownStep lf) $ streamDown ls hs+  {-# Inline streamUp #-}+  {-# Inline streamDown #-}++instance IndexStream z => IndexStream (z:.PointL O) where+  streamUp   (ls:.PointL lf) (hs:.PointL ht) = flatten (streamDownMk ht) (streamDownStep lf) $ streamUp   ls hs+  streamDown (ls:.PointL lf) (hs:.PointL ht) = flatten (streamUpMk   lf) (streamUpStep   ht) $ streamDown ls hs+  {-# Inline streamUp #-}+  {-# Inline streamDown #-}++instance IndexStream z => IndexStream (z:.PointL C) where+  streamUp   (ls:.PointL lf) (hs:.PointL ht) = flatten (streamUpMk   lf) (streamUpStep   ht) $ streamUp ls hs+  streamDown (ls:.PointL lf) (hs:.PointL ht) = flatten (streamDownMk ht) (streamDownStep lf) $ streamDown ls hs+  {-# Inline streamUp #-}+  {-# Inline streamDown #-}++streamUpMk lf z = return (z,lf)+{-# Inline [0] streamUpMk #-}++streamUpStep ht (z,k)+  | k > ht    = return $ SM.Done+  | otherwise = return $ SM.Yield (z:.PointL k) (z,k+1)+{-# Inline [0] streamUpStep #-}++streamDownMk ht z = return (z,ht)+{-# Inline [0] streamDownMk #-}++streamDownStep lf (z,k)+  | k < lf    = return $ SM.Done+  | otherwise = return $ SM.Yield (z:.PointL k) (z,k-1)+{-# Inline [0] streamDownStep #-}++{- instance IndexStream z => IndexStream (z:.PointL) where   streamUp (ls:.PointL lf) (hs:.PointL ht) = SM.flatten mk step Unknown $ streamUp ls hs     where mk z = return (z,lf)@@ -80,10 +130,11 @@           {-# Inline [0] mk   #-}           {-# Inline [0] step #-}   {-# Inline streamDown #-}+-} -instance IndexStream PointL+instance IndexStream (Z:.PointL t) => IndexStream (PointL t) -instance Arbitrary PointL where+instance Arbitrary (PointL t) where   arbitrary = do     b <- choose (0,100)     return $ PointL b@@ -93,21 +144,26 @@   +-- * @PointR@+--+-- TODO complete instances+ derivingUnbox "PointR"-  [t| PointR -> Int    |]+  [t| forall t . PointR t -> Int    |]   [| \ (PointR i) -> i |]   [| \ i -> PointR i   |] -instance Binary    PointR-instance Serialize PointR-instance FromJSON  PointR-instance ToJSON    PointR+instance Binary    (PointR t)+instance Serialize (PointR t)+instance FromJSON  (PointR t)+instance ToJSON    (PointR t)+instance Hashable  (PointR t) -instance NFData PointR where+instance NFData (PointR t) where   rnf (PointR l) = rnf l   {-# Inline rnf #-} -instance Index PointR where+instance Index (PointR t) where   linearIndex l _ (PointR z) = undefined   {-# INLINE linearIndex #-}   smallestLinearIndex = undefined

@@ -11,18 +11,20 @@ import           Data.Binary (Binary) import           Data.Bits import           Data.Bits.Extras+import           Data.Hashable (Hashable) import           Data.Serialize (Serialize)-import           Data.Vector.Fusion.Stream.Size import           Data.Vector.Unboxed.Deriving import           Data.Vector.Unboxed (Unbox(..)) import           Debug.Trace-import           GHC.Generics+import           GHC.Generics (Generic) import qualified Data.Vector.Fusion.Stream.Monadic as SM import qualified Data.Vector.Unboxed as VU import           Test.QuickCheck (Arbitrary(..), choose, elements)  import           Data.Bits.Ordered import           Data.PrimitiveArray.Index.Class+import           Data.PrimitiveArray.Index.IOC+import           Data.PrimitiveArray.Vector.Compat   @@ -36,8 +38,11 @@ -- these to reduce programming overhead.  newtype Interface t = Iter { getIter :: Int }-  deriving (Eq,Ord,Read,Show,Generic,Num)+  deriving (Eq,Ord,Generic,Num) +instance Show (Interface t) where+  show (Iter i) = "(I:" ++ show i ++ ")"+ -- | Declare the interface to be the start of a path.  data First@@ -57,17 +62,37 @@ -- -- TODO can we use @Word@s now? -newtype BitSet = BitSet { getBitSet :: Int }+newtype BitSet t = BitSet { getBitSet :: Int }   deriving (Eq,Ord,Read,Generic,FiniteBits,Ranked,Num,Bits) +bitSetI :: Int -> BitSet I+bitSetI = BitSet+{-# Inline bitSetI #-}++bitSetO :: Int -> BitSet O+bitSetO = BitSet+{-# Inline bitSetO #-}++bitSetC :: Int -> BitSet C+bitSetC = BitSet+{-# Inline bitSetC #-}+ -- | A bitset with one interface. -type BS1I i = BitSet:>Interface i+-- type BS1 t i = BitSet t :> Interface i +data BS1 i t = BS1 !(BitSet t) !(Interface i)++deriving instance Show (BS1 i t)+ -- | A bitset with two interfaces. -type BS2I i j = BitSet:>Interface i:>Interface j+-- type BS2 t i j = BitSet t :> Interface i :> Interface j +data BS2 i j t = BS2 !(BitSet t) !(Interface i) !(Interface j)++deriving instance Show (BS2 i j t)+ -- | Successor and Predecessor for sets. Designed as a class to accomodate -- sets with interfaces and without interfaces with one function. --@@ -129,6 +154,7 @@ instance Serialize (Interface t) instance ToJSON    (Interface t) instance FromJSON  (Interface t)+instance Hashable  (Interface t)  instance NFData (Interface t) where   rnf (Iter i) = rnf i@@ -149,23 +175,24 @@   derivingUnbox "BitSet"-  [t| BitSet     -> Int |]+  [t| forall t . BitSet t -> Int |]   [| \(BitSet s) -> s   |]   [| BitSet             |] -instance Show BitSet where+instance Show (BitSet t) where   show (BitSet s) = "<" ++ (show $ activeBitsL s) ++ ">(" ++ show s ++ ")" -instance Binary    BitSet-instance Serialize BitSet-instance ToJSON    BitSet-instance FromJSON  BitSet+instance Binary    (BitSet t)+instance Serialize (BitSet t)+instance ToJSON    (BitSet t)+instance FromJSON  (BitSet t)+instance Hashable  (BitSet t) -instance NFData BitSet where+instance NFData (BitSet t) where   rnf (BitSet s) = rnf s   {-# Inline rnf #-} -instance Index BitSet where+instance Index (BitSet t) where   linearIndex l _ (BitSet z) = z - smallestLinearIndex l -- (2 ^ popCount l - 1)   {-# INLINE linearIndex #-}   smallestLinearIndex l = 2 ^ popCount l - 1@@ -177,71 +204,172 @@   inBounds l h z = popCount l <= popCount z && popCount z <= popCount h   {-# INLINE inBounds #-} +instance IndexStream z => IndexStream (z:.BitSet I) where+  streamUp   (ls:.l) (hs:.h) = flatten (streamUpBsMk   l h) (streamUpBsStep   l h) $ streamUp   ls hs+  streamDown (ls:.l) (hs:.h) = flatten (streamDownBsMk l h) (streamDownBsStep l h) $ streamDown ls hs+  {-# Inline streamUp   #-}+  {-# Inline streamDown #-} +instance IndexStream z => IndexStream (z:.BitSet O) where+  streamUp   (ls:.l) (hs:.h) = flatten (streamDownBsMk l h) (streamDownBsStep l h) $ streamUp   ls hs+  streamDown (ls:.l) (hs:.h) = flatten (streamUpBsMk   l h) (streamUpBsStep   l h) $ streamDown ls hs+  {-# Inline streamUp   #-}+  {-# Inline streamDown #-} -instance IndexStream z => IndexStream (z:.BitSet) where-  streamUp (ls:.l) (hs:.h) = SM.flatten mk step Unknown $ streamUp ls hs-    where mk z = return (z , (if l <= h then Just l else Nothing))-          step (z , Nothing) = return $ SM.Done-          step (z , Just t ) = return $ SM.Yield (z:.t) (z , setSucc l h t)-          {-# Inline [0] mk   #-}-          {-# Inline [0] step #-}+instance IndexStream z => IndexStream (z:.BitSet C) where+  streamUp   (ls:.l) (hs:.h) = flatten (streamUpBsMk   l h) (streamUpBsStep   l h) $ streamUp   ls hs+  streamDown (ls:.l) (hs:.h) = flatten (streamDownBsMk l h) (streamDownBsStep l h) $ streamDown ls hs   {-# Inline streamUp   #-}-  streamDown (ls:.l) (hs:.h) = SM.flatten mk step Unknown $ streamDown ls hs-    where mk z = return (z :. (if l <= h then Just h else Nothing))-          step (z :. Nothing) = return $ SM.Done-          step (z :. Just t ) = return $ SM.Yield (z:.t) (z :. setPred l h t)-          {-# Inline [0] mk   #-}-          {-# Inline [0] step #-}   {-# Inline streamDown #-} -instance IndexStream z => IndexStream (z:.(BitSet:>Interface i)) where-  streamUp (ls:.l@(sl:>_)) (hs:.h@(sh:>_)) = SM.flatten mk step Unknown $ streamUp ls hs-    where mk z = return (z, (if sl<=sh then Just (sl:>(Iter . max 0 $ lsbZ sl)) else Nothing))-          step (z , Nothing) = return $ SM.Done-          step (z,  Just t ) = return $ SM.Yield (z:.t) (z , setSucc l h t)-          {-# Inline [0] mk   #-}-          {-# Inline [0] step #-}+instance IndexStream (Z:.BitSet t) => IndexStream (BitSet t)+++streamUpBsMk :: (Monad m, Ord a) => a -> a -> t -> m (t, Maybe a)+streamUpBsMk l h z = return (z, if l <= h then Just l else Nothing)+{-# Inline [0] streamUpBsMk #-}++streamUpBsStep :: (Monad m, SetPredSucc s) => s -> s -> (t, Maybe s) -> m (SM.Step (t, Maybe s) (t :. s))+streamUpBsStep l h (z , Nothing) = return $ SM.Done+streamUpBsStep l h (z , Just t ) = return $ SM.Yield (z:.t) (z , setSucc l h t)+{-# Inline [0] streamUpBsStep #-}++streamDownBsMk :: (Monad m, Ord a) => a -> a -> t -> m (t, Maybe a)+streamDownBsMk l h z = return (z, if l <=h then Just h else Nothing)+{-# Inline [0] streamDownBsMk #-}++streamDownBsStep :: (Monad m, SetPredSucc s) => s -> s -> (t, Maybe s) -> m (SM.Step (t, Maybe s) (t :. s))+streamDownBsStep l h (z , Nothing) = return $ SM.Done+streamDownBsStep l h (z , Just t ) = return $ SM.Yield (z:.t) (z , setPred l h t)+{-# Inline [0] streamDownBsStep #-}++++-- ** @BS1@++instance Index (BS1 i t) where+  linearIndex (BS1 ls li) (BS1 hs hi) (BS1 s i) = linearIndex (ls:.li) (hs:.hi) (s:.i)+  {-# INLINE linearIndex #-}+  smallestLinearIndex (BS1 s i) = smallestLinearIndex (s:.i)+  {-# INLINE smallestLinearIndex #-}+  largestLinearIndex (BS1 s i) = largestLinearIndex (s:.i)+  {-# INLINE largestLinearIndex #-}+  size (BS1 ls li) (BS1 hs hi) = size (ls:.li) (hs:.hi)+  {-# INLINE size #-}+  inBounds (BS1 ls li) (BS1 hs hi) (BS1 s i) = inBounds (ls:.li) (hs:.hi) (s:.i)+  {-# INLINE inBounds #-}++instance IndexStream z => IndexStream (z:.BS1 i I) 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 #-}-  streamDown (ls:.l@(sl:>_)) (hs:.h@(sh:>_)) = SM.flatten mk step Unknown $ streamDown ls hs-    where mk z = return (z, (if sl<=sh then Just (sh:>(Iter . max 0 $ lsbZ sh)) else Nothing))-          step (z , Nothing) = return $ SM.Done-          step (z , Just t ) = return $ SM.Yield (z:.t) (z , setPred l h t)-          {-# Inline [0] mk   #-}-          {-# Inline [0] step #-}   {-# Inline streamDown #-} -instance IndexStream z => IndexStream (z:.(BitSet:>Interface i:>Interface j)) where-  streamUp (ls:.l@(sl:>_:>_)) (hs:.h@(sh:>_:>_)) = SM.flatten mk step Unknown $ streamUp ls hs-    where mk z | sl > sh   = return (z , Nothing)-               | cl == 0   = return (z , Just (0:>0:>0))-               | cl == 1   = let i = lsbZ sl-                             in  return (z , Just (sl :> Iter i :> Iter i))-               | otherwise = let i = lsbZ sl; j = lsbZ (sl `clearBit` i)-                             in  return (z , Just (sl :> Iter i :> Iter j))-               where cl = popCount sl-          step (z , Nothing) = return $ SM.Done-          step (z , Just t ) = return $ SM.Yield (z:.t) (z , setSucc l h t)-          {-# Inline [0] mk   #-}-          {-# Inline [0] step #-}+instance IndexStream z => IndexStream (z:.BS1 i O) where+  streamUp   (ls:.l) (hs:.h) = flatten (streamDownBsIMk l h) (streamDownBsIStep l h) $ streamUp   ls hs+  streamDown (ls:.l) (hs:.h) = flatten (streamUpBsIMk   l h) (streamUpBsIStep   l h) $ streamDown ls hs   {-# Inline streamUp #-}-  streamDown (ls:.l@(sl:>_:>_)) (hs:.h@(sh:>_:>_)) = SM.flatten mk step Unknown $ streamDown ls hs-    where mk z | sl > sh   = return (z , Nothing)-               | ch == 0   = return (z , Just (0:>0:>0))-               | ch == 1   = let i = lsbZ sh-                             in  return (z , Just (sh :> Iter i :> Iter i))-               | otherwise = let i = lsbZ sh; j = lsbZ sh-                             in  return (z , Just (sh :> Iter i :> Iter j))-               where ch = popCount sh-          step (z , Nothing) = return $ SM.Done-          step (z , Just t ) = return $ SM.Yield (z:.t) (z , setPred l h t)-          {-# Inline [0] mk   #-}-          {-# Inline [0] step #-}   {-# 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:.BS1 i t) => IndexStream (BS1 i t) -instance SetPredSucc BitSet where+streamUpBsIMk :: (Monad m) => BS1 a i -> BS1 b i -> z -> m (z, Maybe (BS1 c i))+streamUpBsIMk (BS1 sl _) (BS1 sh _) z = return (z, if sl <= sh then Just (BS1 sl (Iter . max 0 $ lsbZ sl)) else Nothing)+{-# Inline [0] streamUpBsIMk #-}++streamUpBsIStep :: (Monad m, SetPredSucc s) => s -> s -> (t, Maybe s) -> m (SM.Step (t, Maybe s) (t :. s))+streamUpBsIStep l h (z , Nothing) = return $ SM.Done+streamUpBsIStep l h (z,  Just t ) = return $ SM.Yield (z:.t) (z , setSucc l h t)+{-# Inline [0] streamUpBsIStep #-}++streamDownBsIMk :: (Monad m) => BS1 a i -> BS1 b i -> z -> m (z, Maybe (BS1 c i))+streamDownBsIMk (BS1 sl _) (BS1 sh _) z = return (z, if sl <= sh then Just (BS1 sl (Iter . max 0 $ lsbZ sh)) else Nothing)+{-# Inline [0] streamDownBsIMk #-}++streamDownBsIStep :: (Monad m, SetPredSucc s) => s -> s -> (t, Maybe s) -> m (SM.Step (t, Maybe s) (t :. s))+streamDownBsIStep l h (z , Nothing) = return $ SM.Done+streamDownBsIStep l h (z , Just t ) = return $ SM.Yield (z:.t) (z , setPred l h t)+{-# Inline [0] streamDownBsIStep #-}++++-- ** BS2++instance Index (BS2 i j t) where+  linearIndex (BS2 ls li lj) (BS2 hs hi hj) (BS2 s i j) = linearIndex (ls:.li:.lj) (hs:.hi:.hj) (s:.i:.j)+  {-# INLINE linearIndex #-}+  smallestLinearIndex (BS2 s i j) = smallestLinearIndex (s:.i:.j)+  {-# INLINE smallestLinearIndex #-}+  largestLinearIndex (BS2 s i j) = largestLinearIndex (s:.i:.j)+  {-# INLINE largestLinearIndex #-}+  size (BS2 ls li lj) (BS2 hs hi hj) = size (ls:.li:.lj) (hs:.hi:.hj)+  {-# INLINE size #-}+  inBounds (BS2 ls li lj) (BS2 hs hi hj) (BS2 s i j) = inBounds (ls:.li:.lj) (hs:.hi:.hj) (s:.i:.j)+  {-# INLINE inBounds #-}++instance IndexStream z => IndexStream (z:.BS2 i j I) where+  streamUp   (ls:.l) (hs:.h) = flatten (streamUpBsIiMk   l h) (streamUpBsIiStep   l h) $ streamUp   ls hs+  streamDown (ls:.l) (hs:.h) = flatten (streamDownBsIiMk l h) (streamDownBsIiStep l h) $ streamDown ls hs+  {-# Inline streamUp #-}+  {-# Inline streamDown #-}++instance IndexStream z => IndexStream (z:.BS2 i j O) where+  streamUp   (ls:.l) (hs:.h) = flatten (streamDownBsIiMk l h) (streamDownBsIiStep l h) $ streamUp   ls hs+  streamDown (ls:.l) (hs:.h) = flatten (streamUpBsIiMk   l h) (streamUpBsIiStep   l h) $ streamDown ls hs+  {-# Inline streamUp #-}+  {-# Inline streamDown #-}++instance IndexStream z => IndexStream (z:.BS2 i j C) where+  streamUp   (ls:.l) (hs:.h) = flatten (streamUpBsIiMk   l h) (streamUpBsIiStep   l h) $ streamUp   ls hs+  streamDown (ls:.l) (hs:.h) = flatten (streamDownBsIiMk l h) (streamDownBsIiStep l h) $ streamDown ls hs+  {-# Inline streamUp #-}+  {-# Inline streamDown #-}++instance IndexStream (Z:.BS2 i j t) => IndexStream (BS2 i j t)++streamUpBsIiMk :: (Monad m) => BS2 a b i -> BS2 c d i -> z -> m (z, Maybe (BS2 e f i))+streamUpBsIiMk (BS2 sl _ _) (BS2 sh _ _) z+  | sl > sh   = return (z , Nothing)+  | cl == 0   = return (z , Just (BS2 0 0 0))+  | cl == 1   = let i = lsbZ sl+                in  return (z , Just (BS2 sl (Iter i) (Iter i)))+  | otherwise = let i = lsbZ sl; j = lsbZ (sl `clearBit` i)+                in  return (z , Just (BS2 sl (Iter i) (Iter j)))+  where cl = popCount sl+{-# Inline [0] streamUpBsIiMk #-}++streamUpBsIiStep :: (Monad m, SetPredSucc s) => s -> s -> (t, Maybe s) -> m (SM.Step (t, Maybe s) (t :. s))+streamUpBsIiStep l h (z , Nothing) = return $ SM.Done+streamUpBsIiStep l h (z , Just t ) = return $ SM.Yield (z:.t) (z , setSucc l h t)+{-# Inline [0] streamUpBsIiStep #-}++streamDownBsIiMk :: (Monad m) => BS2 a b i -> BS2 c d i -> z -> m (z, Maybe (BS2 e f i))+streamDownBsIiMk (BS2 sl _ _) (BS2 sh _ _) z+  | sl > sh   = return (z , Nothing)+  | ch == 0   = return (z , Just (BS2 0 0 0))+  | ch == 1   = let i = lsbZ sh+                in  return (z , Just (BS2 sh (Iter i) (Iter i)))+  | otherwise = let i = lsbZ sh; j = lsbZ sh+                in  return (z , Just (BS2 sh (Iter i) (Iter j)))+  where ch = popCount sh+{-# Inline [0] streamDownBsIiMk #-}++streamDownBsIiStep :: (Monad m, SetPredSucc s) => s -> s -> (t, Maybe s) -> m (SM.Step (t, Maybe s) (t :. s))+streamDownBsIiStep l h (z , Nothing) = return $ SM.Done+streamDownBsIiStep l h (z , Just t ) = return $ SM.Yield (z:.t) (z , setPred l h t)+{-# Inline [0] streamDownBsIiStep #-}++++-- ** Set predecessor and successor++instance SetPredSucc (BitSet t) where   setSucc l h s     | cs > ch                        = Nothing     | Just s' <- popPermutation ch s = Just s'@@ -260,59 +388,59 @@           cs = popCount s   {-# Inline setPred #-} -instance SetPredSucc (BitSet:>Interface i) where-  setSucc (l:>il) (h:>ih) (s:>Iter is)-    | cs > ch                         = Nothing-    | Just is' <- maybeNextActive is s     = Just (s:>Iter is')-    | Just s'  <- popPermutation ch s = Just (s':>Iter (lsbZ s'))-    | cs >= ch                        = Nothing-    | cs < ch                         = let s' = BitSet $ 2^(cs+1)-1 in Just (s' :> Iter (lsbZ s'))+instance SetPredSucc (BS1 i t) where+  setSucc (BS1 l il) (BS1 h ih) (BS1 s (Iter is))+    | cs > ch                          = Nothing+    | Just is' <- maybeNextActive is s = Just $ BS1 s  (Iter is')+    | Just s'  <- popPermutation ch s  = Just $ BS1 s' (Iter $ lsbZ s')+    | cs >= ch                         = Nothing+    | cs < ch                          = let s' = BitSet $ 2^(cs+1)-1 in Just (BS1 s' (Iter (lsbZ s')))     where ch = popCount h           cs = popCount s   {-# Inline setSucc #-}-  setPred (l:>il) (h:>ih) (s:>Iter is)-    | cs < cl                         = Nothing-    | Just is' <- maybeNextActive is s     = Just (s:>Iter is')-    | Just s'  <- popPermutation ch s = Just (s':>Iter (lsbZ s'))-    | cs <= cl                        = Nothing-    | cs > cl                         = let s' = BitSet $ 2^(cs-1)-1 in Just (s' :> Iter (max 0 $ lsbZ s'))+  setPred (BS1 l il) (BS1 h ih) (BS1 s (Iter is))+    | cs < cl                          = Nothing+    | Just is' <- maybeNextActive is s = Just $ BS1 s  (Iter is')+    | Just s'  <- popPermutation ch s  = Just $ BS1 s' (Iter  $ lsbZ s')+    | cs <= cl                         = Nothing+    | cs > cl                          = let s' = BitSet $ 2^(cs-1)-1 in Just (BS1 s' (Iter (max 0 $ lsbZ s')))     where cl = popCount l           ch = popCount h           cs = popCount s   {-# Inline setPred #-} -instance SetPredSucc (BitSet:>Interface i:>Interface j) where-  setSucc (l:>il:>jl) (h:>ih:>jh) (s:>Iter is:>Iter js)+instance SetPredSucc (BS2 i j t) where+  setSucc (BS2 l il jl) (BS2 h ih jh) (BS2 s (Iter is) (Iter js))     -- early termination     | cs > ch                         = Nothing     -- in case nothing was set, set initial set @1@ with both interfaces     -- pointing to the same element-    | cs == 0                         = Just (1:>0:>0)+    | cs == 0                         = Just (BS2 1 0 0)     -- when only a single element is set, we just permute the population     -- and set the single interface     | cs == 1     , Just s'  <- popPermutation ch s-    , let is' = lsbZ s'          = Just (s':>Iter is':>Iter is')+    , let is' = lsbZ s'          = Just (BS2 s' (Iter is') (Iter is'))     -- try advancing only one of the interfaces, doesn't collide with @is@-    | Just js' <- maybeNextActive js (s `clearBit` is) = Just (s:>Iter is:>Iter js')+    | Just js' <- maybeNextActive js (s `clearBit` is) = Just (BS2 s (Iter is) (Iter js'))     -- advance other interface,      | Just is' <- maybeNextActive is s-    , let js' = lsbZ (s `clearBit` is')      = Just (s:>Iter is':>Iter js')+    , let js' = lsbZ (s `clearBit` is')      = Just (BS2 s (Iter is') (Iter js'))     -- find another permutation of the population     | Just s'  <- popPermutation ch s     , let is' = lsbZ s'-    , Just js' <- maybeNextActive is' s'   = Just (s':>Iter is':>Iter js')+    , Just js' <- maybeNextActive is' s'   = Just (BS2 s' (Iter is') (Iter js'))     -- increasing the population forbidden by upper limit     | cs >= ch                        = Nothing     -- increase population     | cs < ch     , let s' = BitSet $ 2^(cs+1)-1     , let is' = lsbZ s'-    , Just js' <- maybeNextActive is' s'   = Just (s':>Iter is':>Iter js')+    , Just js' <- maybeNextActive is' s'   = Just (BS2 s' (Iter is') (Iter js'))     where ch = popCount h           cs = popCount s   {-# Inline setSucc #-}-  setPred (l:>il:>jl) (h:>ih:>jh) (s:>Iter is:>Iter js)+  setPred (BS2 l il jl) (BS2 h ih jh) (BS2 s (Iter is) (Iter js))     -- early termination     | cs < cl                         = Nothing     -- in case nothing was set, set initial set @1@ with both interfaces@@ -322,27 +450,27 @@     -- and set the single interface     | cs == 1     , Just s'  <- popPermutation ch s-    , let is' = lsbZ s'          = Just (s':>Iter is':>Iter is')+    , let is' = lsbZ s'          = Just (BS2 s' (Iter is') (Iter is'))     -- return the single @0@ set-    | cs == 1                         = Just (0:>0:>0)+    | cs == 1                         = Just (BS2 0 0 0)     -- try advancing only one of the interfaces, doesn't collide with @is@-    | Just js' <- maybeNextActive js (s `clearBit` is) = Just (s:>Iter is:>Iter js')+    | Just js' <- maybeNextActive js (s `clearBit` is) = Just (BS2 s (Iter is) (Iter js'))     -- advance other interface,      | Just is' <- maybeNextActive is s-    , let js' = lsbZ (s `clearBit` is')      = Just (s:>Iter is':>Iter js')+    , let js' = lsbZ (s `clearBit` is')      = Just (BS2 s (Iter is') (Iter js'))     -- find another permutation of the population     | Just s'  <- popPermutation ch s     , let is' = lsbZ s'-    , Just js' <- maybeNextActive is' s'   = Just (s':>Iter is':>Iter js')+    , Just js' <- maybeNextActive is' s'   = Just (BS2 s' (Iter is') (Iter js'))     -- decreasing the population forbidden by upper limit     | cs <= cl                        = Nothing     -- decrease population     | cs > cl && cs > 2     , let s' = BitSet $ 2^(cs-1)-1     , let is' = lsbZ s'-    , Just js' <- maybeNextActive is' s'   = Just (s':>Iter is':>Iter js')+    , Just js' <- maybeNextActive is' s'   = Just (BS2 s' (Iter is') (Iter js'))     -- decrease population to single-element sets-    | cs > cl && cs == 2              = Just (1:>0:>0)+    | cs > cl && cs == 2              = Just (BS2 1 0 0)     where cl = popCount l           ch = popCount h           cs = popCount s@@ -350,11 +478,11 @@   -type instance Mask BitSet = BitSet+type instance Mask (BitSet t)  = BitSet t -type instance Mask (BitSet :> Interface i) = BitSet+type instance Mask (BS1 i t)   = BitSet t -type instance Mask (BitSet :> Interface i :> Interface j) = BitSet+type instance Mask (BS2 i j t) = BitSet t   @@ -368,13 +496,10 @@ deriving instance (Read t   , Read    (Mask t)) => Read    (Fixed t) deriving instance (Show t   , Show    (Mask t)) => Show    (Fixed t) deriving instance (Generic t, Generic (Mask t)) => Generic (Fixed t)+instance (Generic t, Generic (Mask t), Hashable t, Hashable (Mask t)) => Hashable (Fixed t)  instance (Generic t, Generic (Mask t), Binary t   , Binary    (Mask t)) => Binary    (Fixed t) instance (Generic t, Generic (Mask t), Serialize t, Serialize (Mask t)) => Serialize (Fixed t)-{- -- TODO do json instances work automatically here?-instance ToJSON    (Interface t)-instance FromJSON  (Interface t)--}  instance NFData (Fixed t) where   rnf (Fixed m s) = m `seq` s `seq` ()@@ -383,11 +508,11 @@ -- fixed AND that during permutations / increases in popCount we do not set -- an already fixed bit -- as otherwise we lose one in popCount. -testBsS :: BitSet -> Maybe (Fixed BitSet)+testBsS :: BitSet t -> Maybe (Fixed (BitSet t)) testBsS k = setSucc (Fixed 0 0) (Fixed 0 7) (Fixed 4 k) {-# NoInline testBsS #-} -instance SetPredSucc (Fixed BitSet) where+instance SetPredSucc (Fixed (BitSet t)) where   setPred (Fixed _ l) (Fixed _ h) (Fixed !m s) = Fixed m <$> setPred l h (s .&. complement m)   {-# Inline setPred #-}   --setSucc (Fixed _ l) (Fixed _ h) (Fixed !m s) = Fixed m <$> setSucc l h (s .&. complement m)@@ -408,54 +533,54 @@           p   = popShiftL m <$> p''   {-# Inline setSucc #-} -instance SetPredSucc (Fixed (BitSet:>Interface i)) where-  setPred (Fixed _ (l:>li)) (Fixed _ (h:>hi)) (Fixed !m (s:>i))-    | s `testBit` getIter i = (Fixed m . (:> i) . ( `setBit` getIter i)) <$> setPred l h (s .&. complement m)-    | otherwise             = (Fixed m) <$> setPred (l:>li) (h:>hi) ((s .&. complement m):>i)+instance SetPredSucc (Fixed (BS1 i t)) where+  setPred (Fixed _ (BS1 l li)) (Fixed _ (BS1 h hi)) (Fixed !m (BS1 s i))+    | s `testBit` getIter i = (Fixed m . (`BS1` i) . ( `setBit` getIter i)) <$> setPred l h (s .&. complement m)+    | otherwise             = (Fixed m) <$> setPred (BS1 l li) (BS1 h hi) (BS1 (s .&. complement m) i)   {-# Inline setPred #-}-  setSucc (Fixed _ (l:>li)) (Fixed _ (h:>hi)) (Fixed !m (s:>i))-    | s `testBit` getIter i = (Fixed m . (:> i) . ( `setBit` getIter i)) <$> setSucc l h (s .&. complement m)-    | otherwise             = (Fixed m) <$> setSucc (l:>li) (h:>hi) ((s .&. complement m):>i)+  setSucc (Fixed _ (BS1 l li)) (Fixed _ (BS1 h hi)) (Fixed !m (BS1 s i))+    | s `testBit` getIter i = (Fixed m . (`BS1` i) . ( `setBit` getIter i)) <$> setSucc l h (s .&. complement m)+    | otherwise             = (Fixed m) <$> setSucc (BS1 l li) (BS1 h hi) (BS1 (s .&. complement m) i)   {-# Inline setSucc #-} -instance SetPredSucc (Fixed (BitSet:>Interface i:>Interface j)) where-  setPred (Fixed _ (l:>li:>lj)) (Fixed _ (h:>hi:>hj)) (Fixed !m (s:>i:>j))+instance SetPredSucc (Fixed (BS2 i j t)) where+  setPred (Fixed _ (BS2 l li lj)) (Fixed _ (BS2 h hi hj)) (Fixed !m (BS2 s i j))     | s `testBit` getIter i && s `testBit` getIter j-    = (Fixed m . (\z       -> (z `setBit` getIter i `setBit` getIter j:>i:>j ))) <$> setPred l h (s .&. complement m)+    = (Fixed m . (\z       -> BS2 (z `setBit` getIter i `setBit` getIter j) i j)) <$> setPred l h (s .&. complement m)     | s `testBit` getIter i-    = (Fixed m . (\(z:>j') -> (z `setBit` getIter i                   :>i:>j'))) <$> setPred (l:>lj) (h:>hj) (s .&. complement m :>j)+    = (Fixed m . (\(BS1 z j') -> BS2 (z `setBit` getIter i) i j')) <$> setPred (BS1 l lj) (BS1 h hj) (BS1 (s .&. complement m) j)     | s `testBit` getIter j-    = (Fixed m . (\(z:>i') -> (z `setBit` getIter j                   :>i':>j))) <$> setPred (l:>li) (h:>hi) (s .&. complement m :>i)+    = (Fixed m . (\(BS1 z i') -> BS2 (z `setBit` getIter j) i' j)) <$> setPred (BS1 l li) (BS1 h hi) (BS1 (s .&. complement m) i)   {-# Inline setPred #-}-  setSucc (Fixed _ (l:>li:>lj)) (Fixed _ (h:>hi:>hj)) (Fixed !m (s:>i:>j))+  setSucc (Fixed _ (BS2 l li lj)) (Fixed _ (BS2 h hi hj)) (Fixed !m (BS2 s i j))     | s `testBit` getIter i && s `testBit` getIter j-    = (Fixed m . (\z       -> (z `setBit` getIter i `setBit` getIter j:>i:>j ))) <$> setSucc l h (s .&. complement m)+    = (Fixed m . (\z       -> BS2 (z `setBit` getIter i `setBit` getIter j) i j)) <$> setSucc l h (s .&. complement m)     | s `testBit` getIter i-    = (Fixed m . (\(z:>j') -> (z `setBit` getIter i                   :>i:>j'))) <$> setSucc (l:>lj) (h:>hj) (s .&. complement m :>j)+    = (Fixed m . (\(BS1 z j') -> BS2 (z `setBit` getIter i) i j')) <$> setSucc (BS1 l lj) (BS1 h hj) (BS1 (s .&. complement m) j)     | s `testBit` getIter j-    = (Fixed m . (\(z:>i') -> (z `setBit` getIter j                   :>i':>j))) <$> setSucc (l:>li) (h:>hi) (s .&. complement m :>i)+    = (Fixed m . (\(BS1 z i') -> BS2 (z `setBit` getIter j) i' j)) <$> setSucc (BS1 l li) (BS1 h hi) (BS1 (s .&. complement m) i)   {-# Inline setSucc #-}   -instance ApplyMask BitSet where+instance ApplyMask (BitSet t) where   applyMask = popShiftL   {-# Inline applyMask #-} -instance ApplyMask (BitSet :> Interface i) where-  applyMask m (s:>i)-    | popCount s == 0 = 0:>0-    | otherwise       = popShiftL m s :> (Iter . getBitSet . popShiftL m . BitSet $ 2 ^ getIter i)+instance ApplyMask (BS1 i t) where+  applyMask m (BS1 s i)+    | popCount s == 0 = BS1 0 0+    | otherwise       = BS1 (popShiftL m s) (Iter . getBitSet . popShiftL m . BitSet $ 2 ^ getIter i)   {-# Inline applyMask #-} -instance ApplyMask (BitSet :> Interface i :> Interface j) where-  applyMask m (s:>i:>j)-    | popCount s == 0 = 0:>0:>0-    | popCount s == 1 = s' :> i' :> Iter (getIter i')-    | otherwise       = s' :> i' :> j'+instance ApplyMask (BS2 i j t) where+  applyMask m (BS2 s i j)+    | popCount s == 0 = BS2 0 0 0+    | popCount s == 1 = BS2 s' i' (Iter $ getIter i')+    | otherwise       = BS2 s' i' j'     where s' = popShiftL m s-          i' = Iter . getBitSet . popShiftL m . BitSet $ 2 ^ getIter i-          j' = Iter . getBitSet . popShiftL m . BitSet $ 2 ^ getIter j+          i' = Iter . getBitSet . popShiftL m $ (BitSet $ 2 ^ getIter i :: BitSet t)+          j' = Iter . getBitSet . popShiftL m $ (BitSet $ 2 ^ getIter j :: BitSet t)   {-# Inline applyMask #-}  @@ -466,43 +591,43 @@   arbitrary = Fixed <$> arbitrary <*> arbitrary   shrink (Fixed m s) = [ Fixed m' s' | m' <- shrink m, s' <- shrink s ] -instance Arbitrary BitSet where+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' -instance Arbitrary (BitSet:>Interface i) where+instance Arbitrary (BS1 i t) where   arbitrary = do     s <- arbitrary     if s==0-      then return (s:>Iter 0)+      then return (BS1 s 0)       else do i <- elements $ activeBitsL s-              return (s:>Iter i)-  shrink (s:>i) =-    let s' = [ (s `clearBit` a:>i)+              return (BS1 s $ Iter i)+  shrink (BS1 s i) =+    let s' = [ BS1 (s `clearBit` a) i              | a <- activeBitsL s              , Iter a /= i ]-             ++ [ 0 :> Iter 0 | popCount s == 1 ]+             ++ [ BS1 0 0 | popCount s == 1 ]     in  s' ++ concatMap shrink s' -instance Arbitrary (BitSet:>Interface i:>Interface j) where+instance Arbitrary (BS2 i j t) where   arbitrary = do     s <- arbitrary     case (popCount s) of-      0 -> return (s:>Iter 0:>Iter 0)+      0 -> return (BS2 s 0 0)       1 -> do i <- elements $ activeBitsL s-              return (s:>Iter i:>Iter i)+              return (BS2 s (Iter i) (Iter i))       _ -> do i <- elements $ activeBitsL s               j <- elements $ activeBitsL (s `clearBit` i)-              return (s:>Iter i:>Iter j)-  shrink (s:>i:>j) =-    let s' = [ (s `clearBit` a:>i:>j)+              return (BS2 s (Iter i) (Iter j))+  shrink (BS2 s i j) =+    let s' = [ BS2 (s `clearBit` a) i j              | a <- activeBitsL s              , Iter a /= i, Iter a /= j ]-             ++ [ 0 `setBit` a :> Iter a :> Iter a+             ++ [ BS2 (0 `setBit` a) (Iter a) (Iter a)                 | popCount s == 2                 , a <- activeBitsL s ]-             ++ [ 0 :> Iter 0 :> Iter 0+             ++ [ BS2 0 0 0                 | popCount s == 1 ]     in  s' ++ concatMap shrink s' 

@@ -7,15 +7,17 @@ import Control.DeepSeq (NFData(..)) import Data.Aeson (FromJSON,ToJSON) import Data.Binary (Binary)+import Data.Hashable (Hashable) import Data.Serialize (Serialize)-import Data.Vector.Fusion.Stream.Monadic (Step(..), flatten, map)-import Data.Vector.Fusion.Stream.Size+import Data.Vector.Fusion.Stream.Monadic (Step(..), map) import Data.Vector.Unboxed.Deriving import GHC.Generics (Generic)-import Test.QuickCheck (Arbitrary(..), choose) import Prelude hiding (map)+import Test.QuickCheck (Arbitrary(..), choose)  import Data.PrimitiveArray.Index.Class+import Data.PrimitiveArray.Index.IOC+import Data.PrimitiveArray.Vector.Compat   @@ -27,27 +29,42 @@ -- the smallest. We do, however, use (0,0) as the smallest as (0,k) gives -- successively smaller upper triangular parts. -newtype Subword = Subword {fromSubword :: (Int:.Int)}+newtype Subword t = Subword {fromSubword :: (Int:.Int)}   deriving (Eq,Ord,Show,Generic,Read)  derivingUnbox "Subword"-  [t| Subword -> (Int,Int) |]+  [t| forall t . Subword t -> (Int,Int) |]   [| \ (Subword (i:.j)) -> (i,j) |]   [| \ (i,j) -> Subword (i:.j) |] -instance Binary    Subword-instance Serialize Subword-instance FromJSON  Subword-instance ToJSON    Subword+instance Binary    (Subword t)+instance Serialize (Subword t)+instance FromJSON  (Subword t)+instance ToJSON    (Subword t)+instance Hashable  (Subword t) -instance NFData Subword where+instance NFData (Subword t) where   rnf (Subword (i:.j)) = i `seq` rnf j   {-# Inline rnf #-} -subword :: Int -> Int -> Subword+-- | 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 #-}+ -- | triangular numbers -- -- A000217@@ -59,7 +76,7 @@ -- | Size of an upper triangle starting at 'i' and ending at 'j'. "(0,N)" what -- be the normal thing to use. -upperTri :: Subword -> Int+upperTri :: Subword t -> Int upperTri (Subword (i:.j)) = triangularNumber $ j-i+1 {-# INLINE upperTri #-} @@ -69,19 +86,19 @@ -- -- TODO probably doesn't work right with non-zero base ?! -subwordIndex :: Subword -> Subword -> Int+subwordIndex :: Subword s -> Subword t -> Int subwordIndex (Subword (l:.n)) (Subword (i:.j)) = adr n (i,j) -- - adr n (l,n)   where     adr n (i,j) = (n+1)*i - triangularNumber i + j {-# INLINE subwordIndex #-} -subwordFromIndex :: Subword -> Int -> Subword+subwordFromIndex :: Subword s -> Int -> Subword t subwordFromIndex = error "subwordFromIndex not implemented" {-# INLINE subwordFromIndex #-}   -instance Index Subword where+instance Index (Subword t) where   linearIndex _ h i = subwordIndex h i   {-# Inline linearIndex #-}   smallestLinearIndex _ = error "still needed?"@@ -93,8 +110,17 @@   inBounds _ (Subword (_:.h)) (Subword (i:.j)) = 0<=i && i<=j && j<=h   {-# Inline inBounds #-} -instance IndexStream z => IndexStream (z:.Subword) where-  streamUp (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten mk step Unknown $ streamUp ls hs+-- | @Subword I@ (inside)++instance IndexStream z => IndexStream (z:.Subword I) where+  streamUp   (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten (streamUpMk     h) (streamUpStep   l h) $ streamUp   ls hs+  streamDown (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten (streamDownMk l h) (streamDownStep   h) $ streamDown ls hs+  {-# Inline streamUp #-}+  {-# Inline streamDown #-}++{-+instance IndexStream z => IndexStream (z:.Subword I) where+  streamUp (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten mk step $ streamUp ls hs     where mk z = return (z,h,h)           step (z,i,j)             | i < l     = return $ Done@@ -103,7 +129,7 @@           {-# Inline [0] mk   #-}           {-# Inline [0] step #-}   {-# Inline streamUp #-}-  streamDown (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten mk step Unknown $ streamDown ls hs+  streamDown (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten mk step $ streamDown ls hs     where mk z = return (z,l,h)           step (z,i,j)             | i > h     = return $ Done@@ -112,16 +138,58 @@           {-# Inline [0] mk   #-}           {-# Inline [0] step #-}   {-# Inline streamDown #-}+-} --- Default methods don't inline in a good way!+-- | @Subword O@ (outside).+--+-- Note: @streamUp@ really needs to use @streamDownMk@ / @streamDownStep@+-- for the right order of indices! -instance IndexStream Subword where+instance IndexStream z => IndexStream (z:.Subword O) where+  streamUp   (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten (streamDownMk l h) (streamDownStep   h) $ streamUp   ls hs+  streamDown (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten (streamUpMk     h) (streamUpStep   l h) $ streamDown ls hs+  {-# Inline streamUp #-}+  {-# Inline streamDown #-}++instance IndexStream z => IndexStream (z:.Subword C) where+  streamUp   (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten (streamUpMk     h) (streamUpStep   l h) $ streamUp   ls hs+  streamDown (ls:.Subword (l:._)) (hs:.Subword (_:.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 (Z:.l) (Z:.h)   {-# INLINE streamUp #-}   streamDown l h = map (\(Z:.i) -> i) $ streamDown (Z:.l) (Z:.h)   {-# INLINE streamDown #-}+-} -instance Arbitrary Subword where+--instance IndexStream (Subword O)++--instance IndexStream (Subword C)++instance Arbitrary (Subword t) where   arbitrary = do     a <- choose (0,100)     b <- choose (0,100)

@@ -0,0 +1,62 @@++-- | 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.DeepSeq (NFData(..))+import Data.Aeson (FromJSON,ToJSON)+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 ToJSON    (Unit t)+instance Hashable  (Unit t)++instance NFData (Unit t) where+  rnf Unit = ()+  {-# Inline rnf #-}++instance Index (Unit t) where+  linearIndex _ _ _ = 0+  {-# Inline linearIndex #-}+  smallestLinearIndex _ = 0+  {-# Inline smallestLinearIndex #-}+  largestLinearIndex _ = 0+  {-# Inline largestLinearIndex #-}+  size _ _ = 1+  {-# Inline size #-}+  inBounds _ _ _ = True+  {-# Inline inBounds #-}++instance IndexStream z => IndexStream (z:.Unit t) where+  streamUp (ls:.Unit) (hs:.Unit) = map (\z -> z:.Unit) $ streamUp ls hs+  {-# Inline streamUp #-}+  streamDown (ls:.Unit) (hs:.Unit) = map (\z -> z:.Unit) $ streamDown ls hs+  {-# Inline streamDown #-}++instance (IndexStream (Z:.Unit t)) => IndexStream (Unit t)++instance Arbitrary (Unit t) where+  arbitrary = pure Unit+  shrink Unit = []

@@ -7,6 +7,7 @@ import Debug.Trace import Test.QuickCheck hiding (Fixed(..), (.&.)) +import Data.PrimitiveArray.Index.IOC import Data.PrimitiveArray.Index.Set  @@ -15,7 +16,7 @@ -- as it is? The mask should actually freeze-fix those bits, where we are -- set to @1@! -prop_Fixed_BitSet_setSucc (u :: Word, Fixed m s :: Fixed BitSet) = traceShow (tgo, tsu) $ tgo == tsu+prop_Fixed_BitSet_setSucc (u :: Word, Fixed m s :: Fixed (BitSet I)) = traceShow (tgo, tsu) $ tgo == tsu   where tgo = go s         tsu = (getFixed <$> setSucc (Fixed 0 0) (Fixed 0 h) (Fixed m s))         fb1 = m .&. s -- fixed bits to 1

@@ -0,0 +1,25 @@++module Data.PrimitiveArray.Vector.Compat+  ( flatten+  , Size(..)+  ) where++import qualified Data.Vector.Fusion.Stream.Monadic as SM++#if MIN_VERSION_vector(0,11,0)+import Data.Vector.Fusion.Bundle.Size+#else+import Data.Vector.Fusion.Stream.Size+#endif++++flatten :: Monad m => (a -> m s) -> (s -> m (SM.Step s b)) -> SM.Stream m a -> SM.Stream m b+{-# Inline flatten #-}++#if MIN_VERSION_vector(0,11,0)+flatten = SM.flatten+#else+flatten = \mk step -> SM.flatten mk step Unknown+#endif+

@@ -1,24 +1,27 @@ Name:           PrimitiveArray-Version:        0.6.1.0+Version:        0.7.0.0 License:        BSD3 License-file:   LICENSE Maintainer:     choener@bioinf.uni-leipzig.de author:         Christian Hoener zu Siederdissen, 2011-2015 copyright:      Christian Hoener zu Siederdissen, 2011-2015-homepage:       http://www.bioinf.uni-leipzig.de/Software/gADP/ homepage:       https://github.com/choener/PrimitiveArray bug-reports:    https://github.com/choener/PrimitiveArray/issues Stability:      Experimental Category:       Data Build-type:     Simple Cabal-version:  >=1.10.0-tested-with:    GHC == 7.8.4, GHC == 7.10.1+tested-with:    GHC == 7.8.4, GHC == 7.10.2 Synopsis:       Efficient multidimensional arrays Description:+                <http://www.bioinf.uni-leipzig.de/Software/gADP/ generalized Algebraic Dynamic Programming>+                .                 This library provides efficient multidimensional arrays. Import                 @Data.PrimitiveArray@ for indices, lenses, and arrays.                 .-                For ADPfusion users, the library also provides the machinary to+                For+                <http://www.bioinf.uni-leipzig.de/Software/gADP/ generalized ADP>+                users, the library also provides the machinary to                 fill tables in the correct order required by usual CYK-style                 parsers, or regular grammars (used e.g. in alignment                 algorithms). This means that unless your grammar require a@@ -45,32 +48,36 @@     Data.PrimitiveArray.FillTables     Data.PrimitiveArray.Index     Data.PrimitiveArray.Index.Class-    Data.PrimitiveArray.Index.Complement     Data.PrimitiveArray.Index.Int-    Data.PrimitiveArray.Index.Outside+    Data.PrimitiveArray.Index.IOC     Data.PrimitiveArray.Index.PhantomInt     Data.PrimitiveArray.Index.Point     Data.PrimitiveArray.Index.Set     Data.PrimitiveArray.Index.Subword+    Data.PrimitiveArray.Index.Unit     Data.PrimitiveArray.QuickCheck.Index.Set+    Data.PrimitiveArray.Vector.Compat   build-depends: base                     >= 4.7      && < 4.9-               , aeson                    >= 0.8      && < 0.10+               , aeson                    >= 0.8      && < 0.11                , binary                   >= 0.7      && < 0.8                , bits                     >= 0.4      && < 0.5                , cereal                   >= 0.4      && < 0.5                , deepseq                  >= 1.3      && < 1.5-               , OrderedBits              >= 0.0.0.1  && < 0.0.1.0+               , hashable                 >= 1.2      && < 1.3+               , OrderedBits              >= 0.0.0.3  && < 0.0.2.0                , primitive                >= 0.5.4    && < 0.7                , QuickCheck               >= 2.7      && < 2.9-               , vector                   >= 0.10     && < 0.11+               , vector                   >= 0.10     && < 0.12                , vector-binary-instances  >= 0.2      && < 0.3                , vector-th-unbox          >= 0.2      && < 0.3   default-extensions: BangPatterns+                    , CPP                     , DefaultSignatures                     , DeriveDataTypeable                     , DeriveGeneric                     , FlexibleContexts                     , FlexibleInstances+                    , GADTs                     , GeneralizedNewtypeDeriving                     , MultiParamTypeClasses                     , RankNTypes@@ -99,7 +106,8 @@     tests   default-language:     Haskell2010-  default-extensions: TemplateHaskell+  default-extensions: CPP+                    , TemplateHaskell   build-depends: base                , PrimitiveArray                , QuickCheck

@@ -2,7 +2,7 @@  # PrimitiveArray -[*generalized ADPfusion Homepage*](http://www.bioinf.uni-leipzig.de/Software/gADP/)+[*generalized Algebraic Dynamic Programming Homepage*](http://www.bioinf.uni-leipzig.de/Software/gADP/)  PrimitiveArray provides operations on multi-dimensional arrays. Internally, the representation is based on the vector library, while the multi-dimensional

@@ -1,3 +1,16 @@+0.7.0.0+-------++- vector <= 0.11 support; including compatibility layer+- redesigned Index structures (for dealing with Inside/Outside/Complement)++0.6.1.1+-------++- Hashable instances for all index structures+- Hashable instances for Unboxed and Boxed arrays. *These require Hashable+  instances for vectors, which are not available by default*+ 0.6.1.0 -------