Haskell: об одном методе реализации функций с переменным числом параметров

– А видела ты Черепаху «Как бы»?
– Нет, – сказала Алиса. – Я даже не знаю, кто это такой.
– Как же, – сказала Королева. – Это то, из чего делают «Как бы черепаший суп».

                  Льюис Кэрролл,                             «Алиса в Стране чудес»

— Судя по твоим речам, ты хорошо знаешь Фангорн? — спросил в ответ Арагорн.
— Какое там! — отозвался старик. — На это ста жизней не хватит. Но я сюда иной раз захаживаю.

                 Джон Р. Р. Толкиен,                            «Властелин Колец» — к слову о моём знании Haskell ;)

Homines dum docent, discunt. (Объясни другим — сам поймёшь.)

                 народная латинская поговорка

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

Казалось бы о каком переменном числе параметров может идти речь при таком раскладе? Однако поразмыслив, посмотрев исходники printf или просто почитав wiki.haskell становится очевидным, что как раз ФП даёт ключ к достаточно красивому, хотя и несколько «казуистическому» решению этой задачи.

В настоящей публикации я рассмотрю один из способов реализации такого механизма на простых примерах, а также предложу некоторое обобщённое решение на базе Template Haskell, для превращения семейства обычных функций с последним параметром типа список в функцию с «как бы с переменным числом параметром» (далее по тексту просто «с переменным числом параметром»).

Коротко опишу суть решения начиная с предельно простого примера.

