Monadic Parser

As of March 2020, School of Haskell has been switched to read-only mode.

In this post I give two implementations of a parser presented in the paper Monads for functional programming by Philip Wadler. The first implementation is essentially the one presented in the paper. The second one uses Haskell do notation, so it is somewhat cleaner and easier to follow.

My main motivation was to confirm there is a bug in the paper: the implementation of term' should use biased choice instead of choice.

First implementation

In the first implementation the monadic type Parser a is a synonym for the type String -> [(a, String)].


import Data.Char

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

unit :: a -> Parser a
unit t = \s -> [(t, s)]

bind :: Parser a -> (a -> Parser b) -> Parser b
m `bind` k = \s -> [(x, y) | (u, v) <- m s, (x, y) <- k u v]

data Term = Con Int | Div Term Term
            deriving (Show)

parseTerm :: String -> Term
parseTerm = fst . head . term

term :: Parser Term
term = factor `bind` term'

term' :: Term -> Parser Term
term' t = (lit '/' `bind` \_ -> factor `bind` \u -> term' (Div t u)) `bchoice` unit t

factor :: Parser Term
factor = (number `bind` \n -> unit (Con n)) `choice`
            (lit '(' `bind` \_ -> term `bind` \t -> lit ')' `bind` \_ -> unit t)

zero :: Parser a
zero = \s -> []

choice :: Parser a -> Parser a -> Parser a
m `choice` n = \s -> m s ++ n s

-- Biased choice
bchoice :: Parser a -> Parser a -> Parser a
m `bchoice` n = \s -> if null (m s) then n s else m s

filt :: Parser a -> (a -> Bool) -> Parser a
m `filt` p = m `bind` \t -> if p t then unit t else zero

item :: Parser Char
item [] = []
item (a : x) = [(a, x)]

digit :: Parser Char
digit = item `filt` isDigit

lit :: Char -> Parser Char
lit c = item `filt` \c' -> c == c'

reiterate :: Parser a -> Parser [a]
reiterate m = (m `bind` \t -> reiterate m `bind` \ts -> unit (t : ts)) `bchoice` unit []

number :: Parser Int
number = reiterate digit `bind` \ds -> unit (read ds :: Int)

main = print $ parseTerm "1972/2/23"

Second Implementation

The second implementation defines a new type for the parser, instead of just a synonym. The new type can be promoted to an instance of the Monad typeclass, which enables the usage of Haskell do notation. That results in code that is somewhat cleaner and easier to follow.


import Data.Char

newtype Parser a = Parser { parse :: String -> [(a, String)] }

instance Monad Parser where
    return t = Parser $ \s -> [(t, s)]
    m >>= k  = Parser $ \s -> [(x, y) | (u, v) <- parse m s, (x, y) <- parse (k u) v]

data Term = Con Int | Div Term Term
            deriving (Show)

parseTerm :: String -> Term
parseTerm = fst . head . parse term

term :: Parser Term
term = do
    t <- factor
    term' t

term' :: Term -> Parser Term
term' t = divFactor `bchoice` return t
    where divFactor = do
            lit '/'
            u <- factor
            term' $ Div t u

factor :: Parser Term
factor = numTerm `choice` parenTerm
    where numTerm = do
            n <- number
            return $ Con n
          parenTerm = do
            lit '('
            t <- term
            lit ')'
            return t

zero :: Parser a
zero = Parser $ \s -> []

choice :: Parser a -> Parser a -> Parser a
m `choice` n = Parser $ \s -> parse m s ++ parse n s

-- Biased choice
bchoice :: Parser a -> Parser a -> Parser a
m `bchoice` n = Parser $ \s -> if null (parse m s) then parse n s else parse m s

filt :: Parser a -> (a -> Bool) -> Parser a
m `filt` p = do
    t <- m
    if p t then return t else zero

item :: Parser Char
item = Parser item'
    where item' [] = []
          item' (a : x) = [(a, x)]

digit :: Parser Char
digit = item `filt` isDigit

lit :: Char -> Parser Char
lit c = item `filt` \c' -> c == c'

reiterate :: Parser a -> Parser [a]
reiterate m = multiple `bchoice` return []
    where multiple = do
            t <- m
            ts <- reiterate m
            return $ t : ts

number :: Parser Int
number = do
    ds <- reiterate digit
    return (read ds :: Int)

main = print $ parseTerm "1972/2/23"