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 env -> Prod (b -> a) env
-> Prod a env
End :: a -> Prod a env
data DTerm = DTerm
data Symbol a env where
Term :: String -> Symbol DTerm env
Nont :: Ref a env -> Symbol a env
NontInt :: Symbol Int env
NontChar :: Symbol Char env
NontVarid :: Symbol String env
NontConid :: Symbol String env
NontOp :: Symbol String env
infixl 5 `ext`
ext :: Env Productions env def' -> [Prod a env]
-> Env Productions env (def', a)
ext g = Ext g . PS
matchSym :: Symbol a env -> Symbol b env
-> Maybe (Equal a b)
matchSym (Nont x) (Nont y) = 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 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)
data Lit a env = Lit (a env)
int :: Lit (Symbol Int) env
char :: Lit (Symbol Char) env
var :: Lit (Symbol String) env
con :: Lit (Symbol String) env
op :: Lit (Symbol String) env
int = Lit NontInt
char = Lit NontChar
var = Lit NontVarid
con = Lit NontConid
op = Lit NontOp
infixr 6 -:-
(-:-) = (,)
infixr 5 <.>, -.>, .>, <#>, -#>, #>
prd a = a ($)
prdId nt = Seq nt $ End id
((chn,s) <.> ps) f = Seq s $ ps f'
where f' sem r = \x -> f sem (chn .=. x .*. r)
(pn,Lit s) -.> pp = \r -> Seq s $ pp (f r)
where f r ff p = \x -> r ff (pn .=. (\(Record HNil) -> x) .*. p)
s .> pp = \r -> Seq (Term s) $ pp (f r)
where f r ff p = \DTerm -> r ff p
((chn,s) <#> sem) f = Seq s (End $ f')
where f' = \x -> f sem
(chn .=. x .*. emptyRecord)
(pn,Lit s) -#> ff = \r -> Seq s (End $ f r)
where f r = \x -> r ff (pn .=. (\(Record HNil) -> x) .*. emptyRecord)
s #> ff = \r -> Seq (Term s) (End $ f r)
where f r = \DTerm -> r ff emptyRecord