Question

假设我们试图表示一种C语言的AST节点。首先，为简单起见，让我们定义节点类型的概念：

data CursorKind = KIntegerLiteral | KStringLiteral | KFunction | KStruct | KTypedef

接下来，让我们添加一个类型，以类型安全的方式表示文字的值：

data LiteralValue k where
  IntegerValue :: Int -> LiteralValue 'KIntegerLiteral
  StringValue :: String -> LiteralValue 'KStringLiteral
  NotALiteral :: LiteralValue '???

这是第一个问题：有没有一种方法来定义NotALiteral子句，使其包含k和KIntegerLiteral以外的任何KStringLiteral？如果没有，那么表达这种后备式条款以避免重复的最佳方法是什么？

无论如何，现在，结合以上所述，让我们在AST中构造一个非常简单的节点表示形式：

data Cursor = Cursor
  { kind :: CursorKind
  , value :: LiteralValue ???
  , children :: [Cursor]
  }

这是第二个问题。我理想地希望拥有value类型的kind。在像Idris这样具有完全依赖类型的语言中，它会非常简单。但是，在现代的Haskell中，我们该如何处理所有单例以及它必须提供的TypeInType？

编辑受@chi答案的启发，我对第一个问题的解决方案是按以下方式使用类型族，因为实际上有大量的游标种类并枚举所有它们似乎是错误的：

type family NotALiteral (k :: CursorKind) :: Bool where
  NotALiteral 'KIntegerLiteral = 'False
  NotALiteral 'KStringLiteral = 'False
  NotALiteral a = 'True

data LiteralValue k where
  IntegerValue :: Int -> LiteralValue 'KIntegerLiteral
  StringValue :: String -> LiteralValue 'KStringLiteral
  NotALiteral :: NotALiteral k ~ 'True => LiteralValue k

现在的问题是在给定游标类型LiteralValue的情况下，该函数的实现会产生匹配的k。理想情况下，我们希望某些东西带有以下签名（是的，我正在使用singletons）：

getLiteralValue :: Sing k -> FFICursor -> FFIMonad (LiteralValue k)

对于k确实是文字的情况，实现很简单：

getLiteralValue SKIntegerLiteral ffi = IntegerValue <$> ffiGetInt ffi
getLiteralValue SKStringLiteral ffi = StringValue <$> ffiGetStr ffi

但是如果我们现在尝试写类似的东西

getLiteralValue _ _ = pure NotALiteral

它将不会进行类型检查，因为ghc无法得出NotALiteral k ~ 'True成立的信息。一种解决方案是继续在单例上进行匹配，但这实际上需要枚举所有种类，但由于数量原因，我想避免这种情况。有更好的方法吗？

Answer 1

如果您只关心防止施工，则可以使用

data LiteralValue k where
  ...
  NotALiteral :: NonLiteral k => LiteralValue k

class NonLiteral k
instance NonLiteral 'KFunction
...

请注意，在这种方法中，k的值在运行时之前被擦除，因此我们将无法对其进行模式匹配。如果知道k很重要，那么我们可以使用单例

data SCursorKind c where
    SKIntegerLiteral :: SCursorKind 'KIntegerLiteral
    SKStringLiteral  :: ScursorKind 'KStringLiteral
    ...

data LiteralValue k where
  ...
  NotALiteral :: NonLiteral k => SCursorKind k -> LiteralValue k

以便我们可以进行图案匹配。

（我认为也可以使用singletons库自动生成单例类型。）

对于第二个问题，使用一个存在性和一个单例：

data Cursor where
   Cursor ::
      { kind :: SCursorKind k
      , value :: LiteralValue k
      , children :: [Cursor]
      } -> Cursor

这会稍微更改字段kind的类型。如果有问题，编写一个fromSCursorKind :: SCursorKind k -> CursorKind函数以恢复原始类型很简单。

Answer 2

另一种选择是使用first-class-families包通过自定义检查约束来创建自定义TypeError。

从语言扩展入手：

