Kata: Mathematical AST - Parsing

Last week, we have tackled the Mathematical AST, displaying expressions in various notations.

As a reminder, here are the following differences between infix, postfix, and prefix notations:

InfixPostfixPrefix
3 + 43 4 ++ 3 4
1 - 2 * 31 2 3 * -- 1 * 2 3
(1 - 2) * 31 2 - 3 ** - 1 2 3

To do so, we can leverage ReadP, a parser combinator directly embedded in base.

The easiest parser to implement is the prefix notation, as follows:

parsePrefix :: String -> Expr
parsePrefix = fst . last . P.readP_to_S expP
  where
    expP :: P.ReadP Expr
    expP =
      P.choice
        [ op '+' Add,
          op '-' Minus,
          op '*' Mul,
          Val . read <$> P.munch1 Char.isDigit
        ]
    op i f = do
      void $ P.char i
      void $ P.char ' '
      x <- expP
      void $ P.char ' '
      y <- expP
      pure $ f x y

The idea is to either parse a number or an operator followed by two expressions, recursively.

One might try to swap statements the operator and left operand, sadly, it would loop forever.

The only way to handle it is to use a layered approached to build parsers, breaking recursion, as follows:

parseInfix :: String -> Expr
parseInfix = fst . last . P.readP_to_S expP
  where
    expP = termP `P.chainl1` addMinusOp
    termP = factorP `P.chainl1` mulOp
    factorP =
      P.skipSpaces
        *> P.choice
          [ Val . read <$> P.munch1 Char.isDigit,
            P.between (P.char '(') (P.char ')') expP
          ]
        <* P.skipSpaces
    addMinusOp =
      P.skipSpaces
        *> P.choice
          [ Add <$ P.char '+',
            Minus <$ P.char '-'
          ]
        <* P.skipSpaces
    mulOp = P.skipSpaces *> (Mul <$ P.char '*') <* P.skipSpaces

Note: during the writing of this log, I have discovering the shunting yard algorithm, an algorithm introduced by Edsger W. Dijkstra, which, as usual, is stack based.

The main idea is to have two stacks, one for operators, and the other for numbers, used initially to go from prefix notation to postfix notation.

Thanks to Haskell sum type, we can squash the two stacks into one bound to the following type:

data EvalExpr
  = Final Expr
  | Partial (Expr -> Expr)
  | Op (Expr -> Expr -> Expr)

unwrapFinal :: EvalExpr -> Expr
unwrapFinal (Final e) = e

The main idea behind this type is to currify operators, applying numbers along the way.

Which gives the following definition:

parsePrefixShuntingYard :: String -> Expr
parsePrefixShuntingYard = unwrapFinal . head . foldl' apply [] . words
  where
    apply :: [EvalExpr] -> String -> [EvalExpr]
    apply es =
      \case
        "+" -> Op Add : es
        "-" -> Op Minus : es
        "*" -> Op Mul : es
        n ->
          let squash =
                \case
                  (Final x : Partial f : es') -> squash (Final (f x) : es')
                  (Final x : Op f : es') -> (Partial (f x) : es')
                  done -> done
           in squash (Final (Val $ read n) : es)

The most complex parse is to "apply" a number to the stack, as we have to recursively squash the stack when the operator has all its operands.

Also, as introduced in the previous logs, we can rely on the Church-encoded, list-like, Memory, to give a simpler representation, as follows:

parsePrefixShuntingYardChurch :: String -> Expr
parsePrefixShuntingYardChurch = top . foldr go emptyMemory . words
  where
    go :: String -> Memory Expr -> Memory Expr
    go =
      \case
        "+" -> op Add
        "-" -> op Minus
        "*" -> op Mul
        n -> number $ Val $ read n

    op :: (a -> a -> a) -> Memory a -> Memory a
    op f = runMemory $ \leftOp -> runMemory (number . f leftOp)

To make it work, we have to go through the expression from then end, with foldlr, and reverse the application order in op.