PEG

gistfile1.txt

module PEG (
  Parse(..),
  eofP, charP, strP, anyOfP, anyButP, anyP, followedP, notFollowedP, ifP, emptyP, optP, repeatP, repeatP1, choiceP, seqP
) where

-- http://d.hatena.ne.jp/Otter_O/20090207/1233991312

import Data.List (intercalate)

ifNothing Nothing v = Just v
ifNothing (Just _) _ = Nothing

newtype Parse i o = Parse {
		runParse :: i -> Maybe (o, i)
	}

instance Monad (Parse i) where
	(>>=) p f = Parse $ \i ->
		case (runParse p i) of
			Nothing -> Nothing
			Just (o, i') -> runParse (f o) i'
	return o = Parse $ \i -> Just (o, i)
	fail _ = Parse $ \_ -> Nothing

_char :: (a -> Bool) -> [a] -> Maybe (a, [a])
_char _ [] = Nothing
_char f (c:cs) =
	if (f c) then Just (c, cs)
		else Nothing

eofP :: Parse [a] [a]
eofP = Parse $ \i -> f i
	where
		f [] = Just([], [])
		f _ = Nothing

charP :: Eq a => a -> Parse [a] a
charP ch = Parse $ \str -> _char (ch ==) str

strP :: Eq a => [a] -> Parse [a] [a]
strP str = sequence . map charP $ str

anyOfP :: Eq a => [a] -> Parse [a] a
anyOfP chs = Parse $ \str -> _char ( (flip elem) chs) str

anyButP :: Eq a => [a] -> Parse [a] a
anyButP chs = Parse $ \str -> _char (not.(flip elem) chs) str

anyP :: Parse [a] a
anyP = Parse $ \str -> _char (\_ -> True) str

followedP :: Parse i [o] -> Parse i [o]
followedP pf = Parse $ \i -> (runParse pf i) >> return ([ ], i)

notFollowedP :: Parse i [o] -> Parse i [o]
notFollowedP nf = Parse $ \i -> ifNothing (runParse nf i) ([ ], i)

ifP:: Parse i o -> (o -> Parse i o) -> Parse i o -> Parse i o
ifP p ps pf = Parse $ \i ->
	case (runParse p i) of
		Nothing -> runParse pf i
		Just (o, i') -> runParse (ps o) i'

emptyP :: Parse a [b]
emptyP = return  []

optP :: Parse i [o] -> Parse i [o]
optP p = ifP p return emptyP

repeatP :: Parse i [o] ->  Parse i [o]
repeatP p = ifP p (\o -> (repeatP p) >>= return.(o++)) emptyP

repeatP1 :: Parse i [o] -> Parse i [o]
repeatP1 p = seqP p (repeatP p)

choiceP :: Parse i o -> Parse i o -> Parse i o
choiceP p q = ifP p return q

seqP :: Parse i [o] -> Parse i [o] -> Parse i [o]
seqP p q = do
	v <- p
	w <- q
	return (v ++ w)



module Main where

import PEG

type StrParser = Parse String String

digitP = do x <- anyOfP ['1'..'9'] ; return [x]

digit0P = do x <- anyOfP ['0'..'9'] ; return [x]

unaryP = do x <- charP '-' ; return [x]

numberP :: StrParser
numberP = ( (strP "0") `seqP` (notFollowedP digitP) )
	`choiceP` 
	( (optP unaryP) `seqP` digitP `seqP` (repeatP digit0P) )

numPI :: Parse String Int
numPI = do
	num <- numberP
	return (read num)

blankChP :: StrParser
blankChP = do x <- anyOfP " \t" ; return [x]

blankP = repeatP blankChP

blockPI = do
	(strP "(") `seqP` blankP
	val <- expPI 
	blankP `seqP` (strP ")") `seqP` blankP
	return val

addDecPI = addPI `choiceP` decPI

numBlkMulDivPI = mulPI `choiceP` divPI `choiceP` numBlkPI

numBlkPI :: Parse String Int
numBlkPI = blockPI `choiceP` numPI

addPI :: Parse String Int
addPI = do
	val1 <- numBlkMulDivPI
	blankP `seqP` (strP "+") `seqP` blankP 
	val2 <- expPI
	return (val1 + val2)

decPI :: Parse String Int
decPI = do
	val1 <- numBlkMulDivPI
	blankP `seqP` (strP "+") `seqP` blankP 
	(val2) <- expPI
	return (val1 - val2)

mulPI :: Parse String Int
mulPI = do
	(val1) <- numBlkPI 
	blankP `seqP` (strP "*") `seqP` blankP 
	(val2) <- numBlkMulDivPI 
	return (val1 * val2)

divPI :: Parse String Int
divPI = do
	(val1) <- numBlkPI
	blankP `seqP` (strP "/") `seqP` blankP 
	(val2) <- numBlkMulDivPI
	return (val1 `div` val2)

expPI = do
	blankP
	(addDecPI `choiceP` numBlkMulDivPI)

main = do
 l <- getLine
 case runParse expPI l of
  Nothing -> return ()
  Just (r, _) -> print r