# 作业信息

• 课程信息：https://bbs.csdn.net/topics/608593392

## 作业内容描述：

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

# 作业实现

``````type rec typ = TInt | TBool | TVar(ref<tvar>) | TArr(typ, typ) | Gen(array<string>, typ)

1、2的分支，直接返回類型TInt和TBool，無需unify

4的if分支，返回的是fresh出來的t，並分別對(t1, TBool)、(t, t2)、(t, t3)進行unify

5的func分支，fresh出來的tx，返回的是tx->tb，無需unify

6的apply分支，返回的是fresh出來的t，並對(t1, t2->t)進行unify

注意1、2處，我私以爲，function和let語義，同樣是有層級的。

``````func x => // level n
let y = // level n + 1
x     // level n + 2
y       // level n + 1``````

## gen

gen(t, level)，注意點，在于識別出肯定未被確定的fresh變量，即let所在層級爲n，那麼level大于等於n的fresh變量肯定都是未確定的，而小于n的fresh變量（相對於本層級是自由變量）不一定未確定

# 測試輸出

input|- [f] => [a] => [b] => if a { f(b) + 1 } else { f(a) }
nogen|- (Bool -> Int) -> Bool -> Bool -> Int

input|- [x] => { let y = x { y } }
nogen|- Var(T/0)
__gen|- forall: T/0. Var(T/0) -> Var(T/0)

input|- [x] => { let y = { [z] => x } { y } }
__gen|- forall: T/2. Var(T/2) -> Var(T/0)
__gen|- forall: T/0, T/3. Var(T/0) -> Var(T/3) -> Var(T/0)

input|- let id = { [x] => x } { let a = id(42) { let b = id(true) { if b { a } else { 11 } } } }
__gen|- forall: T/1. Var(T/1) -> Var(T/1)
nogen|- Int
nogen|- Bool
nogen|- Int

input|- [f] => { let g = f { g(42) } }
nogen|- Var(T/0)
__gen|- forall: T/2. (Int -> Var(T/2)) -> Var(T/2)

input|- let fact = { [n] => if n == 0 { 1 } else { n × fact(n - 1) } } { fact(5) }
nogen|- Int -> Int
nogen|- Int

# 完整程式碼

mono，constraints

``````open Belt

let forceGet = Option.getExn
let roundString = str => "(" ++ str ++ ")"

let assoc = (env, x) => env->List.getAssoc(x, (a, b) => a == b)

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

let typ_to_string = typ => {
let eagerBracket = (x, test) =>
if test {
x->roundString
} else {
x
}

let rec go = (typ, test) =>
switch typ {
| TInt => "Int"
| TBool => "Bool"
| TVar(x) => "Var" ++ x->roundString
| TArr(t1, t2) => (go(t1, true) ++ " -> " ++ go(t2, false))->eagerBracket(test)
}

go(typ, false)
}

type rec expr =
| CstI(int)
| Var(string)
| If(expr, expr, expr)
| Func(string, expr)
| Apply(expr, expr)
| Prim(prim, expr, expr)

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

let infer = expr => {
let count = ref(0)
let var_fresher = () => {
let cur = count.contents
let var = "T/" ++ cur->Int.toString
count := cur + 1
TVar(var)
}

let rec check_expr = (context, expr) =>
switch expr {
| CstI(_) => (TInt, list{})
| Var(x) => (context->assoc(x)->forceGet, list{})
| If(test, so_body, else_body) => {
let t = var_fresher()
let (t1, c1) = check_expr(context, test)
let (t2, c2) = check_expr(context, so_body)
let (t3, c3) = check_expr(context, else_body)
(t, List.concatMany([c1, c2, c3, list{(t1, TBool), (t, t2), (t, t3)}]))
}

| Func(x, body) => {
let tx = var_fresher()
let (tb, cb) = check_expr(list{(x, tx), ...context}, body)
(TArr(tx, tb), cb)
}

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

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

let rec type_subst = (typ, subst) => {
let (x, t) = subst
switch typ {
| TVar(y) =>
if x == y {
t
} else {
typ
}
| TArr(t1, t2) => TArr(type_subst(t1, subst), type_subst(t2, subst))
| _ => typ
}
}

let rec type_substs = (typ, substs) => {
let rec has_var = typ =>
switch typ {
| TVar(_) => true
| TArr(t1, t2) => has_var(t1) || has_var(t2)
| _ => false
}

let rec go = (typ, substs) =>
switch substs {
| list{} => typ
| list{subst, ...rest} => go(type_subst(typ, subst), rest)
}

let t = go(typ, substs)
if has_var(t) {
type_substs(t, substs)
} else {
t
}
}

let solve = constraints => {
let rec go = (constraints, s) => {
let rec occurs = (x, t) =>
switch t {
| TVar(y) => x == y
| TArr(t1, t2) => occurs(x, t1) || occurs(x, t2)
| _ => false
}

switch constraints {
| list{} => s
| list{co, ...rest} =>
switch co {
| (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)
let subst = (x, t)
go(
rest->List.map(e => {
let (t1, t2) = e
(type_subst(t1, subst), type_subst(t2, subst))
}),
list{subst, ...s},
)
}

| _ => assert false
}
}
}

go(constraints, list{})
}

let (t, constraints) = check_expr(list{}, expr)
let substs = solve(constraints)
type_substs(t, substs)
}

