为了测试Kernel FP的健壮性以及进行一些bug的排除，一个四则运算式子的分析程序理所当然地就被实现了。代码如下：
这里使用的方法是，现将字符串切开，然后变成一段一段的，最后直接遍历求值。譬如说输入(1+2)*(3+4)要得到21。程序可以识别出错误，不过main函数忽略一切错误（因为懒得写那么多if）。
P.S. 没有语法糖写起来还真是惨啊……等测试得差不多的时候就把高级的语法糖添加进去。
首先要为token建模。四则运算式子的token类型有括号、运算符和数字：
1 data token
2 = t_leftbrace
3 | t_rightbrace
4 | t_add
5 | t_sub
6 | t_mul
7 | t_div
8 | t_num float
然后是词法分析的函数。token_split输入一个字符串，输出一个token数组和剩余的字符串。剩余的字符串如果存在的话，第一个字符是无法被识别的字符，譬如字母等：
1 data token_stream = token_stream (list token) string
2
3 def token_getnum input =
4 let
5 def _getnum output input =
6 select input of
7 case list x tail : if (and (cegt x '0') (celt x '9')) (_getnum (list x output) tail) (pair output input)
8 case empty : pair output input
9 end
10 in select _getnum "" input of
11 case pair output input : pair (reverse output) input
12 end
13
14 def token_atof input = select atof input of
15 case success number : number
16 end
17
18 def token_split input =
19 let
20 def _split stream = select stream of
21 case token_stream tokens remain : select remain of
22 case empty : stream
23 case list '(' tail : _split (token_stream (list t_leftbrace tokens) tail)
24 case list ')' tail : _split (token_stream (list t_rightbrace tokens) tail)
25 case list '+' tail : _split (token_stream (list t_add tokens) tail)
26 case list '-' tail : _split (token_stream (list t_sub tokens) tail)
27 case list '*' tail : _split (token_stream (list t_mul tokens) tail)
28 case list '/' tail : _split (token_stream (list t_div tokens) tail)
29 else : select token_getnum remain of
30 case pair num tail : select num of
31 case empty : stream
32 case list x xs : _split (token_stream (list (t_num (token_atof num)) tokens) tail)
33 end
34 end
35 end
36 end
37 in select _split (token_stream empty input) of
38 case token_stream tokens remain : token_stream (reverse tokens) remain
39 end
接下来是语法分析。语法分析直接使用我们已经熟练到无法再熟练，连方法都可以倒着背出来的递归下降法进行分析：
1 def token_toint token = select token of
2 case t_leftbrace : 0
3 case t_rightbrace : 1
4 case t_add : 2
5 case t_sub : 3
6 case t_mul : 4
7 case t_div : 5
8 case t_num x : 6
9 end
10
11 def token_startwith token tokens = select tokens of
12 case empty : false
13 case list first remains : iequ (token_toint token) (token_toint first)
14 end
15
16 data expression
17 = e_add expression expression
18 | e_sub expression expression
19 | e_mul expression expression
20 | e_div expression expression
21 | e_num float
22 | e_error string
23
24 def exp_getfactor tokens = select head tokens of
25 case t_num x : pair (success x) (tail tokens)
26 case t_leftbrace : select exp_getexp (tail tokens) of
27 case pair first remains : select first of
28 case fail message : pair first remains
29 case success x :
30 if (token_startwith t_rightbrace remains)
31 (pair first (tail remains))
32 (pair (fail "此处需要右括号") remains)
33 end
34 end
35 else : pair (fail "此处需要表达式") tokens
36 end
37
38 def exp_getterm tokens=
39 let
40 def _getterm current tokens ismul = select exp_getfactor tokens of
41 case pair result remains : select result of
42 case fail message : pair result remains
43 case success x :
44 let
45 def new_current=if ismul (fmul current x) (fdiv current x)
46 in if (isempty remains)
47 (pair (success new_current) remains)
48 select head remains of
49 case t_mul : _getterm new_current (tail remains) true
50 case t_div : _getterm new_current (tail remains) false
51 else : pair (success new_current) remains
52 end
53 end
54 end
55 in _getterm 1.0 tokens true
56
57 def exp_getexp tokens=
58 let
59 def _getexp current tokens isadd = select exp_getterm tokens of
60 case pair result remains : select result of
61 case fail message : pair result remains
62 case success x :
63 let
64 def new_current=if isadd (fadd current x) (fsub current x)
65 in if (isempty remains)
66 (pair (success new_current) remains)
67 select head remains of
68 case t_add : _getexp new_current (tail remains) true
69 case t_sub : _getexp new_current (tail remains) false
70 else : pair (success new_current) remains
71 end
72 end
73 end
74 in _getexp 0.0 tokens true
有了这些函数之后，我们写几个main来测试它们：
1 def main97 = token_getnum "123vczh"
2 def main98 = token_getnum "vczh123"
3 def main99 = token_split "(1+2)*(3+4)"
4 def main100 = select token_split "(1+2)*(3+4)" of
5 case token_stream tokens remains : exp_getexp tokens
6 end
7 def main101 = select token_split "(1+2)*(3+4)" of
8 case token_stream tokens remains : pairfirst (exp_getexp tokens)
9 end
下面就是结果啦！
1 main97返回值：(sysutils.pair "123" "vczh")
2 main98返回值：(sysutils.pair "" "vczh123")
3 main99返回值：(startup.token_stream [startup.t_leftbrace , (startup.t_num 1.0) , startup.t_add , (startup.t_num 2.0) , startup.t_rightbrace , startup.t_mul , startup.t_leftbrace , (startup.t_num 3.0) , startup.t_add , (startup.t_num 4.0) ,startup.t_rightbrace] "")
4 main100返回值：(sysutils.pair (system.success 21.0) "")
5 main101返回值：(system.success 21.0)
返回system.success 21.0！娃哈哈……
posted on 2008-12-13 07:13
陈梓瀚(vczh) 阅读(3342)
评论(2) 编辑 收藏 引用 所属分类:
脚本技术