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

Original author: afrisch
Date: 2005-01-05 11:08:44+00:00

types/patterns.ml

@@ -450,7 +450,8 @@ let filter_descr t p =
 (* Factorization of capture variables and constant patterns *)
 
 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 pi2 ~kind t = Types.Product.pi2 (Types.Product.get ~kind t)
 
@@ -489,15 +490,15 @@ x=(1,2)
       | _ -> assert false
 	  
   and approx_var_node seen q t xs =
-    if (NodeSet.mem q seen) 
+    if (NodeTypeSet.mem (q,t) seen) 
     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 ! *)      
   let rec approx_nil seen ((a,fv,d) as p) t xs =
-(*    assert (Types.subtype t a); 
-      assert (IdSet.subset xs fv); *)
+    assert (Types.subtype t a); 
+    assert (IdSet.subset xs fv);
     if (IdSet.is_empty xs) || (Types.is_empty t) then xs
     else match d with
       | Cup ((a1,_,_) as p1,p2) ->
@@ -514,9 +515,9 @@ x=(1,2)
       | _ -> IdSet.empty
 	  
   and approx_nil_node seen q t xs =
-    if (NodeSet.mem q seen) 
+    if (NodeTypeSet.mem (q,t) seen) 
     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 =
     if IdSet.is_empty xs then IdMap.empty
@@ -531,10 +532,10 @@ x=(1,2)
       IdMap.from_list_disj (List.fold_left aux [] (filter_descr t p))
 	
   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 = 
-    approx_nil NodeSet.empty p (Types.cap t a)
+    approx_nil NodeTypeSet.empty p (Types.cap t a)
 end
 
 
@@ -911,9 +912,19 @@ module Normal = struct
     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 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 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
 
   let nnf lab t0 (pl,t,xs) = 

web/site.cd

@@ -347,7 +347,7 @@ match page with
   transform t with
    | <section title=title>c -> 
          [ <p>[ <b style="color: #008000">title ] !(content c) ]
-   | <paper (r)>[ <title>tit aut::Author* <comment>com <abstract>ab  ]  ->
+   | <paper (r)>[ <title>tit aut::Author* <comment>com <abstract>ab  ] ->
          [ (match r with
            | { file = f; old = "" } -> <a class="old" href=f>tit
            | { file = f } -> <a href=f>tit
@@ -529,7 +529,6 @@ let gen_page_seq
 
 ;;
 
-
 let [<site>[ <title>site p ] ] = 
  try (load_include input :? [ Site ])
  with (err & Latin1) ->