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