230
社区成员
在此稱術語:(de Bruijn index)爲德布朗數,(de Bruijn level)爲德布朗水平線。
我們先假定一種約定:
故解釋lambda式項時,首次進入後,將首先訪問函式項分支或調用項分支。
我們在程式中,取n,並賦值給count變量;取N,並賦值給body變量。並對body進行演算,得果爲result。此時注意,程式裏後續使用了wrap_func函式把原函式項參數λn重新補充回result。即λn.(result)。
Fun(_) => {
let (count, body) = extract(lambda)
let result = calculus(body)
wrap_func(count, result)
}
wrap_func函式的關鍵邏輯在于,演算結果result是否是函式項。若是函式項,則原函式德布朗參數會跟演算結果result的德布朗參數發生索引衝突。
假設演算結果result爲λm.M,則lambda等價于λn.(λm.M)。
具體案例如λ2.(λ2.(0)(1)(2)(3))。其n=2,m=2,λm.M爲λ2.(0)(1)(2)(3),wrap_func(2, λ2.(0)(1)(2)(3))運行結果應當爲λ4.(2)(3)(0)(1)。
我們應注意到,輸入λ2.(λ2.M),真正形態是λ(0).λ(1).(λ(0').λ(1').M),運行結果形態爲λ(0).λ(1).λ(2).λ(3).M。
故程式邏輯,應將(0')爲(2),將(1')爲(3)。代碼如下:
let rec wrap_func = (count, lambda) => {
if count < 0 {
assert false
} else if count == 0 {
lambda
} else {
switch lambda {
| Fun(_) => {
let (bcount, body) = extract(lambda)
let t1 = direct_wrap_func(count + bcount, shift_one(body, 0))
let t2 = direct_reduce(t1, Var(0), 2)
let new_count = count - 1
wrap_func(new_count, direct_unwrap_func(new_count, t2))
/*
性能優化版
let (bcount, body) = extract(lambda)
let t1 = direct_wrap_func(bcount, shift_one(body, 0))
let t2 = Fun(reduce(t1, Var(0), count, count))
let new_count = count - 1
wrap_func(new_count, t2)
*/
}
| _ => direct_wrap_func(count, lambda)
}
}
}
又若X爲函式項λn.N,則應執行歸約(λn.N)[Y'/0],其中Y'=shift(n, Y, 0)。
並對歸約結果,以當前層級爲基準,將所有德布朗數減一,把原函式項參數盡數補充回。
let call_reduce = (lambda, va) => {
let (count, body) = extract(lambda)
let t = direct_reduce(body, shift(count, va, 0), 0)
wrap_func(count - 1, unshift_one(t, 0))
}
常規測試
用例 (λ.0)(λ.0) ==> λ.0
輸入 (λ.0)(λ.0)
輸出 λ.0用例 (λ.(0)(λ.0))(λ.0) ==> λ.0
輸入 (λ.(0)(λ.0))(λ.0)
輸出 λ.0用例 (λ.0)(λλ.(0)(1)) ==> λλ.(0)(1)
輸入 (λ.0)(λλ.(0)(1))
輸出 λλ.(0)(1)用例 (λλ.(1)(0))(λλ.(1)(0)) ==> λ.(0)(λλ.(1)(0))
輸入 (λλ.(1)(0))(λλ.(1)(0))
輸出 λ.(0)(λλ.(1)(0))用例 (λλλ.(1)(2))(λλλ.(0)(1)(2)) ==> λλ.(0)(1)
輸入 (λλλ.(1)(2))(λλλ.(0)(1)(2))
輸出 λλ.(0)(1)用例 (λλλ.(1)(2))(λλλ.(0)((1)(2))) ==> λλ.(0)(1)
輸入 (λλλ.(1)(2))(λλλ.(0)((1)(2)))
輸出 λλ.(0)(1)用例 (λλλ.0)(λλλ.(0)((1)(2))) ==> λλλλλ.(2)((3)(4))
輸入 (λλλ.0)(λλλ.(0)((1)(2)))
輸出 λλλλλ.(2)((3)(4))用例 λ.(λλ.(0)(1))(0) ==> λλ.(0)(1)
輸入 λ.(λλ.(0)(1))(0)
輸出 λλ.(0)(1)用例 λλ.(λλλλ.(0)(1)(2)(3))(1)(0) ==> λλλλ.(1)(0)(2)(3)
輸入 λλ.(λλλλ.(0)(1)(2)(3))(1)(0)
輸出 λλλλ.(1)(0)(2)(3)邱奇測試
用例 if_zero_then_else 0 ==> T
輸入 (λ.(0)(λλλ.2)(λλ.0))(λλ.1)
輸出 λλ.0用例 if_zero_then_else 2 ==> F
輸入 (λ.(0)(λλλ.2)(λλ.0))(λλ.(0)((0)(1)))
輸出 λλ.1用例 succ 3 ==> 4
輸入 (λλλ.(1)((0)(1)(2)))(λλ.(0)((0)((0)(1))))
輸出 λλ.(0)((0)((0)((0)(1))))用例 pred 4 ==> 3
輸入 (λ.(λ.(0)(λλ.0))((0)(λ.(λλλ.(2)(0)(1))((λ.(0)(λλ.1))(0))((λλλ.(1)((0)(1)(2)))((λ.(0)(λλ.1))(0))))((λλλ.(2)(0)(1))(λλ.1)(λλ.1))))(λλ.(0)((0)((0)((0)(1)))))
輸出 λλ.(0)((0)((0)(1)))用例 2 + 3 ==> 5
輸入 (λλλλ.(0)(2)((1)(2)(3)))(λλ.(0)((0)(1)))(λλ.(0)((0)((0)(1))))
輸出 λλ.(0)((0)((0)((0)((0)(1)))))用例 5 - 2 ==> 3
輸入 (λλ.(1)(λ.(λ.(0)(λλ.0))((0)(λ.(λλλ.(2)(0)(1))((λ.(0)(λλ.1))(0))((λλλ.(1)((0)(1)(2)))((λ.(0)(λλ.1))(0))))((λλλ.(2)(0)(1))(λλ.1)(λλ.1))))(0))(λλ.(0)((0)((0)((0)((0)(1))))))(λλ.(0)((0)(1)))
輸出 λλ.(0)((0)((0)(1)))用例 multi1 4 × 3 ==> 12
輸入 (λλ.(λ.(0)(λλλ.2)(λλ.0))(0)(λλ.1)((0)(λ.(λλλλ.(0)(2)((1)(2)(3)))(0)(2))(λλ.1)))(λλ.(0)((0)((0)((0)(1)))))(λλ.(0)((0)((0)(1))))
輸出 λλ.(0)((0)((0)((0)((0)((0)((0)((0)((0)((0)((0)((0)(1))))))))))))用例 multi2 4 × 3 ==> 12
輸入 (λλλλ.(0)(λ.(2)(3)(0))(3))(λλ.(0)((0)((0)((0)(1)))))(λλ.(0)((0)((0)(1))))
輸出 λλ.(0)((0)((0)((0)((0)((0)((0)((0)((0)((0)((0)((0)(1))))))))))))用例 multi_wF 4 × 3 ==> 12
輸入 (λ.(0)(0))(λλλ.(λ.(0)(λλλ.2)(λλ.0))(1)(λλ.1)((λλλλ.(0)(2)((1)(2)(3)))(2)((λ.(0)(0))(0)((λ.(λ.(0)(λλ.0))((0)(λ.(λλλ.(2)(0)(1))((λ.(0)(λλ.1))(0))((λλλ.(1)((0)(1)(2)))((λ.(0)(λλ.1))(0))))((λλλ.(2)(0)(1))(λλ.1)(λλ.1))))(1))(2))))(λλ.(0)((0)((0)((0)(1)))))(λλ.(0)((0)((0)(1))))
輸出 λλ.(0)((0)((0)((0)((0)((0)((0)((0)((0)((0)((0)((0)(1))))))))))))用例 multi_YF 4 × 3 ==> 12
輸入 (λ.(λ.(0)(0))(λ.(1)((λ.(0)(0))(0))))(λλλ.(λ.(0)(λλλ.2)(λλ.0))(1)(λλ.1)((λλλλ.(0)(2)((1)(2)(3)))(2)((0)((λ.(λ.(0)(λλ.0))((0)(λ.(λλλ.(2)(0)(1))((λ.(0)(λλ.1))(0))((λλλ.(1)((0)(1)(2)))((λ.(0)(λλ.1))(0))))((λλλ.(2)(0)(1))(λλ.1)(λλ.1))))(1))(2))))(λλ.(0)((0)((0)((0)(1)))))(λλ.(0)((0)((0)(1))))
輸出 λλ.(0)((0)((0)((0)((0)((0)((0)((0)((0)((0)((0)((0)(1))))))))))))用例 factorial_wF 3 ==> 6
輸入 (λ.(0)(0))(λλ.(λ.(0)(λλλ.2)(λλ.0))(1)(λλ.(0)(1))((λ.(0)(0))(λλλ.(λ.(0)(λλλ.2)(λλ.0))(1)(λλ.1)((λλλλ.(0)(2)((1)(2)(3)))(2)((λ.(0)(0))(0)((λ.(λ.(0)(λλ.0))((0)(λ.(λλλ.(2)(0)(1))((λ.(0)(λλ.1))(0))((λλλ.(1)((0)(1)(2)))((λ.(0)(λλ.1))(0))))((λλλ.(2)(0)(1))(λλ.1)(λλ.1))))(1))(2))))(1)((λ.(0)(0))(0)((λ.(λ.(0)(λλ.0))((0)(λ.(λλλ.(2)(0)(1))((λ.(0)(λλ.1))(0))((λλλ.(1)((0)(1)(2)))((λ.(0)(λλ.1))(0))))((λλλ.(2)(0)(1))(λλ.1)(λλ.1))))(1)))))(λλ.(0)((0)((0)(1))))
輸出 λλ.(0)((0)((0)((0)((0)((0)(1))))))用例 factorial_YF 3 ==> 6
輸入 (λ.(λ.(0)(0))(λ.(1)((λ.(0)(0))(0))))(λλ.(λ.(0)(λλλ.2)(λλ.0))(1)(λλ.(0)(1))((λ.(λ.(0)(0))(λ.(1)((λ.(0)(0))(0))))(λλλ.(λ.(0)(λλλ.2)(λλ.0))(1)(λλ.1)((λλλλ.(0)(2)((1)(2)(3)))(2)((0)((λ.(λ.(0)(λλ.0))((0)(λ.(λλλ.(2)(0)(1))((λ.(0)(λλ.1))(0))((λλλ.(1)((0)(1)(2)))((λ.(0)(λλ.1))(0))))((λλλ.(2)(0)(1))(λλ.1)(λλ.1))))(1))(2))))(1)((0)((λ.(λ.(0)(λλ.0))((0)(λ.(λλλ.(2)(0)(1))((λ.(0)(λλ.1))(0))((λλλ.(1)((0)(1)(2)))((λ.(0)(λλ.1))(0))))((λλλ.(2)(0)(1))(λλ.1)(λλ.1))))(1)))))(λλ.(0)((0)((0)(1))))
輸出 λλ.(0)((0)((0)((0)((0)((0)(1))))))
open Belt
open Common
let roundString = str => "(" ++ str ++ ")"
let assoc = (x, env) => env->List.getAssoc(x, (a, b) => a == b)
type rec lambda /* 式項 */ =
| Var(int) // 底項
| Fun(lambda) // 函式項
| App(lambda, lambda) // 調用項
let print_lambda = lambda => {
let print_dot = is_parent_function =>
if is_parent_function {
"."
} else {
""
}
let print_paren = (test, x) =>
if test {
roundString(x)
} else {
x
}
let rec go = (lambda, is_parent_function) => {
switch lambda {
| Fun(body) => "λ" ++ go(body, true)
| Var(x) => print_dot(is_parent_function) ++ x->Int.toString
| App(m, n) =>
print_dot(is_parent_function) ++
print_paren(
switch m {
| App(_, _) => false
| _ => true
},
go(m, false),
) ++
roundString(go(n, false))
}
}
go(lambda, false)
}
let shift = (offset, lambda, depth) => {
let rec go = (offset, lambda, depth) => {
switch lambda {
| App(m, n) => App(go(offset, m, depth), go(offset, n, depth))
| Fun(body) => Fun(go(offset, body, depth + 1))
| Var(index) =>
if index >= depth {
Var(index + offset)
} else {
lambda
}
}
}
go(offset, lambda, depth)
}
let shift_one = (lambda, depth) => shift(1, lambda, depth)
let unshift_one = (lambda, depth) => shift(-1, lambda, depth)
let rec reduce = (lambda, va, index, p_start_index) => {
switch lambda {
| App(m, n) =>
App(reduce(m, va, index, p_start_index), reduce(n, va, index, p_start_index))
| Fun(body) => Fun(reduce(body, shift_one(va, p_start_index), index + 1, p_start_index))
| Var(n) =>
if n == index {
va
} else {
lambda
}
}
}
let direct_reduce = (lambda, va, p_start_index) => reduce(lambda, va, 0, p_start_index)
let rec extract = lambda =>
switch lambda {
| Fun(body) => {
let (n, b) = extract(body)
(1 + n, b)
}
| _ => (0, lambda)
}
let rec wrap_func = (count, lambda) => {
let rec direct_wrap_func = (count, body) => {
if count == 0 {
body
} else if count < 0 {
switch body {
| Fun(child) => direct_wrap_func(count + 1, child)
| _ => assert false
}
} else {
direct_wrap_func(count - 1, Fun(body))
}
}
let direct_unwrap_func = (count, body) => direct_wrap_func(-count, body)
if count < 0 {
assert false
} else if count == 0 {
lambda
} else {
switch lambda {
| Fun(_) => {
let (bcount, body) = extract(lambda)
let t1 = direct_wrap_func(count + bcount, shift_one(body, 0))
let t2 = direct_reduce(t1, Var(0), 2)
let new_count = count - 1
wrap_func(new_count, direct_unwrap_func(new_count, t2))
/*
let (bcount, body) = extract(lambda)
let t1 = direct_wrap_func(bcount, shift_one(body, 0))
let t2 = Fun(reduce(t1, Var(0), count, count))
let new_count = count - 1
wrap_func(new_count, t2)
*/
}
| _ => direct_wrap_func(count, lambda)
}
}
}
let rec calculus = lambda => {
let call_reduce = (lambda, va) => {
let (count, body) = extract(lambda)
let t = direct_reduce(body, shift(count, va, 0), 0)
wrap_func(count - 1, unshift_one(t, 0))
}
// 此式項內是否存在函式項。
let rec has_unreduced_function = lambda =>
switch lambda {
| App(m, _) =>
switch m {
| Fun(_) => true
| _ => has_unreduced_function(m)
}
| _ => false
}
let rec go = (lambda, depth) => {
switch lambda {
| Var(_) => lambda
| Fun(_) => {
let (count, body) = extract(lambda)
wrap_func(count, calculus(body))
}
| App(m, n) =>
switch m {
| Fun(_) => {
let t = call_reduce(m, n)
if depth == 0 {
calculus(t)
} else {
t
}
}
| _ =>
if has_unreduced_function(m) {
// 若左式項尚存在未歸約的函式項,則先演算左式項。
let ma = go(m, depth + 1)
go(App(ma, n), depth)
} else {
// 因左式項全部歸約完畢,故開始演算右式項。
App(m, calculus(n))
}
}
}
}
go(lambda, 0)
}
type case_pair = {
case: string,
lambda: lambda,
}
let normal_lambdas = list{
{
case: "(λ.0)(λ.0) ==> λ.0",
lambda: App(Fun(Var(0)), Fun(Var(0))),
},
{
case: "(λ.(0)(λ.0))(λ.0) ==> λ.0",
lambda: App(Fun(App(Var(0), Fun(Var(0)))), Fun(Var(0))),
},
{
case: "(λ.0)(λλ.(0)(1)) ==> λλ.(0)(1)",
lambda: App(Fun(Var(0)), Fun(Fun(App(Var(0), Var(1))))),
},
{
case: "(λλ.(1)(0))(λλ.(1)(0)) ==> λ.(0)(λλ.(1)(0))",
lambda: App(Fun(Fun(App(Var(1), Var(0)))), Fun(Fun(App(Var(1), Var(0))))),
},
{
case: "(λλλ.(1)(2))(λλλ.(0)(1)(2)) ==> λλ.(0)(1)",
lambda: App(
Fun(Fun(Fun(App(Var(1), Var(2))))),
Fun(Fun(Fun(App(App(Var(0), Var(1)), Var(2))))),
),
},
{
case: "(λλλ.(1)(2))(λλλ.(0)((1)(2))) ==> λλ.(0)(1)",
lambda: App(
Fun(Fun(Fun(App(Var(1), Var(2))))),
Fun(Fun(Fun(App(Var(0), App(Var(1), Var(2)))))),
),
},
{
case: "(λλλ.0)(λλλ.(0)((1)(2))) ==> λλλλλ.(2)((3)(4))",
lambda: App(Fun(Fun(Fun(Var(0)))), Fun(Fun(Fun(App(Var(0), App(Var(1), Var(2))))))),
},
{
case: "λ.(λλ.(0)(1))(0) ==> λλ.(0)(1)",
lambda: Fun(App(Fun(Fun(App(Var(0), Var(1)))), Var(0))),
},
{
case: "λλ.(λλλλ.(0)(1)(2)(3))(1)(0) ==> λλλλ.(1)(0)(2)(3)",
lambda: Fun(
Fun(
App(App(Fun(Fun(Fun(Fun(App(App(App(Var(0), Var(1)), Var(2)), Var(3)))))), Var(1)), Var(0)),
),
),
},
}
// λλ.0
let b_true = Fun(Fun(Var(0)))
// λλ.1
let b_false = Fun(Fun(Var(1)))
// λλλ.(1)((0)(1)(2))
let succ = Fun(Fun(Fun(App(Var(1), App(App(Var(0), Var(1)), Var(2))))))
// λλ.1
let zero = Fun(Fun(Var(1)))
// λλ.(0)(1)
let one = calculus(App(succ, zero))
// λλ.(0)((0)(1))
let two = calculus(App(succ, one))
// λλ.(0)((0)((0)(1)))
let three = calculus(App(succ, two))
// λλ.(0)((0)((0)((0)(1))))
let four = calculus(App(succ, three))
// λλ.(0)((0)((0)((0)((0)(1)))))
let five = calculus(App(succ, four))
// λ.(0)(λ.(F))(T)
let if_zero_then_else = Fun(App(App(Var(0), wrap_func(1, b_false)), b_true))
// λλλ.(2)(0)(1)
let pair = Fun(Fun(Fun(App(App(Var(2), Var(0)), Var(1)))))
// λ.(0)(b_true)
let first = Fun(App(Var(0), b_true))
// λ.(0)(b_false)
let second = Fun(App(Var(0), b_false))
// λλλλ.(0)(2)((1)(2)(3))
let add = Fun(Fun(Fun(Fun(App(App(Var(0), Var(2)), App(App(Var(1), Var(2)), Var(3)))))))
// λ.(pair)(second (0))((succ)(second (0)))
let pred_it = Fun(App(App(pair, App(second, Var(0))), App(succ, App(second, Var(0)))))
// (pair)(zero)(zero)
let pair_zero = App(App(pair, zero), zero)
// λ.(first)((0)(pred_it)(pair_zero))
let pred = Fun(App(first, App(App(Var(0), pred_it), pair_zero)))
// λλ.(1)(pred)(0)
let minus = Fun(Fun(App(App(Var(1), pred), Var(0))))
// λλ.(if_zero_then_else)(0)(zero)((0)(λ.(add)(0)(2))(zero))
let multi1 = Fun(
Fun(
App(
App(App(if_zero_then_else, Var(0)), zero),
App(App(Var(0), Fun(App(App(add, Var(0)), Var(2)))), zero),
),
),
)
// λλλλ.(0)(λ.(2)(3)(0))(3)
let multi2 = Fun(Fun(Fun(Fun(App(App(Var(0), Fun(App(App(Var(2), Var(3)), Var(0)))), Var(3))))))
// λ.(0)(0)
let combinator_w = Fun(App(Var(0), Var(0)))
// λ.(combinator_w)(λ.(1)((combinator_w)(0)))
let combinator_Y = Fun(App(combinator_w, Fun(App(Var(1), App(combinator_w, Var(0))))))
// (combinator_w)(λλλ.(if_zero_then_else)(1)(zero)((add)(2)((combinator_w)(0)((pred)(1))(2))))
let multi_wF = App(
combinator_w,
Fun(
Fun(
Fun(
App(
App(App(if_zero_then_else, Var(1)), zero),
App(App(add, Var(2)), App(App(App(combinator_w, Var(0)), App(pred, Var(1))), Var(2))),
),
),
),
),
)
// λλλ.(if_zero_then_else)(1)(zero)((add)(2)((0)((pred)(1))(2)))
let multi_F = Fun(
Fun(
Fun(
App(
App(App(if_zero_then_else, Var(1)), zero),
App(App(add, Var(2)), App(App(Var(0), App(pred, Var(1))), Var(2))),
),
),
),
)
let multi_YF = App(combinator_Y, multi_F)
// (combinator_w)(λλ.(if_zero_then_else)(1)(one)((multi_wF)(1)((combinator_w)(0)((pred)(1)))))
let factorial_wF = App(
combinator_w,
Fun(
Fun(
App(
App(App(if_zero_then_else, Var(1)), one),
App(App(multi_wF, Var(1)), App(App(combinator_w, Var(0)), App(pred, Var(1)))),
),
),
),
)
// λλ.(if_zero_then_else)(1)(one)((multi_YF)(1)((0)((pred)(1))))
let factorial_F = Fun(
Fun(
App(
App(App(if_zero_then_else, Var(1)), one),
App(App(multi_YF, Var(1)), App(Var(0), App(pred, Var(1)))),
),
),
)
let factorial_YF = App(combinator_Y, factorial_F)
let church_lambdas = list{
{
case: "if_zero_then_else 0 ==> T",
lambda: App(if_zero_then_else, zero),
},
{
case: "if_zero_then_else 2 ==> F",
lambda: App(if_zero_then_else, two),
},
{
case: "succ 3 ==> 4",
lambda: App(succ, three),
},
{
case: "pred 4 ==> 3",
lambda: App(pred, four),
},
{
case: "2 + 3 ==> 5",
lambda: App(App(add, two), three),
},
{
case: "5 - 2 ==> 3",
lambda: App(App(minus, five), two),
},
{
case: "multi1 4 × 3 ==> 12",
lambda: App(App(multi1, four), three),
},
{
case: "multi2 4 × 3 ==> 12",
lambda: App(App(multi2, four), three),
},
{
case: "multi_wF 4 × 3 ==> 12",
lambda: App(App(multi_wF, four), three),
},
{
case: "multi_YF 4 × 3 ==> 12",
lambda: App(App(multi_YF, four), three),
},
{
case: "factorial_wF 3 ==> 6",
lambda: App(factorial_wF, three),
},
{
case: "factorial_YF 3 ==> 6",
lambda: App(factorial_YF, three),
},
}
let testSuit = pairs => {
pairs->List.forEach(pair => {
let {case, lambda} = pair
Js.log("用例\t" ++ case)
Js.log("輸入\t" ++ print_lambda(lambda))
let reduction = calculus(lambda)
Js.log("輸出\t" ++ print_lambda(reduction))
Js.log("")
})
}
Js.log("常規測試")
testSuit(normal_lambdas)
Js.log("邱奇測試")
testSuit(church_lambdas)