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