λaughedelic's blog

(репост из tumblr)

Всё, пишу последний пост про свои велосипеды. Дальше буду переводить туториалы и делать уже что-нибудь более содержательное. И то, в свободное от учёбы время - надо сконцентрироваться на дипломе..

Итак, напомню, в чём заключается задача. Я писал об этом в первом посте о Template Haskell - задача в том, что хочется делать сплайсинг имён в объявлениях. И я предложил вариант ухода от этой проблемы. Но в заключении того поста я сформулировал недостаток того подхода - с помощью оператора (^=) можно объявлять только значения, то есть если нужна функция с несколькими клозами:

1
2
3
4

foo :: Num a => a → String
foo x 1 = show (x + 23)
foo x 2 = show (x - 98)
foo x _ = show x ++ "blah-blah"

то чтобы сделать шаблон, нужно будет запихнуть все клозы в цитату тела:

1
2
3
4
5
6
7
8
9

fooTemplate :: String → Int → Int → String → Q [Dec]
fooTemplate name y z blah = sequence
    [ name ^:: [t| Num a => a → String |]
    , name ^= [| λ a b → case (a,b) of
                  (x,1) → show (x + y)
                  (x,2) → show (x - z)
                  (x,_) → show x ++ blah
              |]
    ]

Это конечно выглядит так себе. Мне не нравится это ограничение такого подхода. Ещё раз повторюсь, я хочу чтобы шаблон выглядел максимально похожим на то, что он определяет.

И я нашёл решение. Даже два:

• Одно - в лоб, оно не гибкое, не красивое, для него нужно явно пользоваться конструкторами синтаксиса (чего я пытался до этого избежать), но зато простое (в смысле прямолинейное) и в ключе данной локальной задачи вполне подходит.
• Второе решение использует крутую технику - Scrap Your Boilerplate (SYB). Для него нужно немного прокачать своё haskell-fu, но это в любом случае стоит того и на самом деле вовсе не так сложно. То есть я на самом деле не постиг пока всех глубин Generic Programming, посредством SYB, но узнал о том, что это такое в принципе и как этим пользоваться в простейших случаях.

Я хочу, чтобы мой шаблон выглядел как-то так:

1
2
3
4
5
6
7

fooTemplate :: String → Int → Int → String → Q [Dec]
fooTemplate name y z blah = ...
    [d| foo :: Num a => a → a → String
        foo x 1 = show $ x + y
        foo x 2 = show $ x - z
        foo x _ = show x ++ blah
      |]

То есть цитата будет буквально содержать объявление функции с несколькими клозами и будет содержать явные элементы для подстановки: y, z, blah, они стоят в выражении и с ними ничего делать не надо, и есть один “неявный” placeholder (держатель места) - имя функции foo, которое мы хотим заменить на значение параметра name. А вот место, где стоит троеточие - это и будет наше решение, механизм подстановки этого имени.

Скучное решение

Начнём с простого, но скучного решения, чтобы потом увидеть преимущества продвинутого решения.

Итак, цель - замена имени в декларации. Так и напишем:

1

substName :: (Name → Name) → (Dec → Dec)

то есть substName (от substitute name) принимает функцию меняющую одни имена на другие, а выдаёт функцию, которая проделывает эту замену внутри деклараций. Как же она выглядит? А выглядит она стрёмно, приготовьтесь:

1
2
3
4
5
6
7
8
9
10
11
12
13

substName f (SigD    name  typ) =
             SigD (f name) typ
substName f (FunD    name  clauses) =
             FunD (f name) clauses
substName f (DataD cxt    name  tyVarBndr con dervs) =
             DataD cxt (f name) tyVarBndr con dervs
substName f (NewtypeD cxt    name  tyVarBndr con dervs) =
             NewtypeD cxt (f name) tyVarBndr con dervs
substName f (TySynD    name  tyVarBndr typ) =
             TySynD (f name) tyVarBndr typ
substName f (ClassD cxt    name  tyVarBndr funDep dec) =
             ClassD cxt (f name) tyVarBndr funDep dec
substName _ dec = dec

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

То есть эта функция не универсальна, причём в двух аспектах:

• Cрабатывает не для всех деклараций. Это поправимый недостаток - надо просто дописать ещё 8 клозов (см. определение Dec).
• Заменяет имя только на верхнем уровне. Имена могут встречаться глубже - в “теле” декларации.

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

Ладно, теперь сделаем нашу f - функцию меняющую имена, так чтобы она брала список пар строк, которые собственно и означают замену первое на второе:

1
2
3
4
5
6
7

type NamesMap = [(String, String)]

rename :: NamesMap → (Name → Name)
rename namesMap = λ oldName →
    case lookup (show oldName) namesMap of
         Nothing  → oldName
         Just new → mkName new

Функция lookup из Data.List смотрит есть данный элемент в списке пар, в качестве ключа, если есть возвращает соответствующее значение (Just new), из которого мы делаем новое имя (mkName new), если нет - Nothing и мы ничего не заменяем.

