home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / hugs_1 / !Hugs_libhugs_ParseLib < prev    next >
Encoding:
Text File  |  1996-08-12  |  6.2 KB  |  182 lines
  1. {-----------------------------------------------------------------------------
  2.  
  3.                  A LIBRARY OF MONADIC PARSER COMBINATORS
  4.  
  5.                               29th July 1996
  6.  
  7.                  Graham Hutton               Erik Meijer
  8.             University of Nottingham    University of Utrecht
  9.  
  10. This Haskell 1.3 script defines a library of parser combinators, and is taken
  11. from sections 1-6 of our article "Monadic Parser Combinators".  Some changes
  12. to the library have been made in the move from Gofer to Haskell:
  13.  
  14.    * Do notation is used in place of monad comprehension notation;
  15.  
  16.    * The parser datatype is defined using "newtype", to avoid the overhead
  17.      of tagging and untagging parsers with the P constructor.
  18.  
  19. -----------------------------------------------------------------------------}
  20.  
  21. module Parsing
  22.    (Parser, item, apply, (+++), sat, many, many1, sepby, sepby1, chainl,
  23.     chainl1, chainr, chainr1, ops, bracket, char, digit, lower, upper,
  24.     letter, alphanum, string, ident, nat, int, spaces, comment, junk,
  25.     parse, token, natural, integer, symbol, identifier) where
  26.  
  27. infixr 5 +++
  28.  
  29. --- The parser monad ---------------------------------------------------------
  30.  
  31. newtype Parser a   = P (String -> [(a,String)])
  32.  
  33. instance Functor Parser where
  34.    -- map         :: (a -> b) -> (Parser a -> Parser b)
  35.    map f (P p)     = P (\inp -> [(f v, out) | (v,out) <- p inp])
  36.  
  37. instance Monad Parser where
  38.    -- return      :: a -> Parser a
  39.    return v        = P (\inp -> [(v,inp)])
  40.  
  41.    -- >>=         :: Parser a -> (a -> Parser b) -> Parser b
  42.    (P p) >>= f     = P (\inp -> concat [papply (f v) out | (v,out) <- p inp])
  43.  
  44. instance MonadZero Parser where
  45.    -- zero        :: Parser a
  46.    zero            = P (\inp -> [])
  47.  
  48. instance MonadPlus Parser where
  49.    -- (++)        :: Parser a -> Parser a -> Parser a
  50.    (P p) ++ (P q)  = P (\inp -> (p inp ++ q inp))
  51.  
  52. --- Other primitive parser combinators ---------------------------------------
  53.  
  54. item              :: Parser Char
  55. item               = P (\inp -> case inp of
  56.                                    []     -> []
  57.                                    (x:xs) -> [(x,xs)])
  58.  
  59. force             :: Parser a -> Parser a
  60. force (P p)        = P (\inp -> let x = p inp in
  61.                                 (fst (head x), snd (head x)) : tail x)
  62.  
  63. first             :: Parser a -> Parser a
  64. first (P p)        = P (\inp -> case p inp of
  65.                                    []     -> []
  66.                                    (x:xs) -> [x])
  67.  
  68. papply            :: Parser a -> String -> [(a,String)]
  69. papply (P p) inp   = p inp
  70.  
  71. --- Derived combinators ------------------------------------------------------
  72.  
  73. (+++)             :: Parser a -> Parser a -> Parser a
  74. p +++ q            = first (p ++ q)
  75.  
  76. sat               :: (Char -> Bool) -> Parser Char
  77. sat p              = do {x <- item; if p x; return x}
  78.  
  79. many              :: Parser a -> Parser [a]
  80. many p             = force (many1 p +++ return [])
  81.  
  82. many1             :: Parser a -> Parser [a]
  83. many1 p            = do {x <- p; xs <- many p; return (x:xs)}
  84.  
  85. sepby             :: Parser a -> Parser b -> Parser [a]
  86. p `sepby` sep      = (p `sepby1` sep) +++ return []
  87.  
  88. sepby1            :: Parser a -> Parser b -> Parser [a]
  89. p `sepby1` sep     = do {x <- p; xs <- many (do {sep; p}); return (x:xs)}
  90.  
  91. chainl            :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
  92. chainl p op v      = (p `chainl1` op) +++ return v
  93.  
  94. chainl1           :: Parser a -> Parser (a -> a -> a) -> Parser a
  95. p `chainl1` op     = do {x <- p; rest x}
  96.                      where
  97.                         rest x = do {f <- op; y <- p; rest (f x y)}
  98.                                  +++ return x
  99.  
  100. chainr            :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
  101. chainr p op v      = (p `chainr1` op) +++ return v
  102.  
  103. chainr1           :: Parser a -> Parser (a -> a -> a) -> Parser a
  104. p `chainr1` op     = do {x <- p; rest x}
  105.                      where
  106.                         rest x = do {f <- op; y <- p `chainr1` op; return (f x y)}
  107.                                  +++ return x
  108.  
  109. ops               :: [(Parser a, b)] -> Parser b
  110. ops xs             = foldr1 (+++) [do {p; return op} | (p,op) <- xs]
  111.  
  112. bracket           :: Parser a -> Parser b -> Parser c -> Parser b
  113. bracket open p close = do {open; x <- p; close; return x}
  114.  
  115. --- Useful parsers -----------------------------------------------------------
  116.  
  117. char              :: Char -> Parser Char
  118. char x             = sat (\y -> x == y)
  119.  
  120. digit             :: Parser Char
  121. digit              = sat isDigit
  122.  
  123. lower             :: Parser Char
  124. lower              = sat isLower
  125.  
  126. upper             :: Parser Char
  127. upper              = sat isUpper
  128.  
  129. letter            :: Parser Char
  130. letter             = sat isAlpha
  131.  
  132. alphanum          :: Parser Char
  133. alphanum           = sat isAlphanum
  134.  
  135. string            :: String -> Parser String
  136. string ""          = return ""
  137. string (x:xs)      = do {char x; string xs; return (x:xs)}
  138.  
  139. ident             :: Parser String
  140. ident              = do {x <- lower; xs <- many alphanum; return (x:xs)}
  141.  
  142. nat               :: Parser Int
  143. nat                = do {x <- digit; return (ord x - ord '0')} `chainl1` return op
  144.                      where
  145.                         m `op` n = 10*m + n
  146.  
  147. int               :: Parser Int
  148. int                = do {char '-'; n <- nat; return (-n)} +++ nat
  149.  
  150. --- Lexical combinators ------------------------------------------------------
  151.  
  152. spaces            :: Parser ()
  153. spaces             = do {many1 (sat isSpace); return ()}
  154.  
  155. comment           :: Parser ()
  156. comment            = do {string "--"; many (sat (\x -> x /= '\n')); return ()}
  157.  
  158. junk              :: Parser ()
  159. junk               = do {many (spaces +++ comment); return ()}
  160.  
  161. parse             :: Parser a -> Parser a
  162. parse p            = do {junk; p}
  163.  
  164. token             :: Parser a -> Parser a
  165. token p            = do {v <- p; junk; return v}
  166.  
  167. --- Token parsers ------------------------------------------------------------
  168.  
  169. natural           :: Parser Int
  170. natural            = token nat
  171.  
  172. integer           :: Parser Int
  173. integer            = token int
  174.  
  175. symbol            :: String -> Parser String
  176. symbol xs          = token (string xs)
  177.  
  178. identifier        :: [String] -> Parser String
  179. identifier ks      = token (do {x <- ident; if not (elem x ks); return x})
  180.  
  181. ------------------------------------------------------------------------------
  182.