Commit d513db04 authored by POTTIER Francois's avatar POTTIER Francois

Moved the inspection API in a sub-module Inspection.

This guarantees the absence of name clashes.
parent 2135285b
...@@ -32,9 +32,8 @@ let height env = ...@@ -32,9 +32,8 @@ let height env =
let print_element e : string = let print_element e : string =
match e with match e with
| I.Element (s, v, _, _) -> | I.Element (s, v, _, _) ->
let sy = Parser.symbol s in let open Parser.Inspection in
let open Parser in match symbol s with
match sy with
| T T_TIMES -> | T T_TIMES ->
"*" "*"
| T T_RPAREN -> | T T_RPAREN ->
......
...@@ -53,6 +53,13 @@ let entrytypescheme_incremental grammar symbol = ...@@ -53,6 +53,13 @@ let entrytypescheme_incremental grammar symbol =
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* The name of the sub-module that contains the inspection API. *)
let inspection =
"Inspection"
(* -------------------------------------------------------------------------- *)
(* The monolithic (traditional) API: the type [token], the exception [Error], (* The monolithic (traditional) API: the type [token], the exception [Error],
and the parser's entry points. *) and the parser's entry points. *)
...@@ -106,20 +113,26 @@ let incremental_api grammar () = ...@@ -106,20 +113,26 @@ let incremental_api grammar () =
let inspection_api grammar () = let inspection_api grammar () =
TokenType.tokengadtdef grammar @ IIComment "The inspection API." ::
NonterminalType.nonterminalgadtdef grammar @ IIModule (inspection, MTSigEnd (
SymbolType.symbolgadtdef() @
TokenType.tokengadtdef grammar @
NonterminalType.nonterminalgadtdef grammar @
SymbolType.symbolgadtdef() @
IIComment "This function maps a state to its incoming symbol." ::
IIValDecls [
let ty =
arrow (TypApp (interpreter ^ ".lr1state", [ TypVar "a" ]))
(TypApp ("symbol", [ TypVar "a" ]))
in
(* TEMPORARY code sharing with tableBackend *)
"symbol", type2scheme ty
] ::
(* TEMPORARY emit a comment *) []
IIValDecls [
let ty =
arrow (TypApp (interpreter ^ ".lr1state", [ TypVar "a" ]))
(TypApp ("symbol", [ TypVar "a" ]))
in
(* TEMPORARY code sharing with tableBackend *)
"symbol", type2scheme ty
] ::
)) ::
[] []
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
......
...@@ -23,6 +23,10 @@ val result: IL.typ -> IL.typ ...@@ -23,6 +23,10 @@ val result: IL.typ -> IL.typ
val incremental: string val incremental: string
(* The name of the sub-module that contains the inspection API. *)
val inspection: string
(* This writes the interface of the generated parser to the [.mli] file. *) (* This writes the interface of the generated parser to the [.mli] file. *)
val write: UnparameterizedSyntax.grammar -> unit -> unit val write: UnparameterizedSyntax.grammar -> unit -> unit
......
...@@ -876,19 +876,21 @@ let program = ...@@ -876,19 +876,21 @@ let program =
SIValDefs (false, incremental_api) SIValDefs (false, incremental_api)
]) :: ]) ::
listiflazy Settings.inspection (fun () -> listiflazy Settings.inspection (fun () -> [
SIModuleDef (inspection, MStruct (
interface_to_structure ( interface_to_structure (
tokengadtdef grammar @ tokengadtdef grammar @
nonterminalgadtdef grammar @ nonterminalgadtdef grammar @
symbolgadtdef() symbolgadtdef()
) @ ) @
SIValDefs (false, [incoming_symbol_def]) :: SIValDefs (false, [incoming_symbol_def]) ::
[] []
) @ ))
]) @
SIStretch grammar.postludes :: SIStretch grammar.postludes ::
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment