PageRenderTime 107ms CodeModel.GetById 21ms RepoModel.GetById 1ms app.codeStats 0ms

/Cabal/Distribution/Compat/ReadP.hs

https://gitlab.com/kranium/cabal
Haskell | 381 lines | 201 code | 66 blank | 114 comment | 5 complexity | acbbad68cf6995e6f9026b43b6834993 MD5 | raw file
  1. -----------------------------------------------------------------------------
  2. -- |
  3. -- Module : Distribution.Compat.ReadP
  4. -- Copyright : (c) The University of Glasgow 2002
  5. -- License : BSD-style (see the file libraries/base/LICENSE)
  6. --
  7. -- Maintainer : libraries@haskell.org
  8. -- Portability : portable
  9. --
  10. -- This is a library of parser combinators, originally written by Koen Claessen.
  11. -- It parses all alternatives in parallel, so it never keeps hold of
  12. -- the beginning of the input string, a common source of space leaks with
  13. -- other parsers. The '(+++)' choice combinator is genuinely commutative;
  14. -- it makes no difference which branch is \"shorter\".
  15. --
  16. -- See also Koen's paper /Parallel Parsing Processes/
  17. -- (<http://www.cs.chalmers.se/~koen/publications.html>).
  18. --
  19. -- This version of ReadP has been locally hacked to make it H98, by
  20. -- Martin Sj&#xF6;gren <mailto:msjogren@gmail.com>
  21. --
  22. -- The unit tests have been moved to UnitTest.Distribution.Compat.ReadP, by
  23. -- Mark Lentczner <mailto:mark@glyphic.com>
  24. -----------------------------------------------------------------------------
  25. module Distribution.Compat.ReadP
  26. (
  27. -- * The 'ReadP' type
  28. ReadP, -- :: * -> *; instance Functor, Monad, MonadPlus
  29. -- * Primitive operations
  30. get, -- :: ReadP Char
  31. look, -- :: ReadP String
  32. (+++), -- :: ReadP a -> ReadP a -> ReadP a
  33. (<++), -- :: ReadP a -> ReadP a -> ReadP a
  34. gather, -- :: ReadP a -> ReadP (String, a)
  35. -- * Other operations
  36. pfail, -- :: ReadP a
  37. satisfy, -- :: (Char -> Bool) -> ReadP Char
  38. char, -- :: Char -> ReadP Char
  39. string, -- :: String -> ReadP String
  40. munch, -- :: (Char -> Bool) -> ReadP String
  41. munch1, -- :: (Char -> Bool) -> ReadP String
  42. skipSpaces, -- :: ReadP ()
  43. choice, -- :: [ReadP a] -> ReadP a
  44. count, -- :: Int -> ReadP a -> ReadP [a]
  45. between, -- :: ReadP open -> ReadP close -> ReadP a -> ReadP a
  46. option, -- :: a -> ReadP a -> ReadP a
  47. optional, -- :: ReadP a -> ReadP ()
  48. many, -- :: ReadP a -> ReadP [a]
  49. many1, -- :: ReadP a -> ReadP [a]
  50. skipMany, -- :: ReadP a -> ReadP ()
  51. skipMany1, -- :: ReadP a -> ReadP ()
  52. sepBy, -- :: ReadP a -> ReadP sep -> ReadP [a]
  53. sepBy1, -- :: ReadP a -> ReadP sep -> ReadP [a]
  54. endBy, -- :: ReadP a -> ReadP sep -> ReadP [a]
  55. endBy1, -- :: ReadP a -> ReadP sep -> ReadP [a]
  56. chainr, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
  57. chainl, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
  58. chainl1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
  59. chainr1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
  60. manyTill, -- :: ReadP a -> ReadP end -> ReadP [a]
  61. -- * Running a parser
  62. ReadS, -- :: *; = String -> [(a,String)]
  63. readP_to_S, -- :: ReadP a -> ReadS a
  64. readS_to_P -- :: ReadS a -> ReadP a
  65. )
  66. where
  67. import Control.Monad( MonadPlus(..), liftM2 )
  68. import Data.Char (isSpace)
  69. infixr 5 +++, <++
  70. -- ---------------------------------------------------------------------------
  71. -- The P type
  72. -- is representation type -- should be kept abstract
  73. data P s a
  74. = Get (s -> P s a)
  75. | Look ([s] -> P s a)
  76. | Fail
  77. | Result a (P s a)
  78. | Final [(a,[s])] -- invariant: list is non-empty!
  79. -- Monad, MonadPlus
  80. instance Monad (P s) where
  81. return x = Result x Fail
  82. (Get f) >>= k = Get (\c -> f c >>= k)
  83. (Look f) >>= k = Look (\s -> f s >>= k)
  84. Fail >>= _ = Fail
  85. (Result x p) >>= k = k x `mplus` (p >>= k)
  86. (Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
  87. fail _ = Fail
  88. instance MonadPlus (P s) where
  89. mzero = Fail
  90. -- most common case: two gets are combined
  91. Get f1 `mplus` Get f2 = Get (\c -> f1 c `mplus` f2 c)
  92. -- results are delivered as soon as possible
  93. Result x p `mplus` q = Result x (p `mplus` q)
  94. p `mplus` Result x q = Result x (p `mplus` q)
  95. -- fail disappears
  96. Fail `mplus` p = p
  97. p `mplus` Fail = p
  98. -- two finals are combined
  99. -- final + look becomes one look and one final (=optimization)
  100. -- final + sthg else becomes one look and one final
  101. Final r `mplus` Final t = Final (r ++ t)
  102. Final r `mplus` Look f = Look (\s -> Final (r ++ run (f s) s))
  103. Final r `mplus` p = Look (\s -> Final (r ++ run p s))
  104. Look f `mplus` Final r = Look (\s -> Final (run (f s) s ++ r))
  105. p `mplus` Final r = Look (\s -> Final (run p s ++ r))
  106. -- two looks are combined (=optimization)
  107. -- look + sthg else floats upwards
  108. Look f `mplus` Look g = Look (\s -> f s `mplus` g s)
  109. Look f `mplus` p = Look (\s -> f s `mplus` p)
  110. p `mplus` Look f = Look (\s -> p `mplus` f s)
  111. -- ---------------------------------------------------------------------------
  112. -- The ReadP type
  113. newtype Parser r s a = R ((a -> P s r) -> P s r)
  114. type ReadP r a = Parser r Char a
  115. -- Functor, Monad, MonadPlus
  116. instance Functor (Parser r s) where
  117. fmap h (R f) = R (\k -> f (k . h))
  118. instance Monad (Parser r s) where
  119. return x = R (\k -> k x)
  120. fail _ = R (\_ -> Fail)
  121. R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
  122. --instance MonadPlus (Parser r s) where
  123. -- mzero = pfail
  124. -- mplus = (+++)
  125. -- ---------------------------------------------------------------------------
  126. -- Operations over P
  127. final :: [(a,[s])] -> P s a
  128. -- Maintains invariant for Final constructor
  129. final [] = Fail
  130. final r = Final r
  131. run :: P c a -> ([c] -> [(a, [c])])
  132. run (Get f) (c:s) = run (f c) s
  133. run (Look f) s = run (f s) s
  134. run (Result x p) s = (x,s) : run p s
  135. run (Final r) _ = r
  136. run _ _ = []
  137. -- ---------------------------------------------------------------------------
  138. -- Operations over ReadP
  139. get :: ReadP r Char
  140. -- ^ Consumes and returns the next character.
  141. -- Fails if there is no input left.
  142. get = R Get
  143. look :: ReadP r String
  144. -- ^ Look-ahead: returns the part of the input that is left, without
  145. -- consuming it.
  146. look = R Look
  147. pfail :: ReadP r a
  148. -- ^ Always fails.
  149. pfail = R (\_ -> Fail)
  150. (+++) :: ReadP r a -> ReadP r a -> ReadP r a
  151. -- ^ Symmetric choice.
  152. R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k)
  153. (<++) :: ReadP a a -> ReadP r a -> ReadP r a
  154. -- ^ Local, exclusive, left-biased choice: If left parser
  155. -- locally produces any result at all, then right parser is
  156. -- not used.
  157. R f <++ q =
  158. do s <- look
  159. probe (f return) s 0
  160. where
  161. probe (Get f') (c:s) n = probe (f' c) s (n+1 :: Int)
  162. probe (Look f') s n = probe (f' s) s n
  163. probe p@(Result _ _) _ n = discard n >> R (p >>=)
  164. probe (Final r) _ _ = R (Final r >>=)
  165. probe _ _ _ = q
  166. discard 0 = return ()
  167. discard n = get >> discard (n-1 :: Int)
  168. gather :: ReadP (String -> P Char r) a -> ReadP r (String, a)
  169. -- ^ Transforms a parser into one that does the same, but
  170. -- in addition returns the exact characters read.
  171. -- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument
  172. -- is built using any occurrences of readS_to_P.
  173. gather (R m) =
  174. R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))
  175. where
  176. gath l (Get f) = Get (\c -> gath (l.(c:)) (f c))
  177. gath _ Fail = Fail
  178. gath l (Look f) = Look (\s -> gath l (f s))
  179. gath l (Result k p) = k (l []) `mplus` gath l p
  180. gath _ (Final _) = error "do not use readS_to_P in gather!"
  181. -- ---------------------------------------------------------------------------
  182. -- Derived operations
  183. satisfy :: (Char -> Bool) -> ReadP r Char
  184. -- ^ Consumes and returns the next character, if it satisfies the
  185. -- specified predicate.
  186. satisfy p = do c <- get; if p c then return c else pfail
  187. char :: Char -> ReadP r Char
  188. -- ^ Parses and returns the specified character.
  189. char c = satisfy (c ==)
  190. string :: String -> ReadP r String
  191. -- ^ Parses and returns the specified string.
  192. string this = do s <- look; scan this s
  193. where
  194. scan [] _ = do return this
  195. scan (x:xs) (y:ys) | x == y = do get >> scan xs ys
  196. scan _ _ = do pfail
  197. munch :: (Char -> Bool) -> ReadP r String
  198. -- ^ Parses the first zero or more characters satisfying the predicate.
  199. munch p =
  200. do s <- look
  201. scan s
  202. where
  203. scan (c:cs) | p c = do _ <- get; s <- scan cs; return (c:s)
  204. scan _ = do return ""
  205. munch1 :: (Char -> Bool) -> ReadP r String
  206. -- ^ Parses the first one or more characters satisfying the predicate.
  207. munch1 p =
  208. do c <- get
  209. if p c then do s <- munch p; return (c:s)
  210. else pfail
  211. choice :: [ReadP r a] -> ReadP r a
  212. -- ^ Combines all parsers in the specified list.
  213. choice [] = pfail
  214. choice [p] = p
  215. choice (p:ps) = p +++ choice ps
  216. skipSpaces :: ReadP r ()
  217. -- ^ Skips all whitespace.
  218. skipSpaces =
  219. do s <- look
  220. skip s
  221. where
  222. skip (c:s) | isSpace c = do _ <- get; skip s
  223. skip _ = do return ()
  224. count :: Int -> ReadP r a -> ReadP r [a]
  225. -- ^ @ count n p @ parses @n@ occurrences of @p@ in sequence. A list of
  226. -- results is returned.
  227. count n p = sequence (replicate n p)
  228. between :: ReadP r open -> ReadP r close -> ReadP r a -> ReadP r a
  229. -- ^ @ between open close p @ parses @open@, followed by @p@ and finally
  230. -- @close@. Only the value of @p@ is returned.
  231. between open close p = do _ <- open
  232. x <- p
  233. _ <- close
  234. return x
  235. option :: a -> ReadP r a -> ReadP r a
  236. -- ^ @option x p@ will either parse @p@ or return @x@ without consuming
  237. -- any input.
  238. option x p = p +++ return x
  239. optional :: ReadP r a -> ReadP r ()
  240. -- ^ @optional p@ optionally parses @p@ and always returns @()@.
  241. optional p = (p >> return ()) +++ return ()
  242. many :: ReadP r a -> ReadP r [a]
  243. -- ^ Parses zero or more occurrences of the given parser.
  244. many p = return [] +++ many1 p
  245. many1 :: ReadP r a -> ReadP r [a]
  246. -- ^ Parses one or more occurrences of the given parser.
  247. many1 p = liftM2 (:) p (many p)
  248. skipMany :: ReadP r a -> ReadP r ()
  249. -- ^ Like 'many', but discards the result.
  250. skipMany p = many p >> return ()
  251. skipMany1 :: ReadP r a -> ReadP r ()
  252. -- ^ Like 'many1', but discards the result.
  253. skipMany1 p = p >> skipMany p
  254. sepBy :: ReadP r a -> ReadP r sep -> ReadP r [a]
  255. -- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@.
  256. -- Returns a list of values returned by @p@.
  257. sepBy p sep = sepBy1 p sep +++ return []
  258. sepBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a]
  259. -- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@.
  260. -- Returns a list of values returned by @p@.
  261. sepBy1 p sep = liftM2 (:) p (many (sep >> p))
  262. endBy :: ReadP r a -> ReadP r sep -> ReadP r [a]
  263. -- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended
  264. -- by @sep@.
  265. endBy p sep = many (do x <- p ; _ <- sep ; return x)
  266. endBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a]
  267. -- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended
  268. -- by @sep@.
  269. endBy1 p sep = many1 (do x <- p ; _ <- sep ; return x)
  270. chainr :: ReadP r a -> ReadP r (a -> a -> a) -> a -> ReadP r a
  271. -- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.
  272. -- Returns a value produced by a /right/ associative application of all
  273. -- functions returned by @op@. If there are no occurrences of @p@, @x@ is
  274. -- returned.
  275. chainr p op x = chainr1 p op +++ return x
  276. chainl :: ReadP r a -> ReadP r (a -> a -> a) -> a -> ReadP r a
  277. -- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@.
  278. -- Returns a value produced by a /left/ associative application of all
  279. -- functions returned by @op@. If there are no occurrences of @p@, @x@ is
  280. -- returned.
  281. chainl p op x = chainl1 p op +++ return x
  282. chainr1 :: ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a
  283. -- ^ Like 'chainr', but parses one or more occurrences of @p@.
  284. chainr1 p op = scan
  285. where scan = p >>= rest
  286. rest x = do f <- op
  287. y <- scan
  288. return (f x y)
  289. +++ return x
  290. chainl1 :: ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a
  291. -- ^ Like 'chainl', but parses one or more occurrences of @p@.
  292. chainl1 p op = p >>= rest
  293. where rest x = do f <- op
  294. y <- p
  295. rest (f x y)
  296. +++ return x
  297. manyTill :: ReadP r a -> ReadP [a] end -> ReadP r [a]
  298. -- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@
  299. -- succeeds. Returns a list of values returned by @p@.
  300. manyTill p end = scan
  301. where scan = (end >> return []) <++ (liftM2 (:) p scan)
  302. -- ---------------------------------------------------------------------------
  303. -- Converting between ReadP and Read
  304. readP_to_S :: ReadP a a -> ReadS a
  305. -- ^ Converts a parser into a Haskell ReadS-style function.
  306. -- This is the main way in which you can \"run\" a 'ReadP' parser:
  307. -- the expanded type is
  308. -- @ readP_to_S :: ReadP a -> String -> [(a,String)] @
  309. readP_to_S (R f) = run (f return)
  310. readS_to_P :: ReadS a -> ReadP r a
  311. -- ^ Converts a Haskell ReadS-style function into a parser.
  312. -- Warning: This introduces local backtracking in the resulting
  313. -- parser, and therefore a possible inefficiency.
  314. readS_to_P r =
  315. R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s']))