Haskell 中的数据导向编程 (SICP 2.4.3)Data-directed programming in Haskell (SICP 2.4.3)

我手头有一本 sicp，也就是众所周知的《巫师书》¹¹《计算机程序的构造和解释》（Structure and Interpretation of Computer Programs；Abelson 和 Sussman 著；MIT Press；1996 年）。这本书广受赞誉，但我抽不出时间通读全书。相反，我打算偶尔跳着读一些看起来有趣的部分。上周，我们探讨了 Haskell 中的带标签数据（tagged data）。sicp 的作者们并不确信那是最佳方案，因此他们转入了数据导向的程序设计（data-directed programming）。我们也将照此进行。

复数有四种基本运算

复数可以以其直角坐标形式（rectangular form）存储，包含实部和虚部。它们也可以以极坐标形式（polar form）存储，包含模和幅角。无论复数以哪种方式存储，我们都希望能够查询其以下所有四个量：

上次我们基于带标签的值（tagged value）实现了这些操作。为了返回上述四个坐标之一，函数会内省（introspect）标签，以确定如何针对所涉及的数据表示满足调用者的需求。这行得通，但每当我们要添加新的数据表示时，就必须修改所有现有的四个操作。

为了解决这个问题，Abelson 和 Sussman 建议改用数据导向的方法。我们不会像上一篇文章那样从 Lisp 的最底层开始，而是直接跳到中间部分，即使用编译器可识别的元组和字符串来为我们的类型打标签。这意味着我们将从以下代码开始：

In[1]:

attach_tag tag contents = (tag, contents)
type_tag (tag, _) = tag
contents (_, value) = value

is_rectangular z = type_tag z == "rectangular"
is_polar z = type_tag z == "polar"

make_rectangular re im = (attach_tag "rectangular" (re, im))
make_polar r a = (attach_tag "polar" (r, a))

在书中，作者使用了两个神奇的函数 get 和 put，来从一个隐式声明的操作表中存储和检索操作。以下是这两个函数在我们的 Haskell 代码中的样子：

In[2]:

put op tag fn =
  State.modify (Map.insert (op, tag) fn)

get op tag =
  State.gets (Map.lookup (op, tag))

我们将使用它们来为直角坐标表示安装操作，就像 sicp 中的 Lisp 代码那样。

In[3]:

install_rectangular =
  let
    real_part (re, _) = re
    imag_part (_, im) = im
    magnitude (re, im) = sqrt (re^2 + im^2)
    angle (re, im) = atan2 im re
  in do
    put "real_part" "rectangular" real_part
    put "imag_part" "rectangular" imag_part
    put "magnitude" "rectangular" magnitude
    put "angle" "rectangular" angle

我们对极坐标表示执行相同的操作。

In[4]:

install_polar =
  let
    real_part (r, a) = r * cos a
    imag_part (r, a) = r * sin a
    magnitude (r, _) = r
    angle (_, a) = a
  in do
    put "real_part" "polar" real_part
    put "imag_part" "polar" imag_part
    put "magnitude" "polar" magnitude
    put "angle" "polar" angle

我们重新实现 sicp 中的 apply_generic 函数，以便从该表中选择正确的操作。

In[5]:

apply_generic op arg = do
  value <- get op (type_tag arg)
  pure $ case value of
    Just fn -> fn (contents arg)
    Nothing -> error "No method for these types."

此操作可用于实现通用的坐标提取函数。

In[6]:

real_part z = apply_generic "real_part" z
imag_part z = apply_generic "imag_part" z
magnitude z = apply_generic "magnitude" z
angle z = apply_generic "angle" z

接着，因为我们是用 Haskell 编写代码，复数的算术运算看起来会有些笨拙。别担心，我们很快就会解决这个问题。

In[7]:

add_complex za zb = do
  za_re <- real_part za
  za_im <- imag_part za
  zb_re <- real_part zb
  zb_im <- imag_part zb
  pure $ make_rectangular (za_re + zb_re) (za_im + zb_im)

mul_complex za zb = do
  za_r <- magnitude za
  za_a <- angle za
  zb_r <- magnitude zb
  zb_a <- angle zb
  pure $ make_polar (za_r * zb_r) (za_a + zb_a)

要用它运行计算，我们必须将其作为有状态计算来运行，即首先安装操作，然后执行计算。它看起来可能是这样的。

In[8]:

main = flip State.evalStateT Map.empty $ do
  install_rectangular
  install_polar
  zc <- add_complex (make_polar 4 0.3) (make_rectangular 3 2)
  s <- show_complex zc
  liftIO (putStrLn s)

太棒了！我们能做 Lisp 能做的事。

转向纯表

虽然这看起来像是一种倒退，但我们将摒弃隐式操作表，转而显式地指定它。不再是使用安装函数去修改操作表，而是每个安装函数都将返回它们各自负责的那部分表内容。

In[9]:

rectangular =
  let
    real_part (re, _) = re
    imag_part (_, im) = im
    magnitude (re, im) = sqrt (re^2 + im^2)
    angle (re, im) = atan2 im re
  in
    Map.fromList
      [ (("real_part", "rectangular"), real_part)
      , (("imag_part", "rectangular"), imag_part)
      , (("magnitude", "rectangular"), magnitude)
      , (("angle", "rectangular"), angle)
      ]

polar =
  let
    real_part (r, a) = r * cos a
    imag_part (r, a) = r * sin a
    magnitude (r, _) = r
    angle (_, a) = a
  in
    Map.fromList
      [ (("real_part", "polar"), real_part)
      , (("imag_part", "polar"), imag_part)
      , (("magnitude", "polar"), magnitude)
      , (("angle", "polar"), angle)
      ]

当我们修改 apply_generic 函数以将表作为显式参数传入时，我们也必须更新其他的通用方法。

In[10]:

apply_generic table op arg = do
  case Map.lookup (op, type_tag arg) table of
    Just fn -> fn (contents arg)
    Nothing -> error "No method for these types."

real_part table z = apply_generic table "real_part" z
imag_part table z = apply_generic table "imag_part" z
magnitude table z = apply_generic table "magnitude" z
angle table z = apply_generic table "angle" z

最后，我们必须对算术运算做同样的处理。

In[11]:

add_complex table za zb =
  make_rectangular
    (real_part table za + real_part table zb)
    (imag_part table za + imag_part table zb)

mul_complex table za zb =
  make_polar
    (magnitude table za * magnitude table zb)
    (angle table za + angle table zb)

现在我们可以完全以纯函数的方式进行计算，没有任何隐式状态。在开始之前，我们将每种值类型的表合并在一起。

In[12]:

main =
  let
    table = rectangular <> polar
    za = make_polar 4 0.3
    zb = make_rectangular 3 2
    zc = add_complex table za zb
  in
    putStrLn (show_complex table zc)

显式的表引用让代码变得稍微啰嗦了一些，但它们为我们接下来要使用的下一个语言特性充当了很好的垫脚石。

语言本身也支持这一点

通过显式的表引用，我们实际上构建了一个伪装的类型类。我们可以将它正式定义出来，让编译器明白我们的意图。

In[13]:

class Complex z where
  real_part :: z -> Double
  imag_part :: z -> Double
  magnitude :: z -> Double
  angle :: z -> Double

接下来，我们需要为复数的两种表示形式分别定义自定义类型。首先定义直角坐标存储的类型，并为它实现类型类中的通用方法。

In[14]:

data Rectangular = Rectangular Double Double

instance Complex Rectangular where
  real_part (Rectangular re _) = re
  imag_part (Rectangular _ im) = im
  magnitude (Rectangular re im) = sqrt (re^2 + im^2)
  angle (Rectangular re im) = atan2 im re

然后我们对极坐标做同样的处理。

In[15]:

data Polar = Polar Double Double

instance Complex Polar where
  real_part (Polar r a) = r * cos a
  imag_part (Polar r a) = r * sin a
  magnitude (Polar r _) = r
  angle (Polar _ a) = a

在上一篇文章中，Rectangular 和 Polar 是同一个类型 Complex 的两个构造器。而在这里，Rectangular 和 Polar 是两个完全不同的类型。就编译器而言，它们唯一的共同点是都实现了 Complex 接口。

既然我们已经接入了语言机制，就可以移除所有其他代码，用这些函数来替换算术运算。

In[16]:

add_complex za zb =
  Rectangular
    (real_part za + real_part zb)
    (imag_part za + imag_part zb)

mul_complex za zb =
  Polar
    (magnitude za * magnitude zb)
    (angle za + angle zb)

简洁优雅！

将不同表示形式统一对待

这种在 Haskell 中的表示方式的缺点在于，由于 Rectangular 和 Polar 被视为不同的类型，我们无法创建包含两种表示形式的同构数据结构（比如列表）。换句话说，即使我们只关心列表中作为通用复数的元素，以下代码也会产生类型错误：

In[17]:

let
  za = Polar 4 0.3
  zb = Rectangular 3 2
  zs = [za, zb]  -- ! Couldn't match expected type …
in
  foldl1 add_complex zs

这曾让作为 Haskell 初学者的我困惑了很久，但幸运的是，Haskell 也为此提供了一个非常优雅的解决方案。我们可以创建一种称为存在量化类型的东西，用来表达这样一个概念——"这里有一个值，除了知道它是一个复数之外，我们对它一无所知。"

In[18]:

data AnyComplex = forall z. Complex z => AnyComplex z

在这个类型上实现复数的通用方法非常简单，只需将调用转发给底层值即可。我们之所以能这样做，是因为虽然不知道底层值的具体类型，但我们知道它支持这些操作。

In[19]:

