[r2003-03-22 15:32:28 by cvscast] Empty log message

Original author: cvscast
Date: 2003-03-22 15:32:28+00:00

types/patterns.ml

@@ -646,10 +646,7 @@ struct
 	  else
 	    let p = pl.(i) in
 	    let tp = p.Normal.na in
-	    assert(IdSet.disjoint p.Normal.nfv p.Normal.ncatchv);
 	    let v = p.Normal.nfv in
-(*	    let v = IdSet.diff p.Normal.nfv p.Normal.ncatchv in*)
-
 (*	    let tp = Types.normalize tp in *)
 	    let accu' = (i,IdMap.num arity v) :: accu in
 	    `Switch 
@@ -734,12 +731,9 @@ struct
 
   let get_tests pl f t d post =
     let accu = ref [] in
-    let unselect = Array.create (Array.length pl) [] in
     let aux i x = 
-      let yes, no = f x in
-      List.iter (fun ( (pl,ty), info) -> accu := (ty,pl,i,info) :: !accu
-		) yes;
-      unselect.(i) <- no @ unselect.(i) in
+      let (pl,ty), info = f x in
+      accu := (ty,pl,i,info) :: !accu in
     Array.iteri (fun i -> List.iter (aux i)) pl;
 
     let lab =
@@ -764,7 +758,7 @@ struct
       let selected = Array.create (Array.length pl) [] in
       let add r (i, ncv, inf) = selected.(i) <- (r,ncv,inf) :: selected.(i) in
       List.iter (fun (j,r) -> List.iter (add r) infos.(j)) m;
-      d t selected unselect
+      d t selected
     in
     let res = Array.map result disp.codes in
     post (disp,res)
@@ -782,9 +776,9 @@ struct
     let pl = Array.map (fun x -> [x]) (Array.of_list brs) in
     get_tests 
       pl 
-      (fun x -> [x],[])
+      (fun x -> x)
       t
-      (fun _ pl _ ->
+      (fun _ pl ->
 	 let r = ref None in
 	 let aux = function 
 	   | [(res,catchv,e)] -> assert (!r = None); 
@@ -808,17 +802,17 @@ struct
     dispatch_prod0 disp t pl
   and dispatch_prod0 disp t pl =
     get_tests pl
-      (fun (res,(p,q)) -> [p, (res,q)], [])
+      (fun (res,(p,q)) -> p, (res,q))
       (Types.Product.pi1 t)
       (dispatch_prod1 disp t)
       (fun x -> detect_left_tail_call (combine x))
-  and dispatch_prod1 disp t t1 pl _ =
+  and dispatch_prod1 disp t t1 pl =
     get_tests pl
-      (fun (ret1, ncatchv, (res,q)) -> [q, (ret1,res)], [] ) 
+      (fun (ret1, ncatchv, (res,q)) -> q, (ret1,res) ) 
       (Types.Product.pi2_restricted t1 t)
       (dispatch_prod2 disp)
       (fun x -> detect_right_tail_call (combine x))
-  and dispatch_prod2 disp t2 pl _ =
+  and dispatch_prod2 disp t2 pl =
     let aux_final (ret2, ncatchv, (ret1, res)) =  
       IdMap.mapi_to_list (conv_source_prod ret1 ret2) res in
     return disp pl aux_final