home *** CD-ROM | disk | FTP | other *** search
/ PSION CD 2 / PsionCDVol2.iso / Programs / 876 / hugs.sis / Expr.hs < prev    next >
Encoding:
Text File  |  2000-09-21  |  3.0 KB  |  94 lines
  1. -----------------------------------------------------------------------------
  2. -- Parsing simple arithmetic expressions using combinators
  3. --
  4. -- Mark P. Jones, April 4, 1993
  5.  
  6. module Expr where
  7.  
  8. import Char( digitToInt )
  9.  
  10. infixr 6 &&&
  11. infixl 5 >>>
  12. infixr 4 |||
  13.  
  14. type Parser a = String -> [(a,String)]
  15.  
  16. result       :: a -> Parser a
  17. result x s    = [(x,s)]
  18.  
  19. (|||)        :: Parser a -> Parser a -> Parser a
  20. (p ||| q) s   = p s ++ q s
  21.  
  22. (&&&)        :: Parser a -> Parser b -> Parser (a,b)
  23. (p &&& q) s   = [ ((x,y),s1) | (x,s0) <- p s, (y,s1) <- q s0 ]
  24.  
  25. (>>>)        :: Parser a -> (a -> b) -> Parser b
  26. (p >>> f) s   = [ (f x, s0) | (x,s0) <- p s ]
  27.  
  28. many         :: Parser a -> Parser [a]
  29. many p        = q where q = p &&& q >>> (\(x,xs) -> x:xs)
  30.                             |||
  31.                             result []
  32.  
  33. many1        :: Parser a -> Parser [a]
  34. many1 p       = p &&& many p >>> (\(x,xs) -> x:xs)
  35.  
  36. sat          :: (Char -> Bool) -> Parser Char
  37. sat p (c:cs)
  38.         | p c = [ (c,cs) ]
  39. sat p cs      = []
  40.  
  41. tok          :: String -> Parser String
  42. tok s cs      = loop s cs
  43.                 where loop ""     cs            = [(s,cs)]
  44.                       loop (s:ss) (c:cs) | s==c = loop ss cs
  45.                       loop _      _             = []
  46.  
  47. digit        :: Parser Int
  48. digit         = sat isDigit >>> digitToInt
  49.  
  50. number       :: Parser Int
  51. number        = many1 digit >>> foldl (\a x -> 10*a+x) 0
  52.  
  53. -- Original version:
  54. -- eval "1"          (540 reductions, 933 cells)
  55. -- eval "(1)"        (5555 reductions, 8832 cells)
  56. -- eval "((1))"      (50587 reductions, 80354 cells, 1 garbage collection)
  57. -- eval "(((1)))"    (455907 reductions, 724061 cells, 7 garbage collections)
  58. -- eval "1+2+3+4+5"  (1296 reductions, 2185 cells)
  59. -- eval "1+"         (828 reductions, 1227 cells)
  60.  
  61. {-
  62. expr   = term &&& tok "+" &&& expr >>> (\(x,(p,y)) -> x + y)  |||
  63.          term &&& tok "-" &&& expr >>> (\(x,(m,y)) -> x - y)  |||
  64.          term
  65.  
  66. term   = atom &&& tok "*" &&& term >>> (\(x,(t,y)) -> x * y)  |||
  67.          atom &&& tok "/" &&& term >>> (\(x,(d,y)) -> x / y)  |||
  68.          atom
  69. -}
  70.  
  71. atom   = tok "-" &&& number >>> (\(u,n) -> -n)                |||
  72.          number                                               |||
  73.          tok "(" &&& expr &&& tok ")" >>> (\(o,(n,c)) -> n)
  74.  
  75. -- Putting the initial prefix parser first:
  76. -- eval "1"           (96 reductions, 168 cells)
  77. -- eval "(1)"         (191 reductions, 335 cells)
  78. -- eval "((1))"       (283 reductions, 498 cells)
  79. -- eval "(((1)))"     (375 reductions, 661 cells)
  80. -- eval "1+2+3+4+5"   (472 reductions, 905 cells)
  81. -- eval "1+"          (124 reductions, 251 cells)
  82.  
  83. expr   = term &&& (tok "+" &&& expr >>> (\(p,y) -> (+y))       |||
  84.                    tok "-" &&& expr >>> (\(m,y) -> subtract y) |||
  85.                    result id) >>> \(n,f) -> f n
  86.  
  87. term   = atom &&& (tok "*" &&& term >>> (\(t,y) -> (*y))       |||
  88.                    tok "/" &&& term >>> (\(d,y) -> (`div` y))  |||
  89.                    result id) >>> \(n,f) -> f n
  90.  
  91. eval s = case expr s of ((x,""):_) -> x
  92.                         _          -> error "Syntax error in input"
  93.  
  94.