module Data.Parser.Grempa.Grammar.Typed
( Grammar
, Rule, Prod(..), Symbol(..), RId(..)
, GrammarState
, rule
, evalGrammar
, augment
, getFun
, ToSym(..)
, (<@>), (<@)
, (<#>), (<#)
, epsilon) where
import Control.Monad.State
import Data.Data
import Data.Dynamic
import Data.Parser.Grempa.Parser.Table
type Rule t a = [Prod t a]
data Prod t a where
PSeq :: Prod t (b -> a) -> Symbol t b -> Prod t a
PSeqN :: Prod t a -> Symbol t b -> Prod t a
PFun :: Typeable a => a -> Prod t a
deriving Typeable
data Symbol t a where
STerm :: t -> Symbol t t
SRule :: RId t a -> Symbol t a
data RId s a where
RId :: (Typeable t, Typeable a)
=> {rId :: RuleI, rIdRule :: Rule t a} -> RId t a
deriving Typeable
newtype RuleIDs t = RuleIDs { rules :: [RuleI] }
type GrammarState t = State (RuleIDs t)
type Grammar t a = GrammarState t (RId t a)
evalGrammar :: GrammarState t a -> a
evalGrammar = flip evalState (RuleIDs [0..])
augment :: (Typeable t, Typeable a) => Grammar t a -> Grammar t a
augment g = do
rec
s <- rule [id <@> r]
r <- g
return s
getFun :: Prod t a -> DynFun
getFun = getFun' []
where
getFun' :: [Bool] -> Prod s a -> DynFun
getFun' as prod = case prod of
PFun f -> DynFun (toDyn f) as
PSeq p _ -> getFun' (True :as) p
PSeqN p _ -> getFun' (False:as) p
rule :: (Typeable a, Typeable t) => Rule t a -> Grammar t a
rule r = do
st <- get
let i:is = rules st
put st {rules = is}
return $ RId i r
class ToSym t a where
type ToSymT t a :: *
toSym :: a -> Symbol t (ToSymT t a)
instance ToSym t t where
type ToSymT t t = t
toSym = STerm
instance ToSym t (RId t a) where
type ToSymT t (RId t a) = a
toSym = SRule
instance ToSym t (Symbol t a) where
type ToSymT t (Symbol t a) = a
toSym = id
infixl 3 <#>
(<#>) :: (ToSym t x, ToSymT t x ~ b)
=> Prod t (b -> a) -> x -> Prod t a
p <#> q = PSeq p $ toSym q
infixl 3 <#
(<#) :: ToSym t x
=> Prod t a -> x -> Prod t a
p <# q = PSeqN p $ toSym q
infixl 3 <@>
(<@>) :: (ToSym t x, ToSymT t x ~ b, Typeable a, Typeable b)
=> (b -> a)
-> x
-> Prod t a
f <@> p = PSeq (PFun f) $ toSym p
infixl 3 <@
(<@) :: (ToSym t x, Typeable a)
=> a
-> x
-> Prod t a
f <@ p = PSeqN (PFun f) $ toSym p
epsilon :: Typeable a => a -> Prod t a
epsilon c = PFun c