[r2003-05-13 14:01:26 by cvscast] Bug in type-checking for pairs

Original author: cvscast
Date: 2003-05-13 14:01:26+00:00

typing/typer.ml

@@ -805,15 +805,21 @@ and type_check_pair ?(kind=`Normal) loc env e1 e2 constr precise =
       | `Normal -> raise_loc loc (ShouldHave (constr,"but it is a pair."))
       | `XML -> raise_loc loc (ShouldHave (constr,"but it is an XML element.")));
   let pi1 = Types.Product.pi1 rects in
-  
-  let t1 = type_check env e1 (Types.Product.pi1 rects) 
-	     (precise || (Types.Product.need_second rects))in
+
+  let need_s = Types.Product.need_second rects in
+(*  Printf.eprintf "need_second: %b\n" need_s; *)
+  let precise = precise || need_s in
+  let t1 = type_check env e1 (Types.Product.pi1 rects) precise in
   let rects = Types.Product.restrict_1 rects t1 in
   let t2 = type_check env e2 (Types.Product.pi2 rects) precise in
+
   if precise then 
-    match kind with
-      | `Normal -> Types.times (Types.cons t1) (Types.cons t2)
-      | `XML -> Types.xml (Types.cons t1) (Types.cons t2)
+    let t =
+      match kind with
+      	| `Normal -> Types.times (Types.cons t1) (Types.cons t2)
+      	| `XML -> Types.xml (Types.cons t1) (Types.cons t2) in
+    check loc t constr "";
+    t
   else
     constr