Commit 3fe6e945 authored by POTTIER Francois's avatar POTTIER Francois

Moved the stream functions (length, foldr) to Engine.

  (Not great, but they don't deserve a separate module yet.)
Updated Printers and Calc.
parent 599d30cd
module Make
(E : MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE)
(I : MenhirLib.IncrementalEngine.INSPECTION
with type 'a lr1state = 'a E.lr1state)
with type 'a lr1state = 'a E.lr1state
with type production = E.production)
(User : sig
val arrow: string (* should include space on both sides *)
val dot: string
......@@ -73,21 +74,12 @@ module Make
let buffer_element_as_symbol =
into_buffer print_element_as_symbol
(* Folding over a stream. *)
let rec foldr f xs accu =
match Lazy.force xs with
| E.Nil ->
accu
| E.Cons (x, xs) ->
f x (foldr f xs accu)
(* 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 =
foldr (fun element () ->
E.foldr (fun element () ->
buffer_element b element;
out b space
) stack ()
......
module Make
(E : MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE)
(I : MenhirLib.IncrementalEngine.INSPECTION
with type 'a lr1state = 'a E.lr1state)
with type 'a lr1state = 'a E.lr1state
with type production = E.production)
(User : sig
val arrow: string (* should include space on both sides *)
val dot: string
......@@ -21,6 +22,10 @@ module Make
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_env: (Buffer.t -> E.element -> unit) -> Buffer.t -> E.env -> unit
val print_env: (E.element -> string) -> E.env -> string
(* Printing an item. *)
......
......@@ -12,29 +12,11 @@ module Essai = (I : sig
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)
I.length (I.view env)
(* Printing a symbol. *)
......@@ -65,7 +47,7 @@ let print_symbol symbol =
"error"
module P =
Printers.Make(I) (struct
Printers.Make(I)(I) (struct
let arrow = " -> "
let dot = "."
let space = " "
......@@ -74,11 +56,6 @@ module P =
(* Printing an element. *)
let print_element e =
match e with
| I.Element (s, v, _, _) ->
print_symbol (I.X (I.incoming_symbol s))
let print_element e : string =
match e with
| I.Element (s, v, _, _) ->
......@@ -107,21 +84,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 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
......
......@@ -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