Реинтерпретация термов безметочного DSL

[Dmitry Dzhus]

How are you gentlemen,

Наше приложение использует безметочный типизированный DSL для описания

определённой бизнес-логики (т.е. элементы языка представлены не с

помощью обобщённых АДТ, а в виде полиморфных функций, объявленных

вместе с классом типов — об этом можно почитать в статьях О.Киселёва

на тему «tagless final»).

Для DSL написано несколько интерпретаторов.

Вот как объявлены конструкции языка:

> {-# LANGUAGE TypeFamilies #-}

> {-# LANGUAGE EmptyDataDecls #-}

> class Ctl impl where

>   -- Константы.

>   cnst :: Show t => t -> impl t

>   -- Запрос состояния.

>   state :: impl (Maybe Int)

>    -- Проверка на равенство.

>   eq :: impl Int -> impl Int -> impl Bool

>   -- Условный оператор.

>   ite :: impl Bool -> impl t -> impl t -> impl t

>    -- Результаты обработки.

>   retry :: impl Outcome

>   finish :: impl Outcome

>    -- Обязательно потребовать значение.

>   req :: impl (Maybe t) -> impl t

И бизнес-логику можно описывать кусочками кода на этом DSL:

> proc1 :: Ctl impl => impl Outcome

> proc1 = ite (req state `eq` cnst 5) finish retry

Используются эти высокоуровневые описания при помощи интерпретаторов.

Есть текстовый интерпретатор, который выдаёт читабельное описание

того, как задан бизнес-процесс:

> newtype TextE t = TextE { evalText :: String }

> instance Ctl TextE where

>   cnst v = TextE $ show v

>   state = TextE "Текущее состояние"

>   eq v1 v2 = TextE $ concat [evalText v1, " равно ", evalText v2]

>   ite cond t e =

>     TextE $

>     concat ["Если ", evalText cond, ", то ", evalText t, ", иначе ", evalText e]

>   retry = TextE "Повторить обработку"

>   finish = TextE "Закончить"

>   req v = TextE $ concat ["(", evalText v, ")*"]

Интерпретация DSL с помощью TextE порождает строку:

    λ> (evalText proc1) :: String

    "Если (Текущее состояние)* равно 5, то Закончить, иначе Повторить обработку"

Это описание используется в справочных целях пользователями или

аналитиками.

Также я могу получить значение терма DSL в мета-языка (Haskell) с

помощью ещё одного интерпретатора (что собственно и делает приложение

для реализации описанных правил бизнес-логики):

> newtype HaskellE t = HaskellE { evalHaskell :: HaskellType t }

> -- Интерфейс между типами DSL и Haskell.

> type family HaskellType t

> instance Ctl HaskellE where

>   cnst v = HaskellE v

>   state = HaskellE dummyState

>   eq v1 v2 = HaskellE $ evalHaskell v1 == evalHaskell v2

>   ite cond t e =

>     HaskellE $

>     if (evalHaskell cond)

>     then (evalHaskell t)

>     else (evalHaskell e)

>   retry = HaskellE $ print "Повтор..."

>   finish = HaskellE $ print "Завершено!"

>   req term@(HaskellE v) =

>     case v of

>       Just v' -> HaskellE v'

>       Nothing ->

>         HaskellE (error $

>                   "Не удалось получить значение ") -- ++ evalText term)

> -- Реализации-пустышки для простоты изложения

> dummyState = Just 5

> type Outcome = IO ()

> type instance HaskellType t = t

Этот интерпретатор выдаёт запускаемый Haskell-код:

    λ> (evalHaskell proc1) :: IO ()

    "Завершено!"

Теперь к задаче: я бы хотел использовать интерпретатор TextE из

интерпретатора HaskellE. Например, я бы хотел определить неудачную

ветку в `req` так, чтобы текстовое представление вложенного терма (то,

что можно получить с помощью `evalText term`) использовалось в

сообщении об ошибке. Соответствующий код закомментирован в `req` из

реализации HaskellE абзацем выше. Если комментарий убрать, то код

приобретает следующий вид:

        HaskellE (error $

                  "Не удалось получить значение " ++ evalText term)

Тем не менее, система типов не позволяет мне это сделать:

    tagless.lhs:90:71: Couldn't match expected type ‘TextE t0’ …

                    with actual type ‘HaskellE (Maybe t)’

        Relevant bindings include

          v :: HaskellType (Maybe t)

            (bound at /home/dzhus/projects/hs-archive/tagless.lhs:85:22)

          term :: HaskellE (Maybe t)

            (bound at /home/dzhus/projects/hs-archive/tagless.lhs:85:7)

          req :: HaskellE (Maybe t) -> HaskellE t

            (bound at /home/dzhus/projects/hs-archive/tagless.lhs:85:3)

        In the first argument of ‘evalText’, namely ‘term’

        In the second argument of ‘(++)’, namely ‘evalText term’

    Compilation failed.

Сообщение ожидаемо указывает на то, что раз интерпретатор HaskellE уже

был выбран (когда было зафиксировано значение типовой переменной

`impl`), и я не могу использовать интерпретатор TextE внутри HaskellE.

Может ли кто-нибудь предложить решение задачи, которое позволило бы

реинтерпретировать терм из HaskellE в TextE, или вообще как-то

использовать TextE из HaskellE, не копируя внутрь HaskellE реализацию

текстового интерпретатора? Ведь с меточным подходом (на GADT) это

выглядит совсем несложно.

На SO предложили со-интерпретацию термов одновременно двумя

интерпретаторами

(http://stackoverflow.com/questions/25733889/how-to-reinterpret-a-dsl-term-in-final-tagless-approach).

Такой подход не радует, т.к. в действительности у меня есть как

минимум ещё один интерпретатор, решение быстро взрывается. Мой коллега

предложил улучшить этот подход, сделав результатом текстового

интерпретатор монадический трансформер. Можете ли вы предложить что-то

ещё лучше?

Сам DSL, интерпретаторы и HaskellType сильно упрощены в целях

краткости изложения.

[Alexander (qnikst) Vershilov]

Здравствуйте, решение с аналогом монадического стека и двойным проходом
может тут помочь:

newtype HaskellE (m :: * -> *) t = HaskellE { evalHaskell :: (HaskellType t, m t) }

instance (IsText m, Ctl m) => Ctl (HaskellE m) where
   cnst v = HaskellE (v, cnst v)
   state = HaskellE (dummyState, state)

   req (HaskellE (v, term)) =
     case v of
       Just v' -> HaskellE (v', req term)
       Nothing ->
         HaskellE (error $
                   "Не удалось получить значение " ++ evalTextC term, req term)

class IsText m where
   evalTextC :: m a -> String

instance IsText TextE where
   evalTextC = evalText

Тут важно, что мы используем ограничение требующие, чтобы из стека ниже можно было
достать интерпретацию как текст. Однако данное решение не самое удобное, мне
кажется что сделать интерпретатор переводящий в (G)ADT описывающее DSL и
реинтерпретировать его на самом деле было бы проще.




четверг, 29 января 2015 г., 0:56:15 UTC+3 пользователь Dmitry Dzhus написал: