bundles/menhirLib/menhir-20120123/src/interface.ml

   1 (**************************************************************************)
   2 (*                                                                        *)
   3 (*  Menhir                                                                *)
   4 (*                                                                        *)
   5 (*  François Pottier, INRIA Rocquencourt                                  *)
   6 (*  Yann Régis-Gianas, PPS, Université Paris Diderot                      *)
   7 (*                                                                        *)
   8 (*  Copyright 2005-2008 Institut National de Recherche en Informatique    *)
   9 (*  et en Automatique. All rights reserved. This file is distributed      *)
  10 (*  under the terms of the Q Public License version 1.0, with the change  *)
  11 (*  described in file LICENSE.                                            *)
  12 (*                                                                        *)
  13 (**************************************************************************)
  14
  15 open UnparameterizedSyntax
  16 open IL
  17 open CodeBits
  18 open TokenType
  19
  20 (* This is the [Error] exception. *)
  21
  22 let excname =
  23   "Error"
  24
  25 let excdef = {
  26   excname = excname;
  27   exceq = None;
  28 }
  29
  30 let excredef = {
  31   excdef with exceq = Some excname
  32 }
  33
  34 (* The type of the entry point for the start symbol [symbol]. *)
  35
  36 let entrytypescheme symbol =
  37   let ocamltype =
  38     try
  39       StringMap.find symbol PreFront.grammar.types
  40     with Not_found ->
  41       (* Every start symbol should have a type. *)
  42       assert false
  43   in
  44   type2scheme (marrow [ arrow tlexbuf ttoken; tlexbuf ] (TypTextual ocamltype))
  45
  46 (* This is the interface of the generated parser. *)
  47
  48 let interface = {
  49
  50   paramdecls =
  51     PreFront.grammar.parameters;
  52
  53   excdecls =
  54     [ excdef ];
  55
  56   typedecls =
  57     tokentypedef;
  58
  59   valdecls =
  60     StringSet.fold (fun symbol decls ->
  61       (Misc.normalize symbol, entrytypescheme symbol) :: decls
  62     ) PreFront.grammar.start_symbols []
  63
  64 }
  65
  66 (* Writing the interface to a file. *)
  67
  68 let write () =
  69   let mli = open_out (Settings.base ^ ".mli") in
  70   let module P = Printer.Make (struct
  71     let f = mli
  72     let locate_stretches = None
  73     let raw_stretch_action = false
  74   end) in
  75   P.interface interface;
  76   close_out mli
  77