{-# LANGUAGE
    GADTs,
    StandaloneDeriving,
    ConstraintKinds,
    DataKinds,
    TypeFamilies,
    TypeInType,
    TypeOperators,
    ExplicitNamespaces,
    FlexibleInstances,
    UndecidableInstances 
    #-}

接下来，导入

import Data.Kind (Constraint)
import Data.Type.Equality (type (==))
import Data.Type.Bool (If, type (||))
import GHC.TypeLits (TypeError, ErrorMessage(..))

-- package: first-class-families
import Fcf (Eval, Exp, Pure)

接下来，我们需要定义一个数据类型以推迟类型错误，因此除非必要，否则不对其进行评估。还为Eval

定义类型实例

data TypeError' :: ErrorMessage -> Exp a
type instance Eval (TypeError' m) = TypeError m

现在我们要使用的类型

data CursorKind = KIntegerLiteral | KStringLiteral | KFunction | KStruct | KTypedef 

-- Singletons for pattern matching on NotALiteral, can be generated with the singletons package
data SCursorKind (k :: CursorKind) where
  SKIntegerLiteral :: SCursorKind 'KIntegerLiteral
  SKStringLiteral :: SCursorKind 'KStringLiteral
  SKFunction :: SCursorKind 'KFunction
  SKStruct :: SCursorKind 'KStruct 
  SKTypedef :: SCursorKind 'KTypedef

deriving instance Show (SCursorKind k)

data LiteralValue (k :: CursorKind) where
  IntegerValue :: Int -> LiteralValue 'KIntegerLiteral
  StringValue :: String -> LiteralValue 'KStringLiteral
  NotALiteral :: TestLit k => SCursorKind k -> LiteralValue k

deriving instance Show (LiteralValue k)

我添加了Show实例以进行简单测试。现在您可能想知道TestLit k的来源，这就是定义，使用Eval和Pure中的first-class-families和ConstraintKinds：

type TestLit k = Eval (
  If (k == 'KIntegerLiteral || k == 'KStringLiteral)
    (TypeError' ('Text "Wrong CursorKind, shouldn't be KIntegerLiteral or KStringLiteral, but got: " :<>: 'ShowType k)) 
    -- ^could probably give a better TypeError
    (Pure EmptyConstrant)
  )

-- because (Pure (() :: Constraint)) has way too many parentheses
type EmptyConstrant = (() :: Constraint)

在这一点上，我们和chi得到的是同一点，那就是当我们尝试编译表达式NotALiteral SKIntegerLiteral时（也用于字符串文字），我们遇到类型错误。您也可以使用简单的类型系列作为约束（带有自定义TypeError），而不使用first-class-families包。

现在是第二个问题：

要实现所需的功能，可以使用类型类。我将简化这个问题。假设我们需要一个函数SCursorKind k -> LiteralValue k，并且希望将其专用于文字，并将其默认为其他文字，而不必指定所有文字。我们将定义一个类型类：

class LitVal k where
  getLiteralValue :: SCursorKind k -> LiteralValue k

我们只导出函数getLiteralValue，而不是类型类本身，因为我们要提供所有实例。我们需要这些实例的FlexibleInstances和UndecidableInstances，以及OVERLAPPING和OVERLAPPABLE编译指示。

instance {-# OVERLAPPING #-} LitVal 'KIntegerLiteral where
  getLiteralValue _ = IntegerValue 4

instance {-# OVERLAPPING #-} LitVal 'KStringLiteral where
  getLiteralValue _ = StringValue "4"

instance {-# OVERLAPPABLE #-} TestLit k => LitVal k where
  getLiteralValue sk = NotALiteral sk

如果愿意，可以使类型类更复杂（带有额外的参数）。如果您愿意，也可以从构造函数中删除SCursorKind k（但我认为它提供了更好的Show实例）

Here's a runnable example online, using the defintions from Fcf inlined, and Data.Type.Equality since those seem to cause trouble on that site

表达记录类型之间的记录值之间的依赖性

2 个答案: