Folding Parsers — Theo Charalambous

Introduction

Today we continue parsing the grammar that we defined in the previous tutorial, all that remains is the binary and unary expressions, but there is much, much more to them than immediately meets the eye. For example, we have to construct parsers that understand the idea of precedence and associativity. I’ve copied the grammar here for reference.

  SimpleExp := Num | '(' Exp ')'
  Exp       := SimpleExp | UnOpExpr | BinOpExpr | FuncApp
  UnOpExpr  := '-' SimpleExp
             | 'sin' SimpleExp 
             | 'cos' SimpleExp 
             | 'tan' SimpleExp
  BinOpExpr := Exp + Exp  -- lowest precedence
             | Exp - Exp 
             | Exp * Exp 
             | Exp / Exp
             | Exp ^ Exp  -- highest precedence
  FuncDef   := Ident '(' [Var {', ' Var}] ')' '=' Exp
  Var       := Ident
  FuncApp   := Ident '(' [Exp {, Exp}] ')'
  Ident     := String

and the Haskell encoding of this grammar

  data Expr    = Num Float 
               | Var String
               | UnOpExpr UnOp Expr 
               | BinOpExpr BinOp Expr Expr 
               | FuncApp String [Expr]
  data UnOp    = Negate | Sin | Cos | Tan
  data BinOp   = Add    | Sub | Mul | Div | Exp
  data FuncDef = FuncDef String [String] Expr

chainl1

So now we’re going to tackle a big parser. To motivate it, consider the equation 1 + 2 + 3 , we’re going to say that addition is left associative, so we get (1 + 2) + 3 which corresponds to the following AST

To understand what we have to do, let’s think about it from a different way - consider instead if we tried to build this AST from the list [Num 1, Num 2, Num 3] . What we want here is to perform a foldl1 - if you are not comfortable with folding over data structures, then consider a list xs = [1, 2, 3, 4] like

Then foldr f z xs creates the function chain

So essentially what we are doing is applying a function f from the right of the list to the left and building up the final result from the intermediate results. Also, you could just see it as

  f 1 (f 2 (f 3 (f 4 z)))

A foldl is very similar, except instead of going from right to left, it goes from left to right so the transformed tree would be

which of course is just like

  f (f (f (f 1 2) 3) 4) z

foldr1 and foldl1 are very similar, except they use the element at the end of the list instead of another value z , we can define it with the identities

  foldl1 f (x:xs) = foldl f x xs 
  foldr1 f xs     = foldr f (last xs) (init xs)

So now with this in mind, given the list xs = [Num 1, Num 2, Num 3] , we want foldl1 Add xs to get

         Add
        /   \
      Add   Num 3
     /   \ 
  Num 1  Num 2

But how will we do this with our parsers? If we ignore the applicative context for a second, when we parse our string, we will get something like Num 1, Add, Num 2, Add, Num 3 . First I will give a bit of a naive implementation, then a slightly better applicative implementation, and then I will introduce a much faster implementation that I was taught by Jamie Willis.

Generally, monadic computations are more intuitive to define than applicative, so let’s start with that. This idea was inspired by this library.

  chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
  chainl1 p op = do 
      x <- p 
      rest x 
    where 
      rest :: a -> Parser a
      rest x = rest' x <|> pure x

      rest' :: a -> Parser a
      rest' x = do 
        f <- op 
        y <- p 
        rest (f x y)

So essentially, what is happening is that we parse our first expression, then we use a helper function rest to cumulatively build the result in the accumulative parameter. It attempts to parse an operator and an argument, otherwise it just returns the result so far. rest' is responsible for actually trying to parse the next operator and argument and add that to its accumulative parameter.

To really explicitly make the point, let us consider our 1+2+3 example, let pAdd :: Parser Expr consume a + and return an BinOpExpr Add :: Expr -> Expr -> Expr constructor. Let us consider how chainl1 pNum pAdd will execute on "1+2+3"

  x               |  f  |  y  | Input   | Next function call 
                  |     |     | "1+2+3" |  x <- p 
  1               |     |     | "+2+3"  |  rest x, rest' x
  1               |     |     | "+2+3"  |  f <- op 
  1               | Add |     | "2+3"   |  y <- p
  1               | Add |  2  | "+3"    |  rest (f x y)
  Add 1 2         | Add |  2  | "+3"    |  rest' x
  Add 1 2         |     |     | "+3"    |  f <- op 
  Add 1 2         | Add |     | "3"     |  y <- p
  Add 1 2         | Add |  3  | ""      |  rest (f x y)
  Add (Add 1 2) 3 |     |     | ""      |  rest' x
  Add (Add 1 2) 3 |     |     | ""      |  pure x

Note that the final call to rest' x fails because it’s unable to parse pAdd in the remaining (empty) input, so instead rest x returns pure x which will consume no more input and return x - exactly as we expected.

