[r2004-12-26 16:33:24 by afrisch] Before normalization

Original author: afrisch
Date: 2004-12-26 16:33:24+00:00

driver/cduce.ml

@@ -195,7 +195,7 @@ let debug ppf tenv cenv = function
       let t = Typer.typ tenv t
       and pl = List.map (Typer.pat tenv) pl in
 (*      Patterns.Compile.debug_compile ppf t pl *)
-      Patterns.demo_compile ppf (Types.descr t) (List.map Patterns.descr pl)
+      Patterns.demo_compile ppf (Types.descr t) (List.map Patterns.descr pl) 
   | `Explain (t,e) ->
       Format.fprintf ppf "[DEBUG:explain]@.";
       let t = Typer.typ tenv t in

types/patterns.ml

@@ -1780,6 +1780,17 @@ x=(1,2)
       | TCapt (f,r1), r2 | r2, TCapt (f,r1) -> capt f (conj a1 fv1 r1 r2)
       | r1,r2 -> TConj (a1,fv1,r1,r2)
 
+    let constrain a t = 
+      if Types.disjoint a t then TFail
+      else if Types.subtype t a then (
+(*	Format.fprintf Format.std_formatter
+	  "Optimize constraint -> Succeed  a=%a t=%a@."
+	  Types.Print.print a
+	  Types.Print.print t; *)
+	TSucceed
+      )
+      else TConstr (a,t)
+
     let alt p a1 r1 r2 = match (r1,r2) with
       | TFail,r | r,TFail -> r
       | TSucceed, _ -> assert false
@@ -1847,17 +1858,7 @@ x=(1,2)
 	  TRecord ((incr uid; !uid),p, any_or_abs,fv,l,q)
       | Dummy -> assert false
 
-    let constrain a t = 
-      if Types.disjoint a t then TFail
-      else if Types.subtype t a then (
-(*	Format.fprintf Format.std_formatter
-	  "Optimize constraint -> Succeed  a=%a t=%a@."
-	  Types.Print.print a
-	  Types.Print.print t; *)
-	TSucceed
-      )
-      else TConstr (a,t)
-
+ 
     let approx_var p t xs f =
       let vs = Approx.approx_var p t xs in
       let xs = IdSet.diff xs vs in
@@ -2587,7 +2588,7 @@ x=(1,2)
   let actions r = match r.actions with
     | Some a -> a
     | None -> let a = compute_action r in
-(*      Format.fprintf Format.std_formatter "%a%a@." print r print_action a;  *)
+      Format.fprintf Format.std_formatter "%a%a@." print r print_action a;
       r.actions <- Some a; a
 
   let print_dispatcher ppf r =