OCaml 杂记：用对象代数解决表达式问题

众所周知，在 FPL 和 OOPL 中都普遍存在着表达式问题（expression problem）。本文使用 OCaml 语言，用对象代数（object algebra）的方式来「解决」这个问题。

~~实际上是对着 Haskell 中 tagless final 的实现写出来的……~~

遇到的问题：expression problem

我们先来说一下什么是 expression problem。首先我们假设想在 OCaml 中搞一个整数加减运算语言的解释器，我们第一想法肯定是写个 ADT 来表示这套语言的 AST：

type t =
  | Lit of int
  | Add of t * t
  | Sub of t * t

然后可以很愉快的写出一个解释器：

let rec eval = function
  | Lit x -> x
  | Add (a, b) -> eval a + eval b
  | Sub (a, b) -> eval a - eval b

假设到目前为止的这一套代码存在于某A模块中，那么我们在另一个模块中也可以轻而易举的写出打印表达式的函数：

open A

let rec show = function
  | Lit x -> string_of_int x
  | Add (a, b) -> "(" ^ a ^ " + " ^ b ^ ")"
  | Sub (a, b) -> "(" ^ a ^ " - " ^ b ^ ")"

不仅如此，我们再实现一个 pretty printing 也很容易，不需要去修改A中的代码。但是问题来了：假设我们想给我们的语言引入乘法除法，该怎么办？

这种情况下，我们无可避免的要去修改已经写出来的所有代码，然而很可能我们是不能（或者很难）对A进行侵入式的修改的。

解决方案：object algebra

object algebra 的思想其实和 visitor pattern 有点像，就是把 ADT 中的构造器变成类的方法。这样我们原来的t就该写成如下抽象类了：

class virtual ['a] expression =
  object
    method virtual lit : int -> 'a
    method virtual add : 'a -> 'a -> 'a
    method virtual sub : 'a -> 'a -> 'a
  end

为了下面使用方便，引入与这三个虚函数对应的封装函数：

let lit (x : int) ro = ro#lit x
let add x y ro = ro#add (x ro) (y ro)
let sub x y ro = ro#sub (x ro) (y ro)

这样就能避免之后构造表达式时写大量的方法调用代码。

原来的eval和show函数现在就需要转写成expression的子类，思路和 visitor pattern 基本上如出一辙：

class eval =
  object
    inherit [int] expression

    method lit x = x
    method add x y = x + y
    method sub x y = x - y
  end

class show =
  object
    inherit [string] expression

    method lit x = string_of_int x
    method add x y = "(" ^ x ^ " + " ^ y ^ ")"
    method sub x y = "(" ^ x ^ " - " ^ y ^ ")"
  end

接下来为了测试，我们用上面的形式编写一个表达式：

let exp_1 ro = sub (add (lit 114) (lit 514)) (sub (lit 1919) (lit 810)) ro

可以看到，这个表达式完全不比用 ADT 时的形式复杂。不过这里我们刻意没有利用 currying，而是两边都写上了ro，目的是为了避免 value restriction 带来的不利影响。

然后小小的测试一下：

Printf.printf "%S : %i\n" (exp_1 (new show)) (exp_1 (new eval))

输出结果是：

"((114 + 514) - (1919 - 810))" : -481

这和手算结果也是一致的。

扩展

假设以上内容写在模块ObjAlg里，现在我们想在另一个模块（不妨设为ObjAlgExt）里扩展这套语言、加入乘除法，该怎么做？

其实懂上面的设计思路，下面的扩展基本就轻车熟路了。首先我们写个新的expression抽象类继承ObjAlg里那个：

class virtual ['a] expression =
  object
    inherit ['a] ObjAlg.expression

    method virtual mult : 'a -> 'a -> 'a
    method virtual quot : 'a -> 'a -> 'a
  end

还是类似的辅助函数：

let mult a b ro = ro#mult (a ro) (b ro)
let quot a b ro = ro#quot (a ro) (b ro)

至于eval和show也是直接继承ObjAlg里的那个来扩展：

class eval =
  object
    inherit [int] expression
    inherit ObjAlg.eval

    method mult a b = a * b
    method quot a b = a / b
  end

class show =
  object
    inherit [string] expression
    inherit ObjAlg.show

    method mult a b = "(" ^ a ^ " * " ^ b ^ ")"
    method quot a b = "(" ^ a ^ " / " ^ b ^ ")"
  end

我们现在构造一个新的表达式（注意这里直接复用之前的exp_1）：

let exp_2 ro =
  let open ObjAlg in
  (quot (sub exp_1 (mult exp_1 (lit 2))) (lit 48)) ro

再测试一小下：

Printf.printf "%S : %i\n" (exp_2 (new show)) (exp_2 (new eval))

结果：

"((((114 + 514) - (1919 - 810)) - (((114 + 514) - (1919 - 810)) * 2)) / 48)" : 10

这个结果是完全符合预期的。

题外话

不知道读者有没有注意到一点：这里设计的两个抽象类expression是不必要的。因为，我们这里涉及到的所有辅助函数以及构造出的表达式的类型是这样的：

val lit : int -> < lit : int -> 'a; .. > -> 'a
val add :
  ((< add : 'b -> 'c -> 'd; .. > as 'a) -> 'b) -> ('a -> 'c) -> 'a -> 'd
val sub :
  ((< sub : 'b -> 'c -> 'd; .. > as 'a) -> 'b) -> ('a -> 'c) -> 'a -> 'd
  
val mult :
  ((< mult : 'b -> 'c -> 'd; .. > as 'a) -> 'b) -> ('a -> 'c) -> 'a -> 'd
val quot :
  ((< quot : 'b -> 'c -> 'd; .. > as 'a) -> 'b) -> ('a -> 'c) -> 'a -> 'd
  
val exp_1 :
  < add : 'a -> 'a -> 'a; lit : int -> 'a; sub : 'a -> 'a -> 'a; .. > -> 'a
val exp_2 :
  < add : 'a -> 'a -> 'a; lit : int -> 'a; mult : 'a -> 'a -> 'a;
    quot : 'a -> 'a -> 'b; sub : 'a -> 'a -> 'a; .. > ->
  'b

注意到这些类型接受的参数都用到了 row polymorphism，并不依赖于具体的类。所以我们甚至可以不把eval和show实现成类，只是传入孤立的对象。当然本文出于代码复用的考虑，没有这么干。

文章目录

遇到的问题：expression problem

解决方案：object algebra

扩展

题外话