9.5 KiB
9.5 KiB
Functor Class of Parsers
newtype Parser a = P ( String -> [(a, String)] )
parse :: Parser a -> String -> [(a, String)]
parse (P f) src = f src
item :: Parser Char
item = P (\src -> case src of
[] -> []
(c:src') -> [(c,src')] )
symbol :: String -> Parser ()
integer :: Parser Int
binary :: Parser Int
intORbin :: Parser Int
expr :: Parser AST
λ> parse (symbol "something") "nothing"
[]
λ> parse (symbol "<=") "<= something nothing"
[((), "something nothing")]
NOTE: does nothing because all we have implemented for symbol is ()
λ> integer "123 blah blah"
[(123, "blah blah")]
λ> parse binary "101 blah"
[(5, "blah")]
λ> parse intORbin "101 blah"
[(101, "blah"), (5, "blah")]
λ> parse expr "1+2*3"
[(BinOp Addition (LitInteger 1) BinOp Multiplication (LitInteger 2) (LitInteger 3)), "")]
NOTE: expr defined in ArtihExpr
Defining the functor parser
instance Functor Parser where
-- must not give type of fmap as it is already given in functor class
-- good practice to comment type
-- fmap :: (a -> b) -> Parser a -> Parser b
--first assume returns one value
-- doesnt fail, doesn't produce more than one result
fmap g pa = P (\src -> let [(x,src1)] = parse pa src
in [(g x, src1)] )
λ> parse (fmap (+3) integer) "42 blah blah"
[(45, blah blah)]
λ> parse (fmap evaluate expr) "1+2*3"
[(7,"")]
λ> parse (fmap (+3) integer) "42 blah blah"
*** Exception Non-exhaustive patterns
λ> parse (fmap (+3) intORbin) "101 blah"
*** Exception Non-exhaustive patterns
fixing fmap
fmap g pa = P (\src -> [ (g x, src1) | (x,src1) <- parse pa src])
-- using list comprehension
λ> parse (fmap (+3) intORbin) "101 blah"
[(104, "blah"), (8, "blah")]
Applicative Class of Parsers
instance Applicative Parser where
-- pure :: a -> Parser a
-- commenting type for good practice
pure x = P (\src -> [(x, src)])
-- (<*>) :: Parser (a -> b) -> Parser a -> Parser b
simpleFun :: Parser (Int -> Int)
-- parser the function "double" or "square"
λ> parse (fmap (\f -> f 3) simpleFun) "double blah"
[(6, "blah")]
a parser that returns a function as a result
λ> parse simpleFun "double blah blah"
parse simpleFun "double blah blah" :: [(Int -> Int, String)]
-- the function
instance Applicative Parser where
-- pure :: a -> Parser a
-- commenting type for good practice
pure x = P (\src -> [(x, src)])
-- (<*>) :: Parser (a -> b) -> Parser a -> Parser b
pf <*> pa = P (\src -> let [(f,src1)] = parse pf src
[(x,src2)] = parse pa src
in [(f x, src2)] )
-- this works if the two parsers both give one, different result
λ> parse (simpleFun <*> integer) "double 7"
[(14, "")]
λ> parse (simpleFun <*> integer) "square 7"
[(49, "")]
λ> parse (simpleFun <*> integer) "cube 7"
*** Exception non-exhaustive pattern
λ> parse (simpleFun <*> intORbin) "square 101"
*** Exception non-exhaustive pattern
-- fails bc intORbin gives two results
Using list comprehension
pf <*> pa = P (\src -> [ (f x, src2) | (f,src1) <- parse pf src,
(x,src2) <- parse pa src1 ] )
λ> parse (simpleFun <*> integer) "cube 7"
[]
λ> parse (simpleFun <*> intORbin) "square 101"
[(10201, ""), (25, "")]
Monad Class of Parser
Monad class will facilitate the use of do notation.
instance Monad Parser where
-- return :: a -> Parser a
-- we dont have to define return as its automatically defined as
-- return = pure
--only method we need to define for the monad class is bind >>=
-- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
pa >>= fpb = P (\src -> let [(x, src1)] = parse pa src
[(y, src2)] = parse (fpb x) src1
in [(y,src2)] )
checkNum :: Int -> Parser Bool
checkNum n = fmap (==n) integer
λ> parse (checkNum 7) " 7 blah blah"
[(True, "blah blah")]
λ> parse (checkNum 6) " 7 blah blah"
[(False, "blah blah")]
λ> parse (checkNum 7) " no blah blah"
[]
λ> parse (binary >>= checkNum) "101 5"
[(True, "")]
λ> parse (binary >>= checkNum) "101 6"
[(False, "")]
λ> parse (binary >>= checkNum) "no 101 6"
*** Exception non-exhaustive pattern
λ> parse (intORbin >>= checkNum) "101 6"
*** Exception non-exhaustive pattern
--cant cope with multiple values
Using list comprehension
pa >>= fpb = P (\src -> [ (y,src2) | (x,src1) <- parse pa src,
(y,src2) <- parse (fpb x) src1 ] )
λ> parse (binary >>= checkNum) "no 101 6"
[]
λ> parse (intORbin >>= checkNum) "110 6"
[(False,""), (True, "")]
-- false is 110 (base 10) != 6
-- true is 110 (base 2) == 6
Improving the definition further
As we unpack and repack (y,src2), we can just call it r (result)
pa >>= fpb = P (\src -> [ r | (x,src1) <- parse pa src,
r <- parse (fpb x) src1 ] )
λ> parse (intORbin >>= checkNum) "113 113"
[(True,""), (True, "113 ")]
-- the integer part recognises 113 == 113
-- second part will look at 113, realise it is not a binary digit and just read 11 which is equal to 3 hence true
What is the do notation and how is it connected to the bind function, we will show this by writing a simple parser
pairSum :: Parser Int
-- read (parse) an integer, bind it to a function, map it to another parser
pairSum = integer >>= \n -> integer >>= \m -> return (n+m)
λ> parse pairSum "3 8"
[(11, "")]
Rewriting pairSum with do
pairSum :: Parser Int
-- apply integer and then put it into variable n
-- apply integer and bind to variable m
pairSum = do n <- integer
m <- integer
return (n+m)
--much cleaner & easier to understand
parse (symbol "number" >>= \u -> integer) "number 9"
[(9, "")]
parse (symbol "number" >> integer) "number 9"
[(9, "")]
NOTE: >> is a non-dependant bind
the grammer
--funApp ::= ( simpleFun integer )
-- will be a parser that returns an integer
funApp :: Parser Int
funApp = symbol '(' >> (simpleFun <*> integer) >>= \y -> symbol ')' >> return y
λ> parse funApp "(double 5)"
[(10, "")]
Rewrite with do
funApp = do symbol '('
f <- simpleFun
x <-integer
symbol ')'
return (f x)
Alternative Class of Parser
instance Alternative Parser where
-- empty :: Parser a
empty = P (\src -> [])
-- (<|>) :: Parser a -> Parser a -> Parser a
p1 <|> p2 = P (\src -> case parse p1 src of
[] -> parse p2 src
rs -> rs)
-- if p1 fails, then parse with p2, else return result rs
λ> parse (symbol "abc" <|> symbol "acb") "abc"
[("abc", "")]
λ> parse (symbol "abc" <|> symbol "acb") "xyz"
[]
λ> parse (integer <|> binary) "1101"
[(1101,"")]
λ> parse (binary <|> integer) "1101"
[(13,"")]
-- will only apply p2 if p1 fails
λ> parse (binary <|> integer) "1201"
[(1,"201")]
-- binary successfully parses "1" and leaves "201"
Using parallel choice notation <||>
(<||>) :: Parser a -> Parser a -> Parser a
p1 <||> p2 = P (\src -> parse p1 src ++ parse p2 src)
λ> parse (binary <||> integer) "1101"
[(13, ""), (1101, "")]
Explaining the FunParser.hs library
satisfy :: Parser a -> (a -> Bool) -> Parser a
satisfy p cond = do x <- p
if (cond x) then return x
else empty
-- the way to denote failure is empty (from alternitve class)
λ> parse (satisfy integer (>10)) "42"
[(42, "")]
λ> parse (satisfy integer (>10)) "9"
[]
Writing a satisfy function just for characters
sat :: (Char -> Bool) -> Parser Char
-- item parses 1 character
sat cond = satisfy item cond
λ> parse (sat isUpper) "a"
[]
λ> parse (sat isUpper) "A"
['A',""]
lower :: Parser Char
lower = sat isLower
upper :: Parser Char
upper = sat isUpper
digit :: Parser Char
digit = sat isDigit
--and so on for others like letter & alphaNumeric
char :: Char -> Parser Char
char c = sat (==c)
λ> parse (char 'A') "not a captial a"
[]
λ> parse (char 'A') "A not a captial a"
['A'," not a capital a"]
string :: String -> Parser String
string [] = return [] --list as string is list of chars
string (c:cs) = do char c
string cs
return (c:cs)
λ> parse (string "hello") "hello everybody"
[("hello", "everybody")]
λ> parse (string "hello") " hello everybody"
[]
λ> parse (sat isSpace) " hello"
[(' ',"hello")]
λ> parse (many (sat isSpace)) " hello"
[(' ',"hello")]
We have to fix leading white space causing failure
space :: Parser ()
-- a parser that succeeds or fails and does not return anything
space = do many (sat isSpace)
return ()
-- writing a parser to ignore white space
token :: Parser a -> Parser a
token p = do space
x <- p
space
return x
λ> parse (token (string "hello")) " hello everybody"
[("hello","everybody")]
symbol :: String -> Parser String
symbol = token (string s)
λ> parse (symbol "hello") " hello everybody"
[("hello","everybody")]
Defining parsers for arithmetic expressions
-- expr ::= mexpr + exp | mexpr - exp | mexpr
expr :: Parser AST
expr = do t1 <- mexpr
symbol '+'
t2 <- expr
return (BinOp Addition t1 t2)
<|>
do t1 <- mexpr
symbol '-'
t2 <- expr
return (BinOp Subtraction t1 t2)
<|>
mexpr
--we can optimise this grammer as all symbols start with mexpr
-- expr ::= mexpr ( + expr | - expr | empty)
expr :: Parser AST
expr = do t1 <- mexpr
(do symbol '+'
t2 <- expr
return (BinOp Addition t1 t2)
<|>
do symbol '-'
t2 <- expr
return (BinOp Subtraction t1 t2)
<|>
return t1)