Safe Haskell | None |
---|---|
Language | Haskell2010 |
Documentation
class KnownSymbol v => HasRuleExprField rules (v :: Symbol) where #
type RuleExprReturnType rules (v :: Symbol) #
getExprField :: rules -> proxy v -> RuleExprType rules (RuleExprReturnType rules v) #
nonTerminalName :: rules -> proxy v -> String #
type family RuleExprType rules :: Type -> Type #
class MemberInitials rules (initials :: [Symbol]) where #
memberInitials :: T (DictF (HasRuleExprField rules)) initials #
generateRules :: T (DictF (HasRuleExprField rules)) (RulesTag rules) #
class GrammarToken tokens elem where #
tokenToTerminal :: Proxy tokens -> elem -> T (TokensTag tokens) #
semActM :: forall ctx us a. T ctx => T a => (HTExpList us -> Q (TExp (ActionTask ctx a))) -> T TTypeQ us -> SemActM ctx us a Source #
data DictF (a :: k -> Constraint) (b :: k) where #
DictF :: forall k (a :: k -> Constraint) (b :: k). a b => DictF a b |
newtype ActionTask ctx a #
ActionTask | |
|
Instances
Monad (ActionTask ctx) | |
Defined in Language.Parser.Ptera.Syntax (>>=) :: ActionTask ctx a -> (a -> ActionTask ctx b) -> ActionTask ctx b # (>>) :: ActionTask ctx a -> ActionTask ctx b -> ActionTask ctx b # return :: a -> ActionTask ctx a # | |
Functor (ActionTask ctx) | |
Defined in Language.Parser.Ptera.Syntax fmap :: (a -> b) -> ActionTask ctx a -> ActionTask ctx b # (<$) :: a -> ActionTask ctx b -> ActionTask ctx a # | |
Applicative (ActionTask ctx) | |
Defined in Language.Parser.Ptera.Syntax pure :: a -> ActionTask ctx a # (<*>) :: ActionTask ctx (a -> b) -> ActionTask ctx a -> ActionTask ctx b # liftA2 :: (a -> b -> c) -> ActionTask ctx a -> ActionTask ctx b -> ActionTask ctx c # (*>) :: ActionTask ctx a -> ActionTask ctx b -> ActionTask ctx b # (<*) :: ActionTask ctx a -> ActionTask ctx b -> ActionTask ctx a # |
data ActionTaskResult ctx a #
Instances
Functor (ActionTaskResult ctx) | |
Defined in Language.Parser.Ptera.Syntax fmap :: (a -> b) -> ActionTaskResult ctx a -> ActionTaskResult ctx b # (<$) :: a -> ActionTaskResult ctx b -> ActionTaskResult ctx a # | |
(Eq a, Eq ctx) => Eq (ActionTaskResult ctx a) | |
Defined in Language.Parser.Ptera.Syntax (==) :: ActionTaskResult ctx a -> ActionTaskResult ctx a -> Bool # (/=) :: ActionTaskResult ctx a -> ActionTaskResult ctx a -> Bool # | |
(Show a, Show ctx) => Show (ActionTaskResult ctx a) | |
Defined in Language.Parser.Ptera.Syntax showsPrec :: Int -> ActionTaskResult ctx a -> ShowS # show :: ActionTaskResult ctx a -> String # showList :: [ActionTaskResult ctx a] -> ShowS # |
getAction :: ActionTask ctx ctx #
modifyAction :: (ctx -> ctx) -> ActionTask ctx () #
failAction :: ActionTask ctx a #
fixGrammar :: forall (initials :: [Symbol]) (action :: [Type] -> Type -> Type) rules tokens elem. (MemberInitials rules initials, Rules rules, RuleExprType rules ~ RuleExpr action rules tokens elem) => rules -> Grammar action rules tokens elem initials #
ruleExpr :: forall (action :: [Type] -> Type -> Type) rules tokens elem a. [Alt action rules tokens elem a] -> RuleExpr action rules tokens elem a #
(<^>) :: TypedExpr rules tokens elem us1 -> TypedExpr rules tokens elem us2 -> TypedExpr rules tokens elem (Concat us1 us2) infixr 5 Source #
(<:>) :: T ctx => T a => TypedExpr rules tokens elem us -> (HTExpList us -> Q (TExp a)) -> AltM ctx rules tokens elem a infixl 4 Source #
(<::>) :: T ctx => T a => TypedExpr rules tokens elem us -> (HTExpList us -> Q (TExp (ActionTask ctx a))) -> AltM ctx rules tokens elem a infixl 4 Source #
var :: forall v rules tokens elem proxy1 proxy2 a. KnownSymbol v => a ~ RuleExprReturnType rules v => T a => proxy1 rules -> proxy2 v -> TypedExpr rules tokens elem '[a] Source #
varA :: forall v rules tokens elem a. KnownSymbol v => a ~ RuleExprReturnType rules v => T a => TypedExpr rules tokens elem '[a] Source #
tok :: forall t rules tokens elem proxy. T elem => proxy elem -> Membership (TokensTag tokens) t -> TypedExpr rules tokens elem '[elem] Source #
class TokensMember tokens (t :: Symbol) where #
tokensMembership :: Proxy# '(tokens, t) -> Membership (TokensTag tokens) t #