interface.ml 1.4 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 24 25 26 27 28 29 30 31 32 33 34 35 36 37
}

let excredef = {
  excdef with exceq = Some excname
}

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

let entrytypescheme symbol =
  let ocamltype =
    try
      StringMap.find symbol PreFront.grammar.types
    with Not_found ->
      (* Every start symbol should have a type. *)
      assert false
  in
  type2scheme (marrow [ arrow tlexbuf ttoken; tlexbuf ] (TypTextual ocamltype))

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

38 39 40 41 42 43 44 45 46 47 48
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 []
    )
  ])
]
49 50 51 52 53 54 55 56 57 58 59 60 61

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