G-Machine 第二部分

G-Machine 第二部分#

在第一部分中我们探讨了惰性求值的目的，介绍了典型的惰性求值抽象机器 G-Machine 并实现它的一些基本指令。本章为“MoonBit 中实现惰性求值”主题的第二部分，将延续并进一步扩展之前文章中 G-Machine 的实现来支持 let 表达式和基础算术，比较，和其他相关操作。

let 表达式#

coref 中的 let 表达式与 MoonBit 略有差异。MoonBit 的 let 表达式可以创建多个变量，但只能在有限的范围内使用。示例如下：

{
  let x = n + m
  let y = x + 42
  x * y
}

对应的 coreF 表达式：

(let ([x (add n m)]
      [y (add x 42)])
  (mul x y)) ;; xy can only be used within let

需要注意 coreF 中的 let 表达式必须按顺序执行，如下代码是无效的：

(let ([y (add x 42)]
      [x (add n m)])
  (mul x y))

相比之下，letrec 允许本地变量不考虑定义顺序下相互引用，从而更加复杂。

在实现 let（和更复杂的 letrec）表达式之前，我们首先需要修改当前的参数传递方法。let 创建的本地变量应该像参数一样访问，但 let 中的本地变量不对应 NApp 节点，因此我们需要在调用超组合子之前调整栈参数。

调整是在执行 Unwind 指令的过程中完成的。如果超组合子没有参数，则与原始 unwind 相同。当有参数时，超组合子节点的顶部地址会被丢弃，并开始调用 rearrange 函数。

fn rearrange(self : GState, n : Int) -> Unit {
  let appnodes = self.stack.take(n)
  let args = appnodes.map(fn (addr) {
    guard self.heap[addr] is NApp(_, arg)
    arg 
  })
  self.stack = args + appnodes.drop(n - 1)
}

rearrange 函数假设堆栈上的前 N 个地址指向一系列 NApp 节点。它保留最底部的地址（用于 Redex 更新），清理栈顶的 N-1 个地址，然后将 N 个地址放置在栈中，这些地址直接指向参数。

在这之后，通过将 PushArg 指令更改为更通用的 Push 指令，参数和局部变量都可以使用相同的命令进行访问。

fn push(self : GState, offset : Int) -> Unit {
  // Push(n) a0 : . . . : an : s
  //     =>  an : a0 : . . . : an : s
  let addr = self.stack.unsafe_nth(offset)
  self.put_stack(addr)
}

接下来我们需要清理一些不再使用的数据或状态，考虑以下表达式，

(let ([x1 e1]
      [x2 e2])
  expr)

在构建与表达式 expr 对应的图之后，栈中仍然包含指向 e1 和 e2 的地址（分别对应变量 x1 和 x2）,如下所示（栈从下到上增长）

<Address pointing to expr>
       |
<Address pointing to x2>
       |
<Address pointing to x1>
       |
...remaining stack...

因此，我们需要一个新的指令来清理这些不再需要的地址。它被称为 Slide。顾名思义，Slide(n) 的功能是跳过第一个地址并删除以下 N 个地址

fn slide(self : GState, n : Int) -> Unit {
  let addr = self.pop1()
  self.stack = Cons(addr, self.stack.drop(n))
}

现在我们来使用 let 表达式，我们将用 compileC 函数编译与本地变量对应的表达式。然后，遍历变量定义（defs）列表，依次编译并更新相应的偏移量。最后，使用传入的 comp 函数编译主表达式，并添加 Slide 指令来清理不使用的地址。

使用传入的函数编译主表达式，有助于在后续添加新功能时实现代码的高效复用。

fn compileLet(
  comp : (RawExpr[String], List[(String, Int)]) -> List[Instruction],
  defs : List[(String, RawExpr[String])],
  expr : RawExpr[String],
  env : List[(String, Int)]
) -> List[Instruction] {
  let (env, codes) = loop env, List::Nil, defs {
    env, acc, Nil => (env, acc)
    env, acc, Cons((name, expr), rest) => {
      let code = compileC(expr, env)
      let env = List::Cons((name, 0), argOffset(1, env))
      continue env, acc + code, rest
    }
  }
  codes + comp(expr, env) + @immut/list.of([Slide(defs.length())])
}

letrec的语义更加复杂——它允许表达式中的 N 个变量相互引用，因此我们需要预先分配 N 个地址并将其放置在堆栈上。我们需要一个新的指令：Alloc（N），它预先分配 N 个NInd节点，并将地址顺序推送到堆栈上。这些间接节点中的地址是负数，仅用作占位符。

fn alloc_nodes(self : GState, n : Int) -> Unit {
  let dummynode : Node = NInd(Addr(-1))
  for i = 0; i < n; i = i + 1 {
    let addr = self.heap.alloc(dummynode)
    self.put_stack(addr)
  }
}

letrec的用法与let语句类似

  • 使用Alloc(n)来分配 N 个节点

  • 使用loop表达式构建一个完整的环境

  • 在defs中编译本地变量，然后使用Update指令将结果更新到预先分配好的地址。

  • 编译主表达式，并使用Slide指令进行清理。

fn compileLetrec(
  comp : (RawExpr[String], List[(String, Int)]) -> List[Instruction],
  defs : List[(String, RawExpr[String])],
  expr : RawExpr[String],
  env : List[(String, Int)]
) -> List[Instruction] {
  let mut env = env
  loop defs {
    Nil => ()
    Cons((name, _), rest) => {
      env = Cons((name, 0), argOffset(1, env))
      continue rest
    }
  }
  let n = defs.length()
  fn compileDefs(
    defs : List[(String, RawExpr[String])],
    offset : Int
  ) -> List[Instruction] {
    match defs {
      Nil => comp(expr, env) + @immut/list.of([Slide(n)])
      Cons((_, expr), rest) =>
        compileC(expr, env) +
        Cons(Update(offset), compileDefs(rest, offset - 1))
    }
  }

  Cons(Alloc(n), compileDefs(defs, n - 1))
}

添加原语#

从这步开始，我们终于可以开始执行基本的整数运算，如算术、比较与检查两个数字是否相等。首先，修改 Instruction类型以添加相关指令。

  Add
  Sub
  Mul
  Div
  Neg
  Eq // ==
  Ne // !=
  Lt // <
  Le // <=
  Gt // >
  Ge // >=
  Cond(List[Instruction], List[Instruction])

实现这些指令乍看上去似乎很简单。以Add为例：只需从栈中弹出两个地址，获取对应的数字，执行加法操作，然后把结果的地址推回栈中。

fn add(self : GState) -> Unit {
  let (a1, a2) = self.pop2() // Pop two top addresses
  match (self.heap[a1], self.heap[a2]) {
    (NNum(n1), NNum(n2)) => {
      let newnode = Node::NNum(n1 + n2)
      let addr = self.heap.alloc(newnode)
      self.putStack(addr)
    }
    ......
  }
}

然而，接下来我们面临的问题是：这是一个惰性求值的语言。在惰性求值中，传递给 add 的参数很可能还没有被计算（即它们可能不是 NNum 节点，而是尚未计算的表达式）。因此，我们需要一种指令来强制执行计算，确保获取结果，或者在某些情况下，保证计算不会停下来。我们称之为 Eval（即 Evaluation 缩写）。

在术语中，这种计算的结果称为弱头范式（WHNF）。

同时我们需要修改 GState 的架构并加入 dump 的状态，类型是 List[(List[Instruction], List[Addr])]，使用 Eval 和 Unwind 指令的功能

执行Eval指令并不复杂

  • 弹出堆栈的顶部地址

  • 保存当前未执行的指令序列和栈（通过将它们放入 dump 中）

  • 清空当前栈并放入先前保存的地址。

  • 清空当前的指令序列，并放入 Unwind 指令

这与严格求值语言中保存调用者上下文的方式类似，但在实际实现中会采用更高效的方法。

fn eval(self : GState) -> Unit {
  let addr = self.pop1()
  self.put_dump(self.code, self.stack)
  self.stack = @immut/list.of([addr])
  self.code = @immut/list.of([Unwind])
}

这个简单的定义要求我们修改 Unwind 指令，使其在遇到 NNum 分支时，如果发现存在可恢复的上下文（即 dump 不为空），则恢复该上下文。

fn unwind(self : GState) -> Unit {
  let addr = self.pop1()
  match self.heap[addr] {
    NNum(_) => {
      match self.dump {
        Nil => self.put_stack(addr)
        Cons((instrs, stack), rest_dump) => {
          self.stack = stack
          self.put_stack(addr)
          self.dump = rest_dump
          self.code = instrs
        }
      }
    }
    NApp(a1, _) => {
      self.put_stack(addr)
      self.put_stack(a1)
      self.put_code(@immut/list.of([Unwind]))
    }
    NGlobal(_, n, c) => {
      if self.stack.length() < n {
        abort("Unwinding with too few arguments")
      } else {
        if n != 0 {
          self.rearrange(n)
        } else {
          self.put_stack(addr)
        }
        self.put_code(c)
      }
    }
    NInd(a) => {
      self.put_stack(a)
      self.put_code(@immut/list.of([Unwind]))
    }
  }
}