let case = Func(
"f",
Func(
"a",
Func(
"b",
If(Var("a"), Prim(Add, Apply(Var("f"), Var("b")), CstI(1)), Apply(Var("f"), Var("a"))),
),
),
)

Js.log(case->infer->typ_to_string)
``````

mono，unify

``````open Belt

let forceGet = Option.getExn
let roundString = str => "(" ++ str ++ ")"
let assoc = (env, x) => env->List.getAssoc(x, (a, b) => a == b)

type rec typ = TInt | TBool | TVar(ref<tvar>) | TArr(typ, typ)

let typ_to_string = typ => {
let eagerBracket = (x, test) =>
if test {
x->roundString
} else {
x
}

let rec go = (typ, test) =>
switch typ {
| TInt => "Int"
| TBool => "Bool"
| TVar({contents: tvar}) =>
"Var" ++
switch tvar {
}
| TArr(t1, t2) => (go(t1, true) ++ " -> " ++ go(t2, false))->eagerBracket(test)
}

go(typ, false)
}

type rec expr =
| CstI(int)
| Var(string)
| If(expr, expr, expr)
| Func(string, expr)
| Apply(expr, expr)
| Prim(prim, expr, expr)

let infer = expr => {
let count = ref(0)
let var_fresher = () => {
let cur = count.contents
let var = "T/" ++ cur->Int.toString
count := cur + 1
}

let rec repr_type = t =>
switch t {
| TVar(tvar) =>
switch tvar.contents {
let t = t->repr_type
t
}
}

| _ => t
}

let rec deep_repr_type = t =>
switch t {
| TVar(tvar) =>
switch tvar.contents {
let t = t->deep_repr_type
t
}
}
| TArr(t1, t2) => TArr(t1->deep_repr_type, t2->deep_repr_type)

| _ => t
}

let rec unify = (t1, t2) => {
let rec occurs = (x, t) =>
switch t {
| TVar({contents: y}) => x == y
| TArr(t1, t2) => occurs(x, t1) || occurs(x, t2)
| _ => false
}

let t1 = t1->repr_type
let t2 = t2->repr_type
if t1 == t2 {
()
} else {
switch (t1, t2) {
| (TInt, TInt) | (TBool, TBool) => ()
| (TArr(t1, t2), TArr(t3, t4)) => {
unify(t1, t3)
unify(t2, t4)
}

| (TVar(tvar), t) | (t, TVar(tvar)) => {
assert !occurs(tvar.contents, t)
}

| _ => assert false
}
}
}

let rec check_expr = (context, expr) =>
switch expr {
| CstI(_) => TInt
| Var(x) => context->assoc(x)->forceGet
| If(test, so_body, else_body) => {
let t = var_fresher()
let t1 = check_expr(context, test)
let t2 = check_expr(context, so_body)
let t3 = check_expr(context, else_body)
unify(t1, TBool)
unify(t, t2)
unify(t, t3)
t
}

| Func(x, body) => {
let tx = var_fresher()
let tb = check_expr(list{(x, tx), ...context}, body)
TArr(tx, tb)
}

| Apply(e1, e2) => {
let t = var_fresher()
let t1 = check_expr(context, e1)
let t2 = check_expr(context, e2)
unify(t1, TArr(t2, t))
t
}

| Prim(_, e1, e2) => {
let t1 = check_expr(context, e1)
let t2 = check_expr(context, e2)
unify(t1, TInt)
unify(t2, TInt)
TInt
}
}

check_expr(list{}, expr)->deep_repr_type
}

