[基础软件理论与实践] 第一节作业实现

[基础软件理论与实践] 第一节作业实现 lxr2010

作业信息

• 课程信息：https://bbs.csdn.net/topics/608593392
• 第一节作业提交帖：https://bbs.csdn.net/topics/608595919

作业内容描述：

1. Write an interpreter for the stack machine with variables

2. Write a compiler to translate to stack machine instructions

3. Implement the dashed part (one language + two compilers)

   • Interpreter for stack machine with names

   • Compiler that translate named expr into instructions of stack machine with names

   • Compiler that translate instructions of stack machine with names into instructions of stack machine with variables

作业实现

本次作业实现用到了ReScript提供的Belt.List库。该库的setAssoc、hasAssoc、removeAssoc可以将List作为简单的map来使用，在对性能要求不高的场合使用比较方便。本次作业的代码已经放到Github上。

任务1 实现一个支持变量引用的堆栈机

支持变量引用堆栈机（Stack Machine With Variables）中的变量通过提供变量距离栈顶的距离来引用。如Var(0)表示对栈顶的数据进行引用，Var(1)表示对距离栈顶1单位的数据进行引用，依次类推。对于指令Var(i)，主要通过Belt.List.get()函数来实现。注意get()返回的是一个Option类型，需要从类型中提取实际值。对于其他操作，在PPT中已经给了足够的提示。下面的代码中为了后续打印输出时方便，实现了一些字符串转换函数。

module StackMachineWithVariables = {
  type instr = Cst (int) | Add | Mul | Var (int) | Pop | Swap 

  let toString = (inst: instr) : string => switch inst {
    | Cst (i) => "Cst" ++ "(" ++ Js.Int.toString(i) ++ ")"
    | Add => "Add"
    | Mul => "Mul"
    | Var (i) => "Var" ++ "(" ++ Js.Int.toString(i) ++ ")"
    | Pop => "Pop"
    | Swap => "Swap"
  }

  
  let listToString = (instrs: list<instr>) : string => {
    let listTailToString = (instrs: list<instr>) : string => 
      List.fold_left((str,inst)=>str++";"++toString(inst),"",instrs)
    switch instrs {  
      | list{} => "[]"
      | list{inst} => "[" ++ toString(inst) ++"]"
      | list{inst, ...rest} => "[" ++ toString(inst) ++ listTailToString(rest) ++ "]"
    }
  } 

  // Task 1. interpreter of stack machine with variables
  let rec eval = (instrs, stk) => {
    switch (instrs,stk) {
    | (list{Cst (i), ...rest}, stk) => eval (rest , list{i, ...stk})
    | (list{Add, ...rest}, list{a, b, ...stk}) => eval (rest, list{a+b, ...stk})
    | (list{Mul, ...rest}, list{a, b, ...stk}) => eval (rest, list{a*b, ...stk})
    | (list{Var (i), ...rest}, stk) => switch stk->Belt.List.get(i) {
      | Some(v) => eval (rest, list{v, ...stk})
      | None => assert false
    }
    | (list{Pop, ...rest}, list{_, ...stk}) => eval (rest, stk)
    | (list{Swap, ...rest}, list{a, b, ...stk}) => eval (rest, list{b, a, ...stk})
    | (list{} , stk) => (list{}, stk)
    | _ => assert false
    }
  }

  let interpret = (instrs) => switch eval(instrs, list{}) {
    | (_, list{a, ...stk}) => a 
    | _ => assert false 
  }

} 

任务2 编写一个将Nameless Expr转换为支持变量引用堆栈机的编译程序

Nameless Expr是将支持变量名引用的Expr（我们这里称为Named Expr）去掉变量名得到的表达式。去掉变量名减低了表达式的可读性，但是为表达式向堆栈机指令的编译提供了便利，使得堆栈机不再需要维护变量名到变量数值的映射。

另外，在嵌套的子表达式中如果对父表达式中已经存在的变量名重新进行定义，就需要考虑变量名的作用域覆盖问题。如Let("x",Cst(1),Let("x",Var("x"),Var("x")))，由堆栈机来直接处理变量x会十分麻烦。这些都是问题。去掉变量名后上述问题就不需要去考虑了，只要考虑变量的索引就可以了。

