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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* The lexer generator. Command-line parsing. *)
open Syntax
let ml_automata = ref false
let source_name = ref None
let output_name = ref None
let usage = "usage: ocamllex [options] sourcefile"
let print_version_string () =
print_string "The OCaml lexer generator, version ";
print_string Sys.ocaml_version ; print_newline();
exit 0
let print_version_num () =
print_endline Sys.ocaml_version;
exit 0
let specs =
["-ml", Arg.Set ml_automata,
" Output code that does not use the Lexing module built-in automata \
interpreter";
"-o", Arg.String (fun x -> output_name := Some x),
" <file> Set output file name to <file>";
"-q", Arg.Set Common.quiet_mode, " Do not display informational messages";
"-v", Arg.Unit print_version_string, " Print version and exit";
"-version", Arg.Unit print_version_string, " Print version and exit";
"-vnum", Arg.Unit print_version_num, " Print version number and exit";
]
let _ =
Arg.parse
specs
(fun name -> source_name := Some name)
usage
let main () =
let source_name = match !source_name with
| None -> Arg.usage specs usage ; exit 2
| Some name -> name in
let dest_name = match !output_name with
| Some name -> name
| None ->
if Filename.check_suffix source_name ".mll" then
Filename.chop_suffix source_name ".mll" ^ ".ml"
else
source_name ^ ".ml" in
let ic = open_in_bin source_name in
let oc = open_out dest_name in
let tr = Common.open_tracker dest_name oc in
let lexbuf = Lexing.from_channel ic in
lexbuf.Lexing.lex_curr_p <-
{Lexing.pos_fname = source_name; Lexing.pos_lnum = 1;
Lexing.pos_bol = 0; Lexing.pos_cnum = 0};
try
let def = Parser.lexer_definition Lexer.main lexbuf in
let (entries, transitions) = Lexgen.make_dfa def.entrypoints in
if !ml_automata then begin
Outputbis.output_lexdef
ic oc tr
def.header def.refill_handler entries transitions def.trailer
end else begin
let tables = Compact.compact_tables transitions in
Output.output_lexdef ic oc tr
def.header def.refill_handler tables entries def.trailer
end;
close_in ic;
close_out oc;
Common.close_tracker tr;
with exn ->
let bt = Printexc.get_raw_backtrace () in
close_in ic;
close_out oc;
Common.close_tracker tr;
Sys.remove dest_name;
begin match exn with
| Cset.Bad ->
let p = Lexing.lexeme_start_p lexbuf in
Printf.fprintf stderr
"File \"%s\", line %d, character %d: character set expected.\n"
p.Lexing.pos_fname p.Lexing.pos_lnum
(p.Lexing.pos_cnum - p.Lexing.pos_bol)
| Parsing.Parse_error ->
let p = Lexing.lexeme_start_p lexbuf in
Printf.fprintf stderr
"File \"%s\", line %d, character %d: syntax error.\n"
p.Lexing.pos_fname p.Lexing.pos_lnum
(p.Lexing.pos_cnum - p.Lexing.pos_bol)
| Lexer.Lexical_error(msg, file, line, col) ->
Printf.fprintf stderr
"File \"%s\", line %d, character %d: %s.\n"
file line col msg
| Lexgen.Memory_overflow ->
Printf.fprintf stderr
"File \"%s\":\n Position memory overflow, too many bindings\n"
source_name
| Output.Table_overflow ->
Printf.fprintf stderr
"File \"%s\":\ntransition table overflow, automaton is too big\n"
source_name
| _ ->
Printexc.raise_with_backtrace exn bt
end;
exit 3
let _ = main (); exit 0
|