接下来，我们需要实现算术和比较算法。我们使用两个函数来简化二进制运算的形式。比较指令的结果是一个布尔值，简单起见我们使用数字来表示它：0 表示 false，1 表示 true。

fn negate(self : GState) -> Unit {
  let addr = self.pop1()
  match self.heap[addr] {
    NNum(n) => {
      let addr = self.heap.alloc(NNum(-n))
      self.put_stack(addr)
    }
    otherwise => {
      abort("negate: wrong kind of node \{otherwise}, address \{addr}")
    }
  }
}

fn lift_arith2(self : GState, op : (Int, Int) -> Int) -> Unit {
  let (a1, a2) = self.pop2()
  match (self.heap[a1], self.heap[a2]) {
    (NNum(n1), NNum(n2)) => {
      let newnode = Node::NNum(op(n1, n2))
      let addr = self.heap.alloc(newnode)
      self.put_stack(addr)
    }
    (node1, node2) => abort("liftArith2: \{a1} = \{node1} \{a2} = \{node2}")
  }
}

fn lift_cmp2(self : GState, op : (Int, Int) -> Bool) -> Unit {
  let (a1, a2) = self.pop2()
  match (self.heap[a1], self.heap[a2]) {
    (NNum(n1), NNum(n2)) => {
      let flag = op(n1, n2)
      let newnode = if flag { Node::NNum(1) } else { Node::NNum(0) }
      let addr = self.heap.alloc(newnode)
      self.put_stack(addr)
    }
    (node1, node2) => abort("liftCmp2: \{a1} = \{node1} \{a2} = \{node2}")
  }
}

最后，实现分支：

fn condition(self : GState, i1 : List[Instruction], i2 : List[Instruction]) -> Unit {
  let addr = self.pop1()
  match self.heap[addr] {
    NNum(0) => {
      // false
      self.code = i2 + self.code
    }
    NNum(1) => {
      // true
      self.code = i1 + self.code
    }
    otherwise => abort("cond : \{addr} = \{otherwise}")
  }
}

编译部分不需要进行重大调整，只需添加一些预定义程序：

let compiled_primitives : List[(String, Int, List[Instruction])] = @immut/list.of(
  [
    // Arith
    (
      "add",
      2,
      @immut/list.of([Push(1), Eval, Push(1), Eval, Add, Update(2), Pop(2), Unwind]),
    ),
    (
      "sub",
      2,
      @immut/list.of([Push(1), Eval, Push(1), Eval, Sub, Update(2), Pop(2), Unwind]),
    ),
    (
      "mul",
      2,
      @immut/list.of([Push(1), Eval, Push(1), Eval, Mul, Update(2), Pop(2), Unwind]),
    ),
    (
      "div",
      2,
      @immut/list.of([Push(1), Eval, Push(1), Eval, Div, Update(2), Pop(2), Unwind]),
    ),
    // Compare
    (
      "eq",
      2,
      @immut/list.of([Push(1), Eval, Push(1), Eval, Eq, Update(2), Pop(2), Unwind]),
    ),
    (
      "neq",
      2,
      @immut/list.of([Push(1), Eval, Push(1), Eval, Ne, Update(2), Pop(2), Unwind]),
    ),
    (
      "ge",
      2,
      @immut/list.of([Push(1), Eval, Push(1), Eval, Ge, Update(2), Pop(2), Unwind]),
    ),
    (
      "gt",
      2,
      @immut/list.of([Push(1), Eval, Push(1), Eval, Gt, Update(2), Pop(2), Unwind]),
    ),
    (
      "le",
      2,
      @immut/list.of([Push(1), Eval, Push(1), Eval, Le, Update(2), Pop(2), Unwind]),
    ),
    (
      "lt",
      2,
      @immut/list.of([Push(1), Eval, Push(1), Eval, Lt, Update(2), Pop(2), Unwind]),
    ),
    // MISC
    ("negate", 1, @immut/list.of([Push(0), Eval, Neg, Update(1), Pop(1), Unwind])),
    (
      "if",
      3,
      @immut/list.of(
        [
          Push(0),
          Eval,
          Cond(@immut/list.of([Push(1)]), @immut/list.of([Push(2)])),
          Update(3),
          Pop(3),
          Unwind,
        ],
      ),
    ),
  ],
)

并修改初始指令序列

code : @immut/list.of([PushGlobal("main"), Eval]),

总结#

在下一章，我们将改进原语的代码生成，并添加对数据结构的支持。

目录