注意Nameless Expr的Var(i)和支持变量引用堆栈机的Var(i)并不具有相同的含义。Nameless Expr中的Var(i)中的i表示对最近定义的第i个变量的索引；而支持变量引用堆栈机的Var(i)中的i表示对被引用变量在栈中距离栈顶i个单位。编译器需要对Nameless Expr中的Var(i)进行转换。

对于Cst(i)，Add，Mul，直接按照PPT中给出的定义编译即可；

对于Var(i)，先按下不表。我们假设Nameless Expr Var(i)在栈上求值完成后在栈上只占1个单位。

对于Let(expr1,expr2)，该表达式的含义是：首先计算expr1，将其结果作为临时变量；然后计算expr2；最后在栈中去掉计算expr1得到的临时结果。那么临时结果的位置如何确定呢？

假设我们对于Let(expr1,expr2)表达式，满足如下条件：

1. 在expr1计算结束后，表达式的结果在栈上只占1个单位，
2. 在expr2计算结束后，表达式的结果在栈上只占1个单位，
3. 有办法保留expr2 的结果，同时将expr1的结果从栈中去除，

那么我们通过结构归纳法可以证明：所有Nameless Expr在栈上求值完成后在栈上只占1个单位。也就是：
$$([[e:\text{Nameless.expr}]],s){\to }^{\ast }(ϵ,n::s)$$
结合PPT的例子以及若干尝试，可知当Let(expr1,expr2)的语义满足：
$$[[\text{Let}(e_1,e_2)]]=[[e_1]];[[e_2]];\text{Swap};\text{Pop}$$
时满足上述假设。

回到Var(i)的编译上。如果对于Nameless Expr Var(i)，我们可以满足如下条件：

1. 支持变量引用堆栈机指令Var(k)和Var(i)引用的表达式相同

那么可以证明所有Nameless Expr在栈上求值完成后栈顶的值就是表达式的值。即对于上式中的$n$有：
$$e\Downarrow n$$
Nameless Expr中Var(i)引用的每个变量都是由Let(expr1,expr2)表达式的左子式expr1定义的。当左子式计算完成后，在上述假设成立的情况下，可知栈的高度增加了1，并且expr1计算的结果就是栈顶的值。因此我们可以维护一个变量定义时栈的高度表，对于最近定义的第i个变量，其在表中的索引为i；该变量在定义时的栈高度为表中索引i存储的值。这样就在Nameless Expr和支持变量引用堆栈机的Var(i)之间建立了联系。对于Nameless Expr Var(i)，在支持变量引用堆栈机中的指令为Var(k)，则k=当前栈高度-表中第i项高度。

代码如下所示。

module Nameless = {
  type rec expr = 
    | Cst (int)
    | Add (expr, expr) // a + b
    | Mul (expr, expr) // a * b
    | Var (int) 
    | Let (expr, expr)

  let rec toString = (expr:expr) : string => switch expr {
    | Cst (i) => "Cst" ++ "(" ++ Js.Int.toString(i) ++ ")"
    | Add (expr1, expr2) => "Add" ++ "(" ++ toString(expr1) ++"," ++ toString(expr2) ++ ")"
    | Mul (expr1, expr2) => "Mul" ++ "(" ++ toString(expr1) ++"," ++ toString(expr2) ++ ")"
    | Var (i) => "Var" ++ "(" ++ Js.Int.toString(i) ++ ")"
    | Let (expr1, expr2) => "Let" ++ "(" ++ toString(expr1) ++ "," ++ toString(expr2) ++ ")"
  }

}