let case = Func(
"f",
Func(
"a",
Func(
"b",
If(Var("a"), Prim(Add, Apply(Var("f"), Var("b")), CstI(1)), Apply(Var("f"), Var("a"))),
),
),
)

Js.log(case->infer->typ_to_string)
``````

poly，unify

``````open Belt

let forceGet = Option.getExn
let roundString = str => "(" ++ str ++ ")"
let curlyString = str => "{" ++ str ++ "}"
let assoc = (env, x) => env->List.getAssoc(x, (a, b) => a == b)

let curlyBracket = (x, test) =>
if test {
(" " ++ x ++ " ")->curlyString
} else {
x
}

type rec typ = TInt | TBool | TVar(ref<tvar>) | TArr(typ, typ) | Gen(array<string>, typ)

let typ_to_string = typ => {
let eagerBracket = (x, test) =>
if test {
x->roundString
} else {
x
}

let rec go = (typ, test) =>
switch typ {
| TInt => "Int"
| TBool => "Bool"
| TVar({contents: tvar}) =>
"Var" ++
switch tvar {
}
| TArr(t1, t2) => (go(t1, true) ++ " -> " ++ go(t2, false))->eagerBracket(test)
| Gen(qvars, t) => "forall: " ++ qvars->Array.joinWith(", ", x => x) ++ ". " ++ go(t, false)
}

go(typ, false)
}

type prim = Add | Sub | Mul | Eq

type rec expr =
| CstI(int)
| CstB(bool)
| Var(string)
| If(expr, expr, expr)
| Func(string, expr)
| Apply(expr, expr)
| Prim(prim, expr, expr)
| Let(string, expr, expr)

let expr_to_string = expr => {
let rec go = (parent_prior, expr) =>
switch expr {
| CstI(n) =>
if n < 0 {
n->Int.toString->roundString
} else {
n->Int.toString
}
| CstB(b) =>
if b {
"true"
} else {
"false"
}
| Var(x) => x
| If(test, so_body, else_body) =>
"if " ++
go(0, test) ++
" " ++
go(0, so_body)->curlyBracket(true) ++
" else " ++
go(0, else_body)->curlyBracket(true)
| Func(x, expr) => ("[" ++ x ++ "]" ++ " => " ++ go(1, expr))->curlyBracket(parent_prior > 1)
| Apply(e1, e2) => go(0, e1) ++ go(0, e2)->roundString
| Prim(prim, e1, e2) =>
switch prim {
| Add => go(0, e1) ++ " + " ++ go(0, e2)
| Sub => go(0, e1) ++ " - " ++ go(0, e2)
| Mul => go(0, e1) ++ " × " ++ go(0, e2)
| Eq => go(0, e1) ++ " == " ++ go(0, e2)
}
| Let(x, e1, e2) =>
("let " ++ x ++ " = " ++ go(2, e1) ++ " " ++ go(0, e2)->curlyBracket(true))
->curlyBracket(parent_prior > 0)
}

go(0, expr)
}

let infer = expr => {
let count = ref(0)
let var_fresher = level => {
let cur = count.contents
let var = "T/" ++ cur->Int.toString
count := cur + 1
}

let rec repr_type = t =>
switch t {
| TVar(tvar) =>
switch tvar.contents {
let t = t->repr_type
t
}
}

| _ => t
}

let rec deep_repr_type = t =>
switch t {
| TVar(tvar) =>
switch tvar.contents {
let t = t->deep_repr_type
t
}
}
| TArr(t1, t2) => TArr(t1->deep_repr_type, t2->deep_repr_type)

| _ => t
}

let rec unify = (t1, t2) => {
let rec occurs = (x, t) =>
switch t {
| TVar({contents: y}) => x == y
| TArr(t1, t2) => occurs(x, t1) || occurs(x, t2)
| _ => false
}

let t1 = repr_type(t1)
let t2 = repr_type(t2)
if t1 == t2 {
()
} else {
switch (t1, t2) {
| (TInt, TInt) | (TBool, TBool) => ()
| (TArr(t1, t2), TArr(t3, t4)) => {
unify(t1, t3)
unify(t2, t4)
}

| (
) =>
if level1 >= level2 {
} else {
}

| (TVar(tvar), t) | (t, TVar(tvar)) => {
assert !occurs(tvar.contents, t)
}

| _ => assert false
}
}
}

