/usr/lib/hugs/programs/cpphs/Text/ParserCombinators/HuttonMeijer.hs is in hugs 98.200609.21-5.3ubuntu1.
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 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 | -----------------------------------------------------------------------------
-- |
-- Module : ParseLib
-- Copyright : ...
-- Copyright : Graham Hutton (University of Nottingham), Erik Meijer (University of Utrecht)
--
-- Maintainer : Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
-- Stability : Stable
-- Portability : All
--
-- A LIBRARY OF MONADIC PARSER COMBINATORS
--
-- 29th July 1996
--
-- Graham Hutton Erik Meijer
-- University of Nottingham University of Utrecht
--
-- This Haskell script defines a library of parser combinators, and is
-- taken from sections 1-6 of our article "Monadic Parser Combinators".
-- Some changes to the library have been made in the move from Gofer
-- to Haskell:
--
-- * Do notation is used in place of monad comprehension notation;
--
-- * The parser datatype is defined using "newtype", to avoid the overhead
-- of tagging and untagging parsers with the P constructor.
-----------------------------------------------------------------------------
module Text.ParserCombinators.HuttonMeijer
(Parser(..), item, first, papply, (+++), sat, {-tok,-} many, many1,
sepby, sepby1, chainl,
chainl1, chainr, chainr1, ops, bracket, char, digit, lower, upper,
letter, alphanum, string, ident, nat, int, spaces, comment, junk,
skip, token, natural, integer, symbol, identifier) where
import Char
import Monad
infixr 5 +++
type Token = Char
---------------------------------------------------------
-- | The parser monad
newtype Parser a = P ([Token] -> [(a,[Token])])
instance Functor Parser where
-- map :: (a -> b) -> (Parser a -> Parser b)
fmap f (P p) = P (\inp -> [(f v, out) | (v,out) <- p inp])
instance Monad Parser where
-- return :: a -> Parser a
return v = P (\inp -> [(v,inp)])
-- >>= :: Parser a -> (a -> Parser b) -> Parser b
(P p) >>= f = P (\inp -> concat [papply (f v) out | (v,out) <- p inp])
-- fail :: String -> Parser a
fail _ = P (\_ -> [])
instance MonadPlus Parser where
-- mzero :: Parser a
mzero = P (\_ -> [])
-- mplus :: Parser a -> Parser a -> Parser a
(P p) `mplus` (P q) = P (\inp -> (p inp ++ q inp))
-- ------------------------------------------------------------
-- * Other primitive parser combinators
-- ------------------------------------------------------------
item :: Parser Token
item = P (\inp -> case inp of
[] -> []
(x:xs) -> [(x,xs)])
first :: Parser a -> Parser a
first (P p) = P (\inp -> case p inp of
[] -> []
(x:_) -> [x])
papply :: Parser a -> [Token] -> [(a,[Token])]
papply (P p) inp = p inp
-- ------------------------------------------------------------
-- * Derived combinators
-- ------------------------------------------------------------
(+++) :: Parser a -> Parser a -> Parser a
p +++ q = first (p `mplus` q)
sat :: (Token -> Bool) -> Parser Token
sat p = do {x <- item; if p x then return x else mzero}
--tok :: Token -> Parser Token
--tok t = do {x <- item; if t==snd x then return t else mzero}
many :: Parser a -> Parser [a]
many p = many1 p +++ return []
--many p = force (many1 p +++ return [])
many1 :: Parser a -> Parser [a]
many1 p = do {x <- p; xs <- many p; return (x:xs)}
sepby :: Parser a -> Parser b -> Parser [a]
p `sepby` sep = (p `sepby1` sep) +++ return []
sepby1 :: Parser a -> Parser b -> Parser [a]
p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)}
chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainl p op v = (p `chainl1` op) +++ return v
chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
p `chainl1` op = do {x <- p; rest x}
where
rest x = do {f <- op; y <- p; rest (f x y)}
+++ return x
chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainr p op v = (p `chainr1` op) +++ return v
chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a
p `chainr1` op = do {x <- p; rest x}
where
rest x = do {f <- op; y <- p `chainr1` op; return (f x y)}
+++ return x
ops :: [(Parser a, b)] -> Parser b
ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs]
bracket :: Parser a -> Parser b -> Parser c -> Parser b
bracket open p close = do {open; x <- p; close; return x}
-- ------------------------------------------------------------
-- * Useful parsers
-- ------------------------------------------------------------
char :: Char -> Parser Char
char x = sat (\y -> x == y)
digit :: Parser Char
digit = sat isDigit
lower :: Parser Char
lower = sat isLower
upper :: Parser Char
upper = sat isUpper
letter :: Parser Char
letter = sat isAlpha
alphanum :: Parser Char
alphanum = sat isAlphaNum +++ char '_'
string :: String -> Parser String
string "" = return ""
string (x:xs) = do {char x; string xs; return (x:xs)}
ident :: Parser String
ident = do {x <- lower; xs <- many alphanum; return (x:xs)}
nat :: Parser Int
nat = do {x <- digit; return (fromEnum x - fromEnum '0')} `chainl1` return op
where
m `op` n = 10*m + n
int :: Parser Int
int = do {char '-'; n <- nat; return (-n)} +++ nat
-- ------------------------------------------------------------
-- * Lexical combinators
-- ------------------------------------------------------------
spaces :: Parser ()
spaces = do {many1 (sat isSpace); return ()}
comment :: Parser ()
--comment = do {string "--"; many (sat (\x -> x /= '\n')); return ()}
--comment = do
-- _ <- string "--"
-- _ <- many (sat (\x -> x /= '\n'))
-- return ()
comment = do
bracket (string "/*") (many item) (string "*/")
return ()
junk :: Parser ()
junk = do {many (spaces +++ comment); return ()}
skip :: Parser a -> Parser a
skip p = do {junk; p}
token :: Parser a -> Parser a
token p = do {v <- p; junk; return v}
-- ------------------------------------------------------------
-- * Token parsers
-- ------------------------------------------------------------
natural :: Parser Int
natural = token nat
integer :: Parser Int
integer = token int
symbol :: String -> Parser String
symbol xs = token (string xs)
identifier :: [String] -> Parser String
identifier ks = token (do {x <- ident;
if not (elem x ks) then return x
else return mzero})
------------------------------------------------------------------------------
|