有的时候，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) 阅读(1443)
评论(0) 编辑 收藏 引用 所属分类:
脚本技术