Copyright | (c) 2011 Kathleen Fisher <kathleen.fisher@gmail.com> John Launchbury <john.launchbury@gmail.com> |
---|---|
License | MIT |
Maintainer | Karl Cronburg <karl@cs.tufts.edu> |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
This module re-exports all the modules necessary to make use of the Pads quasiquoter and compilation infrastructure.
Synopsis
- data Span = Span {}
- data Loc = Loc {
- recordNumber :: Int64
- byteOffset :: Int64
- data RecordDiscipline
- data Source = Source {
- current :: ByteString
- rest :: ByteString
- loc :: Loc
- bit :: Int
- disc :: RecordDiscipline
- eorAtEOF :: Bool
- newline :: RecordDiscipline
- windows :: RecordDiscipline
- bytes :: Int -> RecordDiscipline
- none :: RecordDiscipline
- zeroLoc :: Loc
- zeroSpan :: Span
- zeroBit :: Int
- incRecordNumber :: Loc -> Loc
- decLineNumber :: Loc -> Loc
- incOffset :: Loc -> Loc
- incOffsetBy :: Loc -> Int -> Loc
- decOffset :: Loc -> Loc
- emptySource :: Source
- padsSourceFromString :: String -> Source
- padsSourceFromStringWithDisc :: RecordDiscipline -> String -> Source
- padsSourceFromFile :: FilePath -> IO Source
- padsSourceFromFileWithDisc :: RecordDiscipline -> FilePath -> IO Source
- padsSourceFromByteString :: ByteString -> Source
- padsSourceFromByteStringWithDisc :: RecordDiscipline -> ByteString -> Source
- isEOF :: Source -> Bool
- isEOR :: Source -> Bool
- takeHeadStr :: String -> Source -> (Bool, Source)
- scanStr :: String -> Source -> (Maybe String, Source)
- regexMatch :: RE -> Source -> (Maybe String, Source)
- regexStop :: RE -> Source -> (Maybe String, Source)
- whileS :: (Char -> Bool) -> Source -> Maybe (String, Source)
- scanTo :: Char -> Source -> (Bool, Source, Span)
- module Language.Pads.RegExp
- data ErrInfo = ErrInfo ErrMsg (Maybe Span)
- data ErrMsg
- = FoundWhenExpecting String String
- | MissingLiteral String
- | ExtraBeforeLiteral String
- | LineError String
- | Insufficient Int Int
- | RegexMatchFail String
- | TransformToDstFail String String String
- | TransformToSrcFail String String String
- | UnderlyingTypedefFail
- | PredicateFailure
- | ExtraStuffBeforeTy String String
- | FileError String String
- | BitWidthError Int Int
- mergeErrInfo :: ErrInfo -> ErrInfo -> ErrInfo
- maybeMergeErrInfo :: Maybe ErrInfo -> Maybe ErrInfo -> Maybe ErrInfo
- module Language.Pads.PadsParser
- module Language.Pads.MetaData
- module Language.Pads.Generic
- module Language.Pads.CoreBaseTypes
- module Language.Pads.Quote
- module Language.Pads.Syntax
- module Language.Pads.BaseTypes
- module Language.Pads.Pretty
- module Language.Pads.PadsPrinter
- module Language.Pads.Generation
- module Data.Data
- module Data.List
- pretty :: Int -> Doc -> String
Documentation
A span in the source input, covering a contiguous range of the Source
input. AFAIK there's no distinction between the states where begin == end
and where end == Nothing
.
Instances
Eq Span Source # | |
Data Span Source # | |
Defined in Language.Pads.Source gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Span -> c Span # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Span # dataTypeOf :: Span -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Span) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Span) # gmapT :: (forall b. Data b => b -> b) -> Span -> Span # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Span -> r # gmapQ :: (forall d. Data d => d -> u) -> Span -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Span -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Span -> m Span # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Span -> m Span # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Span -> m Span # | |
Ord Span Source # | |
Show Span Source # | |
Pretty Span Source # | |
Source location information.
Loc | |
|
Instances
Eq Loc Source # | |
Data Loc Source # | |
Defined in Language.Pads.Source gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Loc -> c Loc # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Loc # dataTypeOf :: Loc -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Loc) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Loc) # gmapT :: (forall b. Data b => b -> b) -> Loc -> Loc # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Loc -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Loc -> r # gmapQ :: (forall d. Data d => d -> u) -> Loc -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Loc -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Loc -> m Loc # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Loc -> m Loc # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Loc -> m Loc # | |
Ord Loc Source # | |
Show Loc Source # | |
Pretty Loc Source # | |
data RecordDiscipline Source #
A record discipline specifies the manner by which pads should partition the input into records. Note that the record character gets consumed internally by the parsing monad.
Single Word8 | Split input based on a single 8-bit unsigned integer (character) |
Multi ByteString | Split input based on more than one character |
Bytes Int | Split the input into records every |
NoPartition | No partitioning of the input - all input data is in the |
NoDiscipline | No discipline is currently installed; all input data is in |
Input source abstraction
Source | |
|
newline :: RecordDiscipline Source #
Record discipline for Unix newlines
windows :: RecordDiscipline Source #
Record discipline for Windows CRLF newlines
bytes :: Int -> RecordDiscipline Source #
Record discipline for every n characters
none :: RecordDiscipline Source #
No record discipline
emptySource :: Source Source #
An empty Source with reasonable defaults for everything.
padsSourceFromString :: String -> Source Source #
Stuff the given String
into a Source
with a newline discipline by
default (see padsSourceFromByteString
)
padsSourceFromFileWithDisc :: RecordDiscipline -> FilePath -> IO Source Source #
Read a Source
from disk using the given record discipline
padsSourceFromByteString :: ByteString -> Source Source #
Construct a Source
from the given ByteString
, preparing the first
record immediately.
padsSourceFromByteStringWithDisc :: RecordDiscipline -> ByteString -> Source Source #
Same as padsSourceFromByteString
but with a record discipline
isEOR :: Source -> Bool Source #
Whether or not the Source
has consumed all input in the current record
takeHeadStr :: String -> Source -> (Bool, Source) Source #
If the front of the current source input matches the given string then remove it and return the modified source. Otherwise return the original source and a boolean flag indicating that we failed to take the given string off the front of the source input.
scanStr :: String -> Source -> (Maybe String, Source) Source #
Scan the current source input until we find the given string: - If we don't find the string return Nothing and leave source unmodified - If we return (Maybe []), then we found the string at the beginning of the source and removed it. - If we return (Maybe junk), then we found the string somewhere after the first character in the source and we consumed / removed (junk:str).
regexMatch :: RE -> Source -> (Maybe String, Source) Source #
Match the beginning of the source input with a regex, returning a tuple of the matched string and the modified source with that string removed.
regexStop :: RE -> Source -> (Maybe String, Source) Source #
Find the first match of a regex in the source input, returning the contents of the source input *before* the match. * If there's no match return Nothing and leave the source unmodified. * If there's a match, return the string before the match and remove *just* the string before from the source input.
scanTo :: Char -> Source -> (Bool, Source, Span) Source #
Scan the input source until we find the given character. If we don't find
the character indicate as such with the boolean (False) and remove all source
input from the current record. If we do find the character, return True and
consume input up to and including the matched character. The Span
in the
returned tuple indicates the region in the input that got scanned and removed
by this function (whether or not we failed to find the character).
module Language.Pads.RegExp
Error information relating back to the source input
Instances
Eq ErrInfo Source # | |
Data ErrInfo Source # | |
Defined in Language.Pads.Errors gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ErrInfo -> c ErrInfo # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ErrInfo # toConstr :: ErrInfo -> Constr # dataTypeOf :: ErrInfo -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ErrInfo) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ErrInfo) # gmapT :: (forall b. Data b => b -> b) -> ErrInfo -> ErrInfo # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ErrInfo -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ErrInfo -> r # gmapQ :: (forall d. Data d => d -> u) -> ErrInfo -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> ErrInfo -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> ErrInfo -> m ErrInfo # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ErrInfo -> m ErrInfo # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ErrInfo -> m ErrInfo # | |
Ord ErrInfo Source # | |
Show ErrInfo Source # | |
Pretty ErrInfo Source # | Pretty printer for reporting where in the source text a parse error occured. |
Errors which can be encountered at runtime when parsing a Pads type
Instances
Eq ErrMsg Source # | |
Data ErrMsg Source # | |
Defined in Language.Pads.Errors gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ErrMsg -> c ErrMsg # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ErrMsg # toConstr :: ErrMsg -> Constr # dataTypeOf :: ErrMsg -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ErrMsg) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ErrMsg) # gmapT :: (forall b. Data b => b -> b) -> ErrMsg -> ErrMsg # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ErrMsg -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ErrMsg -> r # gmapQ :: (forall d. Data d => d -> u) -> ErrMsg -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> ErrMsg -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> ErrMsg -> m ErrMsg # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ErrMsg -> m ErrMsg # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ErrMsg -> m ErrMsg # | |
Ord ErrMsg Source # | |
Show ErrMsg Source # | |
Pretty ErrMsg Source # | Pretty printer for Pads runtime error messages. |
maybeMergeErrInfo :: Maybe ErrInfo -> Maybe ErrInfo -> Maybe ErrInfo Source #
Merge errors in the Maybe monad
module Language.Pads.PadsParser
module Language.Pads.MetaData
module Language.Pads.Generic
module Language.Pads.CoreBaseTypes
module Language.Pads.Quote
module Language.Pads.Syntax
module Language.Pads.BaseTypes
module Language.Pads.Pretty
module Language.Pads.PadsPrinter
module Language.Pads.Generation
module Data.Data
module Data.List