设计简单静态类型语言的类型系统（Haskell）

Question

我一直在考虑为命令式、静态类型的语言编写解释器以适应函数式编程和 Haskell，但是我从来没有真正想过一个清晰的语法，这通常会导致不令人满意的代码和重写所有内容的冲动，所以我来这里寻求帮助。我应该如何设计一个相对简单但可扩展的类型系统？

我想支持基本原语，如数字类型、布尔值、字符等（在掌握基础知识之前不想涉足数组或记录结构）及其相关的基本操作。我最大的问题是我不太清楚类型和运算符之间的关系应该如何实现。

我还不太了解Haskell，但是定义一堆重复求和类型的简单解决方案，如

data ArithmeticOperator =
    Plus
    | Min
    | Mul 
    | Div

data LogicalOperator =
    And
    | Or
    | Not

对我来说 eloquent 似乎没有，因为这种类型划分会进一步传播到构建在这些类型之上的结构，例如表达式，并且在评估表达式时必须对每个运算符进行模式匹配看起来真的很乏味而且不容易扩展。

于是我想到为运算符定义一个灵活的类型，比如

data Operator a b =
    UnaryOperator (a -> b)
    | BinaryOperator (a -> a -> b)

其中a代表参数类型，b是return类型。这个问题是我真的不知道如何强制类型只是我打算支持的类型。它看起来更简洁，但我不确定这是不是"right"。

最后，有没有以初学者友好的方式介绍这个主题的资源？我不想在这个主题上太深入，但我很乐意阅读关于.. 好吧，在设计类型系统时常见 principles/considerations。

Answer 1

根据评论，不要将此作为您的第一个口译员。如果您还没有为无类型 lambda 演算编写过解释器，或者没有学习过教程，例如 Write Yourself a Scheme in 48 Hours，请先完成。

无论如何，这是一个简单的解释器实现，用于具有布尔和数字类型的静态类型表达式语言、一些内置运算符（包括具有临时多态性的运算符）、变量和 let x=... in ...变量绑定，但没有 lambda。它说明了设计类型化解释器的常用方法，但缺少的足够多，不会破坏您的乐趣。

注意：我有意避免使用任何中级或高级 Haskell 功能（例如，类型 ExprU 和 ExprT 没有统一在一个多态类型中——不“trees that grow" for us!; I haven't used GADTs to leverage the Haskell type system 输入目标语言；等等）。这些先进的技术可以带来更安全的代码——而且也非常棒，所以你肯定想在未来看看它们——但它们不是”没有必要让基本类型的解释器工作。

编写解释器时，打开 -Wall 是个好主意——它会提醒您忘记处理哪些模式（即表达式类型）：

