Commit 35fb94d9 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2005-01-05 11:08:43 by afrisch] Bug in factorization

Original author: afrisch
Date: 2005-01-05 11:08:44+00:00
parent b14cf675
...@@ -450,7 +450,8 @@ let filter_descr t p = ...@@ -450,7 +450,8 @@ let filter_descr t p =
(* Factorization of capture variables and constant patterns *) (* Factorization of capture variables and constant patterns *)
module Factorize = struct module Factorize = struct
module NodeSet = Set.Make(Node) module NodeTypeSet = Set.Make(Custom.Pair(Node)(Types))
let pi1 ~kind t = Types.Product.pi1 (Types.Product.get ~kind t) let pi1 ~kind t = Types.Product.pi1 (Types.Product.get ~kind t)
let pi2 ~kind t = Types.Product.pi2 (Types.Product.get ~kind t) let pi2 ~kind t = Types.Product.pi2 (Types.Product.get ~kind t)
...@@ -489,15 +490,15 @@ x=(1,2) ...@@ -489,15 +490,15 @@ x=(1,2)
| _ -> assert false | _ -> assert false
and approx_var_node seen q t xs = and approx_var_node seen q t xs =
if (NodeSet.mem q seen) if (NodeTypeSet.mem (q,t) seen)
then xs then xs
else approx_var (NodeSet.add q seen) q.descr t xs else approx_var (NodeTypeSet.add (q,t) seen) q.descr t xs
(* Obviously not complete ! *) (* Obviously not complete ! *)
let rec approx_nil seen ((a,fv,d) as p) t xs = let rec approx_nil seen ((a,fv,d) as p) t xs =
(* assert (Types.subtype t a); assert (Types.subtype t a);
assert (IdSet.subset xs fv); *) assert (IdSet.subset xs fv);
if (IdSet.is_empty xs) || (Types.is_empty t) then xs if (IdSet.is_empty xs) || (Types.is_empty t) then xs
else match d with else match d with
| Cup ((a1,_,_) as p1,p2) -> | Cup ((a1,_,_) as p1,p2) ->
...@@ -514,9 +515,9 @@ x=(1,2) ...@@ -514,9 +515,9 @@ x=(1,2)
| _ -> IdSet.empty | _ -> IdSet.empty
and approx_nil_node seen q t xs = and approx_nil_node seen q t xs =
if (NodeSet.mem q seen) if (NodeTypeSet.mem (q,t) seen)
then xs then xs
else approx_nil (NodeSet.add q seen) q.descr t xs else approx_nil (NodeTypeSet.add (q,t) seen) q.descr t xs
let cst ((a,_,_) as p) t xs = let cst ((a,_,_) as p) t xs =
if IdSet.is_empty xs then IdMap.empty if IdSet.is_empty xs then IdMap.empty
...@@ -531,10 +532,10 @@ x=(1,2) ...@@ -531,10 +532,10 @@ x=(1,2)
IdMap.from_list_disj (List.fold_left aux [] (filter_descr t p)) IdMap.from_list_disj (List.fold_left aux [] (filter_descr t p))
let var ((a,_,_) as p) t = let var ((a,_,_) as p) t =
approx_var NodeSet.empty p (Types.cap t a) approx_var NodeTypeSet.empty p (Types.cap t a)
let nil ((a,_,_) as p) t = let nil ((a,_,_) as p) t =
approx_nil NodeSet.empty p (Types.cap t a) approx_nil NodeTypeSet.empty p (Types.cap t a)
end end
...@@ -911,9 +912,19 @@ module Normal = struct ...@@ -911,9 +912,19 @@ module Normal = struct
let a = List.fold_left (fun a x -> ncap a (ncapture l x)) a vs in let a = List.fold_left (fun a x -> ncap a (ncapture l x)) a vs in
let vs = facto Factorize.nil t xs pl in let vs = facto Factorize.nil t xs pl in
(*
let ppf = Format.std_formatter in
Format.fprintf ppf "t = %a xs = %a"
Types.Print.print t
Print.print_xs xs;
List.iter (fun p -> Format.fprintf ppf "p:%a " Print.print (descr p)) pl;
Format.fprintf ppf " => %a@."
Print.print_xs vs;
*)
let xs = IdSet.diff xs vs in let xs = IdSet.diff xs vs in
let a = List.fold_left (fun a x -> ncap a (nconstant l x Sequence.nil_cst)) a vs in let a = List.fold_left (fun a x -> ncap a (nconstant l x Sequence.nil_cst)) a vs in
List.fold_left (fun a p -> ncap a (nnormal l (descr p) xs)) a pl List.fold_left (fun a p -> ncap a (nnormal l (descr p) xs)) a pl
let nnf lab t0 (pl,t,xs) = let nnf lab t0 (pl,t,xs) =
......
...@@ -529,7 +529,6 @@ let gen_page_seq ...@@ -529,7 +529,6 @@ let gen_page_seq
;; ;;
let [<site>[ <title>site p ] ] = let [<site>[ <title>site p ] ] =
try (load_include input :? [ Site ]) try (load_include input :? [ Site ])
with (err & Latin1) -> with (err & Latin1) ->
......
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