丘奇数（Church Numerals）和lambda calculus

丘奇数（Church Numerals）和lambda calculus

    以前为了开发KFP，特别学习了一下lambda calculus（也就是我的博客的标题啦）。lanbda calculus是一门神奇的语言，在计算机出现之前就已经被搞出来了。这门语言只有三种语法，然后可以用这个语法来构造整数（！！！）、布尔型和很多递归数据结构等。

    首先介绍一下语法。
    1、func arg代表一个函数调用，func是函数表达式，arg是参数。
    2、\param.value代表一个函数定义，参数是param，返回结果value。
    3、(expr)代表expr的优先级较高。

    上面就是所有的语法了。乍一看好像什么都没有，其实不然。我们现在先看一个东西：函数定义。
    为一个函数定义一个名称是很简单的：
    let double = \num.inc (inc num)) in ...
    代码“...”可以访问到函数double，但是函数定义的内部却不行。不过这并不会带来什么问题（其实是可以递归的，有办法）。当然let-in不是一个合法的lambda calculus程序，不过可以被翻译为：
    (\double. ...) (\num.inc (inc num))
    根据语法规则1，可以将后面的整个函数当作实参传入形参，将所有的double都替换成后面的那个东西，于是double的名称就被定下来了。

    递归怎么办呢？譬如说要写个函数sum n来计算1+2+...+n的值：
    let sum n = if (n==0) 0 (n+(sum (n-1))) in ...
    这里为了方便，我们假设所有的运算符都是存在的。其实a op b可以看成函数调用op a b，如果我们给每一个运算符都分配一个名字，实际上就可以用正确的lambda calculus语法来说明了。所以这里为了方便先这么干。

    sum内部是看不见sum的，因为翻译了之后变成：
    (\sum. ...) (if (n==0) 0 (n+(sum (n-1))))
    那怎么办呢？既然看不见自己，我可以让调用者再外部把它自己传进去当参数总可以吧：
    let sum n = \SELF. if (n==0) 0 (n + (SELF (n-1))) in ...
    但是我们不能用(sum sum)的方法来调用，因为到了最后(SELF (n-1))变成(sum (n-1))，下一步就错了。所以我们造了个Y函数：
    let Y = \f.(\t.f (t t)) (\t.f (t t)) in
    let sum = Y (\SELF. if (n==0) 0 (n + (SELF (n-1)))) in ...
    这样函数\SELF. if (n==0) 0 (n+(SELF (n-1))))就被Y变成了一个真正的递归函数了。不过在这里我不想花很大篇幅解释Y是怎么来的，有兴趣的读者看 这里。

    于是我们可以这么定义数字：
    zero = \s.\z.z
    one = \s.\z.s z
    two = \s.\z.s (s z)
    three = \s.\z.s (s (s z))
    four = \s.\z.s (s (s (s z)))
    数字n是一个函数，这个函数接受两个参数s和z，返回结果是拿s在z上应用n次的结果。所以我们可以很方便的实现乘法：拿“加法”函数当成第一个参数传进a，然后去应用b，就变成乘法了。我们首先创造一个加1函数：
    inc = \a.\s.\z.a s (s z)
    然后是加法和乘法：
    add = \a.\b.\s.\z.a s (b s z)
    mul = \a.\b.\s.\z.a (b s) z
    所以对代码mul (add (one two)) (add (three four))进行求值的时候，我们得到(1+2)*(3+4)=21：\s.\z.(s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s z)))))))))))))))))))))。

    布尔值也是一样的。我们让true接受两个参数返回第一个，false接受两个参数返回第二个：
    true = \a.\b.a
    false = \a.\b.b
    那么and or xor not可以分别写成：
    and = \a.\b.a b false
    or = \a.\b.a true b
    not = \a.a false true
    xor = \a.\b.a (not b) b
    函数if cond t f跟cond t f等价，所以我们不需要if函数。

    接下来怎么实现数据结构呢？假设我们实现一个pair，让pair 1 2将数字保存起来，让first(pair 1 2)返回1，second(pair 1 2)返回2：
    pair = \a.\b.\c.c a b
    first = \p.p true
    second = \p.p false
    我们举一个例子，让p=pair 1 (pair 2 3)，然后求first (second p)：
    first (second p) =
    first (second (pair 1 (pair 2 3))) =
    first ((pair 1(pair 2 3)) false) =
    first (false 1 (pair 2 3)) =
    first (pair 2 3) =
    (pair 2 3) true =
    true 2 3 =
    2
    是不是很神奇捏，lambda calculus仅需那么几条语法就可以实现所有东西了。将pair嵌套在一起可以构成一个列表。下面我们来写一个完整的程序，构造列表[1,2,3,4,5]，然后对每一个元素求平方后相加：1*1 + 2*2 + 3*3 + 4*4 + 5*5 = 55：

    下面是完整的程序：

 1  let Y  =  \f.(\t.f (t t)) (\t.f (t t))  in
 2 
 3  let  true   =  \a.\b.a  in
 4  let  false   =  \a.\b.b  in
 5  let and  =  \a.\b.a b  false   in
 6  let or  =  \a.\b.a  true  b  in
 7  let not  =  \a.a  false   true   in
 8  let xor  =  \a.\b.a (not b) b  in
 9 
