interface.ml 2.67 KB
Newer Older
1 2 3 4 5
open UnparameterizedSyntax
open IL
open CodeBits
open TokenType

POTTIER Francois's avatar
POTTIER Francois committed
6 7 8 9
(* In this module, we use [PreFront], not [Grammar], in order to avoid
   a circularity. [Interface] is used by [Infer], which runs before
   [Grammar]. *)

10 11 12 13 14 15 16
(* This is the [Error] exception. *)

let excname =
  "Error"

let excdef = {
  excname = excname;
17
  exceq = (if Settings.fixedexc then Some "Parsing.Parse_error" else None);
18 19 20 21 22 23
}

let excredef = {
  excdef with exceq = Some excname
}

24 25 26 27 28 29 30 31 32 33
(* Finding the type of a start symbol. *)

let ocamltype_of_start_symbol symbol =
  try
    TypTextual (StringMap.find symbol PreFront.grammar.types)
  with Not_found ->
    (* Every start symbol should have a type. *)
    assert false

(* The type of the monolithic entry point for the start symbol [symbol]. *)
34 35

let entrytypescheme symbol =
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
  let typ = ocamltype_of_start_symbol symbol in
  type2scheme (marrow [ arrow tlexbuf ttoken; tlexbuf ] typ)

(* When the table back-end is active, the generated parser contains,
   as a sub-module, an application of [Engine.Make]. This sub-module
   is named as follows. *)

let interpreter =
  "MenhirInterpreter"

let result t =
  TypApp (interpreter ^ ".result", [ t ])

(* The name of the incremental entry point for the start symbol [symbol]. *)

let incremental symbol =
  Misc.normalize symbol ^ "_incremental" (* TEMPORARY better idea? *)

(* The type of the incremental entry point for the start symbol [symbol]. *)

let entrytypescheme_incremental symbol =
  let t = ocamltype_of_start_symbol symbol in
  type2scheme (marrow [ tunit ] (result t))

(* This is the interface of the generated parser -- only the part
   that is specific of the table back-end. *)

let table_interface =
  if Settings.table then [
    IIModule (
      interpreter,
      MTWithType (
        MTNamedModuleType "MenhirLib.EngineTypes.INCREMENTAL_ENGINE",
        tctoken, WKDestructive, ttoken
      )
    );
    IIValDecls (
      StringSet.fold (fun symbol decls ->
        (incremental symbol, entrytypescheme_incremental symbol) :: decls
      ) PreFront.grammar.start_symbols []
    )
  ] else []
78 79 80

(* This is the interface of the generated parser. *)

81 82 83 84 85 86 87 88 89
let interface = [
  IIFunctor (PreFront.grammar.parameters, [
    IIExcDecls [ excdef ];
    IITypeDecls tokentypedef;
    IIValDecls (
      StringSet.fold (fun symbol decls ->
        (Misc.normalize symbol, entrytypescheme symbol) :: decls
      ) PreFront.grammar.start_symbols []
    )
90
  ] @ table_interface)
91
]
92 93 94 95 96 97 98 99 100 101 102 103 104

(* Writing the interface to a file. *)

let write () =
  let mli = open_out (Settings.base ^ ".mli") in
  let module P = Printer.Make (struct
    let f = mli
    let locate_stretches = None
    let raw_stretch_action = false
  end) in
  P.interface interface;
  close_out mli