127 lines
4.5 KiB
OCaml
127 lines
4.5 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* 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 _ = (* Printexc.catch *) main (); exit 0
|