module Language.Parser.Ptera.Syntax ( T, SafeGrammar.HasRuleExprField (..), SafeGrammar.TokensTag, SafeGrammar.RulesTag, SafeGrammar.RuleExprType, GrammarM, SafeGrammar.MemberInitials (..), SafeGrammar.Rules (..), SafeGrammar.GrammarToken (..), RuleExprM, AltM, SafeGrammar.Expr, HFList.HFList (..), HFList.DictF (..), HList, pattern HNil, pattern (:*), SemActM (..), semActM, ActionTask (..), ActionTaskResult (..), getAction, modifyAction, failAction, Grammar, RuleExpr, Alt, SemAct, semAct, SafeGrammar.fixGrammar, SafeGrammar.ruleExpr, (SafeGrammar.<^>), SafeGrammar.eps, (<:>), (<::>), SafeGrammar.var, SafeGrammar.varA, SafeGrammar.tok, SafeGrammar.TokensMember (..), SafeGrammar.tokA, ) where import Language.Parser.Ptera.Prelude import qualified Language.Parser.Ptera.Data.HFList as HFList import qualified Language.Parser.Ptera.Syntax.SafeGrammar as SafeGrammar type T ctx = GrammarM ctx type GrammarM ctx = SafeGrammar.Grammar (SemActM ctx) type RuleExprM ctx = SafeGrammar.RuleExpr (SemActM ctx) type AltM ctx = SafeGrammar.Alt (SemActM ctx) type Grammar = GrammarM () type RuleExpr = RuleExprM () type Alt = AltM () (<:>) :: SafeGrammar.Expr rules tokens elem us -> (HList us -> a) -> AltM ctx rules tokens elem a Expr rules tokens elem us e <:> :: forall rules tokens elem (us :: [*]) a ctx. Expr rules tokens elem us -> (HList us -> a) -> AltM ctx rules tokens elem a <:> HList us -> a act = Expr rules tokens elem us e forall rules tokens elem (us :: [*]) (action :: [*] -> * -> *) a. Expr rules tokens elem us -> action us a -> Alt action rules tokens elem a SafeGrammar.<:> forall (us :: [*]) a ctx. (HList us -> a) -> SemActM ctx us a semAct HList us -> a act infixl 4 <:> (<::>) :: SafeGrammar.Expr rules tokens elem us -> (HList us -> ActionTask ctx a) -> AltM ctx rules tokens elem a Expr rules tokens elem us e <::> :: forall rules tokens elem (us :: [*]) ctx a. Expr rules tokens elem us -> (HList us -> ActionTask ctx a) -> AltM ctx rules tokens elem a <::> HList us -> ActionTask ctx a act = Expr rules tokens elem us e forall rules tokens elem (us :: [*]) (action :: [*] -> * -> *) a. Expr rules tokens elem us -> action us a -> Alt action rules tokens elem a SafeGrammar.<:> forall (us :: [*]) ctx a. (HList us -> ActionTask ctx a) -> SemActM ctx us a semActM HList us -> ActionTask ctx a act infixl 4 <::> type HList = HFList.T Identity pattern HNil :: HList '[] pattern $bHNil :: HList '[] $mHNil :: forall {r}. HList '[] -> ((# #) -> r) -> ((# #) -> r) -> r HNil = HFList.HFNil pattern (:*) :: u -> HList us -> HList (u ': us) pattern x $b:* :: forall u (us :: [*]). u -> HList us -> HList (u : us) $m:* :: forall {r} {u} {us :: [*]}. HList (u : us) -> (u -> HList us -> r) -> ((# #) -> r) -> r :* xs = HFList.HFCons (Identity x) xs infixr 6 :* newtype SemActM ctx us a = SemActM { forall ctx (us :: [*]) a. SemActM ctx us a -> HList us -> ActionTask ctx a semanticAction :: HList us -> ActionTask ctx a } deriving forall ctx (us :: [*]) a b. a -> SemActM ctx us b -> SemActM ctx us a forall ctx (us :: [*]) a b. (a -> b) -> SemActM ctx us a -> SemActM ctx us b forall a b. a -> SemActM ctx us b -> SemActM ctx us a forall a b. (a -> b) -> SemActM ctx us a -> SemActM ctx us b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: forall a b. a -> SemActM ctx us b -> SemActM ctx us a $c<$ :: forall ctx (us :: [*]) a b. a -> SemActM ctx us b -> SemActM ctx us a fmap :: forall a b. (a -> b) -> SemActM ctx us a -> SemActM ctx us b $cfmap :: forall ctx (us :: [*]) a b. (a -> b) -> SemActM ctx us a -> SemActM ctx us b Functor type SemAct = SemActM () semActM :: (HList us -> ActionTask ctx a) -> SemActM ctx us a semActM :: forall (us :: [*]) ctx a. (HList us -> ActionTask ctx a) -> SemActM ctx us a semActM = forall ctx (us :: [*]) a. (HList us -> ActionTask ctx a) -> SemActM ctx us a SemActM semAct :: (HList us -> a) -> SemActM ctx us a semAct :: forall (us :: [*]) a ctx. (HList us -> a) -> SemActM ctx us a semAct HList us -> a f = forall ctx (us :: [*]) a. (HList us -> ActionTask ctx a) -> SemActM ctx us a SemActM \HList us l -> forall (f :: * -> *) a. Applicative f => a -> f a pure do HList us -> a f HList us l newtype ActionTask ctx a = ActionTask { forall ctx a. ActionTask ctx a -> ctx -> ActionTaskResult ctx a runActionTask :: ctx -> ActionTaskResult ctx a } deriving forall a b. a -> ActionTask ctx b -> ActionTask ctx a forall a b. (a -> b) -> ActionTask ctx a -> ActionTask ctx b forall ctx a b. a -> ActionTask ctx b -> ActionTask ctx a forall ctx a b. (a -> b) -> ActionTask ctx a -> ActionTask ctx b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: forall a b. a -> ActionTask ctx b -> ActionTask ctx a $c<$ :: forall ctx a b. a -> ActionTask ctx b -> ActionTask ctx a fmap :: forall a b. (a -> b) -> ActionTask ctx a -> ActionTask ctx b $cfmap :: forall ctx a b. (a -> b) -> ActionTask ctx a -> ActionTask ctx b Functor data ActionTaskResult ctx a = ActionTaskFail | ActionTaskResult a | ActionTaskModifyResult ctx a deriving (ActionTaskResult ctx a -> ActionTaskResult ctx a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall ctx a. (Eq a, Eq ctx) => ActionTaskResult ctx a -> ActionTaskResult ctx a -> Bool /= :: ActionTaskResult ctx a -> ActionTaskResult ctx a -> Bool $c/= :: forall ctx a. (Eq a, Eq ctx) => ActionTaskResult ctx a -> ActionTaskResult ctx a -> Bool == :: ActionTaskResult ctx a -> ActionTaskResult ctx a -> Bool $c== :: forall ctx a. (Eq a, Eq ctx) => ActionTaskResult ctx a -> ActionTaskResult ctx a -> Bool Eq, Int -> ActionTaskResult ctx a -> ShowS forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a forall ctx a. (Show a, Show ctx) => Int -> ActionTaskResult ctx a -> ShowS forall ctx a. (Show a, Show ctx) => [ActionTaskResult ctx a] -> ShowS forall ctx a. (Show a, Show ctx) => ActionTaskResult ctx a -> String showList :: [ActionTaskResult ctx a] -> ShowS $cshowList :: forall ctx a. (Show a, Show ctx) => [ActionTaskResult ctx a] -> ShowS show :: ActionTaskResult ctx a -> String $cshow :: forall ctx a. (Show a, Show ctx) => ActionTaskResult ctx a -> String showsPrec :: Int -> ActionTaskResult ctx a -> ShowS $cshowsPrec :: forall ctx a. (Show a, Show ctx) => Int -> ActionTaskResult ctx a -> ShowS Show, forall a b. a -> ActionTaskResult ctx b -> ActionTaskResult ctx a forall a b. (a -> b) -> ActionTaskResult ctx a -> ActionTaskResult ctx b forall ctx a b. a -> ActionTaskResult ctx b -> ActionTaskResult ctx a forall ctx a b. (a -> b) -> ActionTaskResult ctx a -> ActionTaskResult ctx b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: forall a b. a -> ActionTaskResult ctx b -> ActionTaskResult ctx a $c<$ :: forall ctx a b. a -> ActionTaskResult ctx b -> ActionTaskResult ctx a fmap :: forall a b. (a -> b) -> ActionTaskResult ctx a -> ActionTaskResult ctx b $cfmap :: forall ctx a b. (a -> b) -> ActionTaskResult ctx a -> ActionTaskResult ctx b Functor) getAction :: ActionTask ctx ctx getAction :: forall ctx. ActionTask ctx ctx getAction = forall ctx a. (ctx -> ActionTaskResult ctx a) -> ActionTask ctx a ActionTask \ctx ctx0 -> forall ctx a. a -> ActionTaskResult ctx a ActionTaskResult ctx ctx0 modifyAction :: (ctx -> ctx) -> ActionTask ctx () modifyAction :: forall ctx. (ctx -> ctx) -> ActionTask ctx () modifyAction ctx -> ctx f = forall ctx a. (ctx -> ActionTaskResult ctx a) -> ActionTask ctx a ActionTask \ctx ctx0 -> forall ctx a. ctx -> a -> ActionTaskResult ctx a ActionTaskModifyResult (ctx -> ctx f ctx ctx0) () failAction :: ActionTask ctx a failAction :: forall ctx a. ActionTask ctx a failAction = forall ctx a. (ctx -> ActionTaskResult ctx a) -> ActionTask ctx a ActionTask \ctx _ -> forall ctx a. ActionTaskResult ctx a ActionTaskFail instance Applicative (ActionTask ctx) where pure :: forall a. a -> ActionTask ctx a pure a x = forall ctx a. (ctx -> ActionTaskResult ctx a) -> ActionTask ctx a ActionTask \ctx _ -> forall ctx a. a -> ActionTaskResult ctx a ActionTaskResult a x ActionTask ctx -> ActionTaskResult ctx (a -> b) mf <*> :: forall a b. ActionTask ctx (a -> b) -> ActionTask ctx a -> ActionTask ctx b <*> ActionTask ctx -> ActionTaskResult ctx a mx = forall ctx a. (ctx -> ActionTaskResult ctx a) -> ActionTask ctx a ActionTask \ctx ctx0 -> case ctx -> ActionTaskResult ctx (a -> b) mf ctx ctx0 of ActionTaskResult ctx (a -> b) ActionTaskFail -> forall ctx a. ActionTaskResult ctx a ActionTaskFail ActionTaskResult a -> b f -> case ctx -> ActionTaskResult ctx a mx ctx ctx0 of ActionTaskResult ctx a ActionTaskFail -> forall ctx a. ActionTaskResult ctx a ActionTaskFail ActionTaskResult a x -> forall ctx a. a -> ActionTaskResult ctx a ActionTaskResult do a -> b f a x ActionTaskModifyResult ctx ctx1 a x -> forall ctx a. ctx -> a -> ActionTaskResult ctx a ActionTaskModifyResult ctx ctx1 do a -> b f a x ActionTaskModifyResult ctx ctx1 a -> b f -> case ctx -> ActionTaskResult ctx a mx ctx ctx1 of ActionTaskResult ctx a ActionTaskFail -> forall ctx a. ActionTaskResult ctx a ActionTaskFail ActionTaskResult a x -> forall ctx a. ctx -> a -> ActionTaskResult ctx a ActionTaskModifyResult ctx ctx1 do a -> b f a x ActionTaskModifyResult ctx ctx2 a x -> forall ctx a. ctx -> a -> ActionTaskResult ctx a ActionTaskModifyResult ctx ctx2 do a -> b f a x instance Monad (ActionTask ctx) where ActionTask ctx -> ActionTaskResult ctx a mx >>= :: forall a b. ActionTask ctx a -> (a -> ActionTask ctx b) -> ActionTask ctx b >>= a -> ActionTask ctx b f = forall ctx a. (ctx -> ActionTaskResult ctx a) -> ActionTask ctx a ActionTask \ctx ctx0 -> case ctx -> ActionTaskResult ctx a mx ctx ctx0 of ActionTaskResult ctx a ActionTaskFail -> forall ctx a. ActionTaskResult ctx a ActionTaskFail ActionTaskResult a x -> forall ctx a. ActionTask ctx a -> ctx -> ActionTaskResult ctx a runActionTask (a -> ActionTask ctx b f a x) ctx ctx0 ActionTaskModifyResult ctx ctx1 a x -> forall ctx a. ActionTask ctx a -> ctx -> ActionTaskResult ctx a runActionTask (a -> ActionTask ctx b f a x) ctx ctx1