module ADP.Fusion.Base.Set where
import Data.Proxy
import Data.Vector.Fusion.Stream.Monadic (singleton,filter,enumFromStepN,map,unfoldr)
import Debug.Trace
import Prelude hiding (map,filter)
import Data.Bits
import Data.Bits.Ordered
import Data.PrimitiveArray hiding (map)
import ADP.Fusion.Base.Classes
import ADP.Fusion.Base.Multi
instance RuleContext (BitSet I) where
type Context (BitSet I) = InsideContext Int
initialContext _ = IStatic 0
instance RuleContext (BitSet O) where
type Context (BitSet O) = OutsideContext Int
initialContext _ = OStatic 0
instance RuleContext (BitSet C) where
type Context (BitSet C) = ComplementContext
initialContext _ = Complemented
newtype instance RunningIndex (BitSet I) = RiBsI (BitSet I)
data instance RunningIndex (BitSet O) = RiBsO !(BitSet O) !(BitSet O)
data instance RunningIndex (BitSet C) = RiBsC !(BitSet C) !(BitSet C)
instance RuleContext (BS2 First Last I) where
type Context (BS2 First Last I) = InsideContext Int
initialContext _ = IStatic 0
instance RuleContext (BS2 First Last O) where
type Context (BS2 First Last O) = OutsideContext ()
initialContext _ = OStatic ()
instance RuleContext (BS2 First Last C) where
type Context (BS2 First Last C) = ComplementContext
initialContext _ = Complemented
newtype instance RunningIndex (BS2 First Last I) = RiBs2I (BS2 First Last I)
data instance RunningIndex (BS2 First Last O) = RiBs2O !(BS2 First Last O) !(BS2 First Last O)
data instance RunningIndex (BS2 First Last C) = RiBs2C !(BS2 First Last C) !(BS2 First Last C)
instance
( Monad m
) => MkStream m S (BitSet I) where
mkStream S (IStatic rb) u s
= staticCheck (rb <= ps) . map (\k -> ElmS . RiBsI $ popShiftL s k) $ unfoldr go strt
where strt = Just $ BitSet $ 2^(ps rb) 1
ps = popCount s
go Nothing = Nothing
go (Just k) = Just $ (k, popPermutation ps k)
mkStream S (IVariable rb) u s
= staticCheck (rb <= popCount s) . singleton . ElmS $ RiBsI 0
instance
( Monad m
) => MkStream m S (BitSet O) where
mkStream S (OStatic rb) u s
= staticCheck (rb + popCount s <= popCount u) . singleton . ElmS $ RiBsO s s
mkStream S (ORightOf _) u s
= error "ADP.Fusion.Base.Set: Entered ORightOf/BitSet (this is probably wrong because it means we have an outside cfg with only terminals on the r.h.s, and the terminals are not a single Outside-Epsilon)"
mkStream S (OFirstLeft rb) u s
= staticCheck (rb + popCount s <= popCount u) . singleton . ElmS $ RiBsO s s
instance
( Monad m
) => MkStream m S (BitSet C) where
instance
( Monad m
) => MkStream m S (BS2 First Last I) where
mkStream S (IStatic rp) u sij@(BS2 s (Iter i) _)
= staticCheck (popCount s == 0 && rp == 0) . singleton . ElmS . RiBs2I $ BS2 0 (Iter i) (Iter i)
mkStream S (IVariable rp) u sij@(BS2 s (Iter i) _)
= staticCheck (popCount s >= rp) . singleton . ElmS . RiBs2I $ BS2 0 (Iter i) (Iter i)
instance
( Monad m
) => MkStream m S (BS2 First Last O) where
instance
( Monad m
) => MkStream m S (BS2 First Last C) where
undefbs2i :: BS2 f l t
undefbs2i = BS2 (1) (1) (1)
undefi :: Interface i
undefi = (1)
instance TableStaticVar (u O) c (BitSet O) where
tableStaticVar _ _ (OStatic d) _ = OFirstLeft d
tableStaticVar _ _ (ORightOf d) _ = OFirstLeft d
tableStreamIndex _ c _ bs = bs
instance TableStaticVar c (u I) (BitSet O) where
instance (MinSize c) => TableStaticVar u c (BitSet I) where
tableStaticVar _ c (IStatic d) _ = IVariable $ d minSize c
tableStaticVar _ _ (IVariable d) _ = IVariable $ d
tableStreamIndex _ c _ bitSet = bitSet
instance TableStaticVar c u (BS2 i j I) where
data ThisThatNaught a b = This a | That b | Naught