1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Pierre Weis, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* only by permission. *)
(* *)
(***********************************************************************)
open List;;
type expr =
| Epsilon
| Caractres of char list
| Alternative of expr * expr
| Squence of expr * expr
| Rptition of expr;;
let subtract l1 l2 =
match l1, l2 with
| _, [] | [], _ -> l1
| _ ->
let rec sub = function
| [] -> []
| elem :: l -> if mem elem l2 then sub l else elem :: sub l in
sub l1;;
let union l1 l2 =
fold_right (fun e res -> if mem e res then res else e :: res) l1 l2;;
let intervalle c1 c2 =
let rec interv n1 n2 =
if n1 > n2 then [] else char_of_int n1 :: interv (n1 + 1) n2 in
interv (int_of_char c1) (int_of_char c2);;
let tous_car = intervalle '\000' '\255';;
let rec lire_expr = parser
| [< r1 = lire_sq; r2 = lire_alternative r1 >] -> r2
and lire_alternative r1 = parser
| [< ''|'; r2 = lire_expr >] -> Alternative(r1,r2)
| [< >] -> r1
and lire_sq = parser
| [< r1 = lire_rpt; r2 = lire_fin_sq r1 >] -> r2
and lire_fin_sq r1 = parser
| [< r2 = lire_sq >] -> Squence(r1,r2)
| [< >] -> r1
and lire_rpt = parser
| [< r1 = lire_simple; r2 = lire_fin_rpt r1 >] -> r2
and lire_fin_rpt r1 = parser
| [< ''*' >] -> Rptition r1
| [< ''+' >] -> Squence(r1, Rptition r1)
| [< ''?' >] -> Alternative(r1, Epsilon)
| [< >] -> r1
and lire_simple = parser
| [< ''.' >] -> Caractres tous_car
| [< ''['; cl = lire_classe >] -> Caractres cl
| [< ''('; r = lire_expr; '')' >] -> r
| [< ''\\'; 'c >] -> Caractres [c]
| [< 'c when c <> '|' && c <> ')' && c <> '$' >] ->
Caractres [c]
and lire_classe = parser
| [< ''^'; cl = lire_ensemble >] -> subtract tous_car cl
| [< cl = lire_ensemble >] -> cl
and lire_ensemble = parser
| [< '']' >] -> []
| [< c1 = lire_car; c2 = lire_intervalle c1 >] -> c2
and lire_intervalle c1 = parser
| [< ''-'; c2 = lire_car; reste = lire_ensemble >] ->
union (intervalle c1 c2) reste
| [< reste = lire_ensemble >] -> union [c1] reste
and lire_car = parser
| [< ''\\'; 'c >] -> c
| [< 'c >] -> c;;
let lire = parser
| [< chapeau = (parser | [< ''^' >] -> true | [< >] -> false);
r = lire_expr;
dollar = (parser | [< ''$' >] -> true | [< >] -> false) >] ->
let r1 =
if dollar then r else Squence(r, Rptition(Caractres tous_car)) in
if chapeau then r1 else Squence(Rptition(Caractres tous_car), r1);;
|
