Copyright | (c) Karl Cronburg 2018 |
---|---|
License | BSD3 |
Maintainer | karl@cs.tufts.edu |
Stability | experimental |
Portability | POSIX |
Safe Haskell | None |
Language | Haskell2010 |
Synopsis
- data Grammar s nts ts dt = G {}
- data ProdElem nts ts
- type ProdElems nts ts = [ProdElem nts ts]
- data Production s nts ts dt = Production nts (ProdRHS s nts ts) (Maybe dt)
- data ProdRHS s nts ts = Prod (StateFncn s) (ProdElems nts ts)
- data StateFncn s
- data Predicate p = Predicate String p
- data Mutator s = Mutator String ()
- class Ref v where
- getRHS :: Production s nts ts dt -> ProdRHS s nts ts
- getLHS :: Production s nts ts dt -> nts
- getDataType :: Production s nts t dt -> Maybe dt
- isSem :: ProdRHS s nts ts -> Bool
- isAction :: ProdRHS s nts ts -> Bool
- sameNTs :: forall nt. (Ref nt, Eq (Sym nt)) => nt -> nt -> Bool
- sameTs :: forall t. (Ref t, Eq (Sym t)) => t -> t -> Bool
- isNT :: ProdElem nts ts -> Bool
- isT :: ProdElem nts ts -> Bool
- isEps :: ProdElem nts ts -> Bool
- getNTs :: [ProdElem b ts] -> [b]
- getTs :: [ProdElem nts b] -> [b]
- getEps :: [ProdElem nts1 ts1] -> [ProdElem nts2 ts2]
- prodsFor :: forall s nts ts dt. Eq nts => Grammar s nts ts dt -> nts -> [Production s nts ts dt]
- getProds :: [ProdRHS s nts ts] -> [ProdElems nts ts]
- validGrammar :: forall s nts ts dt. (Eq nts, Ord nts, Eq ts, Ord ts, Hashable nts, Hashable ts) => Grammar s nts ts dt -> Bool
- hasAllNonTerms :: (Eq nts, Ord nts, Hashable nts, Hashable ts) => Grammar s nts ts dt -> Bool
- hasAllTerms :: (Eq ts, Ord ts, Hashable nts, Hashable ts) => Grammar s nts ts dt -> Bool
- startIsNonTerm :: (Ord nts, Hashable nts) => Grammar s nts ts dt -> Bool
- symbols :: (Ord nts, Ord ts, Hashable s, Hashable nts, Hashable ts) => Grammar s nts ts dt -> Set (ProdElem nts ts)
- defaultGrammar :: forall s nts ts dt. (Ord ts, Hashable ts, Hashable nts, Eq nts) => nts -> Grammar s nts ts dt
Data types
data Grammar s nts ts dt Source #
Core representation of a grammar, as used by the parsing algorithms.
Instances
(Eq s, Eq nts, Eq ts, Eq dt, Hashable nts, Hashable ts, Prettify s, Prettify nts, Prettify ts) => Eq (Grammar s nts ts dt) Source # | |
(Show nts, Show ts, Show s, Show dt) => Show (Grammar s nts ts dt) Source # | |
(Hashable nts, Hashable ts, Eq nts, Eq ts, Lift nts, Lift ts, Lift dt, Data s) => Lift (Grammar s nts ts dt) Source # | |
(Prettify s, Prettify nts, Prettify ts, Prettify dt, Hashable ts, Eq ts, Hashable nts, Eq nts, Ord ts, Ord nts, Ord dt) => Prettify (Grammar s nts ts dt) Source # | |
Grammar ProdElems
nts == Non Terminal Symbol (type) ts == Terminal Symbol (type)
Production elements are only used in the grammar data structure and parser,
therefore these types (nt and ts) are not necessarily equivalent to the
terminal types seen by the tokenizer (nonterminals are special because no one
sees them until after parsing). Also pushing (ts = Sym t)
up to the top of
data constructors gets rid of a lot of unnecessary standalone deriving
instances. Standalone deriving instances in this case are a programming
anti-pattern for allowing you to improperly parametrize your types. In this
case a ProdElem
cares about the terminal symbol type, not the __terminal
token type__. In fact it's redundant to say *terminal token* because all
tokens are terminals in the grammar. A token is by definition a tokenized
value with a named terminal symbol, which is in fact exactly what the
Token
type looks like in Tokenizer
:
(name and
value). So wherever I see an Token
n vn
type variable in the tokenizer, this is
equivalent to (
in the parser. And wherever I see a Sym
t)(
in the
tokenizer, this gets passed into the parser as Token
n v)t
:
n ==Sym
t (Token
n v) == t
NT nts | Nonterminal production element |
T ts | Terminal production element |
Eps | Empty string production element |
Instances
(Eq nts, Eq ts) => Eq (ProdElem nts ts) Source # | |
(Data nts, Data ts) => Data (ProdElem nts ts) Source # | |
Defined in Text.ANTLR.Grammar gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ProdElem nts ts -> c (ProdElem nts ts) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (ProdElem nts ts) # toConstr :: ProdElem nts ts -> Constr # dataTypeOf :: ProdElem nts ts -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (ProdElem nts ts)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (ProdElem nts ts)) # gmapT :: (forall b. Data b => b -> b) -> ProdElem nts ts -> ProdElem nts ts # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ProdElem nts ts -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ProdElem nts ts -> r # gmapQ :: (forall d. Data d => d -> u) -> ProdElem nts ts -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> ProdElem nts ts -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> ProdElem nts ts -> m (ProdElem nts ts) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ProdElem nts ts -> m (ProdElem nts ts) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ProdElem nts ts -> m (ProdElem nts ts) # | |
(Ord nts, Ord ts) => Ord (ProdElem nts ts) Source # | |
Defined in Text.ANTLR.Grammar compare :: ProdElem nts ts -> ProdElem nts ts -> Ordering # (<) :: ProdElem nts ts -> ProdElem nts ts -> Bool # (<=) :: ProdElem nts ts -> ProdElem nts ts -> Bool # (>) :: ProdElem nts ts -> ProdElem nts ts -> Bool # (>=) :: ProdElem nts ts -> ProdElem nts ts -> Bool # max :: ProdElem nts ts -> ProdElem nts ts -> ProdElem nts ts # min :: ProdElem nts ts -> ProdElem nts ts -> ProdElem nts ts # | |
(Show nts, Show ts) => Show (ProdElem nts ts) Source # | |
Generic (ProdElem nts ts) Source # | |
(Lift nts, Lift ts) => Lift (ProdElem nts ts) Source # | |
(Hashable nts, Hashable ts) => Hashable (ProdElem nts ts) Source # | |
Defined in Text.ANTLR.Grammar | |
(Prettify nts, Prettify ts) => Prettify (ProdElem nts ts) Source # | |
type Rep (ProdElem nts ts) Source # | |
Defined in Text.ANTLR.Grammar type Rep (ProdElem nts ts) = D1 (MetaData "ProdElem" "Text.ANTLR.Grammar" "antlr-haskell-0.1.0.1-47wJxWjYxn91lXcjBVmKNu" False) (C1 (MetaCons "NT" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 nts)) :+: (C1 (MetaCons "T" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ts)) :+: C1 (MetaCons "Eps" PrefixI False) (U1 :: Type -> Type))) |
data Production s nts ts dt Source #
A single production rule with some datatype dt annotating what gets produced when this production rule fires.
Production nts (ProdRHS s nts ts) (Maybe dt) |
Instances
(Eq nts, Eq ts, Eq dt) => Eq (Production s nts ts dt) Source # | |
Defined in Text.ANTLR.Grammar (==) :: Production s nts ts dt -> Production s nts ts dt -> Bool # (/=) :: Production s nts ts dt -> Production s nts ts dt -> Bool # | |
(Data s, Data nts, Data ts, Data dt) => Data (Production s nts ts dt) Source # | |
Defined in Text.ANTLR.Grammar gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Production s nts ts dt -> c (Production s nts ts dt) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Production s nts ts dt) # toConstr :: Production s nts ts dt -> Constr # dataTypeOf :: Production s nts ts dt -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Production s nts ts dt)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Production s nts ts dt)) # gmapT :: (forall b. Data b => b -> b) -> Production s nts ts dt -> Production s nts ts dt # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Production s nts ts dt -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Production s nts ts dt -> r # gmapQ :: (forall d. Data d => d -> u) -> Production s nts ts dt -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Production s nts ts dt -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Production s nts ts dt -> m (Production s nts ts dt) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Production s nts ts dt -> m (Production s nts ts dt) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Production s nts ts dt -> m (Production s nts ts dt) # | |
(Ord nts, Ord ts, Ord dt) => Ord (Production s nts ts dt) Source # | |
Defined in Text.ANTLR.Grammar compare :: Production s nts ts dt -> Production s nts ts dt -> Ordering # (<) :: Production s nts ts dt -> Production s nts ts dt -> Bool # (<=) :: Production s nts ts dt -> Production s nts ts dt -> Bool # (>) :: Production s nts ts dt -> Production s nts ts dt -> Bool # (>=) :: Production s nts ts dt -> Production s nts ts dt -> Bool # max :: Production s nts ts dt -> Production s nts ts dt -> Production s nts ts dt # min :: Production s nts ts dt -> Production s nts ts dt -> Production s nts ts dt # | |
(Show s, Show nts, Show ts, Show dt) => Show (Production s nts ts dt) Source # | |
Defined in Text.ANTLR.Grammar showsPrec :: Int -> Production s nts ts dt -> ShowS # show :: Production s nts ts dt -> String # showList :: [Production s nts ts dt] -> ShowS # | |
Generic (Production s nts ts dt) Source # | |
Defined in Text.ANTLR.Grammar type Rep (Production s nts ts dt) :: Type -> Type # from :: Production s nts ts dt -> Rep (Production s nts ts dt) x # to :: Rep (Production s nts ts dt) x -> Production s nts ts dt # | |
(Lift nts, Lift ts, Lift dt) => Lift (Production s nts ts dt) Source # | |
Defined in Text.ANTLR.Grammar lift :: Production s nts ts dt -> Q Exp # | |
(Hashable nts, Hashable ts, Hashable dt) => Hashable (Production s nts ts dt) Source # | |
Defined in Text.ANTLR.Grammar hashWithSalt :: Int -> Production s nts ts dt -> Int # hash :: Production s nts ts dt -> Int # | |
(Prettify s, Prettify nts, Prettify ts, Prettify dt) => Prettify (Production s nts ts dt) Source # | |
Defined in Text.ANTLR.Grammar prettify :: Production s nts ts dt -> Pretty Source # prettifyList :: [Production s nts ts dt] -> Pretty Source # | |
type Rep (Production s nts ts dt) Source # | |
Defined in Text.ANTLR.Grammar type Rep (Production s nts ts dt) = D1 (MetaData "Production" "Text.ANTLR.Grammar" "antlr-haskell-0.1.0.1-47wJxWjYxn91lXcjBVmKNu" False) (C1 (MetaCons "Production" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 nts) :*: (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (ProdRHS s nts ts)) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe dt))))) |
data ProdRHS s nts ts Source #
Right-hand side of a single production rule
Instances
(Eq nts, Eq ts) => Eq (ProdRHS s nts ts) Source # | |
(Data s, Data nts, Data ts) => Data (ProdRHS s nts ts) Source # | |
Defined in Text.ANTLR.Grammar gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ProdRHS s nts ts -> c (ProdRHS s nts ts) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (ProdRHS s nts ts) # toConstr :: ProdRHS s nts ts -> Constr # dataTypeOf :: ProdRHS s nts ts -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (ProdRHS s nts ts)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (ProdRHS s nts ts)) # gmapT :: (forall b. Data b => b -> b) -> ProdRHS s nts ts -> ProdRHS s nts ts # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ProdRHS s nts ts -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ProdRHS s nts ts -> r # gmapQ :: (forall d. Data d => d -> u) -> ProdRHS s nts ts -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> ProdRHS s nts ts -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> ProdRHS s nts ts -> m (ProdRHS s nts ts) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ProdRHS s nts ts -> m (ProdRHS s nts ts) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ProdRHS s nts ts -> m (ProdRHS s nts ts) # | |
(Ord nts, Ord ts) => Ord (ProdRHS s nts ts) Source # | |
Defined in Text.ANTLR.Grammar compare :: ProdRHS s nts ts -> ProdRHS s nts ts -> Ordering # (<) :: ProdRHS s nts ts -> ProdRHS s nts ts -> Bool # (<=) :: ProdRHS s nts ts -> ProdRHS s nts ts -> Bool # (>) :: ProdRHS s nts ts -> ProdRHS s nts ts -> Bool # (>=) :: ProdRHS s nts ts -> ProdRHS s nts ts -> Bool # max :: ProdRHS s nts ts -> ProdRHS s nts ts -> ProdRHS s nts ts # min :: ProdRHS s nts ts -> ProdRHS s nts ts -> ProdRHS s nts ts # | |
(Show nts, Show ts) => Show (ProdRHS s nts ts) Source # | |
Generic (ProdRHS s nts ts) Source # | |
(Lift nts, Lift ts) => Lift (ProdRHS s nts ts) Source # | |
(Hashable nts, Hashable ts) => Hashable (ProdRHS s nts ts) Source # | |
Defined in Text.ANTLR.Grammar | |
(Prettify s, Prettify nts, Prettify ts) => Prettify (ProdRHS s nts ts) Source # | |
type Rep (ProdRHS s nts ts) Source # | |
Defined in Text.ANTLR.Grammar type Rep (ProdRHS s nts ts) = D1 (MetaData "ProdRHS" "Text.ANTLR.Grammar" "antlr-haskell-0.1.0.1-47wJxWjYxn91lXcjBVmKNu" False) (C1 (MetaCons "Prod" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (StateFncn s)) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (ProdElems nts ts)))) |
A function to run when a production rule fires, operating some state s
.
Pass | No predicate or mutator |
Sem (Predicate ()) | Semantic predicate |
Action (Mutator ()) | Mutator, ProdElems is always empty in this one |
Instances
Eq (StateFncn s) Source # | |
Data s => Data (StateFncn s) Source # | |
Defined in Text.ANTLR.Grammar gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> StateFncn s -> c (StateFncn s) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (StateFncn s) # toConstr :: StateFncn s -> Constr # dataTypeOf :: StateFncn s -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (StateFncn s)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (StateFncn s)) # gmapT :: (forall b. Data b => b -> b) -> StateFncn s -> StateFncn s # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> StateFncn s -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> StateFncn s -> r # gmapQ :: (forall d. Data d => d -> u) -> StateFncn s -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> StateFncn s -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> StateFncn s -> m (StateFncn s) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> StateFncn s -> m (StateFncn s) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> StateFncn s -> m (StateFncn s) # | |
Ord (StateFncn s) Source # | |
Defined in Text.ANTLR.Grammar | |
Show (StateFncn s) Source # | |
Generic (StateFncn s) Source # | |
Lift (StateFncn s) Source # | |
Hashable (StateFncn s) Source # | |
Defined in Text.ANTLR.Grammar | |
Prettify (StateFncn s) Source # | |
type Rep (StateFncn s) Source # | |
Defined in Text.ANTLR.Grammar type Rep (StateFncn s) = D1 (MetaData "StateFncn" "Text.ANTLR.Grammar" "antlr-haskell-0.1.0.1-47wJxWjYxn91lXcjBVmKNu" False) (C1 (MetaCons "Pass" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "Sem" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Predicate ()))) :+: C1 (MetaCons "Action" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Mutator ()))))) |
Predicates and Mutators act over some state. The String identifiers should eventually correspond to source-level e.g. location / allocation site information, i.e. two predicates or mutators are equivalent iff they were constructed from the same production rule.
Instances
Eq (Predicate s) Source # | |
Data p => Data (Predicate p) Source # | |
Defined in Text.ANTLR.Grammar gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Predicate p -> c (Predicate p) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Predicate p) # toConstr :: Predicate p -> Constr # dataTypeOf :: Predicate p -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Predicate p)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Predicate p)) # gmapT :: (forall b. Data b => b -> b) -> Predicate p -> Predicate p # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Predicate p -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Predicate p -> r # gmapQ :: (forall d. Data d => d -> u) -> Predicate p -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Predicate p -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Predicate p -> m (Predicate p) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Predicate p -> m (Predicate p) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Predicate p -> m (Predicate p) # | |
Ord (Predicate s) Source # | |
Defined in Text.ANTLR.Grammar | |
Show (Predicate s) Source # | |
(Data s, Typeable s) => Lift (Predicate s) Source # | |
Hashable (Predicate s) Source # | |
Defined in Text.ANTLR.Grammar | |
Prettify (Predicate s) Source # | |
Function for mutating the state of the parser when a certain production rule fires.
Instances
Eq (Mutator s) Source # | |
Data s => Data (Mutator s) Source # | |
Defined in Text.ANTLR.Grammar gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Mutator s -> c (Mutator s) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Mutator s) # toConstr :: Mutator s -> Constr # dataTypeOf :: Mutator s -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Mutator s)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Mutator s)) # gmapT :: (forall b. Data b => b -> b) -> Mutator s -> Mutator s # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mutator s -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mutator s -> r # gmapQ :: (forall d. Data d => d -> u) -> Mutator s -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Mutator s -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Mutator s -> m (Mutator s) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Mutator s -> m (Mutator s) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Mutator s -> m (Mutator s) # | |
Ord (Mutator s) Source # | |
Defined in Text.ANTLR.Grammar | |
Show (Mutator s) Source # | |
(Data s, Typeable s) => Lift (Mutator s) Source # | |
Hashable (Mutator s) Source # | |
Defined in Text.ANTLR.Grammar | |
Prettify (Mutator s) Source # | |
Something is Ref if it can be symbolized by some symbol in a set of symbols. Symbols are typically Strings, an enum data type, or some other Eq-able (best if finite) set of things.
Basic setter / getter functions:
getRHS :: Production s nts ts dt -> ProdRHS s nts ts Source #
Inline get ProdRHS
of a Production
getLHS :: Production s nts ts dt -> nts Source #
Inline get the nonterminal symbol naming a Production
getDataType :: Production s nts t dt -> Maybe dt Source #
sameNTs :: forall nt. (Ref nt, Eq (Sym nt)) => nt -> nt -> Bool Source #
Nonterminals can be symbolized (for now the types are equivalent, i.e. nt == Sym nt)
getEps :: [ProdElem nts1 ts1] -> [ProdElem nts2 ts2] Source #
Get just the epsilons from a list (umm...)
prodsFor :: forall s nts ts dt. Eq nts => Grammar s nts ts dt -> nts -> [Production s nts ts dt] Source #
Get only the productions for the given nonterminal symbol nts:
getProds :: [ProdRHS s nts ts] -> [ProdElems nts ts] Source #
Get just the production elements from a bunch of production rules
validGrammar :: forall s nts ts dt. (Eq nts, Ord nts, Eq ts, Ord ts, Hashable nts, Hashable ts) => Grammar s nts ts dt -> Bool Source #
Does the given grammar make any sense?
hasAllNonTerms :: (Eq nts, Ord nts, Hashable nts, Hashable ts) => Grammar s nts ts dt -> Bool Source #
All nonterminals in production rules can be found in the nonterminals list.
hasAllTerms :: (Eq ts, Ord ts, Hashable nts, Hashable ts) => Grammar s nts ts dt -> Bool Source #
All terminals in production rules can be found in the terminal list.
startIsNonTerm :: (Ord nts, Hashable nts) => Grammar s nts ts dt -> Bool Source #
The starting symbol is a valid nonterminal.