跳转至内容

在 48 小时内编写你自己的 Scheme/评估，第二部分

Add links
来自维基教科书，开放书籍，开放世界
在 48 小时内编写你自己的 Scheme
 ← 错误检查和异常 评估，第二部分 构建一个 REPL → 

附加原语：部分应用

[编辑 | 编辑源代码]

现在我们能够处理类型错误、错误参数等等，我们将充实我们的基本列表，使其不仅能进行计算，还能做更多的事情。我们将添加布尔运算符、条件语句和一些基本字符串操作。

首先将以下内容添加到基本列表中：

("=", numBoolBinop (==)),
("<", numBoolBinop (<)),
(">", numBoolBinop (>)),
("/=", numBoolBinop (/=)),
(">=", numBoolBinop (>=)),
("<=", numBoolBinop (<=)),
("&&", boolBoolBinop (&&)),
("||", boolBoolBinop (||)),
("string=?", strBoolBinop (==)),
("string<?", strBoolBinop (<)),
("string>?", strBoolBinop (>)),
("string<=?", strBoolBinop (<=)),
("string>=?", strBoolBinop (>=)),

这些依赖于我们还没有编写的辅助函数：numBoolBinop、boolBoolBinop 和 strBoolBinop。它们不像接收可变数量的参数并返回一个整数那样，而是接收正好两个参数并返回一个布尔值。它们的区别仅仅在于它们所期望的参数类型，因此我们将重复部分分解成一个通用的 boolBinop 函数，该函数根据它应用于其参数的解包函数进行参数化。

boolBinop :: (LispVal -> ThrowsError a) -> (a -> a -> Bool) -> [LispVal] -> ThrowsError LispVal
boolBinop unpacker op args = if length args /= 2 
                             then throwError $ NumArgs 2 args
                             else do left <- unpacker $ args !! 0
                                      right <- unpacker $ args !! 1
                                      return $ Bool $ left `op` right

因为每个参数都可能抛出类型不匹配异常，所以我们必须在 do 块中（用于 Error 单子）按顺序解包它们。然后，我们将操作应用于两个参数，并将结果包装在 Bool 构造函数中。任何函数都可以通过用反引号（`op`）将其包装成中缀运算符。

另外，请查看类型签名。boolBinop 将 *两个* 函数作为其前两个参数：第一个用于将参数从 LispVal 解包到原生 Haskell 类型，第二个是实际要执行的操作。通过参数化行为的不同部分，使函数更具可重用性。

现在我们定义三个函数，这些函数用不同的解包器专门化 boolBinop

numBoolBinop  = boolBinop unpackNum
strBoolBinop  = boolBinop unpackStr
boolBoolBinop = boolBinop unpackBool

我们还没有告诉 Haskell 如何从 LispVal 中解包字符串。这与 unpackNum 类似，对值进行模式匹配，要么返回它，要么抛出错误。同样，如果传递了一个可以解释为字符串的基本值（例如数字或布尔值），它将静默地将其转换为字符串表示形式。

unpackStr :: LispVal -> ThrowsError String
unpackStr (String s) = return s
unpackStr (Number s) = return $ show s
unpackStr (Bool s)   = return $ show s
unpackStr notString  = throwError $ TypeMismatch "string" notString

我们使用类似的代码来解包布尔值

unpackBool :: LispVal -> ThrowsError Bool
unpackBool (Bool b) = return b
unpackBool notBool  = throwError $ TypeMismatch "boolean" notBool

让我们编译并测试一下，以确保它能正常工作，然后我们继续下一个功能

$ ghc -package parsec -o simple_parser [../code/listing6.1.hs listing6.1.hs]
$ ./simple_parser "(< 2 3)"
#t
$ ./simple_parser "(> 2 3)"
#f
$ ./simple_parser "(>= 3 3)"
#t
$ ./simple_parser "(string=? \"test\"  \"test\")"
#t
$ ./simple_parser "(string<? \"abc\" \"bba\")"
#t

条件语句：模式匹配 2

[编辑 | 编辑源代码]

现在，我们将继续为我们的评估器添加一个 if 子句。与标准 Scheme 一样，我们的评估器将 #f 视为假，将任何其他值视为真