Хорошо, словарик мы обеспечим (пока пусть называется namesMap), теперь нужно её как-то применить к нашим процитированным декларациям. Посмотрим на тип комбинации substName и rename namesMap:

1

substName (rename namesMap) :: Dec → Dec

Так, теперь на тип цитаты: [d| ... |] :: Q [Dec]. Такой же и возвращаемый тип шаблона. То есть нам надо сделать преобразование Dec → Dec внутри Q [Dec]. Чтобы сделать это для [Dec], достаточно применить map:

1

map (substName (rename namesMap)) :: [Dec] → [Dec]

А для того чтобы теперь поднять эту функцию ещё на уровень выше - в монаду Q, нужно применить функцию liftM :: Monad m => (a → b) → (m a → m b):

1

(liftM (map (substName (rename namesMap)))) :: Q [Dec] → Q [Dec]

Что и требовалось. На самом деле список - это же тоже монада, так что мы могли бы написать не map, а ещё один liftM, но ладно, не суть.

Ну и всю эту штуковину надо как-то обозначить, убрав попутно лишние скобки:

1
2

renameDecs :: NamesMap → Q [Dec] → Q [Dec]
renameDecs namesMap = liftM $ map $ substName $ rename namesMap

Итак, у нас уже есть все требуемые элементы, осталось собрать их воедино:

1
2
3
4
5
6
7

fooTemplate :: String → Int → Int → String → Q [Dec]
fooTemplate name y z blah = renameDecs [("foo", name)]
    [d| foo :: Num a => a → a → String
        foo x 1 = show $ x + y
        foo x 2 = show $ x - z
        foo x _ = show x ++ blah
      |]

Вот и весь шаблон. То есть мы действительно только заполнили троеточие, оставив цитату нетронутой и полностью соответствующей виду результата (по модулю подстановок).

По-моему получилось вполне удобно и симпатично. И делать для этого пришлось не так много: substName → rename → renameDecs. Единственное неудобное место в этой цепочке - это громоздкая функция substName.

Решение с помощью SYB

Собственно, второе решение и будет отличаться только определением функции substName. Остальное достаточно универсально и просто.

SYB расшифровывается как Scrap Your Boilerplate и это можно перевести как “Выброси свой говнокод”, или лучше как в этой презентации: “Вычистим скучный код” Ивана Тарасова. Она на русском, включает в себя в некотором виде оф. презентацию SYB и рассматривает альтернативу - Uniplate. Так что всем рекомендую.

Смысл функции substName очень простой - мы хотим подействовать функцией f :: Name → Name на все вхождения Name внутри декларации Dec, а вся эта сложная структура типа Dec нас не интересует. Ну вот SYB как раз и позволяет абстрагироваться нам от этой структуры и написать прямо то, что мы хотим:

1
2

substName :: (Name → Name) → (Dec → Dec)
substName f = everywhere (mkT f)

Дословно - сделать из f универсальную трансформацию (mkT - “make transformation”), применить её везде (everywhere). Разве не замечательно? Просто чудесно! Тот ужасный, гов^W скучный код заменился на всего два слова и притом они довольно прозрачно отражают суть происходящего (если хочется понимания того, как это устроено, поможет презентация, на которую я дал ссылку выше).

С таким определением функция substName нам вообще особо не нужна. Можно сразу написать определением renameDecs без неё, заодно избавившись от скобочек:

1
2

renameDecs :: NamesMap → Q [Dec] → Q [Dec]
renameDecs namesMap = liftM $ map $ everywhere $ mkT $ rename namesMap

Ну и тут можно заметить, что в этой цепочке map становится лишним - everywhere может абстрагировать преобразование не только до Dec → Dec, но и до [Dec] → [Dec] - за бесплатно:

1

renameDecs namesMap = liftM $ everywhere $ mkT $ rename namesMap

К сожалению написать это в стиле point-free не получается, из-за специфичных типов everywhere и mkT. Но даже так, это выглядит довольно хорошо. И при всей своей изящности, это решение лишено тех недостатков, о которых я говорил в первом случае.

Второе решение полностью можно посмотреть тут: GitHub gist.

Итого, не считая необязательные сигнатуры, это решение в итоге укладывается всего в 5 строчек кода. Прекрасно! ^_^

Для частной задачи получилось здорово. Но всё же это велосипед, потому что QuasiQuoting позволяет делать не только такие подстановки, но и любые другие, то есть расцитирование в любом месте, с любым синтаксисом и для любого DSL. Это конечно круто. Но этого, насколько я знаю, для моей задачи из коробки нету и там тоже надо будет что-то сделать/дополнить, что конечно будет круче и универсальнее, но не совсем очевидно. Этим я займусь в следующий раз. По плану, дальше перевод вводного туториала по TH, потом по QQ, а потом уже и новые велоси эксперименты с мета-программированием в общем и QQ в частности.