有的時候，IO的異常處理由于需要一個IOEnv類型的參數而顯得非常麻煩。這個時候我們可以定制自己的一套異常處理系統，從而讓程序變得清晰起來。自己的異常處理系統不同于IO，是沒有副作用的函數集合。下面讓我們看一看如何使用自定義的異常處理系統來分析一個四則運算表達式。
首先，為了使用do-end，我們需要定義一套共4個函數：
1 type Parser T = maybe T (pair string (list token))
2 func parsed T :: T -> Parser T
3 def parsed x = success x
4 func error T :: (pair string (list token)) -> Parser T
5 def error x = fail x
6 func (>>>) T1 T2 :: Parser T1 -> Parser T2 -> Parser T2
7 def (>>>) a b = a >>= \p->b
8 func (>>=) T1 T2:: Parser T1 -> (T1 -> Parser T2) -> Parser T2
9 def (>>=) a b = select a of
10 case fail x : fail x
11 case success x : b x
12 end
加上類型的原因是，異常處理系統需要對類型進行嚴格的約束，但是我們的代碼產生的類型比期望的類型更加寬松。現在使用我們已經熟悉到無法再熟悉、連方法都可以倒著背出來、代碼都能夠倒著寫的
遞歸下降法進行分析：
1 def getfactor tokens = do
2 select head tokens of
3 case t_num x : parsed (pair x (tail tokens))
4 case t_leftbrace : do
5 expression = getexp (tail tokens);
6 select expression of
7 case pair value remains :
8 if(token_startwith t_rightbrace remains)
9 (parsed (pair value (tail remains)))
10 (error (pair "此處需要右括號" remains))
11 end;
12 end
13 else : error (pair "此處需要表達式" tokens)
14 end;
15 end
16
17 def getterm tokens =
18 let
19 def _getterm current tokens ismul = do
20 factor = getfactor tokens;
21 value = parsed (pairfirst factor);
22 remains = parsed (pairsecond factor);
23 new_current = parsed (if ismul (fmul current value) (fdiv current value));
24 if (isempty remains)
25 (parsed (pair new_current remains))
26 select head remains of
27 case t_mul : _getterm new_current (tail remains) true
28 case t_div : _getterm new_current (tail remains) false
29 else : parsed (pair new_current remains)
30 end;
31 end
32 in _getterm 1.0 tokens true
33
34 def getexp tokens =
35 let
36 def _getexp current tokens isadd = do
37 term = getterm tokens;
38 value = parsed (pairfirst term);
39 remains = parsed (pairsecond term);
40 new_current = parsed (if isadd (fadd current value) (fsub current value));
41 if (isempty remains)
42 (parsed (pair new_current remains))
43 select head remains of
44 case t_add : _getexp new_current (tail remains) true
45 case t_sub : _getexp new_current (tail remains) false
46 else : parsed (pair new_current remains)
47 end;
48 end
49 in _getexp 0.0 tokens true
上面的三個函數接受的是list 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
9
10 data token_stream = token_stream (list token) string
11
12 def token_getnum input =
13 let
14 def _getnum output input =
15 select input of
16 case list x tail : if (and (cegt x '0') (celt x '9')) (_getnum (list x output) tail) (pair output input)
17 case empty : pair output input
18 end
19 in select _getnum "" input of
20 case pair output input : pair (reverse output) input
21 end
22
23 def token_atof input = select atof input of
24 case success number : number
25 end
26
27 def token_split input =
28 let
29 def _split stream = select stream of
30 case token_stream tokens remain : select remain of
31 case empty : stream
32 case list '(' tail : _split (token_stream (list t_leftbrace tokens) tail)
33 case list ')' tail : _split (token_stream (list t_rightbrace tokens) tail)
34 case list '+' tail : _split (token_stream (list t_add tokens) tail)
35 case list '-' tail : _split (token_stream (list t_sub tokens) tail)
36 case list '*' tail : _split (token_stream (list t_mul tokens) tail)
37 case list '/' tail : _split (token_stream (list t_div tokens) tail)
38 else : select token_getnum remain of
39 case pair num tail : select num of
40 case empty : stream
41 case list x xs : _split (token_stream (list (t_num (token_atof num)) tokens) tail)
42 end
43 end
44 end
45 end
46 in select _split (token_stream empty input) of
47 case token_stream tokens remain : token_stream (reverse tokens) remain
48 end
49
50 def token_toint token = select token of
51 case t_leftbrace : 0
52 case t_rightbrace : 1
53 case t_add : 2
54 case t_sub : 3
55 case t_mul : 4
56 case t_div : 5
57 case t_num x : 6
58 end
59
60 def token_startwith token tokens = select tokens of
61 case empty : false
62 case list first remains : iequ (token_toint token) (token_toint first)
63 end
我們可以開始寫main函數了：
1 def main127 =select token_split "(1+2)*(3+4)" of
2 case token_stream tokens remains : getexp tokens
3 end
程序完成，看一下運行結果：
1 main127返回值：(system.success (system.pair 21.0 ""))
posted on 2008-12-18 21:23
陳梓瀚(vczh) 閱讀(1466)
評論(0) 編輯 收藏 引用 所屬分類:
腳本技術