関数型パーサー。復習を兼ねてもう一度

プログラミングHaskell
Graham Hutton
オーム社 / ￥ 2,940 ()
在庫あり。

import Data.Char
type Parser a = String -> [(a,String)]


myreturn :: a -> Parser a
myreturn v = \inp ->[(v,inp)]

myfailure :: Parser a
myfailure = \inp -> []

item :: Parser Char
item = \inp -> case inp of
                 [] -> []
                 (x:xs) -> [(x,xs)] 

parse :: Parser a -> String -> [(a, String)]
parse p inp = p inp

(>>==) :: Parser a -> (a -> Parser b) -> Parser b
p >>== f = \inp -> case parse p inp of
                     [] -> []
                     [(v,out)] -> parse (f v) out

--p :: Parser (Char, Char)
--p = item >>== \v -> (item >>== \w -> (item >>== \z -> myreturn (v,z)))

(+++) :: Parser a -> Parser a -> Parser a
p +++ q = \inp -> case parse p inp of
                    [] -> parse q inp
                    [(v, out)] -> [(v, out)]

sat :: (Char -> Bool) -> Parser Char
sat p = item >>== \x -> if p x then myreturn x else myfailure

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 :: Char -> Parser Char
char x = sat (==x)

string :: String -> Parser String
string [] = myreturn []
string (x:xs) = char x >>== \x -> string xs >>== \xs -> myreturn (x:xs)

many :: Parser a -> Parser [a]
many p = many1 p +++ myreturn []
many1 :: Parser a -> Parser [a]
many1 p = p >>== \v -> many p >>== \vs -> myreturn (v:vs)

ident :: Parser String
ident = lower >>== \x -> (many alphanum >>== \xs -> myreturn (x:xs))

nat :: Parser Int
nat = many1 digit >>== \xs -> myreturn (read xs)

space :: Parser ()
space = many (sat isSpace) >>== \_ -> myreturn ()

token :: Parser a -> Parser a
token p = space >>== \_ -> p >>== \v -> space >>== \_ -> myreturn v

identifier :: Parser String
identifier = token ident

natural :: Parser Int
natural = token nat

symbol :: String -> Parser String
symbol xs = token (string xs)

--p :: Parser [Int]
--p = symbol "[" >>== \_ -> natural >>== \n -> many (symbol "," >>== \_ ->
--    natural) >>== \ns -> symbol "]" >>== \_ -> myreturn (n:ns)


expr :: Parser Int
expr = term >>== \t -> ((symbol "+" >>== \_ -> expr >>== \e -> myreturn (t + e)) +++ myreturn t)

term :: Parser Int
term = factor >>== \f -> ((symbol "*" >>== \_ -> term >>== \t -> myreturn (f * t)) +++ myreturn f)

factor :: Parser Int
factor = (symbol "(" >>== \_ -> expr >>== \e -> symbol ")" >>== \_ -> myreturn e) +++ natural

eval :: String -> Int
eval xs = case parse expr xs of
            [(n,[])]  -> n
            [(_,out)] -> error ("unused input " ++ out)
            []        -> error "invalid input"