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

2023-05-06 22:40:10 743 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›
yhgu2000 yhgu2000 墨衍会员 · AI 创作全网分发 墨衍智能分发 通过墨衍一键同步至各平台 可同步平台 CSDN微信公众号微博知乎掘金百家号博客园抖音小红书 你的文章也可以这样分发 墨衍会员 ¥399起/年，写一次发全网 我也要 + 加入社区
win10 离线安装.Net Framework3.5 起因，安装软件比如3dmax2014等需要.Net Framework3.5支撑，那么需要安装低版本的.Net Framework3.5 闲话少说。 1.下载 NetFx3.cab 链接: https://pan.baidu.com/s/124to7F3BOy4yAlY61OjbDg 提取码: kixu 2.将NetFx3.cab 放入 系统盘的windows目录下（示例 C:\Wi... 阅读详情

开学一直在上课，五一节期间才重新着手做这次作业，对于我这个类型系统零基础的选手来说，这次作业确实很有难度……

作业信息

作业内容描述：

  1. Complete the type inference ( two substitution functions )
  2. Complete the implementation for let-polymorphism
  3. Think about how to handle recursive functions

作业实现

和另外两位同学的实现差不多（绝对没有抄他们🤣），所以就不多解释了……

在任务2里我在实现inst函数时采用了不同的处理方法，引入了一个新的IVar类型来标记那些已经由QVar实例化过的变量，这样也能避免反复查上下文表，如果我没理解错的话，这么做应该也是对的……

并查集没做，只是把原理理解了我就已经很满足了……

任务1
module List = Belt.List

type rec expr =
  | CstI(int)
  | CstB(bool)
  | Var(string)
  | If(expr, expr, expr)
  | Fun(string, expr)
  | App(expr, expr)
  | Add(expr, expr)

type rec typ = TInt | TBool | TVar(string) | TArr(typ, typ)

let rec to_string = (t: typ) =>
  switch t {
  | TInt => "Int"
  | TBool => "Bool"
  | TVar(x) => "@" ++ x
  | TArr(x, y) => "(" ++ to_string(x) ++ "->" ++ to_string(y) ++ ")"
  }

type context = list<(string, typ)>
type constraints = list<(typ, typ)>

let rec cs_to_string = (cs: constraints) =>
  switch cs {
  | list{} => ""
  | list{(a, b), ...rest} =>
    "[" ++ to_string(a) ++ " = " ++ to_string(b) ++ "], " ++ cs_to_string(rest)
  }

let tvar_count = ref(0)
let new_tvar = (): typ => {
  tvar_count.contents = tvar_count.contents + 1
  TVar(Js.Int.toString(tvar_count.contents))
}

// 约束提取
let rec check_expr = (ctx: context, expr: expr): (typ, constraints) => {
  switch expr {
  | CstI(_) => (TInt, list{})
  | CstB(_) => (TBool, list{})
  | Var(x) => (
      switch List.getAssoc(ctx, x, (a, b) => a == b) {
      | Some(xt) => xt
      | _ => assert false // 变量名必须在上下文中存在
      },
      list{},
    )
  | If(e1, e2, e3) => {
      let (t1, c1) = check_expr(ctx, e1)
      let (t2, c2) = check_expr(ctx, e2)
      let (t3, c3) = check_expr(ctx, e3)
      (t2, List.concatMany([c1, c2, c3, list{(t1, TBool), (t2, t3)}]))
    }

  | Fun(x, e) => {
      let tx = new_tvar()
      let (te, c) = check_expr(list{(x, tx), ...ctx}, e)
      (TArr(tx, te), c)
    }

  | App(e1, e2) => {
      let t = new_tvar()
      let (t1, c1) = check_expr(ctx, e1)
      let (t2, c2) = check_expr(ctx, e2)
      (t, List.concatMany([c1, c2, list{(t1, TArr(t2, t))}]))
    }

  | Add(e1, e2) => {
      let (t1, c1) = check_expr(ctx, e1)
      let (t2, c2) = check_expr(ctx, e2)
      (TInt, List.concatMany([c1, c2, list{(t1, t2), (t1, TInt)}]))
    }
  }
}

let rec occurs = (x: string, t: typ): bool => {
  switch t {
  | TInt | TBool => false
  | TVar(y) => x == y
  | TArr(t1, t2) => occurs(x, t1) || occurs(x, t2)
  }
}

