1 module Parse 2 (Parse, Parses, -- data types 3 thenP, returnP, eachP, consP, -- sequencing and success 4 elseP, failP, guardP, filterP, -- alternation and failure 5 starP, plusP, cutP, -- repetition and cut 6 endP, itemP, litP, litsP, exactlyP, -- end, next item, and literals 7 spacesP, lexP, lexicalP, lexactlyP, -- spaces and lexemes 8 asciiP, controlP, printP, spaceP, -- character parsers 9 alphaP, upperP, lowerP, digitP, alphanumP, 10 surroundP, plusSepP, starSepP, parenP, listP, -- surrounds and separators 11 useP) -- using a parser 12 where 13 14 import Char -- 1.3 15 16 #if __HASKELL1__ < 5 17 #define isAlphaNum isAlphanum 18 #endif 19 20 infixr 1 `elseP` 21 infix 2 `thenP` 22 infix 2 `eachP` 23 infixr 3 `filterP` 24 infixr 3 `guardP` 25 type Parse a x = a -> [(x, a)] 26 type Parses x = Parse String x 27 thenP :: Parse a x -> (x -> Parse a y) -> Parse a y 28 xP `thenP` kP = \a -> [ (y,c) | (x,b) <- xP a, (y,c) <- kP x b ] 29 returnP :: x -> Parse a x 30 returnP x = \a -> [ (x,a) ] 31 eachP :: Parse a x -> (x -> y) -> Parse a y 32 xP `eachP` f = xP `thenP` (\x -> returnP (f x)) 33 consP :: Parse a x -> Parse a [x] -> Parse a [x] 34 xP `consP` xsP = xP `thenP` (\x -> 35 xsP `thenP` (\xs -> 36 returnP (x:xs))) 37 elseP :: Parse a x -> Parse a x -> Parse a x 38 xP `elseP` yP = \a -> xP a ++ yP a 39 failP :: Parse a x 40 failP = \a -> [] 41 guardP :: Bool -> Parse a x -> Parse a x 42 guardP b xP = if b then xP else failP 43 filterP :: (x -> Bool) -> Parse a x -> Parse a x 44 filterP p xP = xP `thenP` (\x -> p x `guardP` returnP x) 45 starP :: Parse a x -> Parse a [x] 46 starP xP = cutP (plusP xP `elseP` returnP []) 47 plusP :: Parse a x -> Parse a [x] 48 plusP xP = xP `consP` starP xP 49 cutP :: Parse a x -> Parse a x 50 cutP xP = \a -> case xP a of { ~(~(x,b):_) -> [(x,b)] } 51 endP :: Parse [x] () 52 endP = \xs -> if null xs then returnP () xs else failP xs 53 itemP :: Parse [x] x 54 itemP = \xs -> if null xs then failP xs 55 else returnP (head xs) (tail xs) 56 litP :: (Eq x) => x -> Parse [x] x 57 litP c = (\x -> c==x) `filterP` itemP 58 litsP :: (Eq x) => [x] -> Parse [x] [x] 59 litsP [] = returnP [] 60 litsP (c:cs) = litP c `consP` litsP cs 61 exactlyP :: Parse [y] x -> Parse [y] x 62 exactlyP xP = xP `thenP` (\x -> endP `thenP` (\() -> returnP x)) 63 spacesP :: Parses String 64 spacesP = starP spaceP 65 lexicalP :: Parses x -> Parses x 66 lexicalP xP = xP `thenP` (\x -> spacesP `thenP` (\_ -> returnP x)) 67 lexP :: String -> Parses String 68 lexP cs = lexicalP (litsP cs) 69 lexactlyP :: Parses x -> Parses x 70 lexactlyP xP = spacesP `thenP` (\_ -> exactlyP xP) 71 asciiP, controlP, printP, spaceP, upperP :: Parses Char 72 lowerP, alphaP, digitP, alphanumP :: Parses Char 73 asciiP = isAscii `filterP` itemP 74 controlP = isControl `filterP` itemP 75 printP = isPrint `filterP` itemP 76 spaceP = isSpace `filterP` itemP 77 upperP = isUpper `filterP` itemP 78 lowerP = isLower `filterP` itemP 79 alphaP = isAlpha `filterP` itemP 80 digitP = isDigit `filterP` itemP 81 alphanumP = isAlphaNum `filterP` itemP 82 surroundP :: String -> Parses x -> String -> Parses x 83 surroundP l xP r = lexP l `thenP` (\_ -> 84 xP `thenP` (\x -> 85 lexP r `thenP` (\_ -> 86 returnP x))) 87 plusSepP :: String -> Parses x -> Parses [x] 88 plusSepP s xP = xP `consP` starP (lexP s `thenP` (\_ -> xP)) 89 starSepP :: String -> Parses x -> Parses [x] 90 starSepP s xP = plusSepP s xP `elseP` returnP [] 91 parenP :: Parses x -> Parses x 92 parenP xP = surroundP "(" xP ")" 93 listP :: Parses x -> Parses [x] 94 listP xP = surroundP "[" (starSepP "," xP) "]" 95 useP :: x -> Parse a x -> (a -> x) 96 useP failx xP = \a -> case xP a of { [] -> failx; ((x,_):_) -> x }