10  let zero  =  \s.\z.z  in
11  let inc  =  \a.\s.\z.a s (s z)  in
12  let one  =  inc zero  in
13  let two  =  inc one  in
14  let three  =  inc two  in
15  let four  =  inc three  in
16  let five  =  inc four  in
17  let six  =  inc five  in
18  let seven  =  inc six  in
19  let eight  =  inc seven  in
20  let nine  =  inc eight  in
21  let ten  =  inc nine  in
22  let add  =  \a.\b.\s.\z.a s (b s z)  in
23  let mul  =  \a.\b.\s.\z.a (b s) z  in
24  let sqr  =  \a.mul a a  in
25 
26  let pair  =  \a.\b.\c.c a b  in
27  let first  =  \p.p  true   in
28  let second  =  \p.p  false   in
29  let empty  =  pair  false   false   in
30  let list  =  \a.\b.pair  true  (pair a b)  in
31  let head  =  \xs.(first xs) (first (second xs)) ERROR  in
32  let tail  =  \xs.(first xs) (second (second xs)) ERROR  in
33  let join  =  Y \SELF.\xs.\ys.(first xs) (list (head xs) (SELF (tail xs) ys)) ys  in
34  let trans  =  Y \SELF.\f.\xs.(first xs) (list (f (head xs)) (SELF f (tail xs))) empty  in
35 
36  let foldl  =  Y \SELF.\op.\init.\xs.(first xs) (SELF op (op init (head xs)) (tail xs)) init  in
37  let foldr  =  Y \SELF.\op.\init.\xs.(first xs) (op (head xs) (SELF op init (tail xs))) init  in
38  let length  =  foldl (\a.\b.inc a) zero  in
39  let sum  =  foldl add zero  in
40 
41  let long_list  =  list one (list two (list three (list four (list five empty))))  in
42 
43  sum (trans sqr long_list)

    然后是结果。首先我的lambda calculus虚拟机把let-in按照上面的方法重新转换为标准的lambda calculus程序，最后求值：

    数一数吧，上面有55个"(s"，所以结果就是55了。

    我们添加一个计算a的b次方的函数：pow = \a.\b.b (mul a) one，将最后几行改成：
    let one_to_five = list one (list two (list three (list four (list five empty)))) in
    let one_to_ten = join one_to_five (trans (add five) one_to_five) in
    let long_list = trans (pow two) one_to_ten in
    sum long_list
    这计算2^1 + 2^2 + ... + 2^9 + 2^10。结果太长，不截屏幕了，直接复制出来：

  1  (\Y.(\ true .(\ false .(\and.(\or.(\not.(\xor.(\zero.(\one.(\two.(\three.(\four.(\fi
  2  ve.(\six.(\seven.(\eight.(\nine.(\ten.(\inc.(\add.(\mul.(\pow.(\sqr.(\pair.(\fir
  3  st.(\second.(\empty.(\list.(\head.(\tail.(\join.(\trans.(\foldl.(\foldr.(\length
  4  .(\sum.(\one_to_five.(\one_to_ten.(\long_list.(sum long_list) ((trans (pow two))
  5   one_to_ten)) ((join one_to_five) ((trans (add five)) one_to_five))) ((list one)
  6   ((list two) ((list three) ((list four) ((list five) empty)))))) ((foldl add) ze
  7  ro)) ((foldl \a.\b.(inc a)) zero)) (Y \SELF.\op.\init.\xs.(((first xs) ((op (hea
  8  d xs)) (((SELF op) init) (tail xs)))) init))) (Y \SELF.\op.\init.\xs.(((first xs
  9  ) (((SELF op) ((op init) (head xs))) (tail xs))) init))) (Y \SELF.\f.\xs.(((firs
 10  t xs) ((list (f (head xs))) ((SELF f) (tail xs)))) empty))) (Y \SELF.\xs.\ys.(((
 11  first xs) ((list (head xs)) ((SELF (tail xs)) ys))) ys))) \xs.(((first xs) (seco
 12  nd (second xs))) ERROR)) \xs.(((first xs) (first (second xs))) ERROR)) \a.\b.((p
 13  air  true ) ((pair a) b))) ((pair  false )  false )) \p.(p  false )) \p.(p  true )) \a.\b.
 14  \c.((c a) b)) \a.((mul a) a)) \a.\b.((b (mul a)) one)) \a.\b.((b (add a)) zero))
 15   \a.\b.((b inc) a)) \a.\s.\z.((a s) (s z))) \s.\z.(s (s (s (s (s (s (s (s (s (s
 16  z))))))))))) \s.\z.(s (s (s (s (s (s (s (s (s z)))))))))) \s.\z.(s (s (s (s (s (
 17  s (s (s z))))))))) \s.\z.(s (s (s (s (s (s (s z)))))))) \s.\z.(s (s (s (s (s (s
 18  z))))))) \s.\z.(s (s (s (s (s z)))))) \s.\z.(s (s (s (s z))))) \s.\z.(s (s (s z)
 19  ))) \s.\z.(s (s z))) \s.\z.(s z)) \s.\z.z) \a.\b.((a (not b)) b)) \a.((a  false )
 20  true )) \a.\b.((a  true ) b)) \a.\b.((a b)  false )) \a.\b.b) \a.\b.a) \f.(\t.(f (t t
 21  )) \t.(f (t t))))
 22  最终结果：
 23  \s.\z.(s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 24   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 25  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 26  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 27   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 28  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 29  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 30   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 31  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 32  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 33   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 34  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 35  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 36   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 37  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 38  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 39   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 40  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 41  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 42   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 43  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 44  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 45   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 46  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 47  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 48   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 49  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 50  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 51   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 52  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 53  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 54   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 55  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 56  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 57   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 58  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 59  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 60   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 61  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 62  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 63   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 64  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 65  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 66   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 67  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 68  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 69   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 70  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 71  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 72   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 73  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 74  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 75   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 76  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 77  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 78   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 79  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 80  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 81   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 82  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 83  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 84   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 85  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 86  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 87   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 88  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 89  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 90   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 91  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 92  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 93   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 94  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 95  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 96   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (
 97  s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 98  (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s
 99   (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s z)))))))))))))))