// Task 2. Compiler from Nameless expr to stack machine with variables.
module NamelessExprToStackMachineWithVariables = {
  open! StackMachineWithVariables 
  type depthTable = list<int>
  let rec compHelper = (expr: Nameless.expr, depthtable: depthTable, stkdepth:int) : list<instr> => {
    switch (expr,depthtable,stkdepth) {
      | (Nameless.Cst(i),_,_) => list{Cst(i)}
      | (Nameless.Add(expr1, expr2),dt,sd) => Belt.List.concatMany([
        compHelper(expr1,dt,sd),
        compHelper(expr2,dt,sd+1),
        list{Add}
      ])
      | (Nameless.Mul(expr1, expr2),dt,sd) => Belt.List.concatMany([
        compHelper(expr1,dt,sd),
        compHelper(expr2,dt,sd+1),
        list{Mul}
      ])
      | (Nameless.Var(i),dt,sd) => switch dt->Belt.List.get(i) {
        | Some(h) => list{Var(sd - h)}
        | None => assert false 
      }
      | (Nameless.Let(expr1, expr2),dt,sd) => Belt.List.concatMany([
        compHelper(expr1, dt, sd),
        compHelper(expr2, list{sd+1, ...dt}, sd+1),
        list{Swap,Pop}
      ])
    }
  }

  let comp = (expr: Nameless.expr) : list<StackMachineWithVariables.instr> => 
    compHelper(expr, list{}, 0)
}

任务3 设计实现从Named Expr到支持变量名的堆栈机再到支持变量的堆栈机的转换路径

任务3.1 设计支持变量名的堆栈机

支持变量名的堆栈机（Stack Machine With Names）由三个部分组成，指令、堆栈、变量环境。
$$\begin{array}{rl}\text{code:}& c::=ϵ\mid i;c\\ \text{stack:}& s::=ϵ\mid v::s\\ \text{env:}& \Gamma ::=ϵ\mid (x,v)::\Gamma \end{array}$$
其中i为指令类型，v为整数类型，x为字符串类型。

为了支持变量名引用，在Cst(i)，Add，Mul的基础上，增加以下指令：

• Store(x)：将栈顶元素出栈，并与变量名x绑定，保存到变量环境中
• Load(x)：按照变量名x，从变量环境中索引变量，将变量的值压入栈顶
• Clear(x)：从变量环境中清除变量名x的记录

迁移规则：
$$\begin{array}{rl}(\text{Cst}(i);c,s,\Gamma )& \to (c,i::s,\Gamma )\\ (\text{Add};c,n_2::n_1::s,\Gamma )& \to (c,n_1+n_2::s,\Gamma )\\ (\text{Mul};c,n_2::n_1::s,\Gamma )& \to (c,n_1\times n_2::s,\Gamma )\end{array}$$
对于变量环境$\Gamma$支持的操作包括：

• Store：$\Gamma [x:=v]$

• Load：$\Gamma [x]$

• Clear：$\Gamma /x$

操作含义与对应指令相同。

为了方便实现，我们假定变量环境中对相同的变量名只保存唯一的值。这个假设可以在编译时进行保证。

变量名相关的迁移规则：
$$\begin{array}{rl}(\text{Store}(x);c,n::s,\Gamma )& \to (c,s,\Gamma [x:=n])\\ (\text{Load}(x);c,s,\Gamma )& \to (c,\Gamma [x]::s,\Gamma )\\ (\text{Clear}(x);c,s,\Gamma )& \to (c,s,\Gamma /x)\end{array}$$
如果堆栈机指令是通过Named Expr编译生成的，那么$\Gamma$的Store和Load操作可以优化为更简单的list操作。通用方法是使用Belt.List库的setAssoc和removeAssoc实现。不过$\Gamma$中包含多个变量名相同的记录时，这两个函数并不能保证正确性。

代码如下。

module StackMachineWithName = {
  type instr = 
    | Cst(int) 
    | Add 
    | Mul 
    | Store(string) // pop stack top value to name
    | Load(string) // push name's value to stack top
    | Clear(string) // remove record of name from env

  type env = list<(string, int)>

  let toString = (instr: instr) : string => switch instr {
    | Cst(i) => "Cst" ++ "(" ++ Js.Int.toString(i) ++ ")"
    | Add => "Add"
    | Mul => "Mul"  
    | Store(s) => "Store" ++ "(" ++ s ++ ")"
    | Load(s) => "Load" ++ "(" ++ s ++ ")"
    | Clear(s) => "Clear" ++ "(" ++ s ++ ")"
  }

  

  let listToString = (instrs : list<instr>): string => {
    let listTailToString = (instrs : list<instr>) : string => 
      List.fold_left((s, inst:instr)=>s++";"++toString(inst), "", instrs)
    switch instrs {
      | list{} => "[]"
      | list{instr} => "[" ++ toString(instr) ++ "]"
      | list{instr,...rest} => "[" ++ toString(instr) ++ listTailToString(rest) ++"]"
    }
  }


  let assoc = (s: string, env: env) : int =>
    switch env->Belt.List.getAssoc(s,(a, b)=> a==b) {
      | Some(i) => i 
      | None => assert false 
    }
  let removeName = (s: string, env: env) : env => 
    env->Belt.List.removeAssoc(s,(a,b)=> a==b)

  let rec eval = (instrs :list<instr>, stk : list<int> , env: env): list<int> => {
    switch (instrs, stk, env) {
      | (list{Cst(i),...rest}, stk, env) => eval(rest, list{i, ...stk}, env)
      | (list{Add, ...rest}, list{a, b, ...stk}, env) => eval(rest, list{a+b, ...stk}, env)
      | (list{Mul, ...rest}, list{a, b, ...stk}, env) => eval(rest, list{a*b, ...stk}, env)
      | (list{Store(s), ...rest}, list{a, ...stk} , env) => eval (rest, stk, list{(s,a), ...env})
      | (list{Load(s), ...rest}, stk, env) => eval(rest, list{assoc(s,env), ...stk}, env)
      | (list{Clear(s), ...rest}, stk, list{(x,_), ...env}) => {
        assert (s==x)
        eval(rest, stk, env)
        }
      | (list{}, stk, env) => stk
      | _ => {
        Js.log(listToString(instrs))
        Js.log(stk)
        Js.log(env)
        assert false
      }
    }
  }

  let interpret = (instrs) => 
    switch eval(instrs, list{}, list{}) {
      | list{a, ..._} => a 
      | stk => {
        Js.log("Empty stack")
        Js.log(stk)
        assert false 
      }
    }

}

任务3.2 实现从Named Expr到支持变量名的堆栈机指令的编译程序

编译规则：
$$\begin{array}{rl}[[\text{Cst}(i)]]& =\text{Cst}(i)\\ [[\text{Add}(e_1,e_2)]]& =[[e_1]];[[e_2]];\text{Add}\\ [[\text{Mul}(e_1,e_2)]]& =[[e_1]];[[e_2]];\text{Mul}\\ [[\text{Var}(x)]]& =\text{Load}(x)\\ [[\text{Let}(x,e_1,e_2)]]& =[[e_1]];\text{Store}(x);[[e_2]];\text{Clear}(x)\end{array}$$
前面提到Named Expr中存在变量名的作用域覆盖问题。这个问题是由Let的子表达式中对父表达式中已经定义的变量进行重新定义导致的。为此，我们在编译过程中维护一个定义深度：所有变量名的定义深度初始均为0；在Let表达式中，$e_1$表达式计算结束后，变量名x被定义，定义深度增加1。在$e_2$执行结束后，变量名x被释放，它的定义深度减少1。这样，在子表达式中对x的重新定义会使变量名x得到更高的定义深度。对变量名的定义可以用变量名和定义深度的组合来唯一的表示。Var(x)对于变量名x的引用是对当前定义深度最高的x变量名进行引用。

可以证明，每个Named Expr执行前后，各变量的定义深度保持不变。

更进一步，我们可以将变量名x和定义深度d映射为一个新的名字$x^{\ast }$，替换掉所有定义深度为d的变量名x，表达式的计算结果保持不变。经过这一变换，Named Expr中不存在对父表达式中相同变量名的重复定义。转换到支持变量名的堆栈机上，变量环境中对同一变量名只需要保存一个值。于是上述编译规则的部分变化为：
$$\begin{array}{rlr}[[\text{Var}(x)]]& =& \text{Load}(x^{\ast })\\ [[\text{Let}(x,e_1,e_2)]]& =& [[e_1]];\text{Store}(x^{\ast });[[e_2]];\text{Clear}(x^{\ast })\end{array}$$
下面是代码：

module Named = {
  type rec expr = Cst(int) | Add(expr, expr) | Mul(expr,expr) | Var(string) | Let(string, expr, expr)
  type env = list<(string,int)>
  let rec toString = (expr:expr) : string => switch expr {
    | Cst (i) => "Cst" ++ "(" ++ Js.Int.toString(i) ++ ")"
    | Add (expr1, expr2) => "Add" ++ "(" ++ toString(expr1) ++"," ++ toString(expr2) ++ ")"
    | Mul (expr1, expr2) => "Mul" ++ "(" ++ toString(expr1) ++"," ++ toString(expr2) ++ ")"
    | Var (s) => "Var" ++ "(" ++ s ++ ")"
    | Let (s, expr1, expr2) => "Let" ++ "(" ++ s ++ "," ++ toString(expr1) ++ "," ++ toString(expr2) ++ ")"
  }
}

module NamedExprToStackWithName = {
  type depthTable = list<(string,int)>
  open! StackMachineWithName

  // mangling: convert names with identical string but different scope into new, unique names.
  // This makes stack machine with name easier to implement.
  let mangled = (s: string, d:int) : string => {
    let len = Js.String.length(s)
    Js.Int.toString(len)++"_"++s++"_"++Js.Int.toString(d)
  }

  let depth = (s:string, d:depthTable): int => 
    switch d->Belt.List.getAssoc(s,(a,b)=>a==b) {
      | Some(i) => i 
      | None => 0
    }
  
  let updatedDepthtable = (d:depthTable, s:string, v: int) : depthTable =>
    Belt.List.setAssoc(d,s,v,(a, b)=>a==b)

  let rec compHelper = (expr: Named.expr, depthtable: depthTable):list<instr> => 
    switch (expr,depthtable) {
      | (Named.Cst(i),_) => list{Cst(i)}
      | (Named.Add(expr1, expr2),d) => Belt.List.concatMany([
        compHelper(expr1,d),
        compHelper(expr2,d),
        list{Add}
      ])
      | (Named.Mul(expr1, expr2),d) => Belt.List.concatMany([
        compHelper(expr1,d),
        compHelper(expr2,d),
        list{Mul}
      ])
      | (Named.Var(s),d) => list{Load(mangled(s,depth(s,d)))}
      | (Named.Let(s,expr1,expr2),d) => {
        let cur = depth(s,d)
        Belt.List.concatMany([
          compHelper(expr1,d),
          list{Store(mangled(s,cur+1))},
          compHelper(expr2,updatedDepthtable(d,s,cur+1)),
          list{Clear(mangled(s,cur+1))}
        ])
      }
    }

  let comp = (expr: Named.expr) => compHelper(expr,list{})
}

任务3.3 实现从支持变量名的堆栈机指令到支持变量引用的堆栈机指令的编译程序

对于变量名，类似任务2，需要将变量名转换为变量引用时变量在栈内位置与栈顶的距离。可以维护一个变量深度表，记录每个变量定义时栈的高度。另外，支持变量引用的堆栈机不再维护变量环境$\Gamma$，而是将所有计算数据放在栈上处理。所以编译时需要模拟支持变量名堆栈机指令翻译到支持变量引用堆栈机指令时后者栈高度的变化。

支持变量名堆栈机指令	支持变量引用堆栈机的栈高度变化	支持变量引用堆栈机指令
Cst(i)	+1	{Cst(i)}
Add	-1	{Add}
Mul	-1	{Mul}
Store(x)	0	{}，将当前栈高度记录为x定义时栈高度
Load(x)	+1	{Var(k)}，其中k=当前栈高度-变量x定义时栈高度
Clear(x)	-1	{Swap,Pop}

代码如下：由于List库和Belt.List库中不支持Scan操作(Iter+Reduce)，所以使用Reduce操作实现。可以将该操作理解为命令式语言中的遍历操作。

module StackMachineWithNameToWithVariables = {
  open! StackMachineWithVariables
  type depthTable = list<(string,int)>

  type transState = {
    outputRev : list<instr>, // record instructions of stack machine with variables.
    depthtable : depthTable, // record stack depth to compute named variables' distances from stack top
    stkdepth : int  // current stack depth
  }

