[r2004-12-23 21:52:59 by afrisch] Empty log message

Original author: afrisch
Date: 2004-12-23 21:52:59+00:00

types/patterns.ml

@@ -1891,6 +1891,7 @@ x=(1,2)
       outputs : output array;
       rescode : rescode;
       reqs    : (Derivation.t * Types.t * fv) list;
+         (* initial derivation; assumption; variables *)
       assumpt : Types.t;
       mutable actions : actions option;
     }
@@ -2008,6 +2009,7 @@ x=(1,2)
       (r,!i + 1)
 
     let disp_id = ref 0
+
     let mk reqs =
       let nb = ref (-1) in
       let codes = ref [] in
@@ -2015,7 +2017,7 @@ x=(1,2)
 	if Types.is_empty t0 then RFail
 	else match l with
 	  | [] -> incr nb; codes := (t0,ar,List.rev binds) :: !codes; RCode !nb
-	  | ((a,fv,_),(t,xs)) :: rem ->
+	  | ((a,_,_),(t,xs)) :: rem ->
 	      let (alc,ar') = alloc ar xs in
 	      RSwitch 
 		(aux (Types.diff t0 (Types.diff t a))
@@ -2030,13 +2032,15 @@ x=(1,2)
 	  reqs in
 (*      let t0 = Types.any in *)
       let rc = aux t0 0 [] reqs in
+      let reqs = 
+	List.map 
+	  (fun (p,(t,xs)) -> 
+	     (Derivation.mkopt p t xs, t, xs)) reqs in
       let os = Array.of_list (List.rev !codes) in
-      let ders = List.map 
-	(fun (p,(t,xs)) -> (Derivation.mkopt p t xs, t, xs)) reqs in
       {	id      = (incr disp_id; !disp_id);
 	outputs = os;
 	rescode = rc;
-	reqs    = ders;
+	reqs    = reqs;
 	assumpt = t0;
 	actions = None }
 
@@ -2081,8 +2085,8 @@ x=(1,2)
 		 TargExpr.print res;
 	       IdMap.iteri (fun x i ->
 			      Format.fprintf Format.std_formatter "%a->%i@."
-				Ident.print x i) fill;*)
-(*	       let fill = IdMap.restrict fill (IdMap.domain res) in *)
+				Ident.print x i) fill;
+	       let fill = IdMap.restrict fill (IdMap.domain res) in  *)
 	       IdMap.collide (fun i r -> o.(i) <- r) fill res
 	   | None, None -> ()
 	   | _ -> assert false)
@@ -2109,7 +2113,9 @@ x=(1,2)
       let aux accu (t,xs,q1,q2) =
 	let q = selq (q1,q2) in
 	let xs = IdSet.cap xs q.fv in
+	let p = q.descr in
 	let t = pi t in
+
 	if (IdSet.is_empty xs) && (Types.subtype t (Types.descr q.accept)) 
 	then accu
 	else add_req accu q.descr t xs in