100  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
101  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
102  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
103  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
104  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
105  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
106  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
107  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
108  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
109  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
110  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
111  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
112  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
113  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
114  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
115  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
116  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
117  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
118  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
119  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
120  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
121  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
122  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
123  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
124  ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
125  )))))))))))))))))))))))))))))))

    下面是lambda calculus虚拟机的C++代码。代码使用了Vczh Combinator Parser组装编译器，然后用一个池来存放运行时需要的东西，速度很快：

  1  #include  " ..\..\..\..\VL++\Library\Platform\VL_Console.h "
  2  #include  " ..\..\..\..\VL++\Library\Data\Data\VL_Data_Map.h "
  3  #include  " ..\..\..\..\VL++\Library\Data\Data\VL_Data_Pool.h "
  4  #include  " ..\..\..\..\VL++\Library\Data\VL_Stream.h "
  5  #include  " ..\..\..\..\VL++\Library\Data\VL_System.h "
  6  #include  " ..\..\..\..\VL++\Library\Data\Grammar2\Combinator\VL_CpKernel.h "
  7  #include  " ..\..\..\..\VL++\Library\Data\Grammar2\Combinator\VL_CpLexer.h "
  8 
  9  using   namespace  vl;
 10  using   namespace  vl::platform;
 11  using   namespace  vl::stream;
 12  using   namespace  vl::system;
 13  using   namespace  vl::pool;
 14  using   namespace  vl::grammar;
 15 
 16  /* ********************************************************************************************************
 17  运行时表达式
 18  ******************************************************************************************************** */
 19 
 20  enum  LambdaRuntimeKind
 21  {
 22      lrkPrimitive,
 23      lrkClosure,
 24      lrkInvoke
 25  };
 26  class  LambdaRuntime
 27  {
 28  public :
 29      typedef VL_Pool < LambdaRuntime >             RuntimePool;
 30 
 31      RuntimePool *                 Pool;
 32      LambdaRuntimeKind            Kind;
 33      VInt                        ID;
 34      LambdaRuntime *                 Closure;
 35      LambdaRuntime *                 Expression;
 36 
 37       void  SetPrimitive(RuntimePool *  aPool , VInt aID)
 38      {
 39          Pool = aPool;
 40          Kind = lrkPrimitive;
 41          ID = aID;
 42          Closure = 0 ;
 43          Expression = 0 ;
 44      }
 45 
 46       void  SetClosure(RuntimePool *  aPool , VInt aID , LambdaRuntime *  aExpression)
 47      {
 48          Pool = aPool;
 49          Kind = lrkClosure;
 50          ID = aID;
 51          Closure = 0 ;
 52          Expression = aExpression;
 53      }
 54 
 55       void  SetInvoke(RuntimePool *  aPool , LambdaRuntime *  aClosure , LambdaRuntime *  aExpression)
 56      {
 57          Pool = aPool;
 58          Kind = lrkInvoke;
 59          ID =- 1 ;
 60          Closure = aClosure;
 61          Expression = aExpression;
 62      }
 63 
 64      LambdaRuntime *  Alpha(VInt ExpID , LambdaRuntime *  Code)
 65      {
 66           switch (Kind)
 67          {
 68           case  lrkPrimitive:
 69               return  (ID == ExpID) ? Code: this ;
 70           case  lrkClosure:
 71               if (ID == ExpID)
 72              {
 73                   return   this ;
 74              }
 75               else
 76              {
 77                  LambdaRuntime *  NewExpression = Expression -> Alpha(ExpID,Code);
 78                   if (Expression == NewExpression)
 79                  {
 80                       return   this ;
 81                  }
 82                   else
 83                  {
 84                      LambdaRuntime *  AlphaTransformed = Pool -> Alloc();
 85                      AlphaTransformed -> SetClosure(Pool,ID,NewExpression);
 86                       return  AlphaTransformed;
 87                  }
 88              }
 89           case  lrkInvoke:
 90              {
 91                  LambdaRuntime *  NewClosure = Closure -> Alpha(ExpID,Code);
 92                  LambdaRuntime *  NewExpression = Expression -> Alpha(ExpID,Code);
 93                   if (Closure == NewClosure  &&  Expression == NewExpression)
 94                  {
 95                       return   this ;
 96                  }
 97                   else
 98                  {
 99                      LambdaRuntime *  AlphaTransformed = Pool -> Alloc();
100                      AlphaTransformed -> SetInvoke(Pool,NewClosure,NewExpression);
101                       return  AlphaTransformed;
102                  }
103              }
104           default :
105               return   0 ;
106          }
107      }
108 
109      LambdaRuntime *  Evaluate(VBool EvaluatingRoot)
110      {
111           switch (Kind)
112          {
113           case  lrkPrimitive:
114               return   this ;
115           case  lrkClosure:
116               if (EvaluatingRoot)
117              {
118                  Expression = Expression -> Evaluate( true );
119                   return   this ;
120              }
121               else
122              {
123                   return   this ;
124              }
125           case  lrkInvoke:
126              {
127                  Closure = Closure -> Evaluate( false );
128                   if (Closure -> Kind == lrkClosure)
129                  {
130                       * this =* Closure -> Expression -> Alpha(Closure -> ID,Expression) -> Evaluate(EvaluatingRoot);
131                       return   this ;
132                  }
133                   else
134                  {
135                      Expression = Expression -> Evaluate(EvaluatingRoot);
136                       return   this ;
137                  }
138              }
139           default :
140               return   0 ;
141          }
142      }
143  };
144 
145  class  LambdaEnvironment
146  {
147  public :
148      LambdaRuntime::RuntimePool    Pool;
149 
150      LambdaEnvironment():Pool( 65536 )
151      {
152      }
153  };
154 
155  /* ********************************************************************************************************
156  语法树
157  ******************************************************************************************************** */
158 
159  class  LambdaError
160  {
161  public :
162      VUnicodeString Message;
163 
164      LambdaError(VUnicodeString aMessage)
165      {
166          Message = aMessage;
167      }
168  };
169 
170  class  LambdaIdentifier
171  {
172  public :
173      typedef VL_ListedMap < VUnicodeString , VInt >         TokenMap;
174      typedef VL_ListedMap < VInt , VUnicodeString >         TokenMapRev;
175 
176      VUnicodeString            Token;
177      VInt                    ID;
178 
179      LambdaIdentifier()
180      {
181          ID =- 1 ;
182      }
183 
184      VBool  operator == ( const  LambdaIdentifier &  Identifier)
185      {
186           return  ID == Identifier.ID;
187      }
188 
189      VBool  operator != ( const  LambdaIdentifier &  Identifier)
190      {
191           return  ID != Identifier.ID;
192      }
193 
194       void  Initialize(TokenMap &  Tokens)
195      {
196          VInt Index = Tokens.IndexOfKey(Token);
197           if (Index ==- 1 )
198          {
199              ID = Tokens.KeyCount();
200              Tokens.Add(Token,ID);
201          }
202           else
203          {
204              ID = Tokens.ValueOfIndex(Index);
205          }
206      }
207 
208       void  Initialize(TokenMapRev &  Tokens)
209      {
210          Token = Tokens[ID];
211      }
212 
213       void  Collect(TokenMapRev &  Tokens)
214      {
215          Tokens.Add(ID,Token);
216      }
217  };
218 
219  class  LambdaCode :  public  VL_Base
220  {
221  public :
222      typedef VL_AutoPtr < LambdaCode >                             Ptr;
223 
224      friend LambdaCode::Ptr        CreateCode(LambdaRuntime *  Runtime);
225 
226       virtual   void                 Initialize(LambdaIdentifier::TokenMap &  Tokens) = 0 ;
227       virtual   void                 Initialize(LambdaIdentifier::TokenMapRev &  Tokens) = 0 ;
228       virtual   void                 Collect(LambdaIdentifier::TokenMapRev &  Tokens) = 0 ;
229       virtual  VUnicodeString        ToString() = 0 ;
230       virtual  LambdaRuntime *         CreateRuntime(LambdaEnvironment *  Environment) = 0 ;
231 
232      LambdaCode::Ptr Evaluate()
233      {
234          LambdaEnvironment Environment;
235          LambdaRuntime *  Runtime = CreateRuntime( & Environment);
236          LambdaRuntime *  Evaluated = Runtime -> Evaluate( true );
237          LambdaCode::Ptr Code = CreateCode(Evaluated);
238          LambdaIdentifier::TokenMapRev Tokens;
239          Collect(Tokens);
240          Code -> Initialize(Tokens);
241           return  Code;
242      }
243  };
244 
245  class  LambdaCodePrimitive :  public  LambdaCode
246  {
247  public :
248      LambdaIdentifier        Name;
249 
250       void  Initialize(LambdaIdentifier::TokenMap &  Tokens)
251      {
252          Name.Initialize(Tokens);
253      }
254 
255       void  Initialize(LambdaIdentifier::TokenMapRev &  Tokens)
256      {
257          Name.Initialize(Tokens);
258      }
259 
260       void  Collect(LambdaIdentifier::TokenMapRev &  Tokens)
261      {
262          Name.Collect(Tokens);
263      }
264 
265      VUnicodeString ToString()
266      {
267           return  Name.Token;
268      }
269 
270      LambdaRuntime *  CreateRuntime(LambdaEnvironment *  Environment)
271      {
272          LambdaRuntime *  Runtime = Environment -> Pool.Alloc();
273          Runtime -> SetPrimitive( & Environment -> Pool,Name.ID);
274           return  Runtime;
275      }
276  };
277 
278  class  LambdaCodeClosure :  public  LambdaCode
279  {
280  public :
281      LambdaIdentifier        Parameter;
282      LambdaCode::Ptr            Expression;
283 
284       void  Initialize(LambdaIdentifier::TokenMap &  Tokens)
285      {
286          Parameter.Initialize(Tokens);
287          Expression -> Initialize(Tokens);
288      }
289 
290       void  Initialize(LambdaIdentifier::TokenMapRev &  Tokens)
291      {
292          Parameter.Initialize(Tokens);
293          Expression -> Initialize(Tokens);
294      }
295 
296       void  Collect(LambdaIdentifier::TokenMapRev &  Tokens)
297      {
298          Parameter.Collect(Tokens);
299          Expression -> Collect(Tokens);
300      }
301 
302      VUnicodeString ToString()
303      {
304           return  L " \\ " + Parameter.Token + L " . " + Expression -> ToString();
305      }
306 
307      LambdaRuntime *  CreateRuntime(LambdaEnvironment *  Environment)
308      {
309          LambdaRuntime *  Runtime = Environment -> Pool.Alloc();
310          Runtime -> SetClosure( & Environment -> Pool,Parameter.ID,Expression -> CreateRuntime(Environment));
311           return  Runtime;
312      }
313  };
314 
315  class  LambdaCodeInvoke :  public  LambdaCode
316  {
317  public :
318      LambdaCode::Ptr            Function;
319      LambdaCode::Ptr            Argument;
320 
321       void  Initialize(LambdaIdentifier::TokenMap &  Tokens)
322      {
323          Function -> Initialize(Tokens);
324          Argument -> Initialize(Tokens);
325      }
326 
327       void  Initialize(LambdaIdentifier::TokenMapRev &  Tokens)
328      {
329          Function -> Initialize(Tokens);
330          Argument -> Initialize(Tokens);
331      }
332 
333       void  Collect(LambdaIdentifier::TokenMapRev &  Tokens)
334      {
335          Function -> Collect(Tokens);
336          Argument -> Collect(Tokens);
337      }
338 
339      VUnicodeString ToString()
340      {
341           return  L " ( " + Function -> ToString() + L "   " + Argument -> ToString() + L " ) " ;
342      }
343 
344      LambdaRuntime *  CreateRuntime(LambdaEnvironment *  Environment)
345      {
346          LambdaRuntime *  Runtime = Environment -> Pool.Alloc();
347          Runtime -> SetInvoke( & Environment -> Pool,Function -> CreateRuntime(Environment),Argument -> CreateRuntime(Environment));
348           return  Runtime;
349      }
350  };
351 
352  LambdaCode::Ptr CreateCode(LambdaRuntime *  Runtime)
353  {
354       switch (Runtime -> Kind)
355      {
356       case  lrkPrimitive:
357          {
358              LambdaCodePrimitive *  Primitive = new  LambdaCodePrimitive;
359              Primitive -> Name.ID = Runtime -> ID;
360               return  Primitive;
361          }
362       case  lrkClosure:
363          {
364              LambdaCodeClosure *  Closure = new  LambdaCodeClosure;
365              Closure -> Parameter.ID = Runtime -> ID;
366              Closure -> Expression = CreateCode(Runtime -> Expression);
367               return  Closure;
368          }
369       case  lrkInvoke:
370          {
371              LambdaCodeInvoke *  Invoke = new  LambdaCodeInvoke;
372              Invoke -> Function = CreateCode(Runtime -> Closure);
373              Invoke -> Argument = CreateCode(Runtime -> Expression);
374               return  Invoke;
375          }
376       default :
377           return   0 ;
378      }
379  }
380 
381  /* ********************************************************************************************************
382  语法分析器
383  ******************************************************************************************************** */
384 
385  enum  LambdaTokenID
386  {
387      ltiLet,
388      ltiIn,
389      ltiClosure,
390      ltiName,
391      ltiLeft,
392      ltiRight,
393      ltiDot,
394      ltiEqual,
395  };
396 
397  LambdaCode::Ptr ToPrimitive(VL_CpToken Token)
398  {
399      LambdaCodePrimitive *  Primitive = new  LambdaCodePrimitive;
400      Primitive -> Name.Token = VUnicodeString(Token.Start,Token.Length);
401       return  Primitive;
402  }
403 
404  LambdaCode::Ptr ToInvoke( const  VL_CpList < LambdaCode::Ptr >&  Input)
405  {
406      LambdaCode::Ptr Code = Input.Head -> Data;
407      VL_CpList < LambdaCode::Ptr > ::Node::Ptr Current = Input.Head -> Next;
408       while (Current)
409      {
410          LambdaCodeInvoke *  Invoke = new  LambdaCodeInvoke;
411          Invoke -> Function = Code;
412          Invoke -> Argument = Current -> Data;
413          Code = Invoke;
414          Current = Current -> Next;
415      }
416       return  Code;
417  }
418 
419  LambdaCode::Ptr ToClosure( const  VL_CpPair < VL_CpToken , LambdaCode::Ptr >&  Input)
420  {
421      LambdaCodeClosure *  Closure = new  LambdaCodeClosure;
422      Closure -> Parameter.Token = VUnicodeString(Input.First.Start,Input.First.Length);
423      Closure -> Expression = Input.Second;
424       return  Closure;
425  }
426 
427  LambdaCode::Ptr ToLetIn( const  VL_CpPair < VL_CpPair < VL_CpToken , LambdaCode::Ptr >  , LambdaCode::Ptr >&  Input)
428  {
429      LambdaCodeInvoke *  Invoke = new  LambdaCodeInvoke;
430      Invoke -> Function = ToClosure(VL_CpPair < VL_CpToken , LambdaCode::Ptr > (Input.First.First,Input.Second));
431      Invoke -> Argument = Input.First.Second;
432       return  Invoke;
433  }
434 
435  LambdaCode::Ptr Parse(VUnicodeString Code)
436  {
437      VL_CpLexer Lexer;
438      Lexer
439           << Token( false ,L " let " ,ltiLet)
440           << Token( false ,L " in " ,ltiIn)
441           << Token( false ,L " \\ " ,ltiClosure)
442           << Token( false ,L " ( " ,ltiLeft)
443           << Token( false ,L " ) " ,ltiRight)
444           << Token( false ,L " . " ,ltiDot)
445           << Token( false ,L " = " ,ltiEqual)
446           << Token( false ,_Name,ltiName)
447           << Token( true ,_Blank, - 1 )
448           << Token( true ,_CComment, - 1 )
449           << Token( true ,_CppComment, - 1 )
450          ;
451 
452      typedef _Wrapper < VL_CpTokenNodePtr , LambdaCode::Ptr >  CodeRule;
453      typedef _Terminal < VL_CpTokenNodePtr , LambdaCode::Ptr >  CodeTerminal;
454 
455      CodeRule Unit,Expr;
456 
457      CodeTerminal Primitive  =
458          (ToPrimitive  <<=  Token(ltiName));
459 
460      CodeTerminal Closure  =  
461          (ToClosure  <<=  ((Toks(L " \\ " )  >  Token(ltiName)  <  Toks(L " . " ))  +  Expr));
462 
463      CodeTerminal Bracket  =  
464          (Toks(L " ( " )  >  Expr  <  Toks(L " ) " ));
465 
466      CodeTerminal InExpr  =
467          Toks(L " in " )  >  Expr;
468 
469      Unit =
470          Primitive  ||  Closure  ||  Bracket;
471 
472      CodeTerminal Invoke =
473          (ToInvoke  <<=   ++ Unit);
474 
475      CodeTerminal LetIn =
476          (ToLetIn  <<= ((Toks(L " let " )  >  Token(ltiName)  <  Toks(L " = " ))  +  Expr  +  InExpr));
477 
478      Expr =
479          Invoke  ||  LetIn;
480 
481      VL_CpParser < VL_CpTokenNodePtr , LambdaCode::Ptr >  Parser = Expr;
482 
483      LambdaCode::Ptr Lambda = Parser.Parse(Lexer.Parse(Code.Buffer()).First.Head).Head -> Data.First;
484 
485      LambdaIdentifier::TokenMap Tokens;
486      Lambda -> Initialize(Tokens);
487       return  Lambda;
488  }
489 
490  /* ********************************************************************************************************
491  主程序
492  ******************************************************************************************************** */
493 
494  void  vlmain()
495  {
496      GetConsole() -> SetTitle(L " Vczh Lambda Evaluator " );
497      GetConsole() -> SetTestMemoryLeaks( true );
498      GetConsole() -> SetPauseOnExit( true );
499 
500      VUnicodeString WorkSpace = VFileName(GetConsole() -> GetAppPath()).MakeAbsolute(L " ..\\TestData\\ " ).GetStrW();
501      VUnicodeString Code;
502      {
503          VL_FileStream Stream(WorkSpace + L " Program_01.txt " ,VL_FileStream::vomRead);
504          Code = ReadText( & Stream);
505      }
506 
507       try
508      {
509          LambdaCode::Ptr Lambda = Parse(Code);
510          GetConsole() -> WriteLine(Lambda -> ToString());
511           try
512          {
513              LambdaCode::Ptr Evaluated = Lambda -> Evaluate();
514              GetConsole() -> WriteLine(L " 最终结果： " );
515              GetConsole() -> WriteLine(Evaluated -> ToString());
516          }
517           catch ( const  LambdaError &  Error)
518          {
519              GetConsole() -> WriteLine(Error.Message);
520          }
521      }
522       catch ( const  VL_CpException < VL_CpTokenNodePtr >&  e)
523      {
524           if (e.Input)
525          {
526              GetConsole() -> WriteLine(L " 第 " + VUnicodeString(e.Input -> Data.Line + 1 ) + L " 行，记号\ "" +VUnicodeString(e.Input->Data.Start,e.Input->Data.Length)+L " \ " 附近有语法错误。 " );
527          }
528           else
529          {
530              GetConsole() -> WriteLine(L " 程序末尾附近出现语法错误。 " );
531          }
532      }
533  }