let inst = (t, level) => {
let subst = (qvar, new_tvar, t) => {
let rec go = t =>
switch t {
| TInt | TBool => t
| TVar({contents: tvar}) =>
switch tvar {
if x == qvar {
new_tvar
} else {
t
}
| _ => assert false
}
| TArr(t1, t2) => TArr(go(t1), go(t2))

| Gen(_, _) => assert false
}

go(t)
}

switch t {
| Gen(qvars, ti) => {
let length = qvars->Array.length
let ti = ref(ti)
if length > 0 {
qvars->Array.forEach(qvar => {
ti := subst(qvar, var_fresher(level), ti.contents)
})
ti.contents
} else {
assert false
}
}

| _ => t
}
}

let gen = (t, level) => {
let rec get_qvars = t => {
switch t {
| TInt | TBool => []
| TVar({contents: tvar}) =>
switch tvar {
if level_inner >= level {
[x]
} else {
[]
}
| _ => assert false
}
| TArr(t1, t2) => Array.concat(t1->get_qvars, t2->get_qvars)

| Gen(_, _) => assert false
}
}

let t = t->deep_repr_type
let qvars = t->get_qvars
if qvars->Array.length > 0 {
let qvars = HashSet.String.fromArray(qvars)->HashSet.String.toArray
let t_gen = Gen(qvars, t)
Js.log("__gen|-\t" ++ typ_to_string(t_gen))
t_gen
} else {
Js.log("nogen|-\t" ++ typ_to_string(t))
t
}
}

let rec check_expr = (context, expr, level) =>
switch expr {
// expr: TInt
| CstI(_) => TInt
// expr: TBool
| CstB(_) => TBool
| Var(x) => inst(context->assoc(x)->forceGet, level)
// expr: t = fresh T && U(t1, TBool) U(t, t2) U(t, t3)
| If(test, so_body, else_body) => {
let t = var_fresher(level)
let t1 = check_expr(context, test, level)
let t2 = check_expr(context, so_body, level)
let t3 = check_expr(context, else_body, level)
unify(t1, TBool)
unify(t, t2)
unify(t, t3)
t
}

// expr: tx->tb tx = fresh T
| Func(x, body) => {
let tx = var_fresher(level)
let tb = check_expr(list{(x, tx), ...context}, body, level + 1)
TArr(tx, tb)
}

// expr: t = fresh T && U(t1, t2->t)
| Apply(e1, e2) => {
let t = var_fresher(level)
let t1 = check_expr(context, e1, level)
let t2 = check_expr(context, e2, level)
unify(t1, TArr(t2, t))
t
}

| Prim(prim, e1, e2) => {
let t1 = check_expr(context, e1, level)
let t2 = check_expr(context, e2, level)
unify(t1, TInt)
unify(t2, TInt)
switch prim {
// expr: TInt && U(t1, TInt) U(t2, TInt)
| Add | Sub | Mul => TInt
// expr: TBool && U(t1, TInt) U(t2, TInt)
| Eq => TBool
}
}

// expr: t2
| Let(x, e1, e2) => {
let e1_context = list{(x, var_fresher(level)), ...context}
let t1 = check_expr(e1_context, e1, level + 1)
let t_gen = gen(t1, level)
let e2_context = list{(x, t_gen), ...context}
let t2 = check_expr(e2_context, e2, level)
t2
}
}

gen(check_expr(list{}, expr, 0), 0)
}

let cases = [
Func(
"f",
Func(
"a",
Func(
"b",
If(Var("a"), Prim(Add, Apply(Var("f"), Var("b")), CstI(1)), Apply(Var("f"), Var("a"))),
),
),
),
Func("x", Let("y", Var("x"), Var("y"))),
Func("x", Let("y", Func("z", Var("x")), Var("y"))),
Let(
"id",
Func("x", Var("x")),
Let(
"a",
Apply(Var("id"), CstI(42)),
Let("b", Apply(Var("id"), CstB(true)), If(Var("b"), Var("a"), CstI(11))),
),
),
Func("f", Let("g", Var("f"), Apply(Var("g"), CstI(42)))),
Let(
"fact",
Func(
"n",
If(
Prim(Eq, Var("n"), CstI(0)),
CstI(1),
Prim(Mul, Var("n"), Apply(Var("fact"), Prim(Sub, Var("n"), CstI(1)))),
),
),
Apply(Var("fact"), CstI(5)),
),
]

cases->Array.forEach(case => {
Js.log("input|-\t" ++ expr_to_string(case))
case->infer->ignore
Js.log("")
})
``````

...全文
173 回复 打赏 收藏 转发到动态 举报

230

rescript开发语言 个人社区 广东省·深圳市

• 近7日
• 近30日
• 至今