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获取）错误消息中。该相关代码在HaskellE的req实现中被注释掉了以上。如果评论被还原，则代码看起来像

    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.

该消息基本上表示解释器HaskellE已经存在在实例化类型变量impl时被选中，而我不能在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

此类允许我们从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)*

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

1 个答案: