為了測試Kernel FP的健壯性以及進(jìn)行一些bug的排除，一個四則運算式子的分析程序理所當(dāng)然地就被實現(xiàn)了。代碼如下：
這里使用的方法是，現(xiàn)將字符串切開，然后變成一段一段的，最后直接遍歷求值。譬如說輸入(1+2)*(3+4)要得到21。程序可以識別出錯誤，不過main函數(shù)忽略一切錯誤（因為懶得寫那么多if）。
P.S. 沒有語法糖寫起來還真是慘啊……等測試得差不多的時候就把高級的語法糖添加進(jìn)去。
首先要為token建模。四則運算式子的token類型有括號、運算符和數(shù)字：
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
然后是詞法分析的函數(shù)。token_split輸入一個字符串，輸出一個token數(shù)組和剩余的字符串。剩余的字符串如果存在的話，第一個字符是無法被識別的字符，譬如字母等：
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
接下來是語法分析。語法分析直接使用我們已經(jīng)熟練到無法再熟練，連方法都可以倒著背出來的遞歸下降法進(jìn)行分析：
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 "此處需要表達(dá)式") 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
有了這些函數(shù)之后，我們寫幾個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
下面就是結(jié)果啦！
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) 閱讀(3378)
評論(2) 編輯 收藏 引用 所屬分類:
腳本技術(shù)