Text/ParserCombinators/Parsec/Expr.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Text.ParserCombinators.Parsec.Expr
   4 -- Copyright   :  (c) Daan Leijen 1999-2001
   5 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   6 --
   7 -- Maintainer  :  daan@cs.uu.nl
   8 -- Stability   :  provisional
   9 -- Portability :  portable
  10 --
  11 -- A helper module to parse \"expressions\".
  12 -- Builds a parser given a table of operators and associativities.
  13 --
  14 -----------------------------------------------------------------------------
  15
  16 module Text.ParserCombinators.Parsec.Expr
  17                  ( Assoc(..), Operator(..), OperatorTable
  18                  , buildExpressionParser
  19                  ) where
  20
  21 import Text.ParserCombinators.Parsec.Prim
  22 import Text.ParserCombinators.Parsec.Combinator
  23
  24
  25 -----------------------------------------------------------
  26 -- Assoc and OperatorTable
  27 -----------------------------------------------------------
  28 data Assoc                = AssocNone
  29                           | AssocLeft
  30                           | AssocRight
  31
  32 data Operator t st a      = Infix (GenParser t st (a -> a -> a)) Assoc
  33                           | Prefix (GenParser t st (a -> a))
  34                           | Postfix (GenParser t st (a -> a))
  35
  36 type OperatorTable t st a = [[Operator t st a]]
  37
  38
  39
  40 -----------------------------------------------------------
  41 -- Convert an OperatorTable and basic term parser into
  42 -- a full fledged expression parser
  43 -----------------------------------------------------------
  44 buildExpressionParser :: OperatorTable tok st a -> GenParser tok st a -> GenParser tok st a
  45 buildExpressionParser operators simpleExpr
  46     = foldl (makeParser) simpleExpr operators
  47     where
  48       makeParser term ops
  49         = let (rassoc,lassoc,nassoc
  50                ,prefix,postfix)      = foldr splitOp ([],[],[],[],[]) ops
  51
  52               rassocOp   = choice rassoc
  53               lassocOp   = choice lassoc
  54               nassocOp   = choice nassoc
  55               prefixOp   = choice prefix  <?> ""
  56               postfixOp  = choice postfix <?> ""
  57
  58               ambigious assoc op= try $
  59                                   do{ op; fail ("ambiguous use of a " ++ assoc
  60                                                  ++ " associative operator")
  61                                     }
  62
  63               ambigiousRight    = ambigious "right" rassocOp
  64               ambigiousLeft     = ambigious "left" lassocOp
  65               ambigiousNon      = ambigious "non" nassocOp
  66
  67               termP      = do{ pre  <- prefixP
  68                              ; x    <- term
  69                              ; post <- postfixP
  70                              ; return (post (pre x))
  71                              }
  72
  73               postfixP   = postfixOp <|> return id
  74
  75               prefixP    = prefixOp <|> return id
  76
  77               rassocP x  = do{ f <- rassocOp
  78                              ; y  <- do{ z <- termP; rassocP1 z }
  79                              ; return (f x y)
  80                              }
  81                            <|> ambigiousLeft
  82                            <|> ambigiousNon
  83                            -- <|> return x
  84
  85               rassocP1 x = rassocP x  <|> return x
  86
  87               lassocP x  = do{ f <- lassocOp
  88                              ; y <- termP
  89                              ; lassocP1 (f x y)
  90                              }
  91                            <|> ambigiousRight
  92                            <|> ambigiousNon
  93                            -- <|> return x
  94
  95               lassocP1 x = lassocP x <|> return x
  96
  97               nassocP x  = do{ f <- nassocOp
  98                              ; y <- termP
  99                              ;    ambigiousRight
 100                               <|> ambigiousLeft
 101                               <|> ambigiousNon
 102                               <|> return (f x y)
 103                              }
 104                            -- <|> return x
 105
 106            in  do{ x <- termP
 107                  ; rassocP x <|> lassocP  x <|> nassocP x <|> return x
 108                    <?> "operator"
 109                  }
 110
 111
 112       splitOp (Infix op assoc) (rassoc,lassoc,nassoc,prefix,postfix)
 113         = case assoc of
 114             AssocNone  -> (rassoc,lassoc,op:nassoc,prefix,postfix)
 115             AssocLeft  -> (rassoc,op:lassoc,nassoc,prefix,postfix)
 116             AssocRight -> (op:rassoc,lassoc,nassoc,prefix,postfix)
 117
 118       splitOp (Prefix op) (rassoc,lassoc,nassoc,prefix,postfix)
 119         = (rassoc,lassoc,nassoc,op:prefix,postfix)
 120
 121       splitOp (Postfix op) (rassoc,lassoc,nassoc,prefix,postfix)
 122         = (rassoc,lassoc,nassoc,prefix,op:postfix)
 123