{-# OPTIONS_GHC -Wall #-}

此外，为了保持理智，我们需要使用一些单子：

import Control.Monad
import Control.Monad.Reader
import Control.Monad.Except

您在问题中提到您正在努力解决两种方法：一开始就按类型划分运算符，或者以某种方式反映 Haskell 类型系统中的运算符类型。您对第一种方法的直觉是正确的——它不会很好地工作。第二种方法是可行的，但您将很快运行对抗一些您可能还没有准备好使用的非常先进的 Haskell 技术。

相反，对于我们的静态类型语言，让我们从定义完全非类型化抽象表达式语法开始。请注意，这是一种可能由完全不知道类型的解析器生成的抽象语法：

-- Untyped expressions
data ExprU
  = FalseU | TrueU           -- boolean literals
  | NumU Double              -- numeric literal
  | VarU String              -- variable
  | UnU UnOp ExprU           -- unary operator
  | BinU BinOp ExprU ExprU   -- binary operator
  | LetU String ExprU ExprU  -- let x = expr1 in expr2
data UnOp = NegOp | NotOp
  deriving (Show)
data BinOp = PlusOp | MulOp | AndOp | OrOp | EqualsOp
  deriving (Show)

请注意，我们可以直接为此编写一个解释器。但是，解释器必须处理错误类型的表达式，例如：

BinU PlusOp FalseU (NumU 1)   -- False + 1

这会破坏定义静态类型语言的全部目的。

关键是我们可以采用这种无类型语言，在解释它之前，实际上类型检查它！使用 Haskell 类型系统对目标语言进行类型检查有很酷的技术，但是定义一个单独的数据类型来表示表达式类型要容易得多：

-- Simple expression types
data Typ
  = BoolT
  | NumT
  deriving (Show, Eq)

对于我们的运营商来说，给他们也方便"types"：

-- Types of operators
data BinTyp = BinTyp Typ Typ Typ   -- binary ops: two arg types plus result type
data UnTyp  = UnTyp Typ Typ        -- unary ops: arg type plus result type

在具有 first-class 函数的语言中，我们可能会将这些类型组合成一个 Haskell Typ，它不仅可以表示 "primitive" 类型，例如bools 和 nums 还有函数类型，比如 Bool -> Bool -> Bool，等等。但是，对于这种简单的语言，我们将 "expression types" 和 "operator types" 分开。

我们如何处理这些类型？好吧，我们采用无类型表达式 ExprU 并通过向每个表达式添加类型注释来对它们进行类型检查：

-- Typed expressions
data ExprT
  = BoolLit Bool
  | NumLit Double
  | VarT Typ String
  | UnT Typ UnOp ExprT
  | BinT Typ BinOp ExprT ExprT
  | LetT Typ String ExprT ExprT

在这里，每个构造函数（文字除外）都有一个 Typ 字段，它给出了相关表达式的类型。（实际上，我们也可以向文字中添加一个 Typ 字段，即使它是多余的。）使用辅助函数从 ExprT 中提取类型会很有帮助：

exprTyp :: ExprT -> Typ
exprTyp (BoolLit _) = BoolT
exprTyp (NumLit _) = NumT
exprTyp (VarT t _) = t
exprTyp (UnT t _ _) = t
exprTyp (BinT t _ _ _) = t
exprTyp (LetT t _ _ _) = t

类型检查将在跟踪变量类型的 monad 中进行（这是我们无法通过检查表达式立即弄清楚的一件事）：

type TypContext = [(String, Typ)]   -- context of variable types
type TC = ExceptT Error (Reader TypContext)

现在，我们可以只使用字符串作为类型错误：

type Error = String

我们的类型检查器非常容易编写。我采用无类型表达式 ExprU，并添加适当的类型注释以生成 ExprT:

tc :: ExprU -> TC ExprT

创建 "typed version" 文字很容易：

tc (FalseU) = pure $ BoolLit False
tc (TrueU) = pure $ BoolLit True
tc (NumU x) = pure $ NumLit x

在我们的语言中，变量的类型也很简单。我们只允许在定义变量之后使用变量（通过 LetU 绑定——见下文），因此它们的类型在当前上下文中始终可用：

tc (VarU var) = do
  mt <- asks (lookup var)
  case mt of
    Just t -> pure $ VarT t var
    Nothing -> throwError $ "undefined variable " ++ var

一元运算符的类型很简单。仅有的两个一元运算符是 "negate" 和 "not"，它们都只适用于一种参数类型并产生一种结果类型。 where 子句中的 unTyp 函数告诉我们 UnTyp 我们的一元运算符有什么：

tc (UnU op e) = do
  let UnTyp targ tresult = unTyp op
  e' <- tc e
  let t = exprTyp e'
  when (t /= targ) $ throwError $ "op " ++ show op ++ 
    " expected arg of type " ++ show targ ++ ", got " ++ show t
  pure $ UnT tresult op e'
  where
    unTyp NegOp = UnTyp NumT NumT
    unTyp NotOp = UnTyp BoolT BoolT

对于二元运算符，EqualsOp有点复杂。我们想要实现一些特别的多态性，以便它可以应用于布尔值和数字，尽管我们将要求类型匹配（因此 False == 1 是不允许的）。因此，我们将检查参数的类型并确保它们匹配。但是，无论参数是什么类型，BinU EqualsOp _ _ 表达式的类型始终是布尔值，因此类型化版本始终是 BinT BootT EqualsOp _ _:

tc (BinU EqualsOp e1 e2) = do
  e1' <- tc e1
  e2' <- tc e2
  let t1 = exprTyp e1'
      t2 = exprTyp e2'
  when (t1 /= t2) $ throwError $ "op EqualOp needs to compare equal types"
  pure $ BinT BoolT EqualsOp e1' e2'

其他二元运算符是单型的，所以我们像上面的（单型）一元运算符一样处理它们：

tc (BinU op e1 e2) = do
  let BinTyp targ1 targ2 tresult = binTyp op
  e1' <- tc e1
  e2' <- tc e2
  let t1 = exprTyp e1'
      t2 = exprTyp e2'
  when (t1 /= targ1) $ throwError $ "op " ++ show op ++
    " expected left arg of type " ++ show targ1 ++ ", got " ++ show t1
  when (t2 /= targ2) $ throwError $ "op " ++ show op ++
    " expected right arg of type " ++ show targ2 ++ ", got " ++ show t2
  pure $ BinT tresult op e1' e2'
  where
    binTyp PlusOp = BinTyp NumT NumT NumT
    binTyp MulOp = BinTyp NumT NumT NumT
    binTyp AndOp = BinTyp BoolT BoolT BoolT
    binTyp OrOp = BinTyp BoolT BoolT BoolT
    binTyp EqualsOp = error "internal error"

您可能认为 LetU 表达式的类型检查很复杂，但这非常简单。对于let x=exp1 in exp2，我们只是计算exp1的类型，然后在计算exp2的类型时将x的那个类型添加到类型上下文中：

tc (LetU var e1 e2) = do
  e1' <- tc e1
  let t1 = exprTyp e1'
  e2' <- local ((var,t1):) $ tc e2
  let t2 = exprTyp e2'
  pure $ LetT t2 var e1' e2'

这就是类型检查器的全部内容。

一旦类型检查器运行创建一个具有声音类型的 ExprT，我们将要对其进行评估。我们将表达式的值表示为：

-- Values
data Value
  = BoolV Bool
  | NumV Double
  deriving (Show)

评估将在具有为变量赋值的上下文的 monad 中进行：

type ValContext = [(String, Value)]   -- context of variable values
type E = Reader ValContext

请注意，我们在这里不需要 ExceptT 转换器。事实证明，经过类型检查的程序在我们的语言中不会产生运行次错误。

evaluator/interpreter:

eval :: ExprT -> E Value

以显而易见的方式评估文字：

eval (BoolLit b) = pure $ BoolV b
eval (NumLit x) = pure $ NumV x

在当前上下文中查找变量值：

eval (VarT _ var) = do
  mt <- asks (lookup var)
  case mt of
    Just v -> pure $ v
    Nothing -> internalerror

请注意，类型检查器已经确保变量仅在定义时使用，因此查找失败 "can't happen"。我们使用函数 internalerror（定义如下）来满足编译器所有情况都已处理，这样我们就可以避免警告，但是 internalerror 不会被调用，除非我们的解释器中存在错误。

一元运算符的解释如下：

eval (UnT _ op e) = run op <$> eval e
  where run NegOp (NumV x) = NumV (-x)
        run NotOp (BoolV b) = BoolV (not b)
        run _ _ = internalerror

同样，由于类型检查器，我们不能将 NegOp 应用于布尔值或将 NotOp 应用于数字，因此此处缺少的情况（例如 run NegOp (BoolV b)) 不可能发生。不幸的是，这意味着我们失去了启用 -Wall 的一些好处——如果我们忘记处理一个新的运算符，它将在运行时抛出一个 internalerror。 <插入悲伤的表情符号>

