1{-# LANGUAGE CPP #-} 2{-# LANGUAGE DeriveDataTypeable #-} 3{-# LANGUAGE Safe #-} 4 5----------------------------------------------------------------------------- 6-- | 7-- Module : Text.Parsec.Expr 8-- Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007 9-- License : BSD-style (see the LICENSE file) 10-- 11-- Maintainer : derek.a.elkins@gmail.com 12-- Stability : provisional 13-- Portability : non-portable 14-- 15-- A helper module to parse \"expressions\". 16-- Builds a parser given a table of operators and associativities. 17-- 18----------------------------------------------------------------------------- 19 20module Text.Parsec.Expr 21 ( Assoc(..), Operator(..), OperatorTable 22 , buildExpressionParser 23 ) where 24 25import Data.Typeable ( Typeable ) 26 27import Text.Parsec.Prim 28import Text.Parsec.Combinator 29 30----------------------------------------------------------- 31-- Assoc and OperatorTable 32----------------------------------------------------------- 33 34-- | This data type specifies the associativity of operators: left, right 35-- or none. 36 37data Assoc = AssocNone 38 | AssocLeft 39 | AssocRight 40 deriving ( Typeable ) 41 42-- | This data type specifies operators that work on values of type @a@. 43-- An operator is either binary infix or unary prefix or postfix. A 44-- binary operator has also an associated associativity. 45 46data Operator s u m a = Infix (ParsecT s u m (a -> a -> a)) Assoc 47 | Prefix (ParsecT s u m (a -> a)) 48 | Postfix (ParsecT s u m (a -> a)) 49#if MIN_VERSION_base(4,7,0) 50 deriving ( Typeable ) 51#endif 52 53-- | An @OperatorTable s u m a@ is a list of @Operator s u m a@ 54-- lists. The list is ordered in descending 55-- precedence. All operators in one list have the same precedence (but 56-- may have a different associativity). 57 58type OperatorTable s u m a = [[Operator s u m a]] 59 60----------------------------------------------------------- 61-- Convert an OperatorTable and basic term parser into 62-- a full fledged expression parser 63----------------------------------------------------------- 64 65-- | @buildExpressionParser table term@ builds an expression parser for 66-- terms @term@ with operators from @table@, taking the associativity 67-- and precedence specified in @table@ into account. Prefix and postfix 68-- operators of the same precedence can only occur once (i.e. @--2@ is 69-- not allowed if @-@ is prefix negate). Prefix and postfix operators 70-- of the same precedence associate to the left (i.e. if @++@ is 71-- postfix increment, than @-2++@ equals @-1@, not @-3@). 72-- 73-- The @buildExpressionParser@ takes care of all the complexity 74-- involved in building expression parser. Here is an example of an 75-- expression parser that handles prefix signs, postfix increment and 76-- basic arithmetic. 77-- 78-- > expr = buildExpressionParser table term 79-- > <?> "expression" 80-- > 81-- > term = parens expr 82-- > <|> natural 83-- > <?> "simple expression" 84-- > 85-- > table = [ [prefix "-" negate, prefix "+" id ] 86-- > , [postfix "++" (+1)] 87-- > , [binary "*" (*) AssocLeft, binary "/" (div) AssocLeft ] 88-- > , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft ] 89-- > ] 90-- > 91-- > binary name fun assoc = Infix (do{ reservedOp name; return fun }) assoc 92-- > prefix name fun = Prefix (do{ reservedOp name; return fun }) 93-- > postfix name fun = Postfix (do{ reservedOp name; return fun }) 94 95buildExpressionParser :: (Stream s m t) 96 => OperatorTable s u m a 97 -> ParsecT s u m a 98 -> ParsecT s u m a 99buildExpressionParser operators simpleExpr 100 = foldl (makeParser) simpleExpr operators 101 where 102 makeParser term ops 103 = let (rassoc,lassoc,nassoc 104 ,prefix,postfix) = foldr splitOp ([],[],[],[],[]) ops 105 106 rassocOp = choice rassoc 107 lassocOp = choice lassoc 108 nassocOp = choice nassoc 109 prefixOp = choice prefix <?> "" 110 postfixOp = choice postfix <?> "" 111 112 ambiguous assoc op= try $ 113 do{ _ <- op; fail ("ambiguous use of a " ++ assoc 114 ++ " associative operator") 115 } 116 117 ambiguousRight = ambiguous "right" rassocOp 118 ambiguousLeft = ambiguous "left" lassocOp 119 ambiguousNon = ambiguous "non" nassocOp 120 121 termP = do{ pre <- prefixP 122 ; x <- term 123 ; post <- postfixP 124 ; return (post (pre x)) 125 } 126 127 postfixP = postfixOp <|> return id 128 129 prefixP = prefixOp <|> return id 130 131 rassocP x = do{ f <- rassocOp 132 ; y <- do{ z <- termP; rassocP1 z } 133 ; return (f x y) 134 } 135 <|> ambiguousLeft 136 <|> ambiguousNon 137 -- <|> return x 138 139 rassocP1 x = rassocP x <|> return x 140 141 lassocP x = do{ f <- lassocOp 142 ; y <- termP 143 ; lassocP1 (f x y) 144 } 145 <|> ambiguousRight 146 <|> ambiguousNon 147 -- <|> return x 148 149 lassocP1 x = lassocP x <|> return x 150 151 nassocP x = do{ f <- nassocOp 152 ; y <- termP 153 ; ambiguousRight 154 <|> ambiguousLeft 155 <|> ambiguousNon 156 <|> return (f x y) 157 } 158 -- <|> return x 159 160 in do{ x <- termP 161 ; rassocP x <|> lassocP x <|> nassocP x <|> return x 162 <?> "operator" 163 } 164 165 166 splitOp (Infix op assoc) (rassoc,lassoc,nassoc,prefix,postfix) 167 = case assoc of 168 AssocNone -> (rassoc,lassoc,op:nassoc,prefix,postfix) 169 AssocLeft -> (rassoc,op:lassoc,nassoc,prefix,postfix) 170 AssocRight -> (op:rassoc,lassoc,nassoc,prefix,postfix) 171 172 splitOp (Prefix op) (rassoc,lassoc,nassoc,prefix,postfix) 173 = (rassoc,lassoc,nassoc,op:prefix,postfix) 174 175 splitOp (Postfix op) (rassoc,lassoc,nassoc,prefix,postfix) 176 = (rassoc,lassoc,nassoc,prefix,op:postfix) 177