[r2002-11-24 16:49:22 by cvscast] Simplifications in patterns.ml

Original author: cvscast
Date: 2002-11-24 16:49:22+00:00

types/patterns.ml

@@ -966,8 +966,8 @@ struct
       (int * (capture, int) SortedMap.t) list
 
   and interface =
-    [ `Result of int * Types.descr * int  (* code, accepted type, arity *)
-    | `Switch of (capture, int) SortedMap.t * interface * interface
+    [ `Result of int
+    | `Switch of interface * interface
     | `None ]
 
   and dispatcher = {
@@ -1091,68 +1091,41 @@ struct
     try DispMap.find (t,pl) !dispatchers
     with Not_found ->
       let nb = ref 0 in
-      let rec aux t arity i = 
+      let codes = ref [] in
+      let rec aux t arity i accu = 
 	if Types.is_empty t then `None
 	else
 	  if i = Array.length pl 
-	  then (incr nb; `Result (!nb - 1, t, arity))
+	  then (incr nb; codes := (t,arity,accu)::!codes; `Result (!nb - 1))
 	  else
 	    let p = pl.(i) in
 	    let tp = p.Normal.na in
-	    let v = p.Normal.nfv in
-
-	    let v = SortedList.diff v p.Normal.ncatchv in
-(*
-	    Printf.eprintf "ncatchv = (";
-	    List.iter (fun s -> Printf.eprintf "%s;" s) p.Normal.ncatchv;
-	    Printf.eprintf ")\n";
-	    flush stderr;
-*)
-	    
+	    let v = SortedList.diff p.Normal.nfv p.Normal.ncatchv in
 (*	    let tp = Types.normalize tp in *)
+	    let accu' = (i,num arity v) :: accu in
 	    `Switch 
-	      (num arity v,
-	       aux (Types.cap t tp) (arity + (List.length v)) (i+1),
-	       aux (Types.diff t tp) arity (i+1)
+	      (
+	       aux (Types.cap t tp) (arity + (List.length v)) (i+1) accu',
+	       aux (Types.diff t tp) arity (i+1) accu
 	      )
       in
-      let iface = aux t 0 0 in
-      let codes = Array.create !nb (Types.empty,0,[]) in
-      let rec aux i accu = function
-	| `None -> ()
-	| `Switch (pos, yes, no) -> 
-	    aux (i + 1) ((i,pos) :: accu) yes; aux (i + 1) accu no
-	| `Result (code,t,arity) -> 
-	    codes.(code) <- (t,arity, accu)
-      in
-      aux 0 [] iface;
+      let iface = aux t 0 0 [] in
       let res = { id = !cur_id; 
 		  t = t;
 		  pl = pl;
 		  interface = iface;
-		  codes = codes;
+		  codes = Array.of_list (List.rev !codes);
 		  actions = None } in
       incr cur_id;
       dispatchers := DispMap.add (t,pl) res !dispatchers;
       res
     
-  let compare_masks a1 a2 =
-    try
-      for i = 0 to Array.length a1 - 1 do
-	match a1.(i),a2.(i) with   
-	  | None,Some _| Some _, None -> raise Exit
-	  | _ -> ()
-      done;
-      true
-    with Exit -> false
-
   let find_code d a =
     let rec aux i = function
-      | `Result (code,_,_) -> code
-      | `None -> 
-	  assert false
-      | `Switch (_,yes,no) ->
-	  match a.(i) with Some _ -> aux (i + 1) yes | None -> aux (i + 1) no
+      | `Result code -> code
+      | `None -> assert false
+      | `Switch (yes,_) when a.(i) <> None -> aux (i + 1) yes
+      | `Switch (_,no) -> aux (i + 1) no
     in
     aux 0 d.interface
 
@@ -1191,6 +1164,7 @@ struct
 
 
   let dispatch_basic disp : (Types.descr * result) list =
+(* TODO: try other algo, using disp.codes .... *)
     let pl = Array.map (fun p -> p.Normal.nbasic) disp.pl in
     let tests =
       let accu = ref [] in