type subst = list<(string, typ)>

let rec st_to_string = (st: subst) =>
  switch st {
  | list{} => ""
  | list{(a, b), ...rest} => a ++ "= " ++ to_string(b) ++ ", " ++ st_to_string(rest)
  }

let rec rest_subst = (cs: constraints, x: string, xt: typ): constraints => {
  switch cs {
  | list{} => cs
  | list{c, ...rest} =>
    list{
      switch c {
      | (TVar(y), yt) if y == x => (xt, yt)
      | (yt, TVar(y)) if y == x => (xt, yt)
      | _ => c
      },
      ...rest_subst(rest, x, xt),
    }
  }
}

// 约束求解
let solve = (cs: constraints): subst => {
  let rec go = (cs, s): subst => {
    switch cs {
    | list{} => s
    | list{c, ...rest} =>
      switch c {
      | (TInt, TInt) | (TBool, TBool) => go(rest, s)
      | (TArr(t1, t2), TArr(t3, t4)) => go(list{(t1, t3), (t2, t4), ...rest}, s)
      | (TVar(x), t) | (t, TVar(x)) => {
          assert !occurs(x, t) // 禁止递归类型
          go(rest_subst(rest, x, t), list{(x, t), ...s})
        }

      | _ => assert false
      }
    }
  }
  go(cs, list{})
}

let rec subst_resolve = (x: string, s: subst): typ => {
  switch s {
  | list{} => TVar(x)
  | list{(y, yt), ...rest} =>
    if y == x {
      yt
    } else {
      subst_resolve(x, rest)
    }
  }
}

let rec type_subst = (t: typ, s: subst): typ => {
  switch t {
  | TVar(x) => {
      let y = subst_resolve(x, s)
      if y == TVar(x) {
        y
      } else {
        type_subst(y, s) // 递归求解，直到解无可解
      }
    }

  | TArr(t1, t2) => TArr(type_subst(t1, s), type_subst(t2, s))
  | _ => t
  }
}

// 类型推导
let infer = (expr: expr): typ => {
  let (t, cs) = check_expr(list{}, expr)
  let s = solve(cs)
  type_subst(t, s)
}

let test = Fun(
  "f",
  Fun("a", Fun("b", If(Var("a"), Add(App(Var("f"), Var("b")), CstI(1)), App(Var("f"), Var("a"))))),
)

let inferred = infer(test)
Js.log(inferred->to_string)

let omega = Fun("x", App(Var("x"), Var("x")))
let omega_inferred = infer(omega)
Js.log(omega_inferred->to_string)
任务2和3
module List = Belt.List

type rec expr =
  | CstI(int)
  | CstB(bool)
  | Var(string)
  | If(expr, expr, expr)
  | Fun(string, expr)
  | App(expr, expr)
  | Add(expr, expr)
  | Let(string, expr, expr)

type rec typ = TInt | TBool | TArr(typ, typ) | TVar(string) | QVar(string) | IVar(string) // 使用IVar来标记已经实例化的类型变量

let rec to_string = (t: typ) =>
  switch t {
  | TInt => "Int"
  | TBool => "Bool"
  | TArr(x, y) => "(" ++ to_string(x) ++ "->" ++ to_string(y) ++ ")"
  | TVar(x) => "@" ++ x
  | IVar(x) => "#" ++ x
  | QVar(x) => "$" ++ x
  }

type context = list<(string, typ)>
type constraints = list<(typ, typ)>

let rec cs_to_string = (cs: constraints) =>
  switch cs {
  | list{} => ""
  | list{(a, b), ...rest} => to_string(a) ++ " = " ++ to_string(b) ++ ", " ++ cs_to_string(rest)
  }

let var_count = ref(0)
let new_tvar = (): typ => {
  var_count.contents = var_count.contents + 1
  TVar(Js.Int.toString(var_count.contents))
}
let new_ivar = (): typ => {
  var_count.contents = var_count.contents + 1
  IVar(Js.Int.toString(var_count.contents))
}

let inst = (ty: typ): typ => {
  let rec go = (ty: typ, ctx: context): (typ, context) => {
    switch ty {
    | TArr(t1, t2) => {
        let (t1, ctx) = go(t1, ctx)
        let (t2, ctx) = go(t2, ctx)
        (TArr(t1, t2), ctx)
      }

    | QVar(x) =>
      switch List.getAssoc(ctx, x, (a, b) => a == b) {
      | Some(y) => (y, ctx)
      | None => {
          let y = new_ivar()
          (y, list{(x, y), ...ctx})
        }
      }

    | _ => (ty, ctx)
    }
  }
  let (t, _) = go(ty, list{})
  Js.log(ty->to_string)
  Js.log(t->to_string)
  Js.log("---")
  t
}

let rec gen = (ty: typ): typ => {
  switch ty {
  | TArr(t1, t2) => TArr(gen(t1), gen(t2))
  | TVar(x) => QVar(x)
  | _ => ty
  }
}

// 约束提取
let rec check_expr = (ctx: context, expr: expr): (typ, constraints) => {
  switch expr {
  | CstI(_) => (TInt, list{})
  | CstB(_) => (TBool, list{})
  | Var(x) => {
      let ty = switch List.getAssoc(ctx, x, (a, b) => a == b) {
      | Some(xt) => inst(xt)
      | _ => assert false // 变量名必须在上下文中存在
      }
      (ty, list{})
    }

  | If(e1, e2, e3) => {
      let (t1, c1) = check_expr(ctx, e1)
      let (t2, c2) = check_expr(ctx, e2)
      let (t3, c3) = check_expr(ctx, e3)
      (t2, List.concatMany([c1, c2, c3, list{(t1, TBool), (t2, t3)}]))
    }

  | Fun(x, e) => {
      let tx = new_tvar()
      let (te, c) = check_expr(list{(x, tx), ...ctx}, e)
      (TArr(tx, te), c)
    }

  | App(e1, e2) => {
      let t = new_tvar()
      let (t1, c1) = check_expr(ctx, e1)
      let (t2, c2) = check_expr(ctx, e2)
      (t, List.concatMany([c1, c2, list{(t1, TArr(t2, t))}]))
    }

  | Add(e1, e2) => {
      let (t1, c1) = check_expr(ctx, e1)
      let (t2, c2) = check_expr(ctx, e2)
      (TInt, List.concatMany([c1, c2, list{(t1, t2), (t1, TInt)}]))
    }

  | Let(x, e1, e2) => {
      let xt = new_tvar() // 不知道这样处理递归对不对
      let (t1, c1) = check_expr(list{(x, xt), ...ctx}, e1)
      let (t2, c2) = check_expr(list{(x, gen(t1)), ...ctx}, e2)

      (t2, List.concatMany([c1, c2]))
    }
  }
}

let rec occurs = (x: string, t: typ): bool => {
  switch t {
  | TInt | TBool => false
  | TVar(y) | IVar(y) => x == y
  | TArr(t1, t2) => occurs(x, t1) || occurs(x, t2)
  | QVar(_) => assert false
  }
}

type subst = list<(string, typ)>

let rec st_to_string = (st: subst) =>
  switch st {
  | list{} => ""
  | list{(a, b), ...rest} => a ++ "= " ++ to_string(b) ++ ", " ++ st_to_string(rest)
  }

let rec rest_subst = (cs: constraints, x: string, xt: typ): constraints => {
  switch cs {
  | list{} => cs
  | list{c, ...rest} =>
    list{
      switch c {
      | (TVar(y) | IVar(y), yt) if y == x => (xt, yt)
      | (yt, TVar(y) | IVar(y)) if y == x => (xt, yt)
      | _ => c
      },
      ...rest_subst(rest, x, xt),
    }
  }
}

// 约束求解
let solve = (cs: constraints): subst => {
  let rec go = (cs, s): subst => {
    switch cs {
    | list{} => s
    | list{c, ...rest} =>
      switch c {
      | (TInt, TInt) | (TBool, TBool) => go(rest, s)
      | (TArr(t1, t2), TArr(t3, t4)) => go(list{(t1, t3), (t2, t4), ...rest}, s)
      | (TVar(x) | IVar(x), t) | (t, TVar(x) | IVar(x)) => {
          assert !occurs(x, t) // 禁止递归类型
          go(rest_subst(rest, x, t), list{(x, t), ...s})
        }

      | _ => assert false
      }
    }
  }
  go(cs, list{})
}

