Commit db9e9e43 authored by POTTIER Francois's avatar POTTIER Francois

Replaced lazy with unit abstractions in [min] and [add].

parent a70e8903
......@@ -38,7 +38,7 @@ let min_lazy p1 p2 =
| Reachable _ ->
p1
| Unreachable ->
Lazy.force p2
p2()
let add p1 p2 =
match p1, p2 with
......@@ -55,7 +55,7 @@ let add_lazy p1 p2 =
| Unreachable ->
Unreachable
| Reachable _ ->
add p1 (Lazy.force p2)
add p1 (p2())
let print conv p =
match p with
......
......@@ -22,7 +22,7 @@ val singleton: 'a -> 'a t
val min: 'a t -> 'a t -> 'a t
val add: 'a t -> 'a t -> 'a t
val min_lazy: 'a t -> 'a t Lazy.t -> 'a t
val add_lazy: 'a t -> 'a t Lazy.t -> 'a t
val min_lazy: 'a t -> (unit -> 'a t) -> 'a t
val add_lazy: 'a t -> (unit -> 'a t) -> 'a t
val print: ('a -> string) -> 'a t -> string
......@@ -46,7 +46,7 @@ let min_lazy p1 p2 =
| Finite 0 ->
p1
| _ ->
min p1 (Lazy.force p2)
min p1 (p2())
let until_finite p1 p2 =
match p1 with
......@@ -67,7 +67,7 @@ let add_lazy p1 p2 =
| Infinity ->
Infinity
| _ ->
add p1 (Lazy.force p2)
add p1 (p2())
let print p =
match p with
......
......@@ -13,8 +13,8 @@ val singleton: 'a -> t
val min: t -> t -> t
val add: t -> t -> t
val min_lazy: t -> t Lazy.t -> t
val add_lazy: t -> t Lazy.t -> t
val min_lazy: t -> (unit -> t) -> t
val add_lazy: t -> (unit -> t) -> t
val until_finite: t -> t Lazy.t -> t
......
......@@ -49,7 +49,7 @@ let min_lazy p1 p2 =
| Finite (0, _) ->
p1
| _ ->
min p1 (Lazy.force p2)
min p1 (p2())
(* [until_finite] can be viewed as a variant of [min_lazy] where
we are happy as soon as we find a finite value. It can be viewed
......@@ -78,7 +78,7 @@ let add_lazy p1 p2 =
| Infinity ->
Infinity
| _ ->
add p1 (Lazy.force p2)
add p1 (p2())
let print conv p =
match p with
......
......@@ -21,8 +21,8 @@ val singleton: 'a -> 'a t
val min: 'a t -> 'a t -> 'a t
val add: 'a t -> 'a t -> 'a t
val min_lazy: 'a t -> 'a t Lazy.t -> 'a t
val add_lazy: 'a t -> 'a t Lazy.t -> 'a t
val min_lazy: 'a t -> (unit -> 'a t) -> 'a t
val add_lazy: 'a t -> (unit -> 'a t) -> 'a t
val until_finite: 'a t -> 'a t Lazy.t -> 'a t
......
......@@ -78,13 +78,13 @@ let first prod i z =
let foreach_terminal (f : Terminal.t -> property) : property =
Terminal.fold (fun t accu ->
(* A feeble attempt at being slightly lazy. Not essential. *)
P.min_lazy accu (lazy (f t))
P.min_lazy accu (fun () -> f t)
) P.bottom
let foreach_terminal_in toks (f : Terminal.t -> property) : property =
TerminalSet.fold (fun t accu ->
(* A feeble attempt at being slightly lazy. Not essential. *)
P.min_lazy accu (lazy (f t))
P.min_lazy accu (fun () -> f t)
) toks P.bottom
let foreach_terminal_until_finite (f : Terminal.t -> property) : property =
......@@ -99,7 +99,7 @@ let foreach_terminal_until_finite (f : Terminal.t -> property) : property =
let foreach_production nt (f : Production.index -> property) : property =
Production.foldnt nt P.bottom (fun prod accu ->
(* A feeble attempt at being slightly lazy. Not essential. *)
P.min_lazy accu (lazy (f prod))
P.min_lazy accu (fun () -> f prod)
)
(* A question takes the form [s, a, prod, i, z], as defined below.
......@@ -230,7 +230,7 @@ let answer (q : question) (get : question -> property) : property =
if TerminalSet.mem q.a (first prod' 0 c) then
P.add_lazy
(get { s = q.s; a = q.a; prod = prod'; i = 0; z = c })
(lazy (get { s = s'; a = c; prod = q.prod; i = q.i + 1; z = q.z }))
(fun () -> get { s = s'; a = c; prod = q.prod; i = q.i + 1; z = q.z })
else
P.bottom
)
......@@ -286,21 +286,21 @@ let backward s ((s', z) : Q.t) (get : Q.t -> property) : property =
P.bottom
| Some (Symbol.T t) ->
List.fold_left (fun accu pred ->
P.min_lazy accu (lazy (
P.min_lazy accu (fun () ->
P.add (get (pred, t)) (P.singleton t)
))
)
) P.bottom (Lr1.predecessors s')
| Some (Symbol.N nt) ->
List.fold_left (fun accu pred ->
P.min_lazy accu (lazy (
P.min_lazy accu (fun () ->
foreach_production nt (fun prod ->
foreach_terminal_in (first prod 0 z) (fun a ->
P.add_lazy
(get (pred, a))
(lazy (answer { s = pred; a = a; prod = prod; i = 0; z = z }))
(fun () -> answer { s = pred; a = a; prod = prod; i = 0; z = z })
)
)
))
)
) P.bottom (Lr1.predecessors s')
(* Debugging wrapper. TEMPORARY *)
......
......@@ -528,11 +528,11 @@ module Production = struct
(* This funny variant is lazy. If at some point [f] does not demand its
second argument, then iteration stops. *)
let foldnt_lazy (nt : Nonterminal.t) (f : index -> 'a Lazy.t -> 'a) (seed : 'a) : 'a =
let foldnt_lazy (nt : Nonterminal.t) (f : index -> (unit -> 'a) -> 'a) (seed : 'a) : 'a =
let k, k' = ntprods.(nt) in
let rec loop prod seed =
if prod < k' then
f prod (lazy (loop (prod + 1) seed))
f prod (fun () -> loop (prod + 1) seed)
else
seed
in
......@@ -780,7 +780,7 @@ module GenericAnalysis
an alternative between several productions, we compute a property for
each of them independently, then we combine these properties using
[disjunction]. *)
val disjunction: property -> property Lazy.t -> property
val disjunction: property -> (unit -> property) -> property
(* [P.bottom] should be a neutral element for [disjunction]. We use it in
the analysis of an alternative with zero branches. *)
......@@ -790,7 +790,7 @@ module GenericAnalysis
combine these properties using [conjunction]. In general, conjunction
needs access to the first member of the sequence (a symbol), not just
to its analysis (a property). *)
val conjunction: Symbol.t -> property -> property Lazy.t -> property
val conjunction: Symbol.t -> property -> (unit -> property) -> property
(* [epsilon] abstracts the empty sequence. It should be a neutral element
for [conjunction]. *)
......@@ -847,7 +847,7 @@ end = struct
let sym = rhs.(i) in
S.conjunction sym
(symbol sym get)
(lazy (loop (i+1)))
(fun () -> loop (i+1))
in
loop i
......@@ -943,9 +943,9 @@ module NONEMPTY =
(* A terminal symbol is nonempty. *)
let terminal _ = true
(* An alternative is nonempty if at least one branch is nonempty. *)
let disjunction p q = p || (Lazy.force q)
let disjunction p q = p || q()
(* A sequence is nonempty if both members are nonempty. *)
let conjunction _ p q = p && (Lazy.force q)
let conjunction _ p q = p && q()
(* The sequence epsilon is nonempty. It generates the singleton
language {epsilon}. *)
let epsilon = true
......@@ -958,9 +958,9 @@ module NULLABLE =
(* A terminal symbol is not nullable. *)
let terminal _ = false
(* An alternative is nullable if at least one branch is nullable. *)
let disjunction p q = p || (Lazy.force q)
let disjunction p q = p || q()
(* A sequence is nullable if both members are nullable. *)
let conjunction _ p q = p && (Lazy.force q)
let conjunction _ p q = p && q()
(* The sequence epsilon is nullable. *)
let epsilon = true
end)
......@@ -975,13 +975,13 @@ module FIRST =
(* A terminal symbol has a singleton FIRST set. *)
let terminal = TerminalSet.singleton
(* The FIRST set of an alternative is the union of the FIRST sets. *)
let disjunction p q = TerminalSet.union p (Lazy.force q)
let disjunction p q = TerminalSet.union p (q())
(* The FIRST set of a sequence is the union of:
the FIRST set of the first member, and
the FIRST set of the second member, if the first member is nullable. *)
let conjunction symbol p q =
if NULLABLE.symbol symbol then
TerminalSet.union p (Lazy.force q)
TerminalSet.union p (q())
else
p
(* The FIRST set of the empty sequence is empty. *)
......
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