module Text.GrammarCombinators.Base.Domain (
DomainMap(supIx, subIx),
DomainEmbedding(supPF),
SubVal(MkSubVal, unSubVal),
IxMapId, IxMapBase, IxMapSeq, ApplyIxMap,
MemoFam(toMemo, fromMemo), Memo, memoFamily,
FoldFam(foldFam),
EqFam(overrideIdx, eqIdx), overrideIdxK,
ShowFam(showIdx),
Domain,
memoFamilyK, toMemoK, fromMemoK,
LiftFam(liftIdxE, liftIdxP)
) where
import Generics.MultiRec.Base
import Generics.MultiRec.HFunctor
import Language.Haskell.TH.Syntax (Exp, Pat)
data IxMapId
data IxMapBase (m :: * -> *)
data IxMapSeq (l1 :: *) (l2 :: * -> *)
type family ApplyIxMap (m :: *) ix
type instance ApplyIxMap (IxMapBase m) ix = m ix
type instance ApplyIxMap (IxMapSeq l1 l2) ix = ApplyIxMap l1 (l2 ix)
type instance ApplyIxMap IxMapId ix = ix
class MemoFam (phi :: * -> *) where
data Memo phi :: (* -> *) -> *
fromMemo :: Memo phi v -> (forall ix. phi ix -> v ix)
toMemo :: (forall ix. phi ix -> v ix) -> Memo phi v
memoFamily :: (MemoFam phi) =>
(forall ix. phi ix -> v ix) -> (forall ix. phi ix -> v ix)
memoFamily f = fromMemo (toMemo f)
memoFamilyK :: (MemoFam phi) =>
(forall ix. phi ix -> v) -> (forall ix. phi ix -> v)
memoFamilyK f = fromMemoK (toMemoK f)
toMemoK :: (MemoFam phi) =>
(forall ix. phi ix -> v) -> Memo phi (K0 v)
toMemoK f = toMemo (K0 . f)
fromMemoK :: (MemoFam phi) =>
Memo phi (K0 v) -> phi ix -> v
fromMemoK m = unK0 . fromMemo m
class FoldFam phi where
foldFam :: (forall ix. phi ix -> b -> b) -> b -> b
class ShowFam phi where
showIdx :: forall ix. phi ix -> String
class EqFam phi where
eqIdx :: forall ix1 ix2. phi ix1 -> phi ix2 -> Bool
eqIdx idx1 = overrideIdxK (const False) idx1 True
overrideIdx :: (forall ix'. phi ix' -> r ix') -> phi oix ->
r oix -> phi ix -> r ix
overrideIdxK :: (EqFam phi) => (forall ix'. phi ix' -> v) -> phi oix -> v -> phi ix -> v
overrideIdxK f idx v = unK0 . overrideIdx (K0 . f) idx (K0 v)
class (FoldFam phi,
ShowFam phi,
EqFam phi,
MemoFam phi) => Domain phi
class DomainMap phi phi' supIxT where
supIx :: phi' ix -> phi (supIxT ix)
subIx :: phi (supIxT ix) -> phi' ix
class (DomainMap phi phi' supIxT) =>
DomainEmbedding phi phi' supIxT where
supPF :: (HFunctor phi (PF phi)) =>
phi' ix -> phi (supIxT ix) ->
PF phi' (SubVal supIxT r) ix -> PF phi r (supIxT ix)
data SubVal (supIxT :: * -> *) v ix = MkSubVal {
unSubVal :: v (supIxT ix)
} deriving (Show)
class LiftFam phi where
liftIdxE :: phi ix -> Exp
liftIdxP :: phi ix -> Pat