let rec subst_resolve = (x: string, s: subst): typ => {
  switch s {
  | list{} => TVar(x)
  | list{(y, yt), ...rest} =>
    if y == x {
      yt
    } else {
      subst_resolve(x, rest)
    }
  }
}

let rec type_subst = (t: typ, s: subst): typ => {
  switch t {
  | TVar(x) => {
      let y = subst_resolve(x, s)
      if y == TVar(x) {
        y
      } else {
        type_subst(y, s) // 递归求解，直到解无可解
      }
    }

  | TArr(t1, t2) => TArr(type_subst(t1, s), type_subst(t2, s))
  | _ => t
  }
}

// 类型推导
let infer = (expr: expr): typ => {
  let (t, cs) = check_expr(list{}, expr)
  Js.log(t->to_string)
  Js.log(cs->cs_to_string)
  let s = solve(cs)
  type_subst(t, s)
}

// let test = Let("a", Fun("x", Var("x")), Let("b", Var("a"), App(Var("b"), CstI(10))))

// let test = Let("id", Fun("x", Var("x")), Let("a", App(Var("id"), CstI(42)), Var("a")))

// 递归函数
let test = Let("a", Fun("x", App(Var("a"), Var("x"))), App(Var("a"), CstI(42)))

let inferred = infer(test)
Js.log(inferred->to_string)
...全文
别再傻傻分不清了！用Design Compiler和PrimeTime实操对比PBA与GBA模式 本文深度解析静态时序分析(STA)中Design Compiler与PrimeTime工具的PBA与GBA模式差异，通过实际案例演示两种模式在转换时间计算、时钟路径分析等方面的对比，并提供工程实践中模式选择的策略与调试技巧，帮助工程师在芯片设计流程中平衡精度与效率。 阅读详情

相关推荐

YHG-101型微机化氧量自动分析仪手册.doc

YHG-101型微机化氧量自动分析仪手册doc,YHG-101型微机化氧量自动分析仪手册

weixin_38744207

国产超临界600MW机组技术解析：从沁北电厂看超临界直流锅炉运行

超临界发电技术是火电行业提升热效率、降低供电煤耗的关键路径。其核心在于工质参数超过水的临界点，锅炉采用无汽包的直流设计，工质一次通过蒸发受热面，燃水比的精准控制成为运行命门。相比亚临界机组，超临界机组主蒸汽压力更高、热效率更优，每度电可节约标煤15至20克，大幅减少碳排放，被广泛用于600MW及以上大型火电机组，并深度参与调峰运行。华能沁北电厂作为国产超临界600MW机组的依托工程，系统梳理了锅炉、汽轮机、发电机及控制系统参数，记录了从湿态转干态、燃水比调节到给水泵汽蚀处理等关键实操经验。理解超临界直流锅炉

任云舒

国产QFSN-600-2YHG型汽轮发电机漏氢原因分析及处理 (2013年)

氢系统对于发电机的安全运行起到了关键的作用。介绍了庄河发电公司QFSN-600-2YHG型汽轮发电机组,在运行中发现严重漏氢现象,叙述了对氢系统进行全面检查的过程,及漏点的处理工艺和原因分析。实践表明:采用标准的工艺流程对机组漏氢进行检修,可得到满意的效果。

weixin_38672800

YHG系列水平轴转刷曝气机通过科技成果鉴定 (1995年)

由清华大学环境工程系和北京市市政工程机械公司共同开发研制的ＹＨＰ系列水平轴转刷曝气机，于１９９５年５月１９日通过建设部组织的科技成果鉴定。该产品技术路线正确周密，结构合理，叶片结构有创新，减速装置采用三环减速技术，高效节能，综合技术性能指标达到和超过了国内外同类产品的先进水平，是我国的专利产品，其价格仅为国外同类产品的二分之一。转刷曝气机是一种应用广泛的氧化沟曝气充氧设备。氧化沟作为城市污水?...

weixin_38666232

内蒙古某发电厂发电机穿转子作业指导书.doc

内蒙古某发电厂发电机穿转子作业指导书.doc

yyyyyyhhh222
评论
收藏 已收藏
分享
返回顶部
yhgu2000
yhgu2000
raelidea 231 成员 35 内容
+ 加入社区