uu-parsinglib-2.5.5: Online, error-correcting parser combinators; monadic and applicative interfaces

Text.ParserCombinators.UU.Core

Contents

Description

The module Core contains the basic functionality of the parser library. It uses the breadth-first module to realise online generation of results, the error correction administration, dealing with ambigous grammars; it defines the types of the elementary parsers and recognisers involved.For typical use cases of the libray see the module Text.ParserCombinators.UU.Examples

Synopsis

Provides

class Provides state symbol token | state symbol -> token whereSource

The function splitState playes a crucial role in splitting up the state. The symbol parameter tells us what kind of thing, and even which value of that kind, is expected from the input. The state and and the symbol type together determine what kind of token has to be returned. Since the function is overloaded we do not have to invent all kind of different names for our elementary parsers.

Methods

splitState :: symbol -> (token -> state -> Steps a) -> state -> Steps aSource

Instances

(Eq a, Show a, IsLocationUpdatedBy loc a) => Provides (Str a loc) a a 
(Show a, Eq a, IsLocationUpdatedBy loc [a]) => Provides (Str a loc) (Token a) [a] 
(Show a, IsLocationUpdatedBy loc [a]) => Provides (Str a loc) (Munch a) [a] 
(Ord a, Show a, IsLocationUpdatedBy loc a) => Provides (Str a loc) (a, a) a 
(Show a, IsLocationUpdatedBy loc a) => Provides (Str a loc) (a -> Bool, String, a) a 

Eof

class Eof state whereSource

Methods

eof :: state -> BoolSource

deleteAtEnd :: state -> Maybe (Cost, state)Source

Instances

Show a => Eof (Str a loc) 

Location

class Show loc => IsLocationUpdatedBy loc str whereSource

The input state may contain a location which can be used in error messages. Since we do not want to fix our input to be just a String we provide an interface which can be used to advance the location by passing its information in the function splitState

Methods

advance :: loc -> str -> locSource

class ExtAlternative p whereSource

In order to be able to describe greedy parsers we introduce an extra operator, whch indicates a biased choice

Methods

(<<|>) :: p a -> p a -> p aSource

Instances

ExtAlternative Maybe 
ExtAlternative (P st)

<<|> is the greedy version of <|>. If its left hand side parser can make some progress that alternative is committed. Can be used to make parsers faster, and even get a complete Parsec equivalent behaviour, with all its (dis)advantages. use with are!

The triples containg a history, a future parser and a recogniser: T

data T st a Source

Constructors

T (forall r. (a -> st -> Steps r) -> st -> Steps r) (forall r. (st -> Steps r) -> st -> Steps (a, r)) (forall r. (st -> Steps r) -> st -> Steps r) 

Instances

Functor (T st) 
Applicative (T state) 
Alternative (T state) 

Triples are Applicative: <*>, <*, *> and pure

The descriptor P of a parser, including the tupled parser corresponding to this descriptor

data P st a Source

Constructors

P (T st a) (Maybe (T st a)) Nat (Maybe a) 

Instances

Monad (P st) 
Functor (P state) 
MonadPlus (P st) 
Applicative (P state) 
Alternative (P state) 
ExtAlternative (P st)

<<|> is the greedy version of <|>. If its left hand side parser can make some progress that alternative is committed. Can be used to make parsers faster, and even get a complete Parsec equivalent behaviour, with all its (dis)advantages. use with are!

Show (P st a) 

Parsers are functors: fmap

Parsers are Applicative: <*>, <*, *> and pure

Parsers are Alternative: <|> and empty

An alternative for the Alternative, which is greedy: <<|>

Parsers can recognise single tokens: pSym and pSymExt

pSymExt :: Provides state symbol token => Nat -> Maybe token -> symbol -> P state tokenSource

Since pSymExt is overloaded both the type and the value of a symbol determine how to decompose the input in a token and the remaining input. pSymExt takes two extra parameters: the first describing the minimal number of tokens recognised, and the second telling whether the symbol can recognise the empty string and the value which is to be returned in that case

pSym :: Provides state symbol token => symbol -> P state tokenSource

pSym covers the most common case of recognsiing a symbol: a single token is removed form the input, and it cannot recognise the empty string

Parsers are Monads: >>= and return

Additional useful combinators

(<?>) :: P state a -> String -> P state aSource

The parsers build a list of symbols which are expected at a specific point. This list is used to report errors. Quite often it is more informative to get e.g. the name of the non-terminal. The <?> combinator replaces this list of symbols by it's righ-hand side argument.

micro :: P state a -> Int -> P state aSource

