Можно ли внедрить в Haskell постфиксный калькулятор?

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

На первый взгляд такой код на Haskell не может работать. Функция begin должна иметь произвольное количество аргументов, а Haskell является языком со статической типизацией. Но на самом деле, для написания вариативных (polyvariadic) функций достаточно полиморфизма.

Формально все функции в Haskell являются функциями с одним аргументом (в силу каррирования). В данной статье арностью функции будем называть количество аргументов, которые нужно передать функции, чтобы возвращаемое значение было не функцией. Или, другими словами, количество стрелок вне скобок в описании типа функции. В этом смысле простейшей вариативной функцией является id.

main =
    print $ id id id 1

Если мы посмотрим типы, которые выводит компилятор, то увидим, что у нас три разных функции id с разным количеством аргументов.

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

После этого простого примера становится понятно, что для решения исходной задачи достаточно, чтобы begin была функцией, которая принимает функцию и возвращает функцию.

Первая, наивная реализация идеи:

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

Данное решение очень простое, но у него есть существенный ��едостаток. При большом количестве "операций" внутри begin-end выведение типа занимает много времени. Во всех функциях выше (кроме заключительного end) возвращаемый тип t в описании повторяется дважды. Поэтому при увеличении количества промежуточных функций размер описаний растёт по экспоненте (начиная с конца), и фактический тип функции begin получается очень сложный.

В приведённом выше примере тип begin выглядит так

• 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

Для решения этой проблемы мы объявим специальный класс Forth. Заодно заменим список на цепочку вложенных пар, чтобы наш стек мог хранить значения разных типов. Название для класса выбрано не случайно. С его помощью можно реализовать полноценный постфиксный язык - с ветвлением, циклами, побочными эффектами и так далее.

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

Теперь тип функции begin гораздо проще, и исходный код компилируется очень быстро.

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

Аналогичный подход может использоваться и для других задач. Например, для имитации функции форматирования.

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" '!'

Более подробную информацию по теме со ссылками на оригинальные работы можно найти здесь: Polyvariadic functions and keyword arguments: pattern-matching on the type of the context.

Постфиксный калькулятор на Haskell