Commit f8ceb6e1 authored by POTTIER Francois's avatar POTTIER Francois

Changed the [lookahead] field to [Terminal.t] instead of [Terminal.t option].

Maybe less efficient, but much simpler, for now.
parent aa2896d9
...@@ -47,15 +47,12 @@ end ...@@ -47,15 +47,12 @@ end
module Q = LowIntegerPriorityQueue module Q = LowIntegerPriorityQueue
type assumption =
Terminal.t option
type fact = { type fact = {
source: Lr1.node; source: Lr1.node;
height: int; height: int;
target: Lr1.node; target: Lr1.node;
word: W.word; word: W.word;
lookahead: assumption lookahead: Terminal.t
} }
let foreach_terminal f = let foreach_terminal f =
...@@ -98,21 +95,15 @@ let add fact = ...@@ -98,21 +95,15 @@ let add fact =
let init s = let init s =
if has_nonterminal_transition s then if has_nonterminal_transition s then
add { foreach_terminal (fun z ->
source = s; add {
height = 0; source = s;
target = s; height = 0;
word = W.epsilon; target = s;
lookahead = None; word = W.epsilon;
} lookahead = z
}
let compatible lookahead t = )
assert (not (Terminal.equal t Terminal.error));
match lookahead with
| None ->
true
| Some t' ->
Terminal.equal t t'
let first w z = let first w z =
if W.length w > 0 then W.first w else z if W.length w > 0 then W.first w else z
...@@ -120,7 +111,7 @@ let first w z = ...@@ -120,7 +111,7 @@ let first w z =
module T : sig module T : sig
val register: fact -> bool (* true if fact is new *) val register: fact -> bool (* true if fact is new *)
(* target/z *) (* target/z *)
val query: Lr1.node -> assumption -> (fact -> unit) -> unit val query: Lr1.node -> Terminal.t -> (fact -> unit) -> unit
end = struct end = struct
(* For now, we implement a mapping of [source, height, target, a, z] to [w]. *) (* For now, we implement a mapping of [source, height, target, a, z] to [w]. *)
...@@ -153,19 +144,13 @@ end = struct ...@@ -153,19 +144,13 @@ end = struct
m := M.add key w' !m; m := M.add key w' !m;
true true
let rec register fact = let register fact =
match fact.lookahead with let z = fact.lookahead in
| None -> let a = first fact.word z in
foreach_terminal (fun z -> add (fact.source, fact.height, fact.target, a, z) fact.word
let _ = register { fact with lookahead = Some z } in
()
);
true (* TEMPORARY *)
| Some z ->
let a = first fact.word z in
add (fact.source, fact.height, fact.target, a, z) fact.word
let query _ = assert false let query _ = assert false
end end
(* The module [E] is in charge of recording the non-terminal edges that we have (* The module [E] is in charge of recording the non-terminal edges that we have
...@@ -175,15 +160,15 @@ end ...@@ -175,15 +160,15 @@ end
module E : sig module E : sig
(* [register s nt w z] records that, in state [s], the outgoing edge labeled (* [register s nt w z] records that, in state [s], the outgoing edge labeled
[nt] can be taken by consuming the word [w], if the next symbol satisfies [nt] can be taken by consuming the word [w], if the next symbol is [z].
[z]. It returns [true] if this information is new. *) It returns [true] if this information is new. *)
val register: Lr1.node -> Nonterminal.t -> W.word -> assumption -> bool val register: Lr1.node -> Nonterminal.t -> W.word -> Terminal.t -> bool
(* [query s nt a z] answers whether, in state [s], the outgoing edge labeled (* [query s nt a z] answers whether, in state [s], the outgoing edge labeled
[nt] can be taken by consuming some word [w], under the assumption that [nt] can be taken by consuming some word [w], under the assumption that
the next symbol is [z], and under the constraint that the first symbol of the next symbol is [z], and under the constraint that the first symbol of
[w.z] satisfies [a]. *) [w.z] is [a]. *)
val query: Lr1.node -> Nonterminal.t -> assumption -> Terminal.t -> (W.word -> unit) -> unit val query: Lr1.node -> Nonterminal.t -> Terminal.t -> Terminal.t -> (W.word -> unit) -> unit
end = struct end = struct
...@@ -215,46 +200,31 @@ end = struct ...@@ -215,46 +200,31 @@ end = struct
m := M.add key w' !m; m := M.add key w' !m;
true true
let rec register s nt w oz = let register s nt w z =
match oz with let a = first w z in
| Some z -> add (s, nt, a, z) w
let a = W.first (W.append w (W.singleton z)) in (* TEMPORARY can be optimised *)
add (s, nt, a, z) w
| None ->
(* TEMPORARY naive; and which result should we return? *)
foreach_terminal (fun z ->
let _ = register s nt w (Some z) in
()
);
true
let query s nt oa z f = let query s nt a z f =
match oa with match M.find (s, nt, a, z) !m with
| None -> | w -> f w
(* TEMPORARY naive; search for every a, taking minimum; should begin with z *) | exception Not_found -> ()
assert false
| Some a ->
match M.find (s, nt, a, z) !m with
| w -> f w
| exception Not_found -> ()
end end
let extend fact target w lookahead = let extend fact target w z =
(* TEMPORARY sanity check *) assert (Terminal.equal fact.lookahead (first w z));
(* assert (compatible fact.lookahead (W.first (W.append w (W.singleton lookahead)))); *)
{ {
source = fact.source; source = fact.source;
height = fact.height + 1; height = fact.height + 1;
target = target; target = target;
word = W.append fact.word w; word = W.append fact.word w;
lookahead = lookahead lookahead = z
} }
let new_edge s nt w lookahead = let new_edge s nt w z =
if (E.register s nt w lookahead) then if E.register s nt w z then
T.query s lookahead (* TEMPORARY bug? *) (fun fact -> T.query s (first w z) (fun fact ->
add (extend fact s w lookahead) add (extend fact s w z)
) )
(* [consequences fact] is invoked when we discover a new fact (i.e., one that (* [consequences fact] is invoked when we discover a new fact (i.e., one that
...@@ -288,8 +258,10 @@ let consequences fact = ...@@ -288,8 +258,10 @@ let consequences fact =
fact for later examination. *) fact for later examination. *)
(**) (**)
if compatible fact.lookahead t then if Terminal.equal fact.lookahead t then
add (extend fact s (W.singleton t) None) foreach_terminal (fun z ->
add (extend fact s (W.singleton t) z)
)
| Symbol.N nt -> | Symbol.N nt ->
...@@ -304,7 +276,7 @@ let consequences fact = ...@@ -304,7 +276,7 @@ let consequences fact =
foreach_terminal (fun z -> foreach_terminal (fun z ->
E.query fact.target nt fact.lookahead z (fun w -> E.query fact.target nt fact.lookahead z (fun w ->
add (extend fact s w (Some z)) add (extend fact s w z)
) )
) )
...@@ -325,18 +297,11 @@ let consequences fact = ...@@ -325,18 +297,11 @@ let consequences fact =
if Production.length prod = fact.height then if Production.length prod = fact.height then
new_edge fact.source (Production.nt prod) fact.word fact.lookahead new_edge fact.source (Production.nt prod) fact.word fact.lookahead
| None -> | None ->
match fact.lookahead with let z = fact.lookahead in
| None -> let prods = reductions fact.target z in
TerminalMap.iter (fun z prods -> let prod = Misc.single prods in
let prod = Misc.single prods in if Production.length prod = fact.height then
if Production.length prod = fact.height then new_edge fact.source (Production.nt prod) fact.word z
new_edge fact.source (Production.nt prod) fact.word (Some z)
) (Lr1.reductions fact.target)
| Some z ->
let prods = reductions fact.target z in
let prod = Misc.single prods in
if Production.length prod = fact.height then
new_edge fact.source (Production.nt prod) fact.word (Some z)
let discover fact = let discover fact =
if T.register fact then if T.register fact then
......
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