二元运算符的解释类似：

eval (BinT _ op e1 e2) = run op <$> eval e1 <*> eval e2
  where run EqualsOp (BoolV v1) (BoolV v2) = BoolV $ v1 == v2
        run EqualsOp (NumV v1) (NumV v2) = BoolV $ v1 == v2
        run PlusOp (NumV v1) (NumV v2) = NumV $ v1 + v2
        run MulOp (NumV v1) (NumV v2) = NumV $ v1 * v2
        run AndOp (BoolV v1) (BoolV v2) = BoolV $ v1 && v2
        run OrOp (BoolV v1) (BoolV v2) = BoolV $ v1 || v2
        run _ _ _ = internalerror

因为 Haskell == 运算符是多态的，我们可以向 Value 类型添加一个 Eq 实例，并将前两种情况替换为：

  where run EqualsOp v1 v2 = BoolV $ v1 == v2

但我想说明一个事实，即 EqualsOp (BoolV v1) (NumV v2) 永远不会发生在类型检查程序中。

最后，我们这样处理LetT：

eval (LetT _ var e1 e2) = do
  v1 <- eval e1
  local ((var,v1):) $ eval e2

那是我们的evaluator/interpreter。

有一点值得注意。在我们对 eval 的定义中，我们实际上从未引用 tc 添加的类型注释！出于这个原因，我们实际上可以编写 eval 来解释原始的未类型化 ExprU，因为 tc 完成这一事实足以确保 ExprU 可以在没有类型的情况下被解释运行时间类型错误。也就是说，在这种简单的语言中，程序类型检查的事实比类型检查期间计算的类型重要得多。在更复杂的语言中，类型注释可能更有用。