Applicative chainl1

However, we prefer applicative style programming as it is prime for static analysis (I’ll explain this in detail later). So let’s try and create this function in an applicative style. The structure will be the same - i.e. it will be recursive, in the same way, but we must change the types for in to be applicative. So in the main function body, we are going to parse the first term and then feed this to our helper function (whose type is now different)

  chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
  chainl1 p op = p <**> rest
    where 
      rest :: Parser (a -> a)
      rest = ?

      rest' :: Parser (a -> a)
      rest' = ?

Here is another new operator <**> :: Parser (a -> a) -> Parser a -> Parser a , it is essentially just <*> with the arguments reversed, so sequentially, we first parse the argument, then we pass the function and apply the function to the argument. For the definition of rest , we will still choose between either parsing another operator and term, or just returning - but this time we need functions of type Parser (a -> a) , the first one is just rest' because the types already match, but for the other one we cannot do pure x - we need some function that will return the accumulating parameter, but this is exactly what id is, so we have

  rest = rest' <|> pure id

Next we need to work out a definition for rest' , we need to wrap a function that given a term, parses an operator and another term, and composes the operator and the terms in the correct order. First, let’s try and parse an operator Op , then a term t , and then make a function of type \x -> Op x t , i.e. it places the term in the second argument of the constructor - fortunately, this is not too hard

  (flip <$> op) <*> p

So first we parse an operator, then we flip the arguments, then parse a term and apply that to the operator, but because we have flipped the constructor arguments, the term is exactly where we want it to be. Now we need to work out how to recursively continue this. If we call rest , then we will get a Parser (a -> a) that performs \x -> Op x t or, in the base case, id . So if we ignore the applicative context for a second and consider the 1+2+3+4 example, we have a function that takes an x, a function f that parses +2 to create \x -> x+2 and a function rest that parses +3+4 to create \x -> (x+3)+4 , the way we want to compose these is

  rest (f x)

to guarantee that we get ((1+2)+3)+4 , however, we dont have the luxury and writing our function in any way that we want, what we want to do is first parse with f , then rest , and then create the function \x -> rest (f x) - but all in an applicative context. Therefore what we want is

  (\f r x -> r (f x)) <$> ((flip <$> op) <*> p) <*> rest

The lambda function first takes f , then rest and then composes them in the way we want. Seeing as rest' is only used in one place, we can simply inline it in rest , to get the final result

  chainl1 p op = p <**> rest
    where 
      rest = ((\x' r x -> r (x' x)) 
               <$> ((flip <$> op) <*> p) <*> rest) 
             <|> pure id

Finally we can try this!

  > runParser (chainl1 pNum pAdd) "1"
  Just (Num 1.0,"")
  > runParser (chainl1 pNum pAdd) "1+2"
  Just (BinOpExpr Add (Num 1.0) (Num 2.0),"")
  > runParser (chainl1 pNum pAdd) "1+2+3"
  Just (BinOpExpr Add (BinOpExpr Add (Num 1.0) (Num 2.0)) (Num 3.0),"")
  > runParser (chainl1 pNum pAdd) "1+2+3+"
  Just (BinOpExpr Add (BinOpExpr Add (Num 1.0) (Num 2.0)) (Num 3.0),"+")

Improved Applicative chainl1

This definition was given to me by Jamie Willis, and I’ll attempt to explain it here. The main idea is that instead of constructing our tree as we parse, we parse our tokens and then fold over the list of tokens to construct our tree. So firstly, how can we build our list of tokens ? We’re going to use a similar trick to what we did with sepBy1 , where we will parse one term, and then groups of an operator followed by a token, like

  1   +2   +3   +4

This should follow quite easily from what we’ve done before, but there is a caveat, what we actually want is to partially construct our trees. In the previous examples, we constructed the function \x -> Op x t where t is some number we already know. Essentially what we are trying to build in the following

        Add       Add       Add      
  1    /   \     /   \     /   \    
      _     2   _     3   _     4

and then we can construct are tree by adding the left most subtreetree into the empty space in the next subtree. So the first question is how do we construct these partially applied trees. Let us not worry about the first token just yet, so then we essentially end up with a situation that we had before.

  many (flip <$> op <*> p)

Now we have a list of functions, what we want to do is cummulatively apply them to our accumulating tree. To be really explict, this is what our accumulating tree would look like

             Add         Add           Add      
        1   /   \       /   \         /   \    
           1     2     Add   3       Add   4            
                     /   \         /   \            
                    1     2      Add    3
                                /   \ 
                               1     2

