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



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

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

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

                 Джон Р. Р. Толкиен, 
                          «Властелин Колец» — к слову о моём знании 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 $ f 1 
    putStrLn $ f 1 "qwe"
    putStrLn $ f 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) — иначе такой экземпляр будет «вне закона».

Существует альтернативное решение, но оно также использует расширение TypeFamilies или GADTs.
{-# 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
-->


К сожалению, не доступен сервер mySQL