5
| Caract�res of char list
6
| Alternative of expr * expr
7
| S�quence of expr * expr
14
let rec sub = function
16
| elem :: l -> if mem elem l2 then sub l else elem :: sub l in
20
fold_right (fun e res -> if mem e res then res else e :: res) l1 l2;;
22
let intervalle c1 c2 =
23
let rec interv n1 n2 =
24
if n1 > n2 then [] else char_of_int n1 :: interv (n1 + 1) n2 in
25
interv (int_of_char c1) (int_of_char c2);;
27
let tous_car = intervalle '\000' '\255';;
29
let rec lire_expr = parser
30
| [< r1 = lire_s�q; r2 = lire_alternative r1 >] -> r2
32
and lire_alternative r1 = parser
33
| [< ''|'; r2 = lire_expr >] -> Alternative(r1,r2)
37
| [< r1 = lire_r�p�t; r2 = lire_fin_s�q r1 >] -> r2
39
and lire_fin_s�q r1 = parser
40
| [< r2 = lire_s�q >] -> S�quence(r1,r2)
43
and lire_r�p�t = parser
44
| [< r1 = lire_simple; r2 = lire_fin_r�p�t r1 >] -> r2
46
and lire_fin_r�p�t r1 = parser
47
| [< ''*' >] -> R�p�tition r1
48
| [< ''+' >] -> S�quence(r1, R�p�tition r1)
49
| [< ''?' >] -> Alternative(r1, Epsilon)
52
and lire_simple = parser
53
| [< ''.' >] -> Caract�res tous_car
54
| [< ''['; cl = lire_classe >] -> Caract�res cl
55
| [< ''('; r = lire_expr; '')' >] -> r
56
| [< ''\\'; 'c >] -> Caract�res [c]
57
| [< 'c when c <> '|' && c <> ')' && c <> '$' >] ->
60
and lire_classe = parser
61
| [< ''^'; cl = lire_ensemble >] -> subtract tous_car cl
62
| [< cl = lire_ensemble >] -> cl
64
and lire_ensemble = parser
66
| [< c1 = lire_car; c2 = lire_intervalle c1 >] -> c2
68
and lire_intervalle c1 = parser
69
| [< ''-'; c2 = lire_car; reste = lire_ensemble >] ->
70
union (intervalle c1 c2) reste
71
| [< reste = lire_ensemble >] -> union [c1] reste
74
| [< ''\\'; 'c >] -> c
78
| [< chapeau = (parser | [< ''^' >] -> true | [< >] -> false);
80
dollar = (parser | [< ''$' >] -> true | [< >] -> false) >] ->
82
if dollar then r else S�quence(r, R�p�tition(Caract�res tous_car)) in
83
if chapeau then r1 else S�quence(R�p�tition(Caract�res tous_car), r1);;