有的時(shí)候，IO的異常處理由于需要一個(gè)IOEnv類型的參數(shù)而顯得非常麻煩。這個(gè)時(shí)候我們可以定制自己的一套異常處理系統(tǒng)，從而讓程序變得清晰起來(lái)。自己的異常處理系統(tǒng)不同于IO，是沒(méi)有副作用的函數(shù)集合。下面讓我們看一看如何使用自定義的異常處理系統(tǒng)來(lái)分析一個(gè)四則運(yùn)算表達(dá)式。
首先，為了使用do-end，我們需要定義一套共4個(gè)函數(shù)：
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
加上類型的原因是，異常處理系統(tǒng)需要對(duì)類型進(jìn)行嚴(yán)格的約束，但是我們的代碼產(chǎn)生的類型比期望的類型更加寬松。現(xiàn)在使用我們已經(jīng)熟悉到無(wú)法再熟悉、連方法都可以倒著背出來(lái)、代碼都能夠倒著寫的
遞歸下降法進(jìn)行分析：
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 "此處需要右括號(hào)" remains))
11 end;
12 end
13 else : error (pair "此處需要表達(dá)式" 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
上面的三個(gè)函數(shù)接受的是list token。token及相關(guān)函數(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
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
我們可以開(kāi)始寫main函數(shù)了：
1 def main127 =select token_split "(1+2)*(3+4)" of
2 case token_stream tokens remains : getexp tokens
3 end
程序完成，看一下運(yùn)行結(jié)果：
1 main127返回值：(system.success (system.pair 21.0 ""))
posted on 2008-12-18 21:23
陳梓瀚(vczh) 閱讀(1448)
評(píng)論(0) 編輯 收藏 引用 所屬分類:
腳本技術(shù)