  // reduce this fuction through input
  let transformer = (state: transState, instr : StackMachineWithName.instr) : transState => {
    let rev = state.outputRev
    let d = state.depthtable
    let sd = state.stkdepth

    // helper function to compute named variables' distance from stack top
    let getDiff = (d: depthTable, sd: int, s: string):int => 
      switch Belt.List.getAssoc(d,s,(a,b)=>a==b) {
        | Some(i) =>  sd - i 
        | None => {
          Js.log("Invalid variable reference to \"" ++ s ++ "\"")
          assert false 
        }
      }

    let (revPart, dNew, sdDelta) = switch instr {
      | StackMachineWithName.Cst(i) => (list{Cst(i)}, d, + 1 )
      | StackMachineWithName.Add => (list{Add}, d, - 1)
      | StackMachineWithName.Mul => (list{Mul}, d, - 1)
      | StackMachineWithName.Store(s) => (list{}, 
        Belt.List.setAssoc(d,s,sd,(a,b)=>a==b),
        0)
      | StackMachineWithName.Load(s) => 
        (list{Var(getDiff(d,sd,s))}, d, + 1)
      | StackMachineWithName.Clear(s) => (list{Pop, Swap},
        Belt.List.removeAssoc(d,s,(a,b)=>a==b),
        -1)
    }
    {outputRev: Belt.List.concat(revPart,rev),
     depthtable: dNew,
     stkdepth: sd + sdDelta}
  }

  let comp = (instrs: list<StackMachineWithName.instr>) : list<instr> => {
    let initState : transState = {outputRev: list{}, depthtable:list{}, stkdepth:0}
    let finalState : transState = Belt.List.reduce(instrs,initState,transformer)
    Belt.List.reverse(finalState.outputRev)
  }
  
}

以下是测试代码：

module Test = {
  let namedExprList = {
    open! Named
    list{
  Let("x",Cst(17),Add(Var("x"),Var("x"))),
  Add(Cst(1),Let("x",Cst(2),Add(Var("x"),Cst(7)))),
  Let("x",Let("x",Cst(1),Var("x")),Let("x",Var("x"),Var("x"))),
  Let("x",Cst(1),Cst(2))
    }
  }

  let namelessExprList = {
    open! Nameless 
    list{
  Let(Cst(17),Add(Var(0),Var(0))),
  Add(Cst(1),Let(Cst(2),Add(Var(0),Cst(7)))),
  Let(Let(Cst(1),Var(0)),Let(Var(0),Var(0))),
  Let(Cst(1),Cst(2))
    }
  }

  let task2Helper = (expr :Nameless.expr) : list<StackMachineWithVariables.instr> => {
    Js.log(Nameless.toString(expr))
    let instrList = NamelessExprToStackMachineWithVariables.comp(expr)
    Js.log("Compiled to " ++ StackMachineWithVariables.listToString(instrList))
    Js.log("\n")
    instrList
  }

  let task1Helper = (instrList : list<StackMachineWithVariables.instr>) : int => {
    Js.log(StackMachineWithVariables.listToString(instrList))
    let val = StackMachineWithVariables.interpret(instrList)
    Js.log("Interpreted to " ++ Js.Int.toString(val))
    Js.log("\n")
    val
  }

  let task3Helper = (expr :Named.expr) : int => {
    Js.log(Named.toString(expr))
    let namedInstrList = NamedExprToStackWithName.comp(expr)
    Js.log("Compiled to stack machine with names: " ++ StackMachineWithName.listToString(namedInstrList))
    let val = StackMachineWithName.interpret(namedInstrList)
    Js.log("Interpreted to " ++ Js.Int.toString(val))
    let variableInstrList = StackMachineWithNameToWithVariables.comp(namedInstrList)
    Js.log("Compiled to stack machine with variables: " ++ StackMachineWithVariables.listToString(variableInstrList))
    let variableVal = StackMachineWithVariables.interpret(variableInstrList)
    Js.log("Interpreted to " ++ Js.Int.toString(variableVal))
    Js.log("\n")
    val
  }

  let run = () => {
    Js.log("Task 2 test:")
    let task2res = List.map(task2Helper, namelessExprList)

    Js.log("\n")

    Js.log("Task 1 test:")
    let task1res = List.map(task1Helper, task2res)

    Js.log("\n")

    Js.log("Task 3 test:")
    let task3res = List.map(task3Helper, namedExprList)

    Js.log("\n")
  }
}

Test.run()