{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Safe #-}
module Text.Parsec.Expr
( Assoc(..), Operator(..), OperatorTable
, buildExpressionParser
) where
import Data.Typeable ( Typeable )
import Text.Parsec.Prim
import Text.Parsec.Combinator
data Assoc = AssocNone
| AssocLeft
| AssocRight
deriving ( Typeable )
data Operator s u m a = Infix (ParsecT s u m (a -> a -> a)) Assoc
| Prefix (ParsecT s u m (a -> a))
| Postfix (ParsecT s u m (a -> a))
#if MIN_VERSION_base(4,7,0)
deriving ( Typeable )
#endif
type OperatorTable s u m a = [[Operator s u m a]]
buildExpressionParser :: (Stream s m t)
=> OperatorTable s u m a
-> ParsecT s u m a
-> ParsecT s u m a
buildExpressionParser :: OperatorTable s u m a -> ParsecT s u m a -> ParsecT s u m a
buildExpressionParser operators :: OperatorTable s u m a
operators simpleExpr :: ParsecT s u m a
simpleExpr
= (ParsecT s u m a -> [Operator s u m a] -> ParsecT s u m a)
-> ParsecT s u m a -> OperatorTable s u m a -> ParsecT s u m a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (ParsecT s u m a -> [Operator s u m a] -> ParsecT s u m a
forall (t :: * -> *) s (m :: * -> *) t t t t t u b.
(Foldable t, Stream s m t, Stream s m t, Stream s m t,
Stream s m t, Stream s m t) =>
ParsecT s u m b -> t (Operator s u m b) -> ParsecT s u m b
makeParser) ParsecT s u m a
simpleExpr OperatorTable s u m a
operators
where
makeParser :: ParsecT s u m b -> t (Operator s u m b) -> ParsecT s u m b
makeParser term :: ParsecT s u m b
term ops :: t (Operator s u m b)
ops
= let (rassoc :: [ParsecT s u m (b -> b -> b)]
rassoc,lassoc :: [ParsecT s u m (b -> b -> b)]
lassoc,nassoc :: [ParsecT s u m (b -> b -> b)]
nassoc
,prefix :: [ParsecT s u m (b -> b)]
prefix,postfix :: [ParsecT s u m (b -> b)]
postfix) = (Operator s u m b
-> ([ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b -> b)],
[ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b)],
[ParsecT s u m (b -> b)])
-> ([ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b -> b)],
[ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b)],
[ParsecT s u m (b -> b)]))
-> ([ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b -> b)],
[ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b)],
[ParsecT s u m (b -> b)])
-> t (Operator s u m b)
-> ([ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b -> b)],
[ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b)],
[ParsecT s u m (b -> b)])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Operator s u m b
-> ([ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b -> b)],
[ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b)],
[ParsecT s u m (b -> b)])
-> ([ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b -> b)],
[ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b)],
[ParsecT s u m (b -> b)])
forall s u (m :: * -> *) a.
Operator s u m a
-> ([ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a -> a)],
[ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a)],
[ParsecT s u m (a -> a)])
-> ([ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a -> a)],
[ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a)],
[ParsecT s u m (a -> a)])
splitOp ([],[],[],[],[]) t (Operator s u m b)
ops
rassocOp :: ParsecT s u m (b -> b -> b)
rassocOp = [ParsecT s u m (b -> b -> b)] -> ParsecT s u m (b -> b -> b)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT s u m (b -> b -> b)]
rassoc
lassocOp :: ParsecT s u m (b -> b -> b)
lassocOp = [ParsecT s u m (b -> b -> b)] -> ParsecT s u m (b -> b -> b)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT s u m (b -> b -> b)]
lassoc
nassocOp :: ParsecT s u m (b -> b -> b)
nassocOp = [ParsecT s u m (b -> b -> b)] -> ParsecT s u m (b -> b -> b)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT s u m (b -> b -> b)]
nassoc
prefixOp :: ParsecT s u m (b -> b)
prefixOp = [ParsecT s u m (b -> b)] -> ParsecT s u m (b -> b)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT s u m (b -> b)]
prefix ParsecT s u m (b -> b) -> String -> ParsecT s u m (b -> b)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> ""
postfixOp :: ParsecT s u m (b -> b)
postfixOp = [ParsecT s u m (b -> b)] -> ParsecT s u m (b -> b)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT s u m (b -> b)]
postfix ParsecT s u m (b -> b) -> String -> ParsecT s u m (b -> b)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> ""
ambiguous :: String -> ParsecT s u m a -> ParsecT s u m a
ambiguous assoc :: String
assoc op :: ParsecT s u m a
op= ParsecT s u m a -> ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m a -> ParsecT s u m a)
-> ParsecT s u m a -> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$
do{ a
_ <- ParsecT s u m a
op; String -> ParsecT s u m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("ambiguous use of a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
assoc
String -> String -> String
forall a. [a] -> [a] -> [a]
++ " associative operator")
}
ambiguousRight :: ParsecT s u m a
ambiguousRight = String -> ParsecT s u m (b -> b -> b) -> ParsecT s u m a
forall s u (m :: * -> *) a a.
String -> ParsecT s u m a -> ParsecT s u m a
ambiguous "right" ParsecT s u m (b -> b -> b)
rassocOp
ambiguousLeft :: ParsecT s u m a
ambiguousLeft = String -> ParsecT s u m (b -> b -> b) -> ParsecT s u m a
forall s u (m :: * -> *) a a.
String -> ParsecT s u m a -> ParsecT s u m a
ambiguous "left" ParsecT s u m (b -> b -> b)
lassocOp
ambiguousNon :: ParsecT s u m a
ambiguousNon = String -> ParsecT s u m (b -> b -> b) -> ParsecT s u m a
forall s u (m :: * -> *) a a.
String -> ParsecT s u m a -> ParsecT s u m a
ambiguous "non" ParsecT s u m (b -> b -> b)
nassocOp
termP :: ParsecT s u m b
termP = do{ b -> b
pre <- ParsecT s u m (b -> b)
prefixP
; b
x <- ParsecT s u m b
term
; b -> b
post <- ParsecT s u m (b -> b)
postfixP
; b -> ParsecT s u m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> b
post (b -> b
pre b
x))
}
postfixP :: ParsecT s u m (b -> b)
postfixP = ParsecT s u m (b -> b)
postfixOp ParsecT s u m (b -> b)
-> ParsecT s u m (b -> b) -> ParsecT s u m (b -> b)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (b -> b) -> ParsecT s u m (b -> b)
forall (m :: * -> *) a. Monad m => a -> m a
return b -> b
forall a. a -> a
id
prefixP :: ParsecT s u m (b -> b)
prefixP = ParsecT s u m (b -> b)
prefixOp ParsecT s u m (b -> b)
-> ParsecT s u m (b -> b) -> ParsecT s u m (b -> b)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (b -> b) -> ParsecT s u m (b -> b)
forall (m :: * -> *) a. Monad m => a -> m a
return b -> b
forall a. a -> a
id
rassocP :: b -> ParsecT s u m b
rassocP x :: b
x = do{ b -> b -> b
f <- ParsecT s u m (b -> b -> b)
rassocOp
; b
y <- do{ b
z <- ParsecT s u m b
termP; b -> ParsecT s u m b
rassocP1 b
z }
; b -> ParsecT s u m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> b -> b
f b
x b
y)
}
ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m b
forall a. ParsecT s u m a
ambiguousLeft
ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m b
forall a. ParsecT s u m a
ambiguousNon
rassocP1 :: b -> ParsecT s u m b
rassocP1 x :: b
x = b -> ParsecT s u m b
rassocP b
x ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> b -> ParsecT s u m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
lassocP :: b -> ParsecT s u m b
lassocP x :: b
x = do{ b -> b -> b
f <- ParsecT s u m (b -> b -> b)
lassocOp
; b
y <- ParsecT s u m b
termP
; b -> ParsecT s u m b
lassocP1 (b -> b -> b
f b
x b
y)
}
ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m b
forall a. ParsecT s u m a
ambiguousRight
ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m b
forall a. ParsecT s u m a
ambiguousNon
lassocP1 :: b -> ParsecT s u m b
lassocP1 x :: b
x = b -> ParsecT s u m b
lassocP b
x ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> b -> ParsecT s u m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
nassocP :: b -> ParsecT s u m b
nassocP x :: b
x = do{ b -> b -> b
f <- ParsecT s u m (b -> b -> b)
nassocOp
; b
y <- ParsecT s u m b
termP
; ParsecT s u m b
forall a. ParsecT s u m a
ambiguousRight
ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m b
forall a. ParsecT s u m a
ambiguousLeft
ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m b
forall a. ParsecT s u m a
ambiguousNon
ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> b -> ParsecT s u m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> b -> b
f b
x b
y)
}
in do{ b
x <- ParsecT s u m b
termP
; b -> ParsecT s u m b
rassocP b
x ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> b -> ParsecT s u m b
lassocP b
x ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> b -> ParsecT s u m b
nassocP b
x ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> b -> ParsecT s u m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
ParsecT s u m b -> String -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "operator"
}
splitOp :: Operator s u m a
-> ([ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a -> a)],
[ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a)],
[ParsecT s u m (a -> a)])
-> ([ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a -> a)],
[ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a)],
[ParsecT s u m (a -> a)])
splitOp (Infix op :: ParsecT s u m (a -> a -> a)
op assoc :: Assoc
assoc) (rassoc :: [ParsecT s u m (a -> a -> a)]
rassoc,lassoc :: [ParsecT s u m (a -> a -> a)]
lassoc,nassoc :: [ParsecT s u m (a -> a -> a)]
nassoc,prefix :: [ParsecT s u m (a -> a)]
prefix,postfix :: [ParsecT s u m (a -> a)]
postfix)
= case Assoc
assoc of
AssocNone -> ([ParsecT s u m (a -> a -> a)]
rassoc,[ParsecT s u m (a -> a -> a)]
lassoc,ParsecT s u m (a -> a -> a)
opParsecT s u m (a -> a -> a)
-> [ParsecT s u m (a -> a -> a)] -> [ParsecT s u m (a -> a -> a)]
forall a. a -> [a] -> [a]
:[ParsecT s u m (a -> a -> a)]
nassoc,[ParsecT s u m (a -> a)]
prefix,[ParsecT s u m (a -> a)]
postfix)
AssocLeft -> ([ParsecT s u m (a -> a -> a)]
rassoc,ParsecT s u m (a -> a -> a)
opParsecT s u m (a -> a -> a)
-> [ParsecT s u m (a -> a -> a)] -> [ParsecT s u m (a -> a -> a)]
forall a. a -> [a] -> [a]
:[ParsecT s u m (a -> a -> a)]
lassoc,[ParsecT s u m (a -> a -> a)]
nassoc,[ParsecT s u m (a -> a)]
prefix,[ParsecT s u m (a -> a)]
postfix)
AssocRight -> (ParsecT s u m (a -> a -> a)
opParsecT s u m (a -> a -> a)
-> [ParsecT s u m (a -> a -> a)] -> [ParsecT s u m (a -> a -> a)]
forall a. a -> [a] -> [a]
:[ParsecT s u m (a -> a -> a)]
rassoc,[ParsecT s u m (a -> a -> a)]
lassoc,[ParsecT s u m (a -> a -> a)]
nassoc,[ParsecT s u m (a -> a)]
prefix,[ParsecT s u m (a -> a)]
postfix)
splitOp (Prefix op :: ParsecT s u m (a -> a)
op) (rassoc :: [ParsecT s u m (a -> a -> a)]
rassoc,lassoc :: [ParsecT s u m (a -> a -> a)]
lassoc,nassoc :: [ParsecT s u m (a -> a -> a)]
nassoc,prefix :: [ParsecT s u m (a -> a)]
prefix,postfix :: [ParsecT s u m (a -> a)]
postfix)
= ([ParsecT s u m (a -> a -> a)]
rassoc,[ParsecT s u m (a -> a -> a)]
lassoc,[ParsecT s u m (a -> a -> a)]
nassoc,ParsecT s u m (a -> a)
opParsecT s u m (a -> a)
-> [ParsecT s u m (a -> a)] -> [ParsecT s u m (a -> a)]
forall a. a -> [a] -> [a]
:[ParsecT s u m (a -> a)]
prefix,[ParsecT s u m (a -> a)]
postfix)
splitOp (Postfix op :: ParsecT s u m (a -> a)
op) (rassoc :: [ParsecT s u m (a -> a -> a)]
rassoc,lassoc :: [ParsecT s u m (a -> a -> a)]
lassoc,nassoc :: [ParsecT s u m (a -> a -> a)]
nassoc,prefix :: [ParsecT s u m (a -> a)]
prefix,postfix :: [ParsecT s u m (a -> a)]
postfix)
= ([ParsecT s u m (a -> a -> a)]
rassoc,[ParsecT s u m (a -> a -> a)]
lassoc,[ParsecT s u m (a -> a -> a)]
nassoc,[ParsecT s u m (a -> a)]
prefix,ParsecT s u m (a -> a)
opParsecT s u m (a -> a)
-> [ParsecT s u m (a -> a)] -> [ParsecT s u m (a -> a)]
forall a. a -> [a] -> [a]
:[ParsecT s u m (a -> a)]
postfix)