解析类型化的eDSL（附代码实例）

HackerNews什么值得看
185 阅读8分钟

解析类型化的eDSL

Michelson是Tezos社区的一种智能合约语言。类似于Forth，Michelson合约是由一连串在类型堆栈上操作的指令描述的。每条指令都假定一个特定类型的堆栈作为输入，并产生一个确定类型的输出堆栈。例如，PAIR 指令假定一个类型为a : b : s 的堆栈，对于任何堆栈的尾部s ，产生一个类型为pair a b : s 的堆栈。你可以在官方文档中阅读更多关于Michelson指令和打字的信息。

2019年1月，与托克维尔集团合作，Serokell启动了Morley项目。其目标之一是实现一个测试任意米歇尔森合约的综合框架，支持简单的单元测试，以及更复杂的基于属性的测试。更准确地说，我们想拿一个合同，用各种输入和输出值的集合来喂养，看看它是否表现得像预期的那样。

在我们继续前进之前，有一个小小的评论。在这篇文章中，我们只涵盖了迈克尔逊指令的一小部分，并且只考虑了迈克尔逊类型系统的核心，没有考虑注释。厘清所有这些细节是我们在Morley框架的工作中进行的一项复杂的任务，我们欢迎大家去查看资源库，看看有所有基础细节的类型检查和 解释的实现。

我们决定使用Haskell来实现Morley，首先我们开发了Michelson语言作为一个非常简单的AST数据类型：

data T =
   Tint
 | Tnat
 | Toption T
 | Tlist T

data UVal =
   UInt  Integer
 | USome UVal
 | UNone
 | UList [UVal]

data UInstr =
   UNOP
 | UDROP
 | UDUP
 | USWAP
 | UPUSH T UVal
 | UPAIR
 | UCAR
 | UCDR
 | UADD
 | UCONS
 | UNIL T
 | UIF_CONS

很快我们就明白这个简单的AST受到了某些限制。首先，要生成任意的松散类型的值是不容易的。在我们的AST中，list只是一个构造函数UList [UVal] ，我们无法编写一个Arbitrary 实例来生成一个任意的整数或字符串的列表，这取决于类型上下文。

这个问题的答案很明显：创建一个具有更强类型的AST。然后，表达式就变成了用类型来注释的，这很容易实现，这要归功于强大的GADTs 和DataKinds 扩展。这立即解决了任意值生成的问题。此外，解释器也有可能不再不可预测地出现运行时类型错误的情况：

