lex/main.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id$ *)
  14
  15 (* The lexer generator. Command-line parsing. *)
  16
  17 open Syntax
  18 open Lexgen
  19
  20 let ml_automata = ref false
  21 let source_name = ref None
  22 let output_name = ref None
  23
  24 let usage = "usage: ocamlex [options] sourcefile"
  25
  26 let print_version_string () =
  27   print_string "The Objective Caml lexer generator, version ";
  28   print_string Sys.ocaml_version ; print_newline();
  29   exit 0
  30
  31 let specs =
  32   ["-ml", Arg.Set ml_automata,
  33     " Output code that does not use the Lexing module built-in automata interpreter";
  34    "-o", Arg.String (fun x -> output_name := Some x),
  35     " <file>  Set output file name to <file>";
  36    "-q", Arg.Set Common.quiet_mode, " Do not display informational messages";
  37    "-v",  Arg.Unit print_version_string, " Print version and exit";
  38    "-version",  Arg.Unit print_version_string, " Print version and exit";
  39   ]
  40
  41 let _ =
  42   Arg.parse
  43     specs
  44     (fun name -> source_name := Some name)
  45     usage
  46
  47
  48 let main () =
  49
  50   let source_name = match !source_name with
  51   | None -> Arg.usage specs usage ; exit 2
  52   | Some name -> name in
  53   let dest_name = match !output_name with
  54   | Some name -> name
  55   | None ->
  56       if Filename.check_suffix source_name ".mll" then
  57         Filename.chop_suffix source_name ".mll" ^ ".ml"
  58       else
  59         source_name ^ ".ml" in
  60
  61   let ic = open_in_bin source_name in
  62   let oc = open_out dest_name in
  63   let tr = Common.open_tracker dest_name oc in
  64   let lexbuf = Lexing.from_channel ic in
  65   lexbuf.Lexing.lex_curr_p <-
  66     {Lexing.pos_fname = source_name; Lexing.pos_lnum = 1;
  67      Lexing.pos_bol = 0; Lexing.pos_cnum = 0};
  68   try
  69     let def = Parser.lexer_definition Lexer.main lexbuf in
  70     let (entries, transitions) = Lexgen.make_dfa def.entrypoints in
  71     if !ml_automata then begin
  72       Outputbis.output_lexdef
  73         source_name ic oc tr
  74         def.header entries transitions def.trailer
  75     end else begin
  76        let tables = Compact.compact_tables transitions in
  77        Output.output_lexdef source_name ic oc tr
  78          def.header tables entries def.trailer
  79     end;
  80     close_in ic;
  81     close_out oc;
  82     Common.close_tracker tr;
  83   with exn ->
  84     close_in ic;
  85     close_out oc;
  86     Common.close_tracker tr;
  87     Sys.remove dest_name;
  88     begin match exn with
  89     | Cset.Bad ->
  90         let p = Lexing.lexeme_start_p lexbuf in
  91         Printf.fprintf stderr
  92           "File \"%s\", line %d, character %d: character set expected.\n"
  93           p.Lexing.pos_fname p.Lexing.pos_lnum
  94           (p.Lexing.pos_cnum - p.Lexing.pos_bol)
  95     | Parsing.Parse_error ->
  96         let p = Lexing.lexeme_start_p lexbuf in
  97         Printf.fprintf stderr
  98           "File \"%s\", line %d, character %d: syntax error.\n"
  99           p.Lexing.pos_fname p.Lexing.pos_lnum
 100           (p.Lexing.pos_cnum - p.Lexing.pos_bol)
 101     | Lexer.Lexical_error(msg, file, line, col) ->
 102         Printf.fprintf stderr
 103           "File \"%s\", line %d, character %d: %s.\n"
 104           file line col msg
 105     | Lexgen.Memory_overflow ->
 106         Printf.fprintf stderr
 107           "File \"%s\":\n Position memory overflow, too many bindings\n"
 108           source_name
 109     | Output.Table_overflow ->
 110         Printf.fprintf stderr
 111           "File \"%s\":\ntransition table overflow, automaton is too big\n"
 112           source_name
 113     | _ ->
 114         raise exn
 115     end;
 116     exit 3
 117
 118 let _ = (* Printexc.catch *) main (); exit 0
 119