总之，就是这样。这是完整的代码加上目标语言的示例程序 expr1：

{-# OPTIONS_GHC -Wall #-}

import Control.Monad
import Control.Monad.Reader
import Control.Monad.Except

-- Untyped expressions
data ExprU
  = FalseU | TrueU           -- boolean literals
  | NumU Double              -- numeric literal
  | VarU String              -- variable
  | UnU UnOp ExprU           -- unary operator
  | BinU BinOp ExprU ExprU   -- binary operator
  | LetU String ExprU ExprU  -- let x = expr1 in expr2
data UnOp = NegOp | NotOp
  deriving (Show)
data BinOp = PlusOp | MulOp | AndOp | OrOp | EqualsOp
  deriving (Show)

-- Simple expression types
data Typ
  = BoolT
  | NumT
  deriving (Show, Eq)

-- Types of operators
data BinTyp = BinTyp Typ Typ Typ
data UnTyp  = UnTyp Typ Typ

-- Typed expressions
data ExprT
  = BoolLit Bool
  | NumLit Double
  | VarT Typ String
  | UnT Typ UnOp ExprT
  | BinT Typ BinOp ExprT ExprT
  | LetT Typ String ExprT ExprT

exprTyp :: ExprT -> Typ
exprTyp (BoolLit _) = BoolT
exprTyp (NumLit _) = NumT
exprTyp (VarT t _) = t
exprTyp (UnT t _ _) = t
exprTyp (BinT t _ _ _) = t
exprTyp (LetT t _ _ _) = t

-- Type check an expression
type Error = String
type TypContext = [(String, Typ)]   -- context of variable types
type TC = ExceptT Error (Reader TypContext)
runTC :: TC a -> a
runTC act = case runReader (runExceptT act) [] of
  Left err -> error err
  Right a -> a

tc :: ExprU -> TC ExprT
tc (FalseU) = pure $ BoolLit False
tc (TrueU) = pure $ BoolLit True
tc (NumU x) = pure $ NumLit x
tc (VarU var) = do
  mt <- asks (lookup var)
  case mt of
    Just t -> pure $ VarT t var
    Nothing -> throwError $ "undefined variable " ++ var
tc (UnU op e) = do
  let UnTyp targ tresult = unTyp op
  e' <- tc e
  let t = exprTyp e'
  when (t /= targ) $ throwError $ "op " ++ show op ++
    " expected arg of type " ++ show targ ++ ", got " ++ show t
  pure $ UnT tresult op e'
  where
    unTyp NegOp = UnTyp NumT NumT
    unTyp NotOp = UnTyp BoolT BoolT
tc (BinU EqualsOp e1 e2) = do
  e1' <- tc e1
  e2' <- tc e2
  let t1 = exprTyp e1'
      t2 = exprTyp e2'
  when (t1 /= t2) $ throwError $ "op EqualOp needs to compare equal types"
  pure $ BinT BoolT EqualsOp e1' e2'
tc (BinU op e1 e2) = do
  let BinTyp targ1 targ2 tresult = binTyp op
  e1' <- tc e1
  e2' <- tc e2
  let t1 = exprTyp e1'
      t2 = exprTyp e2'
  when (t1 /= targ1) $ throwError $ "op " ++ show op ++
    " expected left arg of type " ++ show targ1 ++ ", got " ++ show t1
  when (t2 /= targ2) $ throwError $ "op " ++ show op ++
    " expected right arg of type " ++ show targ2 ++ ", got " ++ show t2
  pure $ BinT tresult op e1' e2'
  where
    binTyp PlusOp = BinTyp NumT NumT NumT
    binTyp MulOp = BinTyp NumT NumT NumT
    binTyp AndOp = BinTyp BoolT BoolT BoolT
    binTyp OrOp = BinTyp BoolT BoolT BoolT
    binTyp EqualsOp = error "internal error"
tc (LetU var e1 e2) = do
  e1' <- tc e1
  let t1 = exprTyp e1'
  e2' <- local ((var,t1):) $ tc e2
  let t2 = exprTyp e2'
  pure $ LetT t2 var e1' e2'

-- Evaluate a typed expression
internalerror :: a
internalerror = error "can't happen, internal error in type checker"

-- Values
data Value
  = BoolV Bool
  | NumV Double
  deriving (Show)

type ValContext = [(String, Value)]   -- context of variable values
type E = Reader ValContext
runE :: E a -> a
runE act = runReader act []

eval :: ExprT -> E Value
eval (BoolLit b) = pure $ BoolV b
eval (NumLit x) = pure $ NumV x
eval (VarT _ var) = do
  mt <- asks (lookup var)
  case mt of
    Just v -> pure $ v
    Nothing -> internalerror
eval (UnT _ op e) = run op <$> eval e
  where run NegOp (NumV x) = NumV (-x)
        run NotOp (BoolV b) = BoolV (not b)
        run _ _ = internalerror
eval (BinT _ op e1 e2) = run op <$> eval e1 <*> eval e2
  where run EqualsOp (BoolV v1) (BoolV v2) = BoolV $ v1 == v2
        run EqualsOp (NumV v1) (NumV v2) = BoolV $ v1 == v2
        run PlusOp (NumV v1) (NumV v2) = NumV $ v1 + v2
        run MulOp (NumV v1) (NumV v2) = NumV $ v1 * v2
        run AndOp (BoolV v1) (BoolV v2) = BoolV $ v1 && v2
        run OrOp (BoolV v1) (BoolV v2) = BoolV $ v1 || v2
        run _ _ _ = internalerror
eval (LetT _ var e1 e2) = do
  v1 <- eval e1
  local ((var,v1):) $ eval e2

expr1 :: ExprU
expr1 = LetU "x" (BinU PlusOp (NumU 2) (NumU 3)) (LetU "y" (BinU MulOp (VarU "x") (NumU 5)) (BinU EqualsOp (VarU "y") (NumU 25)))

val1 :: Value
val1 = let e1' = runTC (tc expr1) in runE (eval e1')

main :: IO ()
main = do
  print $ val1

设计简单静态类型语言的类型系统（Haskell）

Designing the type system of a simple statically typed language (in Haskell)

interpreter

haskell

type-systems

functional-programming