Commit 1152829c authored by POTTIER Francois's avatar POTTIER Francois
parents 18b91208 30b7f60c
* Generate default printers for terminal and nonterminal.
Define printers for productions and items, parameterized
over printers for terminal and nonterminal.
* [Printers] could use [print_element_as_symbol] as the default
value of [print_element].
* IncrementalEngine: document [lr1state], [element], [view].
Document the Inspection interface.
* Define MenhirLib.Stream?
* document that --depend may produce inaccurate dependencies
for parser.cmi and that it is recommended to use --raw-depend
--ocamldep "ocamldep -modules" and work from there (which is
......
module Make
(I : MenhirLib.IncrementalEngine.INSPECTION)
(I : MenhirLib.IncrementalEngine.EVERYTHING)
(User : sig
val arrow: string (* should include space on both sides *)
val dot: string
......@@ -10,9 +10,19 @@ module Make
open User
(* Buffer and string utilities. *)
let out =
Buffer.add_string
let with_buffer f x =
let b = Buffer.create 128 in
f b x;
Buffer.contents b
let into_buffer f b x =
out b (f x)
(* Printing a list of symbols. An optional dot is printed at offset
[i] into the list [symbols], if this offset lies between [0] and
the length of the list (included). *)
......@@ -45,16 +55,40 @@ module Make
let buffer_production b prod =
buffer_item b (prod, -1)
let with_buffer f x =
let b = Buffer.create 128 in
f b x;
Buffer.contents b
let print_item =
with_buffer buffer_item
let print_production =
with_buffer buffer_production
(* Printing an element as a symbol. *)
let print_element_as_symbol element =
match element with
| I.Element (s, _, _, _) ->
print_symbol (I.X (I.incoming_symbol s))
let buffer_element_as_symbol =
into_buffer print_element_as_symbol
(* 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. *)
let buffer_stack buffer_element b stack =
I.foldr (fun element () ->
buffer_element b element;
out b space
) stack ()
let buffer_env buffer_element b env =
buffer_stack buffer_element b (I.view env)
let print_stack print_element stack =
with_buffer (buffer_stack (into_buffer print_element)) stack
let print_env print_element env =
with_buffer (buffer_env (into_buffer print_element)) env
end
module Make
(I : MenhirLib.IncrementalEngine.INSPECTION)
(I : MenhirLib.IncrementalEngine.EVERYTHING)
(User : sig
val arrow: string (* should include space on both sides *)
val dot: string
......@@ -8,6 +8,22 @@ module Make
end)
: sig
(* Printing an element as a symbol. This prints just the symbol
that this element represents; nothing more. *)
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 -> 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 -> I.element -> unit) -> Buffer.t -> I.env -> unit
val print_env: (I.element -> string) -> I.env -> string
(* Printing an item. *)
val buffer_item: Buffer.t -> I.item -> unit
......
......@@ -3,40 +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)
(* The length of a stream. *)
let rec length xs =
match Lazy.force xs with
| I.Nil ->
0
| I.Cons (_, xs) ->
1 + length xs
(* Folding over a stream. *)
let rec foldr f xs accu =
match Lazy.force xs with
| I.Nil ->
accu
| I.Cons (x, xs) ->
f x (foldr f xs accu)
(* A measure of the stack height. Used as a primitive way of
testing the [view] function. *)
let height env =
length (I.view env)
(* Printing a symbol. *)
(* A custom symbol printer. *)
let print_symbol symbol =
let open I in
......@@ -72,12 +39,7 @@ module P =
let print_symbol = print_symbol
end)
(* Printing an element. *)
let print_element e =
match e with
| I.Element (s, v, _, _) ->
print_symbol (I.X (I.incoming_symbol s))
(* A custom element printer. *)
let print_element e : string =
match e with
......@@ -107,21 +69,11 @@ let print_element e : string =
| T T_error ->
"error"
(* Printing a stack. *)
let print env : string =
let b = Buffer.create 80 in
foldr (fun e () ->
Buffer.add_string b (print_element e);
Buffer.add_char b ' ';
) (I.view env) ();
Buffer.contents b
(* Debugging. *)
let dump env =
Printf.fprintf stderr "Stack height: %d\n%!" (height env);
Printf.fprintf stderr "Stack view:\n%s\n%!" (print 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 ->
()
......
......@@ -84,6 +84,14 @@ module type INCREMENTAL_ENGINE = sig
| Nil
| Cons of 'a * 'a stream
(* The length of a stream. *)
val length: 'a stream -> int
(* Folding over a stream. *)
val foldr: ('a -> 'b -> 'b) -> 'a stream -> 'b -> 'b
(* We offer a view of the parser's state as a stream of elements. *)
val view: env -> element stream
......@@ -172,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
......@@ -492,12 +492,7 @@ module Make (T : TABLE) = struct
(* --------------------------------------------------------------------------- *)
(* Stack inspection. *)
(* We offer a read-only view of the parser's state as a stream of elements.
Each element contains a pair of a (non-initial) state and a semantic
value associated with (the incoming symbol of) this state. Note that the
type [element] is an existential type. *)
(* Streams. *)
type 'a stream =
'a head Lazy.t
......@@ -506,6 +501,33 @@ module Make (T : TABLE) = struct
| Nil
| Cons of 'a * 'a stream
(* The length of a stream. *)
let rec length xs =
match Lazy.force xs with
| Nil ->
0
| Cons (_, xs) ->
1 + length xs
(* Folding over a stream. *)
let rec foldr f xs accu =
match Lazy.force xs with
| Nil ->
accu
| Cons (x, xs) ->
f x (foldr f xs accu)
(* --------------------------------------------------------------------------- *)
(* Stack inspection. *)
(* We offer a read-only view of the parser's state as a stream of elements.
Each element contains a pair of a (non-initial) state and a semantic
value associated with (the incoming symbol of) this state. Note that the
type [element] is an existential type. *)
type element =
| Element: 'a lr1state * 'a * Lexing.position * Lexing.position -> element
......
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