Copyright | (c) Edward Kmett 2011-2012 (c) Paolo Martini 2007 (c) Daan Leijen 1999-2001 |
---|---|
License | BSD-style (see the LICENSE file) |
Maintainer | ekmett@gmail.com |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
A helper module to parse "expressions". Builds a parser given a table of operators and associativities.
Synopsis
- data Assoc
- data Operator m a
- type OperatorTable m a = [[Operator m a]]
- buildExpressionParser :: forall m a. (Parsing m, Applicative m) => OperatorTable m a -> m a -> m a
Documentation
This data type specifies the associativity of operators: left, right or none.
Instances
Bounded Assoc Source # | |
Enum Assoc Source # | |
Defined in Text.Parser.Expression | |
Eq Assoc Source # | |
Data Assoc Source # | |
Defined in Text.Parser.Expression gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Assoc -> c Assoc # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Assoc # dataTypeOf :: Assoc -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Assoc) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Assoc) # gmapT :: (forall b. Data b => b -> b) -> Assoc -> Assoc # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r # gmapQ :: (forall d. Data d => d -> u) -> Assoc -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Assoc -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Assoc -> m Assoc # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Assoc -> m Assoc # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Assoc -> m Assoc # | |
Ord Assoc Source # | |
Read Assoc Source # | |
Show Assoc Source # | |
Ix Assoc Source # | |
This data type specifies operators that work on values of type a
.
An operator is either binary infix or unary prefix or postfix. A
binary operator has also an associated associativity.
type OperatorTable m a = [[Operator m a]] Source #
An OperatorTable m a
is a list of Operator m a
lists. The list is ordered in descending
precedence. All operators in one list have the same precedence (but
may have a different associativity).
buildExpressionParser :: forall m a. (Parsing m, Applicative m) => OperatorTable m a -> m a -> m a Source #
buildExpressionParser table term
builds an expression parser for
terms term
with operators from table
, taking the associativity
and precedence specified in table
into account. Prefix and postfix
operators of the same precedence can only occur once (i.e. --2
is
not allowed if -
is prefix negate). Prefix and postfix operators
of the same precedence associate to the left (i.e. if ++
is
postfix increment, than -2++
equals -1
, not -3
).
The buildExpressionParser
takes care of all the complexity
involved in building expression parser. Here is an example of an
expression parser that handles prefix signs, postfix increment and
basic arithmetic.
import Control.Applicative ((<|>)) import Text.Parser.Combinators ((<?>)) import Text.Parser.Expression import Text.Parser.Token (TokenParsing, natural, parens, reserve) import Text.Parser.Token.Style (emptyOps) expr :: (Monad m, TokenParsing m) => m Integer expr = buildExpressionParser table term <?> "expression" term :: (Monad m, TokenParsing m) => m Integer term = parens expr <|> natural <?> "simple expression" table :: (Monad m, TokenParsing m) => [[Operator m Integer]] table = [ [prefix "-" negate, prefix "+" id ] , [postfix "++" (+1)] , [binary "*" (*) AssocLeft, binary "/" (div) AssocLeft ] , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft ] ] binary name fun assoc = Infix (fun <$ reservedOp name) assoc prefix name fun = Prefix (fun <$ reservedOp name) postfix name fun = Postfix (fun <$ reservedOp name) reservedOp name = reserve emptyOps name