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

Можно ли внедрить в 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.

Источник: https://habr.com/ru/articles/807523/

Вернуться к списку

Интересные статьи

Как я убеждал блондинку Машу перейти с программирования RTOS в проектирование железа (а также Coq, Lisp и Haskell)

В викенд я зашел в кафе Red Rock и встретил там программистку встроенных систем Машу Горбунову. Вообще, у этого кафе в Маунин-Вью, Калифорния можно встретить кого угодно - например однажды на меня пря...

Две удивительные математические константы, открытые с бумагой, ручкой и калькулятором в руках

От калькулятора до турбулентности один шаг, и этот шаг — константа Фейгенбаума. К старту флагманского курса о Data Science делимся переводом статьи, её автор рассказывает...

Как делали набор для сборки классического калькулятора, воссозданного с нуля

Реплика калькулятора Sinclair Scientific демонстрирует, как заставить дешёвый чип творить чудеса Был ли калькулятор Sinclair Scientific элегантным? Он определённо стал хитом, и п...

Внедрение в архитектуру советских программируемых калькуляторов «Электроника МК-52»

В этой статье я хочу рассказать об архитектуре советских программируемых микрокалькуляторов на примере калькулятора «Электроника МК-52» и как можно внедриться в его архитектуру. Советские ...

Самодельные магнитные карты для калькулятора Casio PRO fx-1

Автор приобрёл калькулятор Casio PRO fx-1 без предназначенных для него магнитных карт. Как они выглядят, показано здесь. По фотографиям автор определил, что длина у них составляет 93 мм, что ...