eval (List [Atom "if", pred, conseq, alt]) = 
     do result <- eval pred
        case result of
             Bool False -> eval alt
             otherwise  -> eval conseq

由于函数定义按顺序进行评估，因此请确保将此函数放在 eval (List (Atom func : args)) = mapM eval args >>= apply func 之上，否则它将抛出一个 Unrecognized primitive function args: "if" 错误。

这是嵌套模式匹配的另一个例子。这里，我们正在寻找一个包含 4 个元素的列表。第一个元素必须是原子 if。其他元素可以是任何 Scheme 表达式。我们取第一个元素，进行评估，如果它是假，则评估备选方案。否则，我们评估结果。

编译并运行它，你就可以尝试条件语句了

$ ghc -package parsec -o simple_parser [../code/listing6.2.hs listing6.2.hs]
$ ./simple_parser "(if (> 2 3) \"no\" \"yes\")"
"yes"
$ ./simple_parser "(if (= 3 3) (+ 2 3 (- 5 1)) \"unequal\")"
9

列表原语：car、cdr 和 cons

[编辑 | 编辑源代码]

为了更好地衡量，我们还将添加基本列表处理原语。因为我们选择将列表表示为 Haskell 代数数据类型而不是对，所以这些原语比许多 Lisp 中的定义要复杂一些。最容易理解它们的方式是根据它们对打印的 S 表达式的影响

  1. (car '(a b c)) = a
  2. (car '(a)) = a
  3. (car '(a b . c)) = a
  4. (car 'a) = error – 不是列表
  5. (car 'a 'b) = error – car 只接受一个参数

我们可以相当直接地将它们翻译成模式子句，回想起 (x : xs) 将一个列表划分为第一个元素和其余部分

car :: [LispVal] -> ThrowsError LispVal
car [List (x : xs)]         = return x
car [DottedList (x : xs) _] = return x
car [badArg]                = throwError $ TypeMismatch "pair" badArg
car badArgList              = throwError $ NumArgs 1 badArgList

让我们用 cdr 做同样的事情

  1. (cdr '(a b c)) = (b c)
  2. (cdr '(a b)) = (b)
  3. (cdr '(a)) = NIL
  4. (cdr '(a . b)) = b
  5. (cdr '(a b . c)) = (b . c)
  6. (cdr 'a) = error – 不是列表
  7. (cdr 'a 'b) = error – 太多参数了

我们可以用一个子句来表示前三个情况。我们的解析器将 '() 表示为 List []，当你将 (x : xs) 与 [x] 进行模式匹配时，xs 被绑定到 []。其他情况则翻译成单独的子句

cdr :: [LispVal] -> ThrowsError LispVal
cdr [List (x : xs)]         = return $ List xs
cdr [DottedList [_] x]      = return x
cdr [DottedList (_ : xs) x] = return $ DottedList xs x
cdr [badArg]                = throwError $ TypeMismatch "pair" badArg
cdr badArgList              = throwError $ NumArgs 1 badArgList

cons 有点棘手，我们需要逐个案例地讨论每个子句。如果你将任何东西与 Nil 进行 cons 操作，你最终会得到一个包含一个元素的列表，Nil 充当终止符

cons :: [LispVal] -> ThrowsError LispVal
cons [x1, List []] = return $ List [x1]

如果你将任何东西与一个列表进行 cons 操作，就像将该东西添加到列表的开头

 
cons [x, List xs] = return $ List $ x : xs

但是，如果列表是一个 DottedList，那么它应该保持为 DottedList，并考虑到不完整的尾部

cons [x, DottedList xs xlast] = return $ DottedList (x : xs) xlast

如果你将两个非列表进行 cons 操作，或者将一个列表放在前面，你将得到一个 DottedList。这是因为这样的 cons 单元格并没有像大多数列表那样以正常的 Nil 结束。

cons [x1, x2] = return $ DottedList [x1] x2

最后，试图将两个以上或以下的参数进行 cons 操作都是错误的

cons badArgList = throwError $ NumArgs 2 badArgList

我们的最后一步是实现 eqv?。Scheme 提供了三种级别的等价谓词：eq?、eqv? 和 equal?。对于我们的目的，eq? 和 eqv? 基本上是一样的：如果它们打印出来一样，则会识别出两个项目是相同的，并且速度相当慢。因此，我们可以为它们编写一个函数，并在 eq? 和 eqv? 下注册它。

eqv :: [LispVal] -> ThrowsError LispVal
eqv [(Bool arg1), (Bool arg2)]             = return $ Bool $ arg1 == arg2
eqv [(Number arg1), (Number arg2)]         = return $ Bool $ arg1 == arg2
eqv [(String arg1), (String arg2)]         = return $ Bool $ arg1 == arg2
eqv [(Atom arg1), (Atom arg2)]             = return $ Bool $ arg1 == arg2
eqv [(DottedList xs x), (DottedList ys y)] = eqv [List $ xs ++ [x], List $ ys ++ [y]]
eqv [(List arg1), (List arg2)]             = return $ Bool $ (length arg1 == length arg2) && 
                                                             (all eqvPair $ zip arg1 arg2)
     where eqvPair (x1, x2) = case eqv [x1, x2] of
                                Left err -> False
                                Right (Bool val) -> val
eqv [_, _]                                 = return $ Bool False
eqv badArgList                             = throwError $ NumArgs 2 badArgList

大多数这些子句是不言自明的，例外的是两个 Lists 的子句。这在确保列表长度相等后，zip 了两个对列表，然后使用函数 all 在 eqvPair 对任何一对返回 False 时返回 False。eqvPair 是局部定义的例子：它是使用 where 关键字定义的，就像普通函数一样，但只能在该特定 eqv 子句中使用。由于我们知道 eqv 只有在参数数量不为 2 时才会抛出错误，因此行 Left err -> False 目前永远不会执行。

equal? 和弱类型：异构列表

[编辑 | 编辑源代码]

既然我们在上面引入了弱类型，我们也希望引入一个 equal? 函数，它会忽略类型标签的差异，只测试两个值是否可以解释为相同的值。例如，(eqv? 2 "2") = #f，但我们希望 (equal? 2 "2") = #t。基本上，我们希望尝试所有解包函数，如果其中任何一个导致 Haskell 值相等，则返回 True。

最显而易见的方法是将解包函数存储在一个列表中，并使用 mapM 按顺序执行它们。不幸的是，这行不通，因为标准 Haskell 只能让你将对象放在一个列表中 *如果它们类型相同*。各种解包函数返回不同的类型，因此你无法将它们存储在同一个列表中。

我们将通过使用 GHC 扩展 - 存在量化类型 - 来解决这个问题，它允许我们创建一个异构列表，并受类型类约束。扩展在 Haskell 世界中相当普遍：它们基本上是创建任何合理的大型程序所必需的，而且它们在不同实现之间通常是兼容的（存在量化类型在 Hugs 和 GHC 中都适用，并且是标准化的候选者）。请注意，你需要为此使用特殊的编译器标志：-fglasgow-exts 如以下所述；或者更新的 -XExistentialQuantification；或者将编译指示 {-# LANGUAGE ExistentialQuantification #-} 添加到代码开头（一般来说，编译器标志 -Xfoo 可以用代码文件中的编译指示 {-# LANGUAGE foo #-} 代替）。

我们需要做的第一件事是定义一个数据类型，它可以容纳从 LispVal -> something 的任何函数，前提是该 something 支持相等性

data Unpacker = forall a. Eq a => AnyUnpacker (LispVal -> ThrowsError a)

这就像任何正常的代数数据类型，除了类型约束。它说，“对于任何是 `Eq` 实例的类型，你可以定义一个 `Unpacker`，它接受一个从 `LispVal` 到该类型的函数，并且可能抛出错误”。我们必须用 `AnyUnpacker` 构造函数包装我们的函数，但之后我们可以创建一个 `Unpacker` 列表，它可以做我们想要做的事情。

与其直接跳到 `equal?` 函数，不如先定义一个辅助函数，它接受一个 `Unpacker`，然后确定两个 `LispVal` 在解包时是否相等。

unpackEquals :: LispVal -> LispVal -> Unpacker -> ThrowsError Bool
unpackEquals arg1 arg2 (AnyUnpacker unpacker) = 
             do unpacked1 <- unpacker arg1
                unpacked2 <- unpacker arg2
                return $ unpacked1 == unpacked2
        `catchError` (const $ return False)

在进行模式匹配以检索实际函数后，我们进入 `ThrowsError` 单子的 do 块。这将检索两个 `LispVal` 的 Haskell 值，然后测试它们是否相等。如果两个解包器中的任何地方出现错误，它将返回 `False`，使用 `const` 函数，因为 `catchError` 期望一个函数来应用于错误值。

最后，我们可以根据这些辅助函数定义 `equal?`。

equal :: [LispVal] -> ThrowsError LispVal
equal [arg1, arg2] = do
      primitiveEquals <- liftM or $ mapM (unpackEquals arg1 arg2) 
                         [AnyUnpacker unpackNum, AnyUnpacker unpackStr, AnyUnpacker unpackBool]
      eqvEquals <- eqv [arg1, arg2]
      return $ Bool $ (primitiveEquals || let (Bool x) = eqvEquals in x)
equal badArgList = throwError $ NumArgs 2 badArgList

第一个操作创建一个 `[unpackNum, unpackStr, unpackBool]` 的异构列表，然后将部分应用的 `(unpackEquals arg1 arg2)` 映射到它上面。这将得到一个布尔值列表，因此我们使用 Prelude 函数 `or` 来返回 true，如果其中任何一个是 true。

第二个操作使用 `eqv?` 测试两个参数。由于我们希望 `equal?` 比 `eqv?` 更宽松，所以当 `eqv?` 返回 true 时，它也应该返回 true。这也让我们避免处理像列表或带点的列表这样的情况（尽管这引入了一个错误；请参阅本节中的练习 #2）。

最后，`equal?` 将这两个值 `or` 起来，并将结果包装在 `Bool` 构造函数中，返回一个 `LispVal`。`let (Bool x) = eqvEquals in x` 是一种从代数类型中提取值的方法：它将 `Bool x` 与 `eqvEquals` 值进行模式匹配，然后返回 `x`。let 表达式的结果是关键字 `in` 后的表达式。

要使用这些函数，请将它们插入我们的基本函数列表中。

("car", car),
("cdr", cdr),
("cons", cons),
("eq?", eqv),
("eqv?", eqv),
("equal?", equal)]

要编译此代码，你需要使用 `-fglasgow-exts` 启用 GHC 扩展。

$ ghc -package parsec -fglasgow-exts -o parser [../code/listing6.4.hs listing6.4.hs]
$ ./parser "(cdr '(a simple test))"
(simple test)
$ ./parser "(car (cdr '(a simple test)))"
simple
$ ./parser "(car '((this is) a test))"
(this is)
$ ./parser "(cons '(this is) 'test)"
((this is) . test)
$ ./parser "(cons '(this is) '())"
((this is))
$ ./parser "(eqv? 1 3)"
#f
$ ./parser "(eqv? 3 3)"
#t
$ ./parser "(eqv? 'atom 'atom)"
#t
练习
  1. 不要将任何非假值视为真值，而是更改 `if` 的定义，以便谓词仅接受 `Bool` 值，并在任何其他值上抛出错误。
  2. equal? 存在一个错误，即使用 `eqv?` 而不是 `equal?` 来比较值列表。例如，` (equal? '(1 "2") '(1 2)) = #f`，而你希望它为 `#t`。更改 `equal?`，使其在递归进入列表结构时继续忽略类型。你可以通过显式地执行此操作，遵循 `eqv?` 中的示例，或者将列表子句分解为一个由相等性测试函数参数化的辅助函数。
  3. 实现 `cond` 和 `case` 表达式。
  4. 添加其余的 字符串函数。你现在还不知道如何做 `string-set!`；这在 Haskell 中很难实现，但你将在接下来的两节中获得足够的信息。


在 48 小时内编写你自己的 Scheme
 ← 错误检查和异常 评估，第二部分 构建一个 REPL → 
取自"https://wikibooks.cn/w/index.php?title=Write_Yourself_a_Scheme_in_48_Hours/Evaluation,_Part_2&oldid=3678299"
华夏公益教科书