Commit 822a9ec0 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2002-12-13 17:40:44 by cvscast] Empty log message

Original author: cvscast
Date: 2002-12-13 17:40:45+00:00
parent e7c54efa
......@@ -60,4 +60,4 @@ let main () =
let () = main ()
let () = main (); Types.print_stat ppf_err
......@@ -1562,3 +1562,5 @@ type ApplicationMessage =
];;
type FIXMLMessage = <FIXMLMessage>[ (Header ApplicationMessage) ];;
type FIXML = <FIXML>[ FIXMLMessage+ ];;
debug compile Any FIXML;;
\ No newline at end of file
......@@ -44,4 +44,7 @@ sig
val hash_descr: descr -> int
val equal_descr: descr -> descr -> bool
val is_recurs: node -> bool
val is_recurs_descr: descr -> bool
end
......@@ -8,6 +8,14 @@ struct
type node = {
id : int;
mutable descr : descr;
mutable recurs : int;
(* -1 means "not yet computed"
-2 means "no"
-3 means "marked"
id>=0 means "yes"
*)
mutable marked : int;
}
and descr = node X.t
......@@ -20,6 +28,9 @@ struct
{
id = !counter;
descr = Obj.magic 0;
recurs = -1;
marked = -1;
}
let equal x y = x.id = y.id
......@@ -41,4 +52,43 @@ struct
d1 d2;
true
with NotEqual -> false
(*
let rec mark_path start = function
| [] -> ()
| n::q -> if n.recurs = -3 then (n.recurs <- start; mark_path start q)
(* This algo is wrong: rework it ... *)
let rec compute_recurs path start n =
match n.recurs with
| -3 -> n.recurs <- start; mark_path start path
| -1 ->
n.recurs <- (-3);
X.iter (compute_recurs (n :: path) start) n.descr;
if n.recurs = -3 then n.recurs <- (-2)
| id when id = start -> mark_path start path
| _ -> () (* "no" or id <> start *)
let is_recurs n =
if (n.recurs = -1) then compute_recurs [] n.id n;
n.recurs >= 0
*)
let rec compute_recurs start n =
if n.marked = start then (if n.id = start then raise Exit) else
(
n.marked <- start;
X.iter (compute_recurs start) n.descr
)
let is_recurs n =
(* if (n.recurs = -1) then
(try compute_recurs n.id n; n.recurs <- (-2)
with Exit -> n.recurs <- 1); *)
(* n.recurs >= 0 *)
true
let is_recurs_descr d =
try X.iter (fun n -> if is_recurs n then raise Exit) d; false
with Exit -> true
end
......@@ -293,6 +293,8 @@ let cache_false = ref Assumptions.empty
exception NotEmpty
let nb_rec = ref 0 and nb_norec = ref 0
let rec empty_rec d =
if Assumptions.mem d !cache_false then false
else if Assumptions.mem d !memo then true
......@@ -301,7 +303,9 @@ let rec empty_rec d =
else if not (Chars.is_empty d.chars) then false
else (
let backup = !memo in
memo := Assumptions.add d backup;
if is_recurs_descr d then
(incr nb_rec; memo := Assumptions.add d backup)
else incr nb_norec;
if
(empty_rec_times d.times) &&
(empty_rec_times d.xml) &&
......@@ -430,7 +434,8 @@ let is_empty d =
(* Printf.eprintf "+"; flush stderr; *)
let old = !memo in
let r = empty_rec d in
if not r then memo := old;
if not r then memo := old
else if not (is_recurs_descr d) then memo := Assumptions.add d !memo;
(* cache_false := Assumptions.empty; *)
(* Printf.eprintf "-\n"; flush stderr; *)
r
......@@ -1434,6 +1439,11 @@ module Char = struct
let any = { empty with chars = Chars.any }
end
let print_stat ppf =
Format.fprintf ppf "nb_rec = %i@." !nb_rec;
Format.fprintf ppf "nb_norec = %i@." !nb_norec;
()
(*
let rec print_normal_record ppf = function
| Success -> Format.fprintf ppf "Yes"
......
......@@ -225,3 +225,4 @@ sig
end
val check: descr -> unit
val print_stat: Format.formatter -> unit
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