We’re clearly folding over the list from left to right, but if we look at the value of foldl we see it has type (b -> a -> b) -> b -> [a] -> [b] . Clearly, our list [a] is the list of partial functions of type Expr -> Expr and b is our first term which has type Expr . Now we need some function that is going of type Expr -> (Expr -> Expr) -> Expr it is a bit sneaky, so I will tell you. Consider ($) :: (a -> b) -> a -> b , normally it is just use as a way of bracketing, but instead we could (for no good reason), write ($) f x to apply x to f , but more interestingly, it we could do (flip ($)) x f , to flip the way we apply a function. We can see that flip ($) :: a -> (a -> b) -> b , which is exactly what we need ! So all we need to do is apply the foldl (flip ($)) function in an applicative context and we get

  chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a 
  chainl1 p op = foldl (flip ($)) 
                   <$> p 
                   <*> many (flip <$> op <*> p)

This definition is better for a few reasons, the most obvious one is that if we use foldl' instead, we get a very efficient function that is not achievable with the other definition.

chainr1

So chainl1 with addition, but what do we do for something like 4^5^6 which should be bracketed as 4^(5^6) . Well this looks more like a fold from right to left.

So first let’s approach this monadically like we did with chainl1 . First note that the right child of 4^5^6 is the tree formed by parsing 5^6 . This is true for any right associative binary operator, so let’s try and use this to our advantage.

What we want to do is parse one number x , one operator f , then build the right subtree of the expression (via recursion) exp and combine them with f x exp .

So our first attempt at creating this might be something like

  chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a
  chainr1 p op = do 
    x <- p 
    f <- op 
    y <- chainr1 p op 
    return $ f x y

however, this does not actually work, for example:

  > runParser (chainr1 pNum pExp) "1^2^3"
  Nothing

The reason this doesn’t work is that eventually we are going to make a recursive call to chainr1 where the remaining string is just a term (in the previous example we would eventually end up with "3" ) and this does not contain an operator as we would expect. Hence, we need to engineer chainr1 a bit more carefully so that it is able to parse a single term.

First we have to extract the logic that begins by parse the operator and the expression that follows the operator, so we do:

  chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a
  chainr1 p op = do 
      x <- p 
      rest x 
    where
      rest x = do
        f <- op 
        y <- chainr1 p op 
        return $ f x y

This function still does not work, but now the problem is more localised, when we try to parse a single term, then x <- p will be okay (it will just parse the term), but rest x will fail as it tries to parse an operator, but there isn’t one. In order to fix this, we just use an alternative to account for when rest x fails - so we get

  chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a
  chainr1 p op = do 
      x <- p 
      rest x <|> return x
    where
      rest x = do
        f <- op
        y <- chainr1 p op 
        return $ f x y

This sorts out the base case when the string to parse is just a single term, now we can test it and see it works!

  > runParser (chainr1 pNum pExp) "1^2^3"
  Just ( BinOpExpr Exp (Num 1.0) 
                       (BinOpExpr Exp (Num 2.0) 
                                      (Num 3.0))
        , "")

So it seems that chainr1 it slightly easier than chainl1 .

Applicative chainr1

Like we did we chainl1 , let’s try and transform chainl1 into an applicative function. It follows the same logic as the monadic version in that we parse a term, and then we try to parse an operator and then the rest of the expression, and if we cannot parse an operator, we simply return the number we parsed.

Let’s break this down into steps - first, we want to parse an operator and then the rest of the expression, we can do this by

  (flip <$> op) <*> chainr1 p op

Note that the recursive call to chainr1 p op represents the second argument of the binary operation, so we want to apply that as the second argument of op and this is why we flip it. Note that this has type Parser (a -> a) , and in order to apply the first argument, we can just do

  p <**> ((flip <$> op) <*> chainr1 p op)

So we parse the first term and apply it after forming the Parser (a -> a) . However, like our original monadic version, this does not work for a single term. Hence, if parsing op fails, we need some fall back that will simply return the value of our first p , we can do this by

  chainr1 = p <**> (((flip <$> op) <*> chainr1 p op) <|> pure id)

Hopefully it is clear how this works. The first part of the alternative forms a function of type Parser (a -> a) that will add the argument as the left hand side of a partially applied binary operation, but if we fail to create a partially applied binary operation, then we simply create a Parser (a -> a) that returns our term.

We can now test this and see we get the exact same results as before

          > runParser (chainr1 pNum pExp) "1^2^3"
          Just ( BinOpExpr Exp (Num 1.0) 
                               (BinOpExpr Exp (Num 2.0) 
                                              (Num 3.0))
                , "")

Finishing notes

Once again we’ve covered quite a lot, in the next tutorial, we will reach our final boss that will put together all of the things that we’ve done so far.

Exercises

Define foldl and foldr
Define foldl in terms of foldr
Write a parser to parse a ”.” followed by some digits. It should work on “.123”, “.01”, but fail of ”.” and “.123a”
Write a function <++> :: Applicate f => f [a] -> f [a] -> f [a] that lifts concatentation to an applicative context.