有的時候，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 =do20       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) true28 case t_div : _getterm new_current (tail remains) false29 else : parsed (pair new_current remains)
30         end;
31     end
32 in _getterm 1.0 tokens true33 34 def getexp tokens =35   let
36     def _getexp current tokens isadd =do37       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) true45 case t_sub : _getexp new_current (tail remains) false46 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) string11 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 : 052 case t_rightbrace : 153 case t_add : 254 case t_sub : 355 case t_mul : 456 case t_div : 557 case t_num x : 658 end
59 60 def token_startwith token tokens = select tokens of
61 case empty : false62 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-19 13:23 陳梓瀚(vczh) 閱讀(1303) 評論(0)  編輯 收藏 引用 所屬分類: 指令碼技術