Commit 1b9adb74 authored by POTTIER Francois's avatar POTTIER Francois

Added the signature [EVERYTHING] in IncrementalEngine.

Used it to clean up Printers and Calc.
parent 3fe6e945
module Make
(E : MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE)
(I : MenhirLib.IncrementalEngine.INSPECTION
with type 'a lr1state = 'a E.lr1state
with type production = E.production)
(I : MenhirLib.IncrementalEngine.EVERYTHING)
(User : sig
val arrow: string (* should include space on both sides *)
val dot: string
......@@ -68,7 +65,7 @@ module Make
let print_element_as_symbol element =
match element with
| E.Element (s, _, _, _) ->
| I.Element (s, _, _, _) ->
print_symbol (I.X (I.incoming_symbol s))
let buffer_element_as_symbol =
......@@ -79,13 +76,13 @@ module Make
this purpose; but the user can define other printers if desired. *)
let buffer_stack buffer_element b stack =
E.foldr (fun element () ->
I.foldr (fun element () ->
buffer_element b element;
out b space
) stack ()
let buffer_env buffer_element b env =
buffer_stack buffer_element b (E.view env)
buffer_stack buffer_element b (I.view env)
let print_stack print_element stack =
with_buffer (buffer_stack (into_buffer print_element)) stack
......
module Make
(E : MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE)
(I : MenhirLib.IncrementalEngine.INSPECTION
with type 'a lr1state = 'a E.lr1state
with type production = E.production)
(I : MenhirLib.IncrementalEngine.EVERYTHING)
(User : sig
val arrow: string (* should include space on both sides *)
val dot: string
......@@ -14,18 +11,18 @@ module Make
(* Printing an element as a symbol. This prints just the symbol
that this element represents; nothing more. *)
val buffer_element_as_symbol: Buffer.t -> E.element -> unit
val print_element_as_symbol: E.element -> string
val buffer_element_as_symbol: Buffer.t -> I.element -> unit
val print_element_as_symbol: I.element -> string
(* Printing a stack or an environment. These functions are parameterized
over an element printer. [print_element_as_symbol] can be used for
this purpose; but the user can define other printers if desired. *)
val buffer_stack: (Buffer.t -> E.element -> unit) -> Buffer.t -> E.element E.stream -> unit
val print_stack: (E.element -> string) -> E.element E.stream -> string
val buffer_stack: (Buffer.t -> I.element -> unit) -> Buffer.t -> I.element I.stream -> unit
val print_stack: (I.element -> string) -> I.element I.stream -> string
val buffer_env: (Buffer.t -> E.element -> unit) -> Buffer.t -> E.env -> unit
val print_env: (E.element -> string) -> E.env -> string
val buffer_env: (Buffer.t -> I.element -> unit) -> Buffer.t -> I.env -> unit
val print_env: (I.element -> string) -> I.env -> string
(* Printing an item. *)
......
......@@ -3,22 +3,7 @@
module I =
Parser.MenhirInterpreter
(* TEMPORARY *)
module Essai = (I : sig
include MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE
include MenhirLib.IncrementalEngine.INSPECTION
with type 'a lr1state := 'a lr1state
with type production := production
end)
(* A measure of the stack height. Used as a primitive way of
testing the [view] function. *)
let height env =
I.length (I.view env)
(* Printing a symbol. *)
(* A custom symbol printer. *)
let print_symbol symbol =
let open I in
......@@ -47,14 +32,14 @@ let print_symbol symbol =
"error"
module P =
Printers.Make(I)(I) (struct
Printers.Make(I) (struct
let arrow = " -> "
let dot = "."
let space = " "
let print_symbol = print_symbol
end)
(* Printing an element. *)
(* A custom element printer. *)
let print_element e : string =
match e with
......@@ -87,7 +72,7 @@ let print_element e : string =
(* Debugging. *)
let dump env =
Printf.fprintf stderr "Stack height: %d\n%!" (height env);
Printf.fprintf stderr "Stack height: %d\n%!" (I.length (I.view env));
Printf.fprintf stderr "Stack view:\n%s\n%!" (P.print_env print_element env);
begin match Lazy.force (I.view env) with
| I.Nil ->
......
......@@ -180,3 +180,15 @@ module type INSPECTION = sig
end
(* This signature combines the incremental API and the inspection API. *)
module type EVERYTHING = sig
include INCREMENTAL_ENGINE
include INSPECTION
with type 'a lr1state := 'a lr1state
with type production := production
end
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