Postfix calculator in Haskell

Is it possible to implement a postfix calculator in Haskell?

main = do
    print $ begin push 1 push 2 add end
    print $ begin push 1 push 2 push 3 add mul end

At first glance, such Haskell code cannot work. The begin function must take an arbitrary number of arguments, and Haskell is a statically typed language. But in fact, polymorphism is enough to write polyvariadic functions.

Formally, all functions in Haskell are functions with one argument (due to currying). In this article, the arity of a function will be the number of arguments that need to be passed to the function so that the return value is not a function. Or, in other words, the number of arrows outside the parentheses in the function type description. In this sense, the simplest variable function is id.

main =
    print $ id id id 1

If we look at the types that the compiler infers, we will see that we have three different id functions with different numbers of arguments.

main =
    print $ (id `asTypeOf` _t1) (id `asTypeOf` _t2) (id `asTypeOf` _t3) 1

-- _t1 :: ((Integer -> Integer) -> Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
-- _t2 :: (Integer -> Integer) -> Integer -> Integer
-- _t3 :: Integer -> Integer

After this simple example, it becomes clear that to solve the original problem, it is enough for begin to be a function that takes a function and returns a function.

The first, naive implementation of the idea:

begin :: ([a] -> t) -> t
begin f = f []

push :: [a] -> a -> ([a] -> t) -> t
push st x f = f (x:st)

add :: [Int] -> ([Int] -> t) -> t
add (x:y:st) f = f (x+y:st)

mul :: [Int] -> ([Int] -> t) -> t
mul (x:y:st) f = f (x*y:st)

end :: [a] -> a
end (x:_) = x

result =
    begin
        push 1
        push 3
        push 7
        add
        push 8
        mul
        add
    end

main :: IO ()
main =
    print $ result -- 81 = 1 + (3 + 7)*8

This solution is very simple, but it has a significant drawback. With a large number of “operations” inside begin-end, type inference takes a lot of time. In all the functions above (except the final end), the return type t is repeated twice in the declaration. Therefore, as the number of intermediate functions increases, the size of the declarations grows exponentially (starting from the end), and the actual type of the begin function becomes very complex.

In the example above, the begin type looks like this

• Found hole:
    _ :: ([Int]
          -> Int
          -> ([Int]
              -> Int
              -> ([Int]
                  -> Int
                  -> ([Int]
                      -> ([Int]
                          -> Int
                          -> ([Int]
                              -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                          -> ([Int] -> ([Int] -> Int) -> Int)
                          -> ([Int] -> Int)
                          -> Int)
                      -> Int
                      -> ([Int]
                          -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                      -> ([Int] -> ([Int] -> Int) -> Int)
                      -> ([Int] -> Int)
                      -> Int)
                  -> ([Int]
                      -> Int
                      -> ([Int]
                          -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                      -> ([Int] -> ([Int] -> Int) -> Int)
                      -> ([Int] -> Int)
                      -> Int)
                  -> Int
                  -> ([Int]
                      -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                  -> ([Int] -> ([Int] -> Int) -> Int)
                  -> ([Int] -> Int)
                  -> Int)
              -> Int
              -> ([Int]
                  -> ([Int]
                      -> Int
                      -> ([Int]
                          -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                      -> ([Int] -> ([Int] -> Int) -> Int)
                      -> ([Int] -> Int)
                      -> Int)
                  -> Int
                  -> ([Int]
                      -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                  -> ([Int] -> ([Int] -> Int) -> Int)
                  -> ([Int] -> Int)
                  -> Int)
              -> ([Int]
                  -> Int
                  -> ([Int]
                      -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                  -> ([Int] -> ([Int] -> Int) -> Int)
                  -> ([Int] -> Int)
                  -> Int)
              -> Int
              -> ([Int]
                  -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
              -> ([Int] -> ([Int] -> Int) -> Int)
              -> ([Int] -> Int)
              -> Int)
          -> Int
          -> ([Int]
              -> Int
              -> ([Int]
                  -> ([Int]
                      -> Int
                      -> ([Int]
                          -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                      -> ([Int] -> ([Int] -> Int) -> Int)
                      -> ([Int] -> Int)
                      -> Int)
                  -> Int
                  -> ([Int]
                      -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                  -> ([Int] -> ([Int] -> Int) -> Int)
                  -> ([Int] -> Int)
                  -> Int)
              -> ([Int]
                  -> Int
                  -> ([Int]
                      -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                  -> ([Int] -> ([Int] -> Int) -> Int)
                  -> ([Int] -> Int)
                  -> Int)
              -> Int
              -> ([Int]
                  -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
              -> ([Int] -> ([Int] -> Int) -> Int)
              -> ([Int] -> Int)
              -> Int)
          -> Int
          -> ([Int]
              -> ([Int]
                  -> Int
                  -> ([Int]
                      -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                  -> ([Int] -> ([Int] -> Int) -> Int)
                  -> ([Int] -> Int)
                  -> Int)
              -> Int
              -> ([Int]
                  -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
              -> ([Int] -> ([Int] -> Int) -> Int)
              -> ([Int] -> Int)
              -> Int)
          -> ([Int]
              -> Int
              -> ([Int]
                  -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
              -> ([Int] -> ([Int] -> Int) -> Int)
              -> ([Int] -> Int)
              -> Int)
          -> Int
          -> ([Int]
              -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
          -> ([Int] -> ([Int] -> Int) -> Int)
          -> ([Int] -> Int)
          -> Int)
         -> Int
         -> ([Int]
             -> Int
             -> ([Int]
                 -> Int
                 -> ([Int]
                     -> ([Int]
                         -> Int
                         -> ([Int]
                             -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                         -> ([Int] -> ([Int] -> Int) -> Int)
                         -> ([Int] -> Int)
                         -> Int)
                     -> Int
                     -> ([Int]
                         -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                     -> ([Int] -> ([Int] -> Int) -> Int)
                     -> ([Int] -> Int)
                     -> Int)
                 -> ([Int]
                     -> Int
                     -> ([Int]
                         -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                     -> ([Int] -> ([Int] -> Int) -> Int)
                     -> ([Int] -> Int)
                     -> Int)
                 -> Int
                 -> ([Int]
                     -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                 -> ([Int] -> ([Int] -> Int) -> Int)
                 -> ([Int] -> Int)
                 -> Int)
             -> Int
             -> ([Int]
                 -> ([Int]
                     -> Int
                     -> ([Int]
                         -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                     -> ([Int] -> ([Int] -> Int) -> Int)
                     -> ([Int] -> Int)
                     -> Int)
                 -> Int
                 -> ([Int]
                     -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                 -> ([Int] -> ([Int] -> Int) -> Int)
                 -> ([Int] -> Int)
                 -> Int)
             -> ([Int]
                 -> Int
                 -> ([Int]
                     -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                 -> ([Int] -> ([Int] -> Int) -> Int)
                 -> ([Int] -> Int)
                 -> Int)
             -> Int
             -> ([Int]
                 -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
             -> ([Int] -> ([Int] -> Int) -> Int)
             -> ([Int] -> Int)
             -> Int)
         -> Int
         -> ([Int]
             -> Int
             -> ([Int]
                 -> ([Int]
                     -> Int
                     -> ([Int]
                         -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                     -> ([Int] -> ([Int] -> Int) -> Int)
                     -> ([Int] -> Int)
                     -> Int)
                 -> Int
                 -> ([Int]
                     -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                 -> ([Int] -> ([Int] -> Int) -> Int)
                 -> ([Int] -> Int)
                 -> Int)
             -> ([Int]
                 -> Int
                 -> ([Int]
                     -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                 -> ([Int] -> ([Int] -> Int) -> Int)
                 -> ([Int] -> Int)
                 -> Int)
             -> Int
             -> ([Int]
                 -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
             -> ([Int] -> ([Int] -> Int) -> Int)
             -> ([Int] -> Int)
             -> Int)
         -> Int
         -> ([Int]
             -> ([Int]
                 -> Int
                 -> ([Int]
                     -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
                 -> ([Int] -> ([Int] -> Int) -> Int)
                 -> ([Int] -> Int)
                 -> Int)
             -> Int
             -> ([Int]
                 -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
             -> ([Int] -> ([Int] -> Int) -> Int)
             -> ([Int] -> Int)
             -> Int)
         -> ([Int]
             -> Int
             -> ([Int]
                 -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
             -> ([Int] -> ([Int] -> Int) -> Int)
             -> ([Int] -> Int)
             -> Int)
         -> Int
         -> ([Int]
             -> ([Int] -> ([Int] -> Int) -> Int) -> ([Int] -> Int) -> Int)
         -> ([Int] -> ([Int] -> Int) -> Int)
         -> ([Int] -> Int)
         -> Int

To solve this problem, we will declare a special Forth class. At the same time, let's replace the list with a chain of nested pairs so that our stack can store values of different types. The name for the class was not chosen by chance. With its help, you can implement a full-fledged postfix language – with branching, loops, side effects, and so on.

class Forth stack r where
    build :: stack -> r

begin = build ()

data End = End
end = End
instance (stack ~ (a, v)) => Forth stack (End -> a) where
    build (x,_) _ = x

data Add = Add
add = Add
instance Forth (Int,stack) r => Forth (Int,(Int,stack)) (Add -> r) where
    build (x, (y,st)) _ = build (x + y, st)

data Mul = Mul
mul = Mul
instance Forth (Int,stack) r => Forth (Int,(Int,stack)) (Mul -> r) where
    build (x, (y,st)) _ = build (x * y, st)
 
data Push = Push
push = Push
instance (a ~ Int, Forth (Int,stack) r) => Forth stack (Push -> a -> r) where
    build st _ x = build (x,st)


result = 
    begin
        push 1
        push 3
        push 7
        add
        push 8
        mul
        add
    end


main :: IO ()
main =
    print $ result

Now the begin function type is much simpler and the source code compiles very quickly.

• Found hole:
    _t1
      :: Push
         -> Int
         -> Push
         -> Int
         -> Push
         -> Int
         -> Add
         -> Push
         -> Int
         -> Mul
         -> Add
         -> End
         -> Int

A similar approach can be used for other tasks. For example, to simulate the formatting function.

class C a where
    f :: String -> a

instance C String where
    f s = s

instance C x => C (Char -> x) where
    f a x = f (a ++ [x])

instance C x => C (Bool -> x) where
    f a x = f (a ++ show x)

instance C x => C (String -> x) where
    f a x = f (a ++ x) 
    
main :: IO ()
main = 
    putStrLn $ f "Hello, " True " world" '!'

More detailed information on the topic with links to original works can be found here: Polyvariadic functions and keyword arguments: pattern-matching on the type of the context.