Safe Haskell | None |
---|---|
Language | Haskell2010 |
The checker monad.
Responsible for throwing errors and accumulating warnings.
Synopsis
- class Monad m => MonadCheck m where
- fatalError :: FatalError -> m a
- recoverableError :: RecoverableError -> m ()
- warn :: Warning -> m ()
- atPosition :: ToPosition' p => p -> m a -> m a
- askPosition :: m Position'
- data FatalError
- data RecoverableError
- = DelimitersNotSupported
- | IncompatibleDefinition ICat Position
- | CoercionsOfCoerceCat
- | CoercionsOfBuiltinCat
- | CoercionsOfIdentCat
- | CoercionsOfTokenCat
- | UnknownCatName CatName
- | CoerceBuiltinCat BuiltinCat
- | CoerceIdentCat IdentCat
- | CoerceListCat CatName
- | CoerceTokenCat CatName
- | DuplicateLabel LabelName Position
- | DuplicateRHS Position
- | InvalidListRule LabelName
- | InvalidListLabel Type
- | InvalidLabelNil FunType
- | InvalidLabelCons FunType
- | InvalidLabelSg FunType
- | InvalidLabelWild FunType
- | IgnoringUndeclaredFunction
- | NotEnoughParameters (List1 String1)
- | DroppingSpuriousParameters (List1 Arg)
- | MissingArguments LabelName (List1 Type)
- | DroppingSpuriousArguments LabelName (List1 Exp)
- | ExpectedVsInferredType Type Type
- | NullableToken CatName Regex
- | IllformedBlockComment
- | ConflictingUsesOfLayoutKeyword Keyword Position
- | EmptyGrammar
- data Warning
- = FooWarning
- | LabelClashesWithCategory LabelName Position
- | IgnoringNullCoercions
- | NonUniformListRule Cat [Cat]
- | ParameterShouldBeLowerCase VarName
- | ShadowingParameter VarName
- | ShadowedByParameter VarName
- | EmptyToken CatName Regex
- | IgnoringEmptyLineComment
- | IgnoringEmptyBlockComment
- | EmptyLayoutKeyword
- | UndefinedLayoutKeyword Keyword
- | DuplicateLayoutKeyword Keyword Position
- | DuplicateLayoutTop Position
- type ICat = Cat' CatName
- type PFatalError = WithPosition' FatalError
- type PRecoverableError = WithPosition' RecoverableError
- type PWarning = WithPosition' Warning
- type PWarnErr = WithPosition' (Either RecoverableError Warning)
- type RecoverableErrors = [PRecoverableError]
- type Warnings = [PWarning]
- type WarnErrs = [PWarnErr]
- newtype Check a = Check {}
- runCheck :: Check a -> (Warnings, RecoverableErrors, Either PFatalError a)
Specification
class Monad m => MonadCheck m where Source #
Monad for error reporting and warnings.
Nothing
fatalError :: FatalError -> m a Source #
default fatalError :: (MonadTrans t, MonadCheck n, t n ~ m) => FatalError -> m a Source #
recoverableError :: RecoverableError -> m () Source #
default recoverableError :: (MonadTrans t, MonadCheck n, t n ~ m) => RecoverableError -> m () Source #
warn :: Warning -> m () Source #
default warn :: (MonadTrans t, MonadCheck n, t n ~ m) => Warning -> m () Source #
atPosition :: ToPosition' p => p -> m a -> m a Source #
Set the file position for subsequent errors.
default atPosition :: (MonadTransControl t, MonadCheck n, t n ~ m) => ToPosition' p => p -> m a -> m a Source #
askPosition :: m Position' Source #
Retrieve the stored position.
default askPosition :: (MonadTrans t, MonadCheck n, t n ~ m) => m Position' Source #
Instances
Warnings and errors
data FatalError Source #
Fatal errors (check cannot continue).
FatalError | |
UndefinedLabel LabelName | The given label isn't contained in the |
ListsDontInhabitType Type | A list expression was found at the given type, which isn't a |
Instances
Show FatalError Source # | |
Defined in BNFC.Check.Monad |
data RecoverableError Source #
Any of these errors allows to continue BNFC, but may result in undesired/illformed output.
DelimitersNotSupported | The pragma |
IncompatibleDefinition ICat Position | E.g. trying to mix ordinary rules with list pragmas or |
CoercionsOfCoerceCat | Trying to apply |
CoercionsOfBuiltinCat | Trying to apply |
CoercionsOfIdentCat | Trying to apply |
CoercionsOfTokenCat | Trying to apply |
UnknownCatName CatName | This base category is not defined. |
CoerceBuiltinCat BuiltinCat | Tried to make a precedence variant of a builtin category, like |
CoerceIdentCat IdentCat | Tried to make a precedence variant of an ident category, like |
CoerceListCat CatName | Tried to make a precedence variant of a list category, like |
CoerceTokenCat CatName | Tried to make a precedence variant of a token category, like |
DuplicateLabel LabelName Position | |
DuplicateRHS Position | The same BNF rule already exists, at |
InvalidListRule LabelName | Cannot use ordinary or defined labels to construct a list category. |
InvalidListLabel Type | List label to construct non-list category. |
InvalidLabelNil FunType | Invalid type for label |
InvalidLabelCons FunType | Invalid type for label |
InvalidLabelSg FunType | Invalid type for label |
InvalidLabelWild FunType | Invalid type for label |
IgnoringUndeclaredFunction |
|
NotEnoughParameters (List1 String1) | Type checker added missing parameters in a |
DroppingSpuriousParameters (List1 Arg) | These parameters were ignored since they are too many, according to the type. |
MissingArguments LabelName (List1 Type) | A constructor/function misses arguments of the given types. |
DroppingSpuriousArguments LabelName (List1 Exp) | A constructor/function was given (these) more arguments than needed. |
ExpectedVsInferredType Type Type | An expression of the first type was expected, but it has the second type. |
NullableToken CatName Regex | Defined |
IllformedBlockComment | One of the delimiters of a block comment is empty. |
ConflictingUsesOfLayoutKeyword Keyword Position | A keyword appears both in |
EmptyGrammar | No entrypoints have been defined. This is an error that does not block any other checks, so it is "recoverable". But it makes flags failure of the check phase, because later phases (e.g. parser generation) will crash. |
Instances
Show RecoverableError Source # | |
Defined in BNFC.Check.Monad |
Any of these warnings drops the useless or redundant definition.
FooWarning | |
LabelClashesWithCategory LabelName Position | The label |
IgnoringNullCoercions |
|
NonUniformListRule Cat [Cat] | A list rule with different coercion levels of the base category. Cannot implement faithful printer for such rules. |
ParameterShouldBeLowerCase VarName | Grammar permits upper case parameters, but this isn't Haskell-style (which is the model for BNFC's expression syntax otherwise). |
ShadowingParameter VarName | A parameter shadows a previous one. |
ShadowedByParameter VarName | The given label is shadowed by a parameter, which looks confusing. |
EmptyToken CatName Regex | Defined |
IgnoringEmptyLineComment |
|
IgnoringEmptyBlockComment |
|
EmptyLayoutKeyword |
|
UndefinedLayoutKeyword Keyword |
|
DuplicateLayoutKeyword Keyword Position | This layout keyword already occurred in a pragma of the same kind. |
DuplicateLayoutTop Position |
|
Types used only in the checker
type ICat = Cat' CatName Source #
Intermediated form of categories. (No builtins/token types recognized yet.)
Implementation
type PFatalError = WithPosition' FatalError Source #
type PWarning = WithPosition' Warning Source #
type PWarnErr = WithPosition' (Either RecoverableError Warning) Source #
type RecoverableErrors = [PRecoverableError] Source #
The LBNF checker monad.
Instances
Monad Check Source # | |
Functor Check Source # | |
Applicative Check Source # | |
MonadCheck Check Source # | |
Defined in BNFC.Check.Monad fatalError :: FatalError -> Check a Source # recoverableError :: RecoverableError -> Check () Source # warn :: Warning -> Check () Source # atPosition :: ToPosition' p => p -> Check a -> Check a Source # |
runCheck :: Check a -> (Warnings, RecoverableErrors, Either PFatalError a) Source #