如何在最终无标签方法中重新解释DSL术语？

Question

今天是个好日子.

我们的应用程序使用类型化的DSL来描述某些业务逻辑.DSL附带了几个无标记的解释器.

以下是其术语的声明方式:

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE EmptyDataDecls #-}

class Ctl impl where
  -- Lift constants.
  cnst :: Show t => t -> impl t
  -- Obtain the state.
  state :: impl (Maybe Int)

  -- Test for equality.
  eq :: impl Int -> impl Int -> impl Bool
  -- If-then-else.
  ite :: impl Bool -> impl t -> impl t -> impl t

  -- Processing outcomes.
  retry :: impl Outcome
  finish :: impl Outcome

  -- Require a value.
  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 "My current state"
  eq v1 v2 = TextE $ concat [evalText v1, " equals ", evalText v2]
  ite cond t e =
    TextE $
    concat ["If ", evalText cond, ", then ", evalText t, ", else ", evalText e]
  retry = TextE "Retry processing"
  finish = TextE "Finish"
  req v = TextE $ concat ["(", evalText v, ")*"]

使用TextE解释DSL会产生一个字符串:

?> (evalText proc1) :: String
"If (My current state)* equals 5, then Finish, else Retry processing"

这种描述用作用户/分析师的参考.

我还可以使用另一个解释器来评估元语言(Haskell)的DSL术语,这是应用程序实际遵循规则的方式:

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

-- Interface between types of DSL and 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 "Retrying..."
  finish = HaskellE $ print "Done!"
  req term@(HaskellE v) =
    case v of
      Just v' -> HaskellE v'
      Nothing ->
        HaskellE (error $
                  "Could not obtain required value from ") -- ++ evalText term)

-- Dummy implementations so that this post may be evaluated
dummyState = Just 5
type Outcome = IO ()
type instance HaskellType t = t

该解释器生成可运行的Haskell代码:

?> (evalHaskell proc1) :: IO ()
"Done!"

现在我的问题:我想使用HaskellE解释器的TextE解释器.例如,我想以req一种包含evalText term错误消息中嵌套术语(通常由其获得)的文本表示的方式定义失败分支 .相关代码在req上面的HaskellE的实现中被注释掉了.如果评论被还原,代码看起来像

    HaskellE (error $
              "Could not obtain required value from " ++ 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.

该消息基本上表示impl在实例化类型变量时已经选择了解释器HaskellE ,并且我不能在HaskellE中使用TextE解释器.

我无法理解的是:如何将一个术语从HaskellE重新解释为TextE？

如果我在这里完全错了,我如何重塑我的方法,以便我可以实际使用Haskell中的文本解释器,而无需在HaskellE中重新实现它？用初始方法而不是最终方法看起来很可行.

为了简洁起见,我剥离了我的实际DSL并简化了类型和解释器.

Answer 1

您可以跟踪创建值的表达式的值和信息.如果这样做,您将失去最终无标记表示的一些性能优势.

data Traced t a = Traced {evalTraced :: HaskellType a, trace :: t a}

我们希望将它与TextE痕迹一起使用,因此为方便起见,我们将定义以下内容

evalTextTraced :: Traced TextE a -> HaskellType a
evalTextTraced = evalTraced

这个类允许我们从a恢复错误消息 trace

class Show1 f where
    show1 :: f a -> String

instance Show1 TextE where
    show1 = evalText

instance (Show1 t) => Show1 (Traced t) where
    show1 = show1 . trace

这个解释器会记录任何其他Ctl t解释器,我们可以在解释时从中恢复错误消息Traced t.

instance (Show1 t, Ctl t) => Ctl (Traced t) where
    cnst v = Traced v (cnst v)
    state = Traced dummyState state
    eq (Traced v1 t1) (Traced v2 t2) = Traced (v1 == v2) (eq t1 t2)
    ite (Traced vc tc) (Traced vt tt) (Traced ve te) = Traced (if vc then vt else ve) (ite tc tt te)
    retry = Traced (print "Retrying...") retry
    finish = Traced (print "Done!") finish
    req (Traced v t) = 
        case v of 
            Just v' -> Traced v' rt
            Nothing -> Traced (error ("Could not obtain required value from " ++ show1 rt)) rt
        where rt = req t

您的示例按预期运行

print . evalText . trace $ proc1
evalTextTraced proc1

"If (My current state)* equals 5, then Finish, else Retry processing"
"Done!"

我们仍然可以evalText作为失败要求的示例,但尝试运行它会产生信息性错误消息

proc2 :: Ctl impl => impl Outcome
proc2 = ite (req (cnst Nothing) `eq` cnst 5) finish retry

print . evalText . trace $ proc2
evalTextTraced proc2

"If (Nothing)* equals 5, then Finish, else Retry processing"
finaltagless.hs: Could not obtain required value from (Nothing)*