~ubuntu-branches/ubuntu/karmic/ocaml-doc/karmic

« back to all changes in this revision

Viewing changes to examples/grep/expr.ml

  • Committer: Bazaar Package Importer
  • Author(s): Vanicat Rémi
  • Date: 2002-02-05 10:51:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020205105143-a061tunf8tev07ne
Tags: 3.04-4
* New debian maintainer
* Split doc-base file
* Move to non-free
* Change the copyright file to the copyright of the documentation
* remove FAQs (their license prohibit their redistribution)
* corrected the examples

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
open List;;
 
2
 
 
3
type expr =
 
4
  | Epsilon
 
5
  | Caract�res of char list
 
6
  | Alternative of expr * expr
 
7
  | S�quence of expr * expr
 
8
  | R�p�tition of expr;;
 
9
 
 
10
let subtract l1 l2 =
 
11
  match l1, l2 with
 
12
  | _, [] | [], _ -> l1
 
13
  | _ ->
 
14
     let rec sub = function
 
15
       | [] -> []
 
16
       | elem :: l -> if mem elem l2 then sub l else elem :: sub l in
 
17
     sub l1;;
 
18
 
 
19
let union l1 l2 =
 
20
  fold_right (fun e res -> if mem e res then res else e :: res) l1 l2;;
 
21
 
 
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);;
 
26
 
 
27
let tous_car = intervalle '\000' '\255';;
 
28
 
 
29
let rec lire_expr = parser
 
30
  | [< r1 = lire_s�q; r2 = lire_alternative r1 >] -> r2
 
31
 
 
32
and lire_alternative r1 = parser
 
33
  | [< ''|'; r2 = lire_expr >] -> Alternative(r1,r2)
 
34
  | [< >] -> r1
 
35
 
 
36
and lire_s�q = parser
 
37
  | [< r1 = lire_r�p�t; r2 = lire_fin_s�q r1 >] -> r2
 
38
 
 
39
and lire_fin_s�q r1 = parser
 
40
  | [< r2 = lire_s�q >] -> S�quence(r1,r2)
 
41
  | [< >] -> r1
 
42
 
 
43
and lire_r�p�t = parser
 
44
  | [< r1 = lire_simple; r2 = lire_fin_r�p�t r1 >] -> r2
 
45
 
 
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)
 
50
  | [< >] -> r1
 
51
 
 
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 <> '$' >] ->
 
58
      Caract�res [c]
 
59
 
 
60
and lire_classe = parser
 
61
  | [< ''^'; cl = lire_ensemble >] -> subtract tous_car cl
 
62
  | [< cl = lire_ensemble >] -> cl
 
63
 
 
64
and lire_ensemble = parser
 
65
  | [< '']' >] -> []
 
66
  | [< c1 = lire_car; c2 = lire_intervalle c1 >] -> c2
 
67
 
 
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
 
72
 
 
73
and lire_car = parser
 
74
  | [< ''\\'; 'c >] -> c
 
75
  | [< 'c >] -> c;;
 
76
 
 
77
let lire = parser
 
78
  | [< chapeau = (parser | [< ''^' >] -> true | [< >] -> false);
 
79
       r = lire_expr;
 
80
       dollar = (parser | [< ''$' >] -> true | [< >] -> false) >] ->
 
81
      let r1 =
 
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);;