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