micro inserts a Cost step into the sequence representing the progress the parser is making; for its use see Text.ParserCombinators.UU.Examples

amb :: P st a -> P st [a]Source

class Stores state error | state -> error whereSource

getErrors retreives the correcting steps made since the last time the function was called. The result can, using a monad, be used to control how to proceed with the parsing process.

Methods

getErrors :: state -> ([error], state)Source

Instances

Stores (Str a loc) (Error loc) 

pErrors :: Stores st error => P st [error]Source

The class Stores is used by the function pErrors which retreives the generated correction spets since the last time it was called.

class HasPosition state pos | state -> pos whereSource

pPos retreives the correcting steps made since the last time the function was called. The result can, using a monad, be used to control how to-- proceed with the parsing process.

Methods

getPos :: state -> posSource

Instances

HasPosition (Str a loc) loc 

pPos :: HasPosition st pos => P st posSource

pEnd :: (Stores st error, Eof st) => P st [error]Source

The function pEnd should be called at the end of the parsing process. It deletes any unconsumed input, turning them into error messages

parse :: Eof t => P t a -> t -> aSource

pSwitch :: (st1 -> (st2, st2 -> st1)) -> P st2 a -> P st1 aSource

pSwitch takes the current state and modifies it to a different type of state to which its argument parser is applied. The second component of the result is a function which converts the remaining state of this parser back into a valuee of the original type. For the second argumnet to pSwitch (say split) we expect the following to hold:

  let (n,f) = split st in f n to be equal to st

Maintaining Progress Information

type Cost = IntSource

The data type Steps is the core data type around which the parsers are constructed. It is a describes a tree structure of streams containing (in an interleaved way) both the online result of the parsing process, and progress information. Recognising an input token should correspond to a certain amount of Progress, which tells how much of the input state was consumed. The Progress is used to implement the breadth-first search process, in which alternatives are examined in a more-or-less synchonised way. The meaning of the various Step constructors is as follows:

Step
A token was succesfully recognised, and as a result the input was advanced by the distance Progress
Apply
The type of value represented by the Steps changes by applying the function parameter.
Fail
A correcting step has to made to the input; the first parameter contains information about what was expected in the input, and the second parameter describes the various corrected alternatives, each with an associated Cost
Micro
A small cost is inserted in the sequence, which is used to disambiguate. Use with care!

The last two alternatives play a role in recognising ambigous non-terminals. For a full description see the technical report referred to from the README file..

data Steps a whereSource

Constructors

Step :: Progress -> Steps a -> Steps a 
Apply :: forall a b. (b -> a) -> Steps b -> Steps a 
Fail :: Strings -> [Strings -> (Cost, Steps a)] -> Steps a 
Micro :: Cost -> Steps a -> Steps a 
End_h :: ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r) 
End_f :: [Steps a] -> Steps a -> Steps a 

eval :: Steps a -> aSource

push :: v -> Steps r -> Steps (v, r)Source

apply :: Steps (b -> a, (b, r)) -> Steps (a, r)Source

pushapply :: (b -> a) -> Steps (b, r) -> Steps (a, r)Source

norm :: Steps a -> Steps aSource

norm makes sure that the head of the seqeunce contains progress information. It does so by pushing information about the result (i.e. the Apply steps) backwards.

best' :: Steps b -> Steps b -> Steps bSource

The function best compares two streams and best :: Steps a -> Steps a -> Steps a

getCheapest :: Int -> [(Int, Steps a)] -> Steps aSource

traverse :: Int -> Steps a -> Int -> Int -> IntSource

Auxiliary functions and types

Checking for non-sensical combinations: must_be_non_empty and must_be_non_empties

must_be_non_empty :: [Char] -> P t t1 -> t2 -> t2Source

The function checks wehther its second argument is a parser which can recognise the mety sequence. If so an error message is given using the name of the context. If not then the third argument is returned. This is useful in testing for loogical combinations. For its use see the module Text>parserCombinators.UU.Derived

must_be_non_empties :: [Char] -> P t1 t -> P t3 t2 -> t4 -> t4Source

This function is similar to the above, but can be used in situations where we recognise a sequence of elements separated by other elements. This does not make sense if both parsers can recognise the empty string. Your grammar is then highly ambiguous.

The type Nat for describing the minimal number of tokens consumed

data Nat Source

The data type Nat is used to represent the minimal length of a parser. Care should be taken in order to not evaluate the right hand side of the binary function `nat-add` more than necesssary.

Constructors

Zero 
Succ Nat 
Infinite 

Instances