interface.ml 3.1 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
  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 [
65
    IIComment "The incremental API.";
66 67 68
    IIModule (
      interpreter,
      MTWithType (
69
        MTNamedModuleType "MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE",
70 71 72
        "token", (* NOT [tctoken], which is qualified if [--external-tokens] is used *)
        WKDestructive,
        ttoken
73 74
      )
    );
POTTIER Francois's avatar
POTTIER Francois committed
75
    IIComment "The entry point(s) to the incremental API.";
76 77 78 79 80 81
    IIValDecls (
      StringSet.fold (fun symbol decls ->
        (incremental symbol, entrytypescheme_incremental symbol) :: decls
      ) PreFront.grammar.start_symbols []
    )
  ] else []
82 83 84

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

85 86 87 88 89 90 91
let tokentypedef =
  match tokentypedef with
  | [] ->
      []
  | _ ->
      [ IIComment "The type of tokens."; IITypeDecls tokentypedef ]

92
let interface = [
93 94
  IIFunctor (PreFront.grammar.parameters,
    tokentypedef @ [
95 96
    IIComment "This exception is raised by the monolithic API functions.";
    IIExcDecls [ excdef ];
97
    IIComment "The monolithic API.";
98 99 100 101 102
    IIValDecls (
      StringSet.fold (fun symbol decls ->
        (Misc.normalize symbol, entrytypescheme symbol) :: decls
      ) PreFront.grammar.start_symbols []
    )
103
  ] @ table_interface)
104
]
105 106 107 108 109 110 111 112 113 114 115 116 117

(* 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