home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / gofer230.zip / Progs / Gofer / Demos / Ccexamples / parsers.gs < prev   
Text File  |  1994-06-23  |  6KB  |  184 lines
  1. -------------------------------------------------------------------------------
  2. -- A variety of parsers, with the ability to use overloading to choose between
  3. -- parsers by a top-level type signature:
  4. --
  5. -- ? parse topExpr "1+2"  :: [Int]            ==> [3
  6. --                                                 Program error:
  7. --                                                   Unexpected character `+'
  8. -- ? parse topExpr "1+2"  :: Maybe Int        ==> Just 3
  9. -- ? parse topExpr "1+2"  :: ParseResult Int  ==> ParsedAs 3
  10. --
  11. -- ? parse topExpr "(1+2" :: [Int]           ==> Program error: missing `)'
  12. -- ? parse topExpr "(1+2" :: Maybe Int       ==> Program error: missing `)'
  13. -- ? parse topExpr "(1+2" :: ParseResult Int ==> ParseError "missing `)'"
  14. -- 
  15. -- Mark P. Jones, April 12 1993
  16. -------------------------------------------------------------------------------
  17.  
  18. infixr 7 `seq`
  19. infixl 6 `pam`, `bind_`
  20.  
  21. -- All parsers are constructed from a monad in the following way: -------------
  22.  
  23. type Parser m a = String -> m (a,String)
  24.   in mapP, resultP, bindP, zeroP, plusP, parse, lookahead, sat, errPE
  25.  
  26. mapP           :: Monad m => (a -> b) -> Parser m a -> Parser m b
  27. mapP f p s      = [ (f x, s') | ~(x,s') <- p s ]
  28.  
  29. resultP        :: Monad m => a -> Parser m a
  30. resultP x s     = result (x,s)
  31.  
  32. bindP          :: Monad m => Parser m a -> (a -> Parser m b) -> Parser m b
  33. (p `bindP` q) s = p s `bind` \ ~(x,s') -> q x s'
  34.  
  35. zeroP          :: Monad0 m => Parser m a
  36. zeroP s         = zero
  37.  
  38. plusP          :: MonadPlus m => Parser m a -> Parser m a -> Parser m a
  39. (p `plusP` q) s = p s ++ q s
  40.  
  41. instance Monad m => Functor (Parser m) where
  42.   map = mapP
  43.  
  44. instance Monad m => Monad (Parser m) where
  45.   result = resultP
  46.   bind   = bindP
  47.  
  48. instance Monad0 m => Monad0 (Parser m) where
  49.   zero = zeroP
  50.  
  51. instance MonadPlus m => MonadPlus (Parser m) where
  52.   (++) = plusP
  53.  
  54. class MonadPlus (Parser m) => ParseMonad m where
  55.   parseError  :: String -> Parser m a
  56.   parseError s = error s  -- the user really ought to use a monad that
  57.                           -- provides a better defn than this if they
  58.                           -- want to use parseError in real programs
  59.  
  60. -- Auxiliary functions, using the definition of Parser: -----------------------
  61.  
  62. parse          :: Monad m => Parser m a -> String -> m a
  63. parse p s       = [ x | ~(x,s') <- p s ]
  64.  
  65. parse' p s       = [ x | ~(x,s') <- p s ]
  66.  
  67. lookahead      :: Monad m => Parser m String
  68. lookahead s     = [ (s,s) ]
  69.  
  70. sat            :: Monad0 m => (Char -> Bool) -> Parser m Char
  71. sat p []        = zero
  72. sat p (h:ts)    = [ (h,ts) | p h ]
  73.  
  74. -- General utility functions: -------------------------------------------------
  75.  
  76. pam            :: Functor f => f a -> (a -> b) -> f b
  77. m `pam` f       = map f m
  78.  
  79. bind_          :: Monad m => m a -> m b -> m b
  80. p `bind_` q     = p `bind` const q
  81.  
  82. seq            :: Monad m => m a -> m b -> m (a,b)
  83. p `seq` q       = p `bind` \x -> q `bind` \y -> result (x,y)
  84.  
  85. many           :: MonadPlus m => m a -> m [a]
  86. many p          = q where q = (p `bind` \x -> q `bind` \xs -> result (x:xs))
  87.                               ++
  88.                               result []
  89.  
  90. many1          :: MonadPlus m => m a -> m [a]
  91. many1 p         = p `bind` \x -> many p `bind` \xs -> result (x:xs)
  92.  
  93. tok            :: ParseMonad m => String -> Parser m ()
  94. tok             = foldr bind_ (result ()) . map (sat . (==))
  95.  
  96. -- Simple parsers, uncontrolled backtracking, list of parses: -----------------
  97.  
  98. instance ParseMonad []
  99.  
  100. -- The Maybe monad: -----------------------------------------------------------
  101.  
  102. data Maybe a = Just a | None
  103.  
  104. instance Functor Maybe where
  105.     map f (Just x)  = Just (f x)
  106.     map f None      = None
  107.  
  108. instance Monad Maybe where
  109.     result          = Just
  110.     Just x `bind` f = f x
  111.     None   `bind` f = None
  112.  
  113. instance Monad0 Maybe where
  114.     zero            = None
  115.  
  116. instance MonadPlus Maybe where
  117.     None   ++ y     = y
  118.     Just x ++ y     = Just x
  119.  
  120. instance ParseMonad Maybe
  121.  
  122. -- Simple parsers, uncontrolled backtracking, list of parses: -----------------
  123.  
  124. data ParseResult a = ParsedAs a
  125.                    | ParseError String
  126.                    | Backtrack
  127.  
  128. instance Functor ParseResult where
  129.   map f (ParsedAs x)     = ParsedAs (f x)
  130.   map f (ParseError msg) = ParseError msg
  131.   map f Backtrack        = Backtrack
  132.  
  133. instance Monad ParseResult where
  134.   result x                = ParsedAs x
  135.   ParsedAs x     `bind` f = f x
  136.   ParseError msg `bind` f = ParseError msg
  137.   Backtrack      `bind` f = Backtrack
  138.  
  139. instance Monad0 ParseResult where
  140.   zero = Backtrack
  141.  
  142. instance MonadPlus ParseResult where
  143.   Backtrack  ++ y = y
  144.   other      ++ y = other
  145.  
  146. errPE      :: String -> Parser ParseResult a
  147. errPE msg s = ParseError msg
  148.  
  149. instance ParseMonad ParseResult where
  150.   parseError = errPE
  151.  
  152. -- A silly grammar for arithmetic expressions: -------------------------------
  153.  
  154. topExpr, expr, term, atom, number, digit:: ParseMonad m => Parser m Int
  155.  
  156. topExpr = expr        `bind` \e ->
  157.           lookahead   `bind` \s ->
  158.           if null s then result e
  159.                     else parseError ("Unexpected character `"++[head s]++"'")
  160.  
  161. expr    = term `bind` \x ->
  162.           (tok "+" `bind_` expr `pam` (x+)   ++
  163.            tok "-" `bind_` expr `pam` (x-)   ++
  164.            result x)
  165.  
  166. term    = atom `bind` \x ->
  167.           (tok "*" `bind_` term `pam` (x*)   ++
  168.            tok "/" `bind_` term `pam` (x/)   ++
  169.            result x)
  170.  
  171. atom    =  tok "-" `bind_` expr `pam` negate
  172.           ++
  173.            tok "(" `bind_` expr `bind` (\n -> tok ")" `bind_` result n
  174.                                               ++
  175.                                               parseError "missing `)'")
  176.           ++
  177.            number
  178.  
  179. number  = many1 digit `pam` foldl1 (\a x -> 10*a+x)
  180.  
  181. digit   = sat isDigit `pam` \d -> ord d - ord '0'
  182.  
  183. -------------------------------------------------------------------------------
  184.