3a_asm/Text/Parsec/Combinator.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Text.Parsec.Combinator
   4 -- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
   5 -- License     :  BSD-style (see the LICENSE file)
   6 --
   7 -- Maintainer  :  derek.a.elkins@gmail.com
   8 -- Stability   :  provisional
   9 -- Portability :  portable
  10 --
  11 -- Commonly used generic combinators
  12 --
  13 -----------------------------------------------------------------------------
  14
  15 module Text.Parsec.Combinator
  16     ( choice
  17     , count
  18     , between
  19     , option, optionMaybe, optional
  20     , skipMany1
  21     , many1
  22     , sepBy, sepBy1
  23     , endBy, endBy1
  24     , sepEndBy, sepEndBy1
  25     , chainl, chainl1
  26     , chainr, chainr1
  27     , eof, notFollowedBy
  28     -- tricky combinators
  29     , manyTill, lookAhead, anyToken
  30     ) where
  31
  32 import Control.Monad
  33 import Text.Parsec.Prim
  34
  35 -- | @choice ps@ tries to apply the parsers in the list @ps@ in order,
  36 -- until one of them succeeds. Returns the value of the succeeding
  37 -- parser.
  38
  39 choice :: (Stream s m t) => [ParsecT s u m a] -> ParsecT s u m a
  40 choice ps           = foldr (<|>) mzero ps
  41
  42 -- | @option x p@ tries to apply parser @p@. If @p@ fails without
  43 -- consuming input, it returns the value @x@, otherwise the value
  44 -- returned by @p@.
  45 --
  46 -- >  priority  = option 0 (do{ d <- digit
  47 -- >                          ; return (digitToInt d)
  48 -- >                          })
  49
  50 option :: (Stream s m t) => a -> ParsecT s u m a -> ParsecT s u m a
  51 option x p          = p <|> return x
  52
  53 -- | @option p@ tries to apply parser @p@.  If @p@ fails without
  54 -- consuming input, it return 'Nothing', otherwise it returns
  55 -- 'Just' the value returned by @p@.
  56
  57 optionMaybe :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (Maybe a)
  58 optionMaybe p       = option Nothing (liftM Just p)
  59
  60 -- | @optional p@ tries to apply parser @p@.  It will parse @p@ or nothing.
  61 -- It only fails if @p@ fails after consuming input. It discards the result
  62 -- of @p@.
  63
  64 optional :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()
  65 optional p          = do{ p; return ()} <|> return ()
  66
  67 -- | @between open close p@ parses @open@, followed by @p@ and @close@.
  68 -- Returns the value returned by @p@.
  69 --
  70 -- >  braces  = between (symbol "{") (symbol "}")
  71
  72 between :: (Stream s m t) => ParsecT s u m open -> ParsecT s u m close
  73             -> ParsecT s u m a -> ParsecT s u m a
  74 between open close p
  75                     = do{ open; x <- p; close; return x }
  76
  77 -- | @skipMany1 p@ applies the parser @p@ /one/ or more times, skipping
  78 -- its result.
  79
  80 skipMany1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()
  81 skipMany1 p         = do{ p; skipMany p }
  82 {-
  83 skipMany p          = scan
  84                     where
  85                       scan  = do{ p; scan } <|> return ()
  86 -}
  87
  88 -- | @many p@ applies the parser @p@ /one/ or more times. Returns a
  89 -- list of the returned values of @p@.
  90 --
  91 -- >  word  = many1 letter
  92
  93 many1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m [a]
  94 many1 p             = do{ x <- p; xs <- many p; return (x:xs) }
  95 {-
  96 many p              = scan id
  97                     where
  98                       scan f    = do{ x <- p
  99                                     ; scan (\tail -> f (x:tail))
 100                                     }
 101                                 <|> return (f [])
 102 -}
 103
 104
 105 -- | @sepBy p sep@ parses /zero/ or more occurrences of @p@, separated
 106 -- by @sep@. Returns a list of values returned by @p@.
 107 --
 108 -- >  commaSep p  = p `sepBy` (symbol ",")
 109
 110 sepBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
 111 sepBy p sep         = sepBy1 p sep <|> return []
 112
 113 -- | @sepBy1 p sep@ parses /one/ or more occurrences of @p@, separated
 114 -- by @sep@. Returns a list of values returned by @p@.
 115
 116 sepBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
 117 sepBy1 p sep        = do{ x <- p
 118                         ; xs <- many (sep >> p)
 119                         ; return (x:xs)
 120                         }
 121
 122
 123 -- | @sepEndBy1 p sep@ parses /one/ or more occurrences of @p@,
 124 -- separated and optionally ended by @sep@. Returns a list of values
 125 -- returned by @p@.
 126
 127 sepEndBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
 128 sepEndBy1 p sep     = do{ x <- p
 129                         ; do{ sep
 130                             ; xs <- sepEndBy p sep
 131                             ; return (x:xs)
 132                             }
 133                           <|> return [x]
 134                         }
 135
 136 -- | @sepEndBy p sep@ parses /zero/ or more occurrences of @p@,
 137 -- separated and optionally ended by @sep@, ie. haskell style
 138 -- statements. Returns a list of values returned by @p@.
 139 --
 140 -- >  haskellStatements  = haskellStatement `sepEndBy` semi
 141
 142 sepEndBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
 143 sepEndBy p sep      = sepEndBy1 p sep <|> return []
 144
 145
 146 -- | @endBy1 p sep@ parses /one/ or more occurrences of @p@, seperated
 147 -- and ended by @sep@. Returns a list of values returned by @p@.
 148
 149 endBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
 150 endBy1 p sep        = many1 (do{ x <- p; sep; return x })
 151
 152 -- | @endBy p sep@ parses /zero/ or more occurrences of @p@, seperated
 153 -- and ended by @sep@. Returns a list of values returned by @p@.
 154 --
 155 -- >   cStatements  = cStatement `endBy` semi
 156
 157 endBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
 158 endBy p sep         = many (do{ x <- p; sep; return x })
 159
 160 -- | @count n p@ parses @n@ occurrences of @p@. If @n@ is smaller or
 161 -- equal to zero, the parser equals to @return []@. Returns a list of
 162 -- @n@ values returned by @p@.
 163
 164 count :: (Stream s m t) => Int -> ParsecT s u m a -> ParsecT s u m [a]
 165 count n p           | n <= 0    = return []
 166                     | otherwise = sequence (replicate n p)
 167
 168 -- | @chainr p op x@ parser /zero/ or more occurrences of @p@,
 169 -- separated by @op@ Returns a value obtained by a /right/ associative
 170 -- application of all functions returned by @op@ to the values returned
 171 -- by @p@. If there are no occurrences of @p@, the value @x@ is
 172 -- returned.
 173
 174 chainr :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a
 175 chainr p op x       = chainr1 p op <|> return x
 176
 177 -- | @chainl p op x@ parser /zero/ or more occurrences of @p@,
 178 -- separated by @op@. Returns a value obtained by a /left/ associative
 179 -- application of all functions returned by @op@ to the values returned
 180 -- by @p@. If there are zero occurrences of @p@, the value @x@ is
 181 -- returned.
 182
 183 chainl :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a
 184 chainl p op x       = chainl1 p op <|> return x
 185
 186 -- | @chainl1 p op x@ parser /one/ or more occurrences of @p@,
 187 -- separated by @op@ Returns a value obtained by a /left/ associative
 188 -- application of all functions returned by @op@ to the values returned
 189 -- by @p@. . This parser can for example be used to eliminate left
 190 -- recursion which typically occurs in expression grammars.
 191 --
 192 -- >  expr    = term   `chainl1` mulop
 193 -- >  term    = factor `chainl1` addop
 194 -- >  factor  = parens expr <|> integer
 195 -- >
 196 -- >  mulop   =   do{ symbol "*"; return (*)   }
 197 -- >          <|> do{ symbol "/"; return (div) }
 198 -- >
 199 -- >  addop   =   do{ symbol "+"; return (+) }
 200 -- >          <|> do{ symbol "-"; return (-) }
 201
 202 chainl1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
 203 chainl1 p op        = do{ x <- p; rest x }
 204                     where
 205                       rest x    = do{ f <- op
 206                                     ; y <- p
 207                                     ; rest (f x y)
 208                                     }
 209                                 <|> return x
 210
 211 -- | @chainr1 p op x@ parser /one/ or more occurrences of |p|,
 212 -- separated by @op@ Returns a value obtained by a /right/ associative
 213 -- application of all functions returned by @op@ to the values returned
 214 -- by @p@.
 215
 216 chainr1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
 217 chainr1 p op        = scan
 218                     where
 219                       scan      = do{ x <- p; rest x }
 220
 221                       rest x    = do{ f <- op
 222                                     ; y <- scan
 223                                     ; return (f x y)
 224                                     }
 225                                 <|> return x
 226
 227 -----------------------------------------------------------
 228 -- Tricky combinators
 229 -----------------------------------------------------------
 230 -- | The parser @anyToken@ accepts any kind of token. It is for example
 231 -- used to implement 'eof'. Returns the accepted token.
 232
 233 anyToken :: (Stream s m t, Show t) => ParsecT s u m t
 234 anyToken            = tokenPrim show (\pos _tok _toks -> pos) Just
 235
 236 -- | This parser only succeeds at the end of the input. This is not a
 237 -- primitive parser but it is defined using 'notFollowedBy'.
 238 --
 239 -- >  eof  = notFollowedBy anyToken <?> "end of input"
 240
 241 eof :: (Stream s m t, Show t) => ParsecT s u m ()
 242 eof                 = notFollowedBy anyToken <?> "end of input"
 243
 244 -- | @notFollowedBy p@ only succeeds when parser @p@ fails. This parser
 245 -- does not consume any input. This parser can be used to implement the
 246 -- \'longest match\' rule. For example, when recognizing keywords (for
 247 -- example @let@), we want to make sure that a keyword is not followed
 248 -- by a legal identifier character, in which case the keyword is
 249 -- actually an identifier (for example @lets@). We can program this
 250 -- behaviour as follows:
 251 --
 252 -- >  keywordLet  = try (do{ string "let"
 253 -- >                       ; notFollowedBy alphaNum
 254 -- >                       })
 255
 256 notFollowedBy :: (Stream s m t, Show t) => ParsecT s u m t -> ParsecT s u m ()
 257 notFollowedBy p     = try (do{ c <- p; unexpected (show [c]) }
 258                            <|> return ()
 259                           )
 260
 261 -- | @manyTill p end@ applies parser @p@ /zero/ or more times until
 262 -- parser @end@ succeeds. Returns the list of values returned by @p@.
 263 -- This parser can be used to scan comments:
 264 --
 265 -- >  simpleComment   = do{ string "<!--"
 266 -- >                      ; manyTill anyChar (try (string "-->"))
 267 -- >                      }
 268 --
 269 --    Note the overlapping parsers @anyChar@ and @string \"<!--\"@, and
 270 --    therefore the use of the 'try' combinator.
 271
 272 manyTill :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
 273 manyTill p end      = scan
 274                     where
 275                       scan  = do{ end; return [] }
 276                             <|>
 277                               do{ x <- p; xs <- scan; return (x:xs) }
 278
 279 -- | @lookAhead p@ parses @p@ without consuming any input.
 280
 281 lookAhead :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m a
 282 lookAhead p         = do{ state <- getParserState
 283                         ; x <- p
 284                         ; setParserState state
 285                         ; return x
 286                         }