Commit 385ae35f authored by POTTIER Francois's avatar POTTIER Francois

Updated ErrorReporting to extract positions out of the stack. Untested.

parent cc548853
......@@ -36,11 +36,10 @@ module Make
would require wrapping it in an existential type. *)
items current
(* [test_shift_item t item] tests whether [item] justifies a shift
transition along the terminal symbol [t]. If so, it returns [item],
wrapped in a singleton list. Otherwise, it returns the empty list. *)
(* [is_shift_item t item] determines whether [item] justifies a shift
transition along the terminal symbol [t]. *)
let test_shift_item (t : _ terminal) ((prod, index) as item) : item list =
let is_shift_item (t : _ terminal) (prod, index) : bool =
let rhs = rhs prod in
let length = List.length rhs in
assert (0 < index && index <= length);
......@@ -49,26 +48,61 @@ module Make
don't need to worry about the case where this symbol is nullable
and [t] is generated by the following symbol. In that situation,
we would have to reduce before we can shift [t].) *)
if index < length && xfirst (List.nth rhs index) t then
[ item ]
else
[]
index < length && xfirst (List.nth rhs index) t
(* An explanation is a description of what the parser has recognized in the
recent past and what it expects next. For now, an explanation is just an
item. *)
recent past and what it expects next. *)
type explanation =
item
type 'symbol explanation = {
let compare_explanations =
compare_items
(* An explanation is based on an item. *)
item: item;
(* A past. This is a non-empty sequence of (terminal and non-terminal)
symbols, each of which corresponds to a range of the input file. These
symbols correspond to the first half (up to the bullet) of the item's
right-hand side. In short, they represent what we have recognized in
the recent past. *)
past: ('symbol * Lexing.position * Lexing.position) list;
(* A future. This is a non-empty sequence of (terminal and non-terminal)
symbols These symbols correspond to the second half (after the bullet)
of the item's right-hand side. In short, they represent what we expect
to recognize in the future, if this item is a good prediction. *)
future: 'symbol list;
(* A goal. This is a non-terminal symbol. It corresponds to the item's
left-hand side. In short, it represents the reduction that we will
be able to perform if we successfully recognize this future. *)
goal: 'symbol
}
let compare_explanations x1 x2 =
let c = compare_items x1.item x2.item in
(* TEMPORARY checking that if [c] is 0 then the positions are the same *)
assert (
c <> 0 || List.for_all2 (fun (_, start1, end1) (_, start2, end2) ->
start1.Lexing.pos_cnum = start2.Lexing.pos_cnum &&
end1.Lexing.pos_cnum = end2.Lexing.pos_cnum
) x1.past x2.past
);
c
(* We build lists of explanations. These explanations may originate in
distinct LR(1) states. *)
type explanations =
explanation list
(* [marry past stack] TEMPORARY *)
let rec marry past stack =
match past, stack with
| [], _ ->
[]
| symbol :: past, lazy (Cons (Element (s, _, startp, endp), stack)) ->
assert (compare_symbols symbol (X (incoming_symbol s)) = 0);
(symbol, startp, endp) :: marry past stack
| _ :: _, lazy Nil ->
assert false
(* [investigate t result] assumes that [result] has been obtained by
offering the terminal symbol [t] to the parser. It runs the parser,
......@@ -80,7 +114,7 @@ module Make
(* It is desirable that the semantic actions be side-effect free, or
that their side-effects be harmless (replayable). *)
let rec investigate (t : _ terminal) (result : _ result) (explanations : explanations) : explanations =
let rec investigate (t : _ terminal) (result : _ result) explanations =
match result with
| Shifting (env, _, _) ->
(* The parser is about to shift, which means it is willing to
......@@ -88,9 +122,19 @@ module Make
transition, look at the items that justify shifting [t].
We view these items as explanations: they explain what
we have read and what we expect to read. *)
(* TEMPORARY might also wish to extract a start location from the stack *)
let stack = stack env in
List.fold_left (fun explanations item ->
test_shift_item t item @ explanations
if is_shift_item t item then
let prod, index = item in
let rhs = rhs prod in
{
item = item;
past = List.rev (marry (List.rev (take index rhs)) stack);
future = drop index rhs;
goal = lhs prod
} :: explanations
else
explanations
) explanations (items_current env)
| AboutToReduce _ ->
(* The parser wishes to reduce. Just follow. *)
......@@ -112,7 +156,7 @@ module Make
For every terminal symbol [t], it investigates how the parser reacts when
fed the symbol [t], and returns a list of explanations. *)
let investigate (result : _ result) : explanations =
let investigate (result : _ result) =
weed compare_explanations (
foreach_terminal_but_error (fun symbol explanations ->
match symbol with
......@@ -144,7 +188,7 @@ module Make
this state and analyzes it in order to produce a meaningful
diagnostic. *)
exception Error of explanations
exception Error of xsymbol explanation list
(* TEMPORARY why loop-style? we should offer a simplified incremental API *)
......
......@@ -17,18 +17,36 @@ module Make
open I
(* An explanation is a description of what the parser has recognized in the
recent past and what it expects next. For now, an explanation is just an
item. *)
recent past and what it expects next. *)
type explanation =
item
type 'symbol explanation = {
(* An explanation is based on an item. *)
item: item;
(* A past. This is a non-empty sequence of (terminal and non-terminal)
symbols, each of which corresponds to a range of the input file. These
symbols correspond to the first half (up to the bullet) of the item's
right-hand side. In short, they represent what we have recognized in
the recent past. *)
past: ('symbol * Lexing.position * Lexing.position) list;
(* A future. This is a non-empty sequence of (terminal and non-terminal)
symbols These symbols correspond to the second half (after the bullet)
of the item's right-hand side. In short, they represent what we expect
to recognize in the future, if this item is a good prediction. *)
future: 'symbol list;
(* A goal. This is a non-terminal symbol. It corresponds to the item's
left-hand side. In short, it represents the reduction that we will
be able to perform if we successfully recognize this future. *)
goal: 'symbol
}
(* We build lists of explanations. These explanations may originate in
distinct LR(1) states. *)
type explanations =
explanation list
(* TEMPORARY *)
type reader =
......@@ -36,7 +54,7 @@ module Make
(* TEMPORARY *)
exception Error of explanations
exception Error of xsymbol explanation list
val entry: 'a I.result -> (Lexing.lexbuf -> token) -> Lexing.lexbuf -> 'a
......
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