-- {-# LANGUAGE NoImplicitPrelude #-}
module MonadicParsingInHaskell () where

import Data.Char 
import GHC.Types
import GHC.Base (Monad)
import GHC.Base hiding (MonadPlus, (++), many)
import Data.List (concat)

newtype Parser a = Parser (String -> [(a,String)])

item :: Parser Char
item = Parser (cs -> case cs of
            ""     -> []
            (c:cs) -> [(c,cs)])

instance Monad Parser where
    return a = Parser (cs -> [(a,cs)])
    p >>= f  = Parser (cs -> concat [parse (f a) cs  |
                                (a,cs ) <- parse p cs])

p :: Parser (Char,Char)
p  = do {c <- item; item; d <- item; return (c,d)}

class Monad m => MonadZero m where
      zero :: m a

instance MonadZero => MonadPlus m where
    zero :: m a

instance MonadZero => Parser where
    zero = Parser (cs -> [])

class MonadZero m => MonadPlus m where
      (++) :: m a -> m a -> m a

instance MonadZero Parser where
      zero = Parser (cs -> [])

instance MonadZero Parser where
        zero = Parser (cs -> [])

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

many   :: Parser a -> Parser [a]
many p  = many1 p +++ return []

many    :: Parser a -> Parser [a]
many  p  = many p +++ return []

(+++) :: Parser a -> Parser a -> Parser a
p +++ q = Parser (cs -> case parse (p MonadicParsinginHaskell.++ q) cs of
                               []     -> []
                               (x:xs) -> [x])

instance Monad Parser where
    return a = Parser (cs -> [(a,cs)])
    p >>= f  = Parser (cs -> concat [parse (f a) cs  | (a, cs ) <- parse p cs])

sat  :: (Char -> Bool) -> Parser Char
sat p = do {c <- item; if p c then return c else zero}

char :: Char -> Parser Char
char c = sat (c ==)

string :: String -> Parser String
string ""     = return ""
string (c:cs) = do {char c; string cs; return (c:cs)}

many1  :: Parser a -> Parser [a]
many1 p = do {a <- p; as <- many p; return (a:as)}

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 a <-p
                    as <- many (do {sep; p})
                    return (a:as)

chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainl p op a = (p `chainl1` op) +++ return a

chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
p `chainl1` op = do {a <- p; rest a}
                    where
                       rest a = (do f <- op
                                    b <- p
                                    rest (f a b))
                                +++ return a

space :: Parser String
space = many (sat isSpace)

token  :: Parser a ->  Parser a
token p = do
    a <- p; space; return a

symb :: String -> Parser String
symb cs = token (string cs)

apply  :: Parser a -> String -> [(a,String)]
apply p = parse (do {space; p})

expr  :: Parser Int
expr = term `chainl1` addop

addop :: Parser (Int -> Int -> Int)
addop = do {symb "+"; return (+)} +++ do {symb "-"; return (-)}


mulop :: Parser (Int -> Int -> Int)
mulop = do {symb "*"; return (*)} +++ do {symb "/"; return div}

term :: Parser Int
term = factor `chainl1` mulop

factor :: Parser Int
factor = digit +++ do {symb "("; n <- expr; symb ")"; return n}

digit :: Parser Int
digit = do {x <- token (sat isDigit);  return (ord x - ord  0 )}

错误如下:

The class method signature lacks an accompanying binding. Move the class method site signature to the declaration site of zero.

然而,我并不怀疑这一(几乎完全相同的)法典:

class Monad m => MonadZero m where
    zero :: m a

因此,我不敢确定我需要做些什么才能获得<代码>。 MonadZero => Parse and MonadZero => Parser to work.

吉特·霍姆登也不知道要做什么。