← Back to branch summary

~ubuntu-branches/ubuntu/hoary/pxp/hoary

« back to all changes in this revision

Viewing changes to tools/src/lexpp/lexpp_file.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stefano Zacchiroli
  • Date: 2004-12-09 15:58:32 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20041209155832-qe6fv27rj42vuefm
Tags: 1.1.95-5
rebuilt against ocaml 3.08.2 (and ocamlnet 0.98-3, in turn rebuilt
against ocaml 3.08.2)

Show diffs side-by-side

added added

removed removed

Lines of Context:
tools/src/lexpp/lexpp_file.ml
 
1
(* $Id: lexpp_file.ml 667 2004-06-02 15:21:19Z gerd $
 
2
 * ----------------------------------------------------------------------
 
3
 *
 
4
 *)
 
5
 
 
6
open Printf;;
 
7
 
 
8
let section_re =
 
9
  Netstring_str.regexp "^[(][*][ \t]*\\[\\([A-Za-z0-9_-]+\\)\\][ \t]*[*][)]";;
 
10
 
 
11
let read_sections filename =
 
12
  let f = open_in filename in
 
13
  printf "[reading %s]\n" filename; flush stdout;
 
14
  let current_section = ref None in
 
15
  let current_data = Buffer.create 1000 in
 
16
  let sections = ref [] in
 
17
  let save_section() =
 
18
    match !current_section with
 
19
        None -> ()
 
20
      | Some s ->
 
21
          sections := (s, Buffer.contents current_data) :: !sections;
 
22
          current_section := None;
 
23
  in
 
24
  try
 
25
    while true do
 
26
      let line = input_line f in
 
27
      match Netstring_str.string_match section_re line 0 with
 
28
          Some mtch ->
 
29
            let section_name = Netstring_str.matched_group mtch 1 line in
 
30
            (* save old section: *)
 
31
            save_section();
 
32
            (* begin new section: *)
 
33
            current_section := Some section_name;
 
34
            Buffer.clear current_data;
 
35
        | None ->
 
36
            Buffer.add_string current_data line;
 
37
            Buffer.add_char current_data '\n';
 
38
    done;
 
39
    assert false
 
40
  with
 
41
      End_of_file ->
 
42
        close_in f;
 
43
        save_section();
 
44
        List.rev !sections
 
45
;;
 
46
 
 
47
 
 
48
let parse_char_classes s =
 
49
  Uni_parser.main Uni_lexer.token (Lexing.from_string s)
 
50
;;
 
51
 
 
52
 
 
53
(* The following printing functions have originally been written by Claudio
 
54
 * Sacerdoti Coen.
 
55
 *)
 
56
 
 
57
(* padded_string_of_int i returns the string representing the        *)
 
58
(* integer i (i < 256) using exactly 3 digits (example: 13 -> "013") *)
 
59
 
 
60
let padded_string_of_int i =
 
61
 if i < 10 then
 
62
  "00" ^ string_of_int i
 
63
 else if i < 100 then
 
64
  "0" ^ string_of_int i
 
65
 else
 
66
  string_of_int i
 
67
;;
 
68
 
 
69
(* Two functions useful to print a definition *)
 
70
 
 
71
let rec print_disjunction ?(first = true) out =
 
72
 function
 
73
    [] ->
 
74
      if first then output_string out " ['b'-'a' (*empty*) ] "
 
75
  | he::tl ->
 
76
     if not first then output_string out " | " ;
 
77
     print_re out he ;
 
78
     print_disjunction ~first:false out tl
 
79
 
 
80
and print_re out =
 
81
 function
 
82
    Uni_types.Char i -> output_string out ("'\\" ^ padded_string_of_int i ^ "'")
 
83
  | Uni_types.Interval (l,u) ->
 
84
      output_string out ("['\\" ^ padded_string_of_int l ^ "'-'\\" ^
 
85
                         padded_string_of_int u ^ "']")
 
86
  | Uni_types.Identifier i -> output_string out i
 
87
  | Uni_types.Concat rell ->
 
88
     let foo rel =
 
89
      if List.length rel > 1 then
 
90
       (output_string out "(" ; print_disjunction out rel ;
 
91
        output_string out ")")
 
92
      else
 
93
       print_disjunction out rel
 
94
     in
 
95
      List.iter foo rell
 
96
;;
 
97
 
 
98
(* print_definition prints a definition in the format expected by ocamllex *)
 
99
 
 
100
let print_definition out { Uni_types.id = id ; Uni_types.rel = rel } =
 
101
 output_string out ("let " ^ id ^ " =\n   ") ;
 
102
 print_disjunction out rel ;
 
103
 output_string out "\n\n"
 
104
;;
 
105
 
 
106
 
 
107
(**********************************************************************)
 
108
(* print a definition in the format expected by ulex:                 *)
 
109
(**********************************************************************)
 
110
 
 
111
let rec print_ulex_disjunction ?(first = true) out =
 
112
 function
 
113
    [] ->
 
114
      if first then output_string out " ['b'-'a' (*empty*) ] "
 
115
  | he::tl ->
 
116
     if not first then output_string out " | " ;
 
117
     print_ulex_re out he ;
 
118
     print_ulex_disjunction ~first:false out tl
 
119
 
 
120
and print_ulex_re out =
 
121
 function
 
122
    Uni_types.Char i -> output_string out (string_of_int i)
 
123
  | Uni_types.Interval (l,u) ->
 
124
      output_string out ("[" ^ string_of_int l ^ "-" ^
 
125
                         string_of_int u ^ "]")
 
126
  | Uni_types.Identifier i -> output_string out i
 
127
  | Uni_types.Concat rell ->
 
128
     let foo rel =
 
129
      if List.length rel > 1 then
 
130
       (output_string out "(" ; print_ulex_disjunction out rel ;
 
131
        output_string out ")")
 
132
      else
 
133
       print_ulex_disjunction out rel
 
134
     in
 
135
      List.iter foo rell
 
136
;;
 
137
 
 
138
let print_ulex_definition out { Uni_types.id = id ; Uni_types.rel = rel } =
 
139
 output_string out ("let regexp " ^ id ^ " =\n   ") ;
 
140
 print_ulex_disjunction out rel ;
 
141
 output_string out "\n\n"
 
142
;;