instance Complex AnyComplex where
  real_part (AnyComplex z) = real_part z
  imag_part (AnyComplex z) = imag_part z
  magnitude (AnyComplex z) = magnitude z
  angle (AnyComplex z) = angle z

现在我们可以创建那个列表了，并把它当作复数列表来操作：

In[20]:

let
  za = Polar 4 0.3
  zb = Rectangular 3 2
  zs = [AnyComplex za, AnyComplex zb]
in
  foldl1 add_complex zs

关键在于，AnyComplex 包装器没有类型参数，因为它已经将具体类型隐藏在自身内部了。这意味着编译器看来，AnyComplex 类型的任何两个值看起来都是一样的，尽管它们底层的实现各不相同。

让返回值也具有通用性

Abelson 和 Sussman 在 SICP 中从未做过的一件事，就是让算术函数的返回值也具有通用性——而现在我们有了类型类这套机制，这件事变得很容易。目前，如果我们调用 add_complex，返回的复数会以直角坐标形式存储。但我们可能并不想要这样。

为了避免这种情况，我们可以在类型类定义中添加通用的构造函数。这样我们就可以用直角坐标构造以极坐标形式存储的复数，反之亦然。

In[21]:

class Complex z where
  --------------- >8 -----
  fromRectangular :: Double -> Double -> z
  fromPolar :: Double -> Double -> z

我们为直角坐标和极坐标两种类型都实现了这些方法。

In[22]:

instance Complex Rectangular where
  --------------- >8 -----
  fromRectangular re im = Rectangular re im
  fromPolar r a =
    Rectangular (r * cos a) (r * sin a)

instance Complex Polar where
  --------------- >8 -----
  fromPolar r a = Polar r a
  fromRectangular re im =
    Polar (sqrt (re^2 + im^2)) (atan2 im re)

我们还为 AnyComplex 包装器实现了它们。对于包装器来说，我们可以自由地为 fromRectangular 选择 Rectangular 表示形式，fromPolar 也类似处理。

In[23]:

instance Complex AnyComplex where
  --------------- >8 -----
  fromRectangular re im = AnyComplex (Rectangular re im)
  fromPolar r a = AnyComplex (Polar r a)

现在我们可以用这些新的通用转换函数来实现算术函数了。

In[24]:

add_complex za zb =
  fromRectangular
    (real_part za + real_part zb)
    (imag_part za + imag_part zb)

mul_complex za zb =
  fromPolar
    (magnitude za * magnitude zb)
    (angle za + angle zb)

这样一来，调用方代码就可以决定想要哪种返回形式的表示。如果希望结果以直角坐标形式存储，可以这样写：

In[25]:

zc :: Rectangular = add_complex za zb

但如果更想要极坐标表示，可以改成这样：

In[26]:

zc :: Polar = add_complex za zb

如果想要以 AnyComplex 值的形式返回结果，也没问题！同一个函数就能支持返回所有表示形式。这非常酷。

类型类本质上就是函数字典

类型类在幕后的工作原理，实际上与我们手动实现操作字典时非常相似。如果我们回想一下在那段代码中 add_complex 的类型会是什么样，我们大概会得出类似这样的结果：

In[27]:

add_complex
  :: Map (Op_Name, Type_tag) (Complex -> Double)
  -> Complex
  -> Complex
  -> Complex
add_complex table za zb =
  make_rectangular
    (real_part table za + real_part table zb)
    (imag_part table za + imag_part table zb)

第一个参数，也就是那个字典，携带了接口的实现，这让我们能够处理参数，而无需关心它们是如何存储的。在基于类型类的版本中，我们可以转而将其视为具有类似这样的类型签名：

In[28]:

add_complex :: Complex z => z -> z -> z
add_complex za zb =
  fromRectangular
    (real_part za + real_part zb)
    (imag_part za + imag_part zb)

双横线箭头之前的第一个类型类约束，隐式地携带了那个操作字典。但这实际上是同一回事。

一切顺利

因此，实现这个功能原本需要大约 80 行 Lisp 代码，现在使用类型类只需 35 行多一点就能完成同样的事情。如果算上对返回值进行泛化的附加功能，也只有 45 行，而这是 Lisp 代码所不支持的。

除了代码更短之外，我们还把错误变成了编译时错误，而不是半夜响起的警报。编译器确切地知道类型类字典中有哪些方法，也确切地知道哪些值实现了该类型类，因此我们根本不可能意外地去调用一个不存在的方法，或者试图在一个不支持该方法的值上调用它。

显式字典支持而类型类不支持的一点是，动态扩展可用的泛型操作集合。类型类的操作集合在编译时是固定的，这有利于安全性、性能等。扩展类型类的典型解决方案是创建带有扩展功能的新类型类，然后在需要使用扩展方法集的调用处引入这些约束。这并不像看起来那么严重，因为如果不首先修改现有代码，我们绝不需要让现有代码能够使用扩展的方法集。