interface.ml 3 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
      )
    );
75
    IIComment "The entry points 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
let interface = [
  IIFunctor (PreFront.grammar.parameters, [
87
    IIComment "This exception is raised by the monolithic API functions.";
88
    IIExcDecls [ excdef ];
89
    IIComment "The type of tokens.";
90
    IITypeDecls tokentypedef;
91
    IIComment "The monolithic API.";
92
93
94
95
96
    IIValDecls (
      StringSet.fold (fun symbol decls ->
        (Misc.normalize symbol, entrytypescheme symbol) :: decls
      ) PreFront.grammar.start_symbols []
    )
97
  ] @ table_interface)
98
]
99
100
101
102
103
104
105
106
107
108
109
110
111

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