module ADP.Fusion.Base.Classes where
import Data.Strict.Tuple
import Data.Vector.Fusion.Stream.Size
import qualified Data.Vector.Fusion.Stream.Monadic as S
import Data.PrimitiveArray
data OutsideContext s
= OStatic s
| ORightOf s
| OFirstLeft s
| OLeftOf s
data InsideContext s
= IStatic s
| IVariable s
data ComplementContext
= Complemented
class RuleContext i where
type Context i :: *
initialContext :: i -> Context i
class Element x i where
data Elm x i :: *
type Arg x :: *
getArg :: Elm x i -> Arg x
getIdx :: Elm x i -> i
getOmx :: Elm x i -> i
class (Monad m) => MkStream m x i where
mkStream :: x -> Context i -> i -> i -> S.Stream m (Elm x i)
class Build x where
type Stack x :: *
type Stack x = S :!: x
build :: x -> Stack x
default build :: (Stack x ~ (S :!: x)) => x -> Stack x
build x = S :!: x
instance Build x => Build (x:!:y) where
type Stack (x:!:y) = Stack x :!: y
build (x:!:y) = build x :!: y
data S = S
deriving (Eq,Show)
instance
(
) => Element S i where
data Elm S i = ElmS !i !i
type Arg S = Z
getArg (ElmS _ _) = Z
getIdx (ElmS i _) = i
getOmx (ElmS _ o) = o
deriving instance Show ix => Show (Elm S ix)
staticCheck :: Monad m => Bool -> S.Stream m a -> S.Stream m a
staticCheck b (S.Stream step t n) = b `seq` S.Stream snew (CheckLeft (b:.t)) (toMax n) where
snew (CheckLeft (False:._)) = return $ S.Done
snew (CheckLeft (True :.s)) = return $ S.Skip (CheckRight s)
snew (CheckRight s ) = do r <- step s
case r of
S.Yield x s' -> return $ S.Yield x (CheckRight s')
S.Skip s' -> return $ S.Skip (CheckRight s')
S.Done -> return $ S.Done
data StaticCheck a b = CheckLeft a | CheckRight b
data TableConstraint
= EmptyOk
| NonEmpty
| OnlyZero
deriving (Eq,Show)
minSize :: TableConstraint -> Int
minSize NonEmpty = 1
minSize _ = 0
class ModifyConstraint t where
toNonEmpty :: t -> t
toEmpty :: t -> t
type family TblConstraint x :: *
type instance TblConstraint (is:.i) = TblConstraint is :. TblConstraint i
type instance TblConstraint Z = Z
type instance TblConstraint (Outside o) = TblConstraint o
type instance TblConstraint (Complement o) = TblConstraint o
type instance TblConstraint PointL = TableConstraint
type instance TblConstraint PointR = TableConstraint
type instance TblConstraint Subword = TableConstraint