467 lines
9.5 KiB
Markdown
467 lines
9.5 KiB
Markdown
### Functor Class of Parsers
|
|
|
|
```haskell
|
|
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
|
|
|
|
```haskell
|
|
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`
|
|
|
|
```haskell
|
|
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
|
|
|
|
```haskell
|
|
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
|
|
```
|
|
|
|
```haskell
|
|
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
|
|
|
|
```haskell
|
|
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.
|
|
|
|
```haskell
|
|
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
|
|
|
|
```haskell
|
|
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)
|
|
|
|
```haskell
|
|
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
|
|
|
|
```haskell
|
|
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`
|
|
|
|
```haskell
|
|
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
|
|
```
|
|
|
|
|
|
|
|
```haskell
|
|
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`
|
|
|
|
```haskell
|
|
funApp = do symbol '('
|
|
f <- simpleFun
|
|
x <-integer
|
|
symbol ')'
|
|
return (f x)
|
|
```
|
|
|
|
### Alternative Class of Parser
|
|
|
|
```haskell
|
|
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 `<||>`
|
|
|
|
```haskell
|
|
(<||>) :: 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
|
|
|
|
```haskell
|
|
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
|
|
|
|
```haskell
|
|
sat :: (Char -> Bool) -> Parser Char
|
|
-- item parses 1 character
|
|
sat cond = satisfy item cond
|
|
```
|
|
|
|
```
|
|
λ> parse (sat isUpper) "a"
|
|
[]
|
|
λ> parse (sat isUpper) "A"
|
|
['A',""]
|
|
```
|
|
|
|
```haskell
|
|
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"]
|
|
```
|
|
|
|
```haskell
|
|
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
|
|
|
|
```haskell
|
|
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")]
|
|
```
|
|
|
|
```haskell
|
|
symbol :: String -> Parser String
|
|
symbol = token (string s)
|
|
```
|
|
|
|
```
|
|
λ> parse (symbol "hello") " hello everybody"
|
|
[("hello","everybody")]
|
|
```
|
|
|
|
#### Defining parsers for arithmetic expressions
|
|
|
|
```haskell
|
|
-- 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)
|
|
```
|
|
|