data Val t where
  VInt :: Int -> Val 'TInt
  VNat :: Word -> Val 'TNat
  VList :: [Val t] -> Val ('TList t)
  VPair :: Val p -> Val q -> Val ('TPair p q)

但在引入这种类型后，我们很快发现自己遇到了挑战。将文本代码表示法解析为简单的AST是非常容易的，但对如何对Michelson的类型表示法做同样的事情却不清楚。为了简化事情，我们考虑了从简单AST到类型化AST的转换任务，而不是解析。

从简单AST转换到类型化表示的第一个问题是，AST中父分支的转换取决于子分支的类型。解决这个问题的一个有用的技巧可以在2009年的博文中找到。简而言之，我们创建一个持有值的存在类型以及它的类型，并从我们的类型检查函数返回这个存在类型：

data Sing (t :: T) where
  STInt  :: Sing 'TInt
  STNat  :: Sing 'TNat
  STList :: Sing t -> Sing ('TList t)
  STPair :: Sing p -> Sing q -> Sing ('TPair p q)

data SomeVal1 where
  SomeVal1 :: Val t -> Sing t -> SomeVal1

typeCheckVal1 :: UVal -> Maybe SomeVal1
typeCheckVal1 (UInt i) = Just $ SomeVal1 (VInt i) STInt
typeCheckVal1 (UPair p q) = do
  SomeVal1 pv pt <- typeCheckVal1 p
  SomeVal1 qv qt <- typeCheckVal1 q
  pure $ SomeVal1 (VPair pv qv) (STPair pt qt)
typeCheckVal1 (UList _) = error "not implemented"

Sing 数据类型可以通过使用singletons库自动导出。该库提供了Sing 数据族和有用的辅助函数和类，用于与单数的工作。在这篇文章中，我们将坚持使用手写的Sing 和转换函数。

这种结构有两个主要问题。首先，读者可能已经注意到，STNat 和VNat 构造函数都没有被使用过。事实上，来自简单AST的UInt 构造函数是用来表示有符号和无符号整数的，因为它们的表示方法大致相同。在解析过程中，我们无法真正区分TInt 和TNat 字面符号。

一个类似的问题出现在一个包裹着空列表的列表构造函数中。当给定一个列表构造函数时，我们不知道这个列表包含什么类型的值。在空列表的情况下，我们必须返回forall t. TList t 类型，但是我们的类型表示法并不支持这样的构造。

这个片段的第二个问题是类似的。在非空列表的情况下，我们可以把t 作为第一个元素的类型，并通过比较找出列表中其他元素是否具有相同的类型。但是要比较第一个列表元素的t1 类型和第二个列表元素的t2 类型，我们需要约束条件Typeable t1 和Typeable t2 成立。

要解决第二个问题相对容易。我们引入一个SomeVal 数据类型，并将Typeable 约束条件放在构造函数的范围内：

data SomeVal where
 SomeVal :: Typeable t => Val t -> Sing t -> SomeVal

第一个问题需要改用不同的方法进行类型检查。解决这个问题的一个方法是在我们的简化类型系统中引入某种约束的forall 量词，类似于我们在Haskell中的做法。对于空列表的情况，我们可以写成类似SomeVal (VList []) (forall n. Num n => n) 的东西。这种方法更具有普遍性，但实施和维护起来要麻烦得多。

对我们来说，幸运的是，对于类型检查迈克尔逊程序来说，可以采用更轻的方法。尽管所有的Michelson指令都是多态的，但Michelson程序总是在一个契约的背景下给出的。契约定义了一个输入堆栈类型，每条指令都以明确的方式修改了一个堆栈类型。因此，实际上不需要实现一种类型检查算法，为任意的迈克尔逊指令序列推导出一种类型（有一些forall 量词）。我们将从输入堆栈类型开始，并通过指令进行迭代。这样一来，我们就能坚持由T 数据类型所代表的类型系统。

在这个例子中，我们只考虑了值的类型检查。按照上面定义的规则，我们将实现typeCheckVal 函数，第一个参数是我们要解析的表达式的类型。只有两条指令向堆栈引入新的值（即UPUSH 和UNIL ），而且这两条指令都明确地包含了类型表示。

typeCheckVal :: Sing t -> UVal -> Maybe (Val t)
typeCheckVal STInt (UInt i) = Just (VInt i)
typeCheckVal STNat (UInt i) = do
  guard (i >= 0)
  pure (VNat $ fromIntegral i)
typeCheckVal (STPair pt qt) (UPair p q) = do
  pv <- typeCheckVal pt p
  qv <- typeCheckVal qt q
  pure $ VPair pv qv
typeCheckVal (STList t) (UList l) =
  VList <$> mapM (typeCheckVal t) l
typeCheckVal _ _ = Nothing

在这里我们实际上不需要将Val t 裹进SomeVal ，因为第一个参数很好地定义了函数的输出。重要的是要强调单数在上述结构中的作用。我们所做的是对应该被解析的值的类型进行模式匹配。在术语级函数的代码中对类型进行模式匹配在Haskell中并不常见，而单子可能是最直接的方式。

现在，让我们来实现指令的转换。首先，我们必须稍微修改我们的Sing 数据类型，并提供一些必要的辅助函数：

data Sing (t :: T) where
  STInt  :: Sing 'TInt
  STNat  :: Sing 'TNat
  STList :: Typeable t => Sing t -> Sing ('TList t)
  STPair :: (Typeable p, Typeable q)
         => Sing p -> Sing q -> Sing ('TPair p q)

fromSing :: Sing t -> T
fromSing = ...

data SomeSing where
  SomeSing :: Typeable t => Sing t -> SomeSing

withSomeSing
  :: SomeSing
  -> (forall t . Typeable t => Sing t -> a)
  -> a
withSomeSing (SomeSing a) f = f a

toSing :: T -> SomeSing
toSing = ...

与值类似，我们将定义一个指令的类型化表示。Instr 数据类型由类型参数inp 和out 的种类[T] 参数化，这些参数为指令对应的输入和输出栈类型。这种迈克尔逊指令的表示方法非常优雅，因为它完全模仿了迈克尔逊文档中给出的符号：

data Instr (inp :: [T]) (out :: [T]) where
  Seq :: Instr a b -> Instr b c -> Instr a c
  Nop :: Instr s s

  DROP :: Instr (a ': s) s
  DUP  :: Instr (a ': s) (a ': a ': s)
  SWAP :: Instr (a ': b ': s) (b ': a ': s)
  PUSH :: Val t -> Instr s (t ': s)

  PAIR :: Instr (a ': b ': s) ('TPair a b ': s)
  CAR :: Instr ('TPair a b ': s) (a ': s)
  CDR :: Instr ('TPair a b ': s) (b ': s)

  NIL  :: Instr s ('TList t ': s)
  CONS :: Instr (t ': 'TList t ': s) ('TList t ': s)

  ADDii :: Instr ('TInt ': 'TInt ': s) ('TInt ': s)
  ADDnn :: Instr ('TNat ': 'TNat ': s) ('TNat ': s)
  ADDin :: Instr ('TInt ': 'TNat ': s) ('TInt ': s)
  ADDni :: Instr ('TNat ': 'TInt ': s) ('TInt ': s)

  IF_CONS :: Instr (a ': 'TList a ': s) s'
          -> Instr s s'
          -> Instr ('TList a ': s) s'

ADD 指令的表示法不是很好，但可以通过使用类型类来改进。我们可以创建一个类型类AddOp ，它需要两个类型参数（用于ADD 指令的两个操作数）。它将包含一个用于类型检查的函数，一个用于解释的函数和一个用于结果类型的类型族。为了简单起见，这在文章的代码中没有实现。

我们的函数typeCheckI 将接受一个输入堆栈类型和一个未类型化的指令，并应返回一个输出堆栈类型和一个类型化的指令。因此，我们引入了Stack 和SomeInstr 数据类型。Stack 数据类型类似于vinyl包中的Rec 。唯一的区别是，我们对:& 的第一个参数施加了Typeable 的约束：

data Stack inp where
  SNil  :: Stack '[]
  (::&) :: (Typeable s, Typeable a)
        => Sing a -> Stack s -> Stack (a ': s)
infixr 7 ::&

data SomeInstr inp where
  (:::) :: Typeable out
        => Instr inp out -> Stack out -> SomeInstr inp
infixr 5 :::

现在我们终于可以实现typeCheck 函数了。

typeCheckI
  :: Typeable inp => Stack inp -> UInstr -> Maybe (SomeInstr inp)
typeCheckI s UNOP = pure (Nop ::: s)
typeCheckI (_ ::& s) UDROP = pure (DROP ::: s)
typeCheckI (a ::& s) UDUP = pure (DUP ::: a ::& a ::& s)
typeCheckI (a ::& b ::& s) USWAP = pure (SWAP ::: b ::& a ::& s)
typeCheckI s (UPUSH t v) = withSomeSing (toSing t) $ \t' -> do
  val <- typeCheckVal t' v
  pure (PUSH val ::: t' ::& s)
typeCheckI (a ::& b ::& s) UPAIR = pure (PAIR ::: STPair a b ::& s)
typeCheckI (STPair a _ ::& s) UCAR = pure (CAR ::: a ::& s)
typeCheckI (STPair _ b ::& s) UCDR = pure (CDR ::: b ::& s)
typeCheckI (STInt ::& STInt ::& s) UADD = pure (ADDii ::: STInt ::& s)
typeCheckI (STNat ::& STNat ::& s) UADD = pure (ADDnn ::: STNat ::& s)
typeCheckI (STInt ::& STNat ::& s) UADD = pure (ADDin ::: STInt ::& s)
typeCheckI (STNat ::& STInt ::& s) UADD = pure (ADDni ::: STInt ::& s)
typeCheckI s (UNIL t) = withSomeSing (toSing t) $ \t' ->
  pure (NIL ::: STList t' ::& s)
typeCheckI ((_ :: Sing a) ::& STList (e :: Sing b) ::& s) UCONS = do
  Refl <- eqT @a @b
  pure (CONS ::: STList e ::& s)
typeCheckI (STList a ::& s) (UIF_CONS consCase nilCase) = do
  nc ::: (s' :: Stack out1) <- typeCheck s nilCase
  cc ::: (_ :: Stack out2) <- typeCheck (a ::& STList a ::& s) consCase
  Refl <- eqT @out1 @out2
  pure (IF_CONS cc nc ::: s')
typeCheckI _ _ = Nothing

typeCheck
  :: Typeable inp => Stack inp -> [UInstr] -> Maybe (SomeInstr inp)
typeCheck s [] = pure (Nop ::: s)
typeCheck s (i : []) = typeCheckI s i
typeCheck s (i : is) = do
  a ::: s' <- typeCheckI s i
  b ::: s'' <- typeCheck s' is
  pure (a `Seq` b ::: s'')

在typeCheckI ，我们对一个输入堆栈类型和一个未定型的指令进行模式匹配。在CONS 的情况下，我们需要额外检查堆栈的第一个元素和堆栈第二个元素的列表的子类型是否相等。在IF_CONS 的情况下，使用对typeCheck 的递归调用来检查这两个延续。

现在，当我们最终确定了如何对米歇尔森指令的序列进行类型检查时，让我们看看我们的eDSL可以如何解释：

interpret
  :: Rec Val inp -> Instr inp out -> Rec Val out
interpret s Nop = s
interpret s (Seq a b) = interpret (interpret s a) b
interpret (_ :& s) DROP = s
interpret (a :& s) DUP = a :& a :& s
interpret (a :& b :& s) SWAP = b :& a :& s
interpret (a :& b :& s) PAIR = VPair a b :& s
interpret s (PUSH v) = v :& s
interpret (VPair a _ :& s) CAR = a :& s
interpret (VPair _ b :& s) CDR = b :& s
interpret (VInt a :& VInt b :& s) ADDii = VInt (a + b) :& s
interpret (VInt a :& VNat b :& s) ADDin = VInt (a + fromIntegral b) :& s
interpret (VNat a :& VInt b :& s) ADDni = VInt (fromIntegral a + b) :& s
interpret (VNat a :& VNat b :& s) ADDnn = VNat (a + b) :& s
interpret s NIL = VList [] :& s
interpret (a :& VList l :& s) CONS = VList (a : l) :& s
interpret (VList [] :& s) (IF_CONS _ nilCase) = interpret s nilCase
interpret (VList (a : l) :& s) (IF_CONS consCase _) =
  interpret (a :& VList l :& s) consCase

有趣的是，interpret 函数是总的，这是高级类型表示法的一个肯定的好处。Val 数据类型包含了足够的信息，使类型检查器能够考虑输入堆栈和指令的所有可能情况，而且不需要在运行时进行额外的检查，这是一种容易出错的做法。简而言之，如果程序进行了类型检查，在运行时就不会产生错误。

总而言之，在这篇文章中，我们看到了如何应用Haskell的一些高级类型化技术对简单的严格类型化的堆栈语言进行类型检查。我们采用了一个简单的语言AST表示（可以使用任何解析技术很容易地从文本中获得），并将其转换为同一语言的严格类型化表示。严格类型化表示与定义语言的类型系统是1:1对应的，通过严格类型化表示中的术语，我们可以保证它的类型良好。所描述的方法在很大程度上依赖于这样一个事实：类型系统不定义抽象类型，所有类型都是具体的，也就是说，只有内置结构是多态的。这种限制适用于各种语言，因此我们认为我们的方法具有高度的可重用性。

avatar
文章
阅读
粉丝