module Language.Grammars.Grammar where
import Language.AbstractSyntax.TTTAS
import Language.Grammars.AspectAG hiding (append)
data Grammar a
= forall env . Grammar (Ref a env)
(Env Productions env env)
newtype Productions a env
= PS {unPS :: [Prod a env]}
data Prod a env where
Seq :: Symbol b t env -> Prod (b -> a) env
-> Prod a env
End :: a -> Prod a env
data DTerm = DTerm
data TTerm
data TNonT
data TAttT
data Symbol a t env where
Term :: String -> Symbol DTerm TTerm env
Nont :: Ref a env -> Symbol a TNonT env
NontInt :: Symbol Int TAttT env
NontChar :: Symbol Char TAttT env
NontVarid :: Symbol String TAttT env
NontConid :: Symbol String TAttT env
NontOp :: Symbol String TAttT env
getRefNT :: Symbol a TNonT env -> Ref a env
getRefNT (Nont ref) = ref
pairEq :: Maybe (Equal a b) -> Maybe (Equal (a,t) (b,t))
pairEq (Just Eq) = Just Eq
pairEq Nothing = Nothing
matchSym :: Symbol a t1 env -> Symbol b t2 env
-> Maybe (Equal (a,t1) (b,t2))
matchSym (Nont x) (Nont y) = pairEq $ match x y
matchSym (Term x) (Term y) | x == y = Just Eq
matchSym NontInt NontInt = Just Eq
matchSym NontVarid NontVarid = Just Eq
matchSym NontConid NontConid = Just Eq
matchSym NontOp NontOp = Just Eq
matchSym _ _ = Nothing
append :: (a -> b -> c) -> Prod a env -> Symbol b t env
-> Prod c env
append g (End f ) s = Seq s (End (g f))
append g (Seq t ts ) s
= Seq t (append (\b c d -> g (b d) c) ts s)
int :: Symbol Int TAttT env
char :: Symbol Char TAttT env
var :: Symbol String TAttT env
con :: Symbol String TAttT env
op :: Symbol String TAttT env
int = NontInt
char = NontChar
var = NontVarid
con = NontConid
op = NontOp
data EP a b env = EP a (b env)
infixr 6 <=>
(<=>) :: a -> b env -> EP a b env
(<=>) = EP
infixr 5 <.>
data PreProd a b env = PreProd (a -> (Prod b env))
class ProdSeq a b c d | a c -> b d where
(<.>) :: a env -> b env -> PreProd c d env
instance (HExtend (LVPair t v) l l') => ProdSeq
(EP t (Symbol b TNonT))
(PreProd (l -> v -> t2) (b -> a))
(l' -> t2)
a where
(EP chn s) <.> (PreProd ps) = PreProd $
\f -> let f' r = \x -> f (chn .=. x .*. r)
in Seq s $ ps f'
instance (HExtend (LVPair t (Record HNil -> v)) l l') => ProdSeq
(EP t (Symbol b TAttT))
(PreProd (l -> v -> t2) (b -> a))
(l' -> t2)
a where
(EP pn s) <.> (PreProd pp) = PreProd $ \r -> Seq s $ pp (f r)
where f r p = \x -> r (pn .=. (\(Record HNil) -> x) .*. p)
instance ProdSeq
(Symbol DTerm TTerm)
(PreProd (t1 -> DTerm -> t2) (DTerm -> a))
(t1 -> t2)
a where
s <.> (PreProd pp) = PreProd $ \r -> Seq s $ pp (f r)
where f r p = \DTerm -> r p
prdEnd :: PreProd (Record HNil -> b) b env
prdEnd = PreProd $ \f -> End (f emptyRecord)
prd :: (a -> b) -> PreProd (a -> b) t t1 -> Prod t t1
prd sem (PreProd ps) = ps sem
prdId :: Symbol a TNonT env -> Prod a env
prdId nt = Seq nt $ End id