{-# LANGUAGE  FlexibleInstances, RankNTypes #-} -- (0)  class VarArgs a where prc :: String -> a -- (1)  instance VarArgs String where prc = id -- (2)  instance  (Show a, VarArgs r) => VarArgs (a -> r) where -- (3)     prc acc = \x -> prc $ acc ++ " " ++ show x   magic = prc []  useMagic :: (forall a. VarArgs a => a) -> IO () -- (4) useMagic f = do     putStrLn $ magic 1      putStrLn $ magic 1 "qwe"     putStrLn $ magic 1 "qwe" [1, 2, 3]  main :: IO () main = do      putStrLn $ magic 1 2 "qwe" [1,2,3] 123.456     useMagic magic  -- (5) 

Что же здесь происходит и каким образом удаётся передать функции magic не только произвольное количество параметров, но к тому же параметры разных типов?

Итак в (1) мы объявляем класс VarArgs с единственным методом prc просто умеющим создать из строки значение заданного типа. Далее, в (2) мы реализуем экземпляр этого класса для типа String (также известного, как [Char]). Обратите внимание, что пришлось воспользоваться расширением FlexibleInstances (0) — иначе такой экземпляр будет «вне закона».

{-# LANGUAGE TypeFamilies #-}   instance a ~ Char => VarArgs [a] where prc = id 

Экземпляр VarArgs String — это собственно и есть «тело» функции с переменным числом параметров. В примере мы просто возвращаем накопленные параметры. Теперь перейдём к самому интересному, в (3) мы объявляем экземпляр VarArgs для функционального типа (a -> r), при этом требуя, что бы тип аргумента a умел отображаться в строку, а тип результата r вновь принадлежал бы классу VarArgs.

Вот тут то «собака и порылась» — инстанцируя класс функциональным типом с типом возврата также допускающим (в частности) функцию мы позволяем методу prc в зависимости от контекста вызова возвращать как финальное значение типа String, если в контексте требуется строка, так и функцию, если тип результата вызова prc выводится из контекста как функциональный.

Теперь рассмотрим определение prc для экземпляра VarArgs (a -> r). Если вывести тип prc, то мы получим

prc :: (Show a, VarArgs r) => String -> (a -> r) 

Т.е. мы должны вернуть функцию, что-то делающую с представимым в качестве строки значением. Аргумент acc это суть «накопитель» результата последовательной обработки параметров. В данном случае мы просто прибавляем к нему строковое представление параметра через пробел.

Важный момент в том, что мы не просто возвращаем приращённый «аккумулятор», но вызываем (в «теле» результирующей функции) рекурсивно prc чтобы получить требуемый тип результата r. Какая именно реализация prc будет вызвана (т.е. какой тип будет выведен) зависит от контекста (не забываем, что функции Haskell — это уравнения, а процесс вычисления — это последовательные подстановки выражений с актуализацией параметров).

Самое интересное, что несмотря на «полулегальный» статус мы вполне может передавать (4) и использовать (5) функцию с переменным числом параметров в качестве аргумента другой функции. Правда для этого нам пришлось использовать ещё одно расширение RankNTypes (0) и квантификатор forall в определении вызывающе функции (4).

Звучит немного запутанно, поэтому рассмотрим по шагам как вычисляется выражение справа от $ в (4):

1. magic (она же prc []) вызывается с параметром 1 т.е. используется в функциональном контексте, поэтому работает экземпляр
   VarArgs (a -> r), в итоге возвращается…
2. … снова функция т.к. у нас опять есть аргумент 2 т.е. опять присутствует функциональный контекст
3. аналогичным образом обрабатываются «qwe» и [1,2,3]
4. наконец результат последнего вызова функции prc с накопленными строковыми представлениями предыдущих параметров и текущим параметром 123.456 уже будет требовать строкового контекста, как параметр функции putStrLn — запускается prc из экземпляра VarArgs String

Теперь рассмотрим другой, чуть более сложный пример: вычислитель выражений в обратной польской нотации. Что-то наподобие:

> calcRPN 5 8 (*) 2 (+) -- 5*8 + 2 42 

Максимально примитивная реализация может выглядеть как-то так:

{-# LANGUAGE ExtendedDefaultRules, FlexibleInstances, GADTs #-}  data Expr = Num Double | Op (Double -> Double -> Double)  calcRPN' :: [Expr] -> Double calcRPN' = head . foldr rpnStep [] . reverse  rpnStep :: Expr -> [Double] -> [Double] rpnStep (Num n) stack = n : stack rpnStep (Op f) (x:y:stack) = (f x y) : stack  class ArgPrc a where   prc :: [Expr] -> a  class ArgSrc a where    toArg :: a -> Expr  instance ArgPrc Double where   prc = calcRPN' . reverse   instance (ArgSrc a, ArgPrc r) => ArgPrc (a -> r) where   prc acc  = prc . (: acc) . toArg -- (2)  instance ArgSrc Expr where   toArg = id  instance a ~ Double => ArgSrc (a -> a -> a) where   toArg = Op  instance ArgSrc Integer where   toArg = Num . fromIntegral  instance ArgSrc String where   toArg = Num . fst . head . (reads :: ReadS Double)  instance ArgSrc [Double] where   toArg = Num . sum  calcRPN :: ArgPrc a => a calcRPN = prc []  main = do     print $ calcRPN' [Num 5, Num 5, Op (*)]     print $ calcRPN [1::Double,2,3] "5" (*) 7 (*)                           

Схема реализации переменного числа параметров та же, что и в предыдущем примере, только теперь мы будем:

• накапливать аргументы (типа Expr) в списке для последующей обработки вместо того, что бы сразу строить результат (2);
• использовать «обёрточный» класс ArgSrc для декларации типов, которые могут выступать в качестве «выражений» (Expr)
• использовать некоторый «трюк» (расширение GADTs) для реализации экземпляра
  instance a ~ Double => ArgSrc (a -> a -> a)

Наконец давайте рассмотрим схематический вариант реализации функции printf:

{-# LANGUAGE GADTs, FlexibleInstances, ExtendedDefaultRules #-}   type FmtRes = (String, String)  class PfVal a where     doFmt :: (String, String) -> a -> FmtRes  instance PfVal Integer where     doFmt (fmt, res) x =          let (b, s) = span (/= '%') fmt         in  (res ++ (tail . tail $ s), b ++ show x)  instance PfVal String where     doFmt (fmt, res) x =          let (b, s) = span (/= '%') fmt         in  (res ++ (tail . tail $ s), b ++ x)  class ArgProc a where     prc :: FmtRes -> a  instance ArgProc String where      prc = uncurry (++)  instance ArgProc (IO ()) where      prc = putStrLn . uncurry (++)  instance (PfVal a, ArgProc r) => ArgProc (a -> r) where     prc st =  prc . doFmt st  printf fmt = prc (fmt, "")  main ::  IO() main = do                    putStrLn $ printf "%d %s" 1 "qwe"     printf "%s %d" "This is" 123 

Полагаю, код в особых комментариях не нуждается, отмечу только, что теперь мы снова генерируем результат «на лету», вместо накапливания параметров и реализуем два терминальных экземпляра класса ArgProc: для типа String и для типа IO ().

Если обобщить проиллюстрированную схему, то можно выделить следующие элементы:

1. Некоторый тип — аккумулятор (назовём A) предварительного результата вычислений на основе параметров типа a. Степень «предварительности» может варьироваться от простого накопления параметров в каком-то контейнере типа списка (как в примере с обратной польской нотацией) до почти готового результата для текущего набора параметров (как в примере с printf). Всё, что нам требуется от этого типа, это наличие операции типа

    A -> a -> A 

2. Основной класс (назовём ArgProc), посредством экземпляров которого реализуется вся «механика» переменного числа параметров. Этот класс имеет единственный метод (назовём prc), который что-то делает с аккумулятором A:
   

   class ArgProc a where     prc :: A -> a 

3. Класс типов, которые могут выступать в качестве параметров (назовём ArgSrc), поддерживающий функцию конвертации значений в тип параметров (некоторый тип a допускающий операцию :: A -> a -> A )
4. Экземпляр основного класса, отвечающий за обработку параметров и накопление предварительного результата:
   

   instance (ArgSrc a, ArgProc r) ArgProc (a -> r) where     prc :: A -> (a -> r) 

   В примере с printf накапливается сразу результат (второй элемент пары) и попутно обрабатывается состояние (строка формата). В примере с обратной польской нотацией параметры просто складываются в список для последующей обработки.

5. Терминальные экземпляр(ы) основного класса, отвечающий за окончательную обработку предварительного результата:
   

   instance ArgProc R1 where  prc :: A -> R1 instance ArgProc R2 where  prc :: A -> R2 ... 

   В примере с обратной польской нотацией присутствует всего один такой экземпляр для результирующего типа Double — он просто запускает вычисление для списка предварительно накопленных параметров. В примере с printf экземпляр для String просто конкатенирует отформатированную строку с остатками формата (подразумевается, что там остался плоский текст). Экземпляр для IO () дополнительно выводит результат.

6. Инициализатор начального состояния предварительного результата вычислений A. в общем случае — это функция от набора фиксированных параметров, в примерах это константное значение [] и функция
   

    \x -> (x, "") :: String -> (String -> String) 

Нетрудно видеть, что такую схему можно воплотить в жизнь средствами «чёрной магии» Template Haskell. Это неплохое упражнение для закрепления материала, а также хорошая площадка для плясок с бубном экспериментов с Template Haskell.

В текущей реализации я ограничился подмножеством общей схемы: накопитель — это просто список значений некоторого типа, инициализатор соответственно просто []. У таких ограничений есть конечно определённые минусы, но идея состоит в том, что бы превратить семейство обычных функций с идентичным типом параметров, последний из которых список, и различными типами возврата, в функцию, принимающую переменное число параметров (помимо фиксированных, идущих до списка).

Попутно автоматизируем процесс «неявного приведения» (в терминологии других ЯП) заданных типов к типу элементов списка параметров. Ещё одно ограничение — «донорские» функции должны иметь «простые» типы (не полиморфные типы без квантификаторов и ограничений).

Снова сразу начну с примеров использования, так будет понятна идея, а уже потом кратко пройдусь по реализации. Итак начнём с чего-нибудь простенького:

{-# LANGUAGE TemplateHaskell, FlexibleInstances, ExtendedDefaultRules #-}   import Data.Function.Vargs -- (1)  -- (2) tester' q (x : y : z) =       putStrLn $ "Fixed parameter " ++ q ++ ", next x = " ++ x ++ " and y = " ++ y                      ++ " and rest = " ++ show z  $( return [] ) -- (3)  -- (4) defVargsFun "tester" ['tester']         (''Integer, [| ("Int " ++) . show |]) -- (5)         (''(), [| const "NULL" |]) -- (6)         ([t| [Int] |], [| ("[Int] " ++) . show |]) -- (7)          ([t| [Double] |], [| ("[Double] " ++) . show |]) -- (8)   main :: IO () main = do     tester "<const>" "qwe" 100500 () [1::Int,2,3] [4::Double,5,6] -- (9) 

В данном примере мы создаём функцию-обёртку tester для функции tester’, имеющей тип

tester' :: String -> [String] -> IO () 

Пройдёмся по тексту:

• (1) — подключаем модуль, реализующий переменное число параметров
• (2) — определяем «подопытную» функцию для превращения
• (3) — трюк, для гарантированной работы reify (подробно, например, здесь)
• (4) — определяем функцию с переменным числом параметров
  Параметры начиная с 3-го — значения одного из типов
  
  • (Name, ExpQ)
  • (TypeQ, ExpQ)

  они описываю как можно конвертировать значения заданного типа (Integer, () и т.д.), в значения типа элементов списка параметров (String). Тип задаётся либо именем ((5), (6)) либо выражением ((7), (8)). Обратите внимание, что сами элементы передаются тоже как переменные параметры!

• (9) — собственно вызов функции с переменным числом параметров разного типа (приводимого к строке) в произвольном порядке

Идём дальше, точнее возвращаемся к примеру с обратной польской нотацией:

{-# LANGUAGE TemplateHaskell, FlexibleInstances, ExtendedDefaultRules, GADTs #-} --   import Data.Function.Vargs  data Expr = Num Double | Op (Double -> Double -> Double)  calcRPN' :: [Expr] -> Double calcRPN' = head . foldr rpnStep [] . reverse  rpnStep :: Expr -> [Double] -> [Double] rpnStep (Num n) stack = n : stack rpnStep (Op f) (x:y:stack) = (f x y) : stack  $( return [] )  defVargsFun "calcRPN" ['calcRPN']     (''Integer, [| Num . fromIntegral |])     (''String,  [| Num . fst . head . (reads :: ReadS Double) |])     (Genz [t| Double -> Double -> Double |], [| Op |]) -- (1)     ([t| [Double] |], [| Num . sum |])  main = do     print $ calcRPN' [Num 5, Num 5, Op (*)]     print $ calcRPN [1::Double,2,3] "5" (+) 7 (*)  

В этом примере всё аналогично предыдущему, за исключением одного интересного момента (1): тут мы используем не просто TypeQ, а некоторую обёртку Genz над ним. Эта обёртка заставляет генератор строить экземпляр вида:

instance a ~ Double => ArgSrc (a -> a -> a) where 

вместо стандартного

instance ArgSrc (Double -> Double -> Double) where 

который в данном случае не пройдёт проверку типов.

Ну и последний пример, та самая функция printf, точнее ей схематичный аналог:

{-# LANGUAGE TemplateHaskell, FlexibleInstances, ExtendedDefaultRules, ExistentialQuantification #-}   import Data.Function.Vargs  type FmtRes = (String, String)  class PfVal a where     doFmt :: FmtRes -> a -> FmtRes  instance PfVal Integer where     doFmt (fmt, res) x =          let (b, s) = span (/= '%') fmt         in  (res ++ (tail . tail $ s), b ++ show x)  instance PfVal Double where     doFmt (fmt, res) x =          let (b, s) = span (/= '%') fmt         in  (res ++ (tail . tail $ s), b ++ show x)  instance PfVal String where     doFmt (fmt, res) x =          let (b, s) = span (/= '%') fmt         in  (res ++ (tail . tail $ s), b ++ x)  data PfValWrap = forall a. PfVal a => Val a -- (1)  printf_String :: String -> [PfValWrap] -> String -- (2) printf_String fmt vs =      uncurry (flip (++)) $ foldl step (fmt, "") vs          where step fmt (Val f) = doFmt fmt f  printf_IO :: String -> [PfValWrap] -> IO () -- (3) printf_IO fmt = putStrLn . printf_String fmt  $( return [] )  defVargsFun "printf"          ['printf_String, 'printf_IO] -- (4)         [''Integer, ''Double, ''String]  main :: IO () main = do     let fmt = "Number one is %d, number two is %f and string is \"%s\""     printf_IO fmt [Val 100, Val 123.456, Val "ok"]     putStrLn $ printf fmt 100 123.456 "ok"     printf fmt 100 123.456 "ok" 

Тут стоит отметить три новых момента:

• использование типа-обёртки (1) для обработки значений произвольных типов, поддерживающих контракт класса PfVal (умеющих выводить себя в строку по заданному формату)
• наличие двух обработчиков параметров (2)-(3) для различных типов результата (String и IO ())
• автоматическая генерация кода для конвертации значений указанных типов в тип-обёртку PfValWrap (фактически просто вытягивается через рефлексию reify единственный конструктор типа — Val)

Теперь пару слов о том, как всё это устроено. Собственно всё что делает defVargsFun, это создаёт несколько классов и экземпляров, на основании информации полученной от reify, а также декларацию и определение самой функции с переменным числом параметров. Вся эта «кухня» соответствует общей схеме, ранее рассмотренной на примерах. Опять же нагляднее и проще будет продемонстрировать на примере, что именно генерируется. Рассмотрим код, генерируемый вызовом:

defVargsFun "printf"          ['printf_String, 'printf_IO]          [''Integer, ''Double, ''String] 

Этот код можно посмотреть если запустить ghc с ключом -ddump-splices. Для наглядности, я поправил форматирование и убрал лишние скобки:

class ArgPrc_printf_aa3M a where -- (1)   prc_printf_aa3O :: String -> [PfValWrap] -> a -- (2)  class ArgSrc_printf_aa3N a where -- (3)   toArg_printf_aa3Q :: a -> PfValWrap -- (4)  instance ArgPrc_printf_aa3M String where -- (5)   prc_printf_aa3O a1 = printf_String a1 . reverse  instance ArgPrc_printf_aa3M (IO ()) where -- (6)   prc_printf_aa3O a1 = printf_IO a1 . reverse  -- (7) instance (ArgSrc_printf_aa3N a, ArgPrc_printf_aa3M r) => ArgPrc_printf_aa3M (a -> r) where   prc_printf_aa3O a1 acc_printf_aa3P     = prc_printf_aa3O a1 . (: acc_printf_aa3P) . toArg_printf_aa3Q  -- (8) instance ArgSrc_printf_aa3N PfValWrap where   toArg_printf_aa3Q = id  instance ArgSrc_printf_aa3N Integer where   toArg_printf_aa3Q = Val  instance ArgSrc_printf_aa3N Double where   toArg_printf_aa3Q = Val  instance ArgSrc_printf_aa3N String where   toArg_printf_aa3Q = Val  -- (9) printf :: forall a. ArgPrc_printf_aa3M a => String -> a printf a1 = prc_printf_aa3O a1 [] 

Монада Q обеспечивает нам генерацию уникальных имён — отсюда «заковыристые» окончания в названиях. Пройдёмся по тексту:

• объявляется основной класс-обработчик переменного числа параметров (1) и его ключевой метод (2)
• объявляется класс (3) для «неявного приведения» значений заданных типов к типу элементов списка параметров (PfValWrap) с единственным методом (4)
• определяются «терминальные» экземпляры нашего основного класса (1) для типов String (5) и IO () (6), реализация методов — суть вызов указанной функции с передачей всех фиксированных параметров и списка накопленных «переменных» параметров. Т.к. накопление параметров у нас производится «с головы» списка, то перед вызовом «родной» функции вызывается reverse
• определяется экземпляр (7) основного класса (1) для функционального типа (a -> r) — тут и производится преобразование значения типов, принадлежащих специально созданному классу (3), посредством вызова метода (4), к типу элементов списка параметров (PfValWrap), и, далее, помещение этого значения в список
• далее(8), определяются экземпляры класса (3) для всех указанных типов + экземпляр для самого типа PfValWrap (такая «тавтология» необходимо т.к. для преобразования унифицированно вызывается метод (4))
• и наконец декларируется и определяется сама функция-обёртка с переменным числом параметров

Исходный код модуля Data.Function.Vargs с комментариями, а также вышеприведённые примеры его использования лежат тут, документация в формате haddoc доступна здесь и в составе пакета. В настоящий момент пакет находится в стадии experimental от слова «совсем» 😉

Возможно со временем доведу до ума — как минимум надо сделать анализ и обработку ошибочных ситуаций (недопустимые или несовместимые типы), как максимум:

• реализовать обобщённую схему и поддержку полиморфных типов в «родительских» функциях;
• разрешить осмысленное именование создаваемых классов и методов, в частности, для возможности передачи обёрточной функции в качестве параметра другим функциям;
• возможно рассмотреть альтернативные схемы реализации.

Тогда, думаю, не стыдно будет выложить на hackage (хотя там уже есть достойные пакеты типа HList на похожие темы).

Полезные ссылки по теме:

1. Varargs
2. Polyvariadic functions
3. Template Hakell
4. Existential type
5. HList

ссылка на оригинал статьи https://habrahabr.ru/post/324190/