[r2003-05-25 11:12:58 by cvscast] Display of samples

Original author: cvscast
Date: 2003-05-25 11:13:31+00:00

Makefile

@@ -89,6 +89,7 @@ clean:
 	for i in $(CLEAN_DIRS); do \
 	(cd $$i; rm -f *.cmi *.cmo *.cma *.cmx *.o *~); \
 	done
+	rm -f `find -name "*~"`
 	rm -f *.cmi *.cmo *.cma *.cmx *.a *.cmxa *.o *~
 	rm -f cduce ocamlprof.dump
 	rm -f dtd2cduce pool webiface
@@ -186,5 +187,5 @@ package:
 	rm -Rf package
 	mkdir package
 	cp -R $(DISTRIB) package/
-	(cd package; headache -h ../header $(DEPEND))
+	(cd package; headache -h ../header $(DEPEND); rm -Rf `find -name "CVS"`)
 

driver/cduce.ml

@@ -20,6 +20,11 @@ let print_norm ppf d =
   Location.protect ppf 
     (fun ppf -> Types.Print.print ppf ((*Types.normalize*) d))
 
+let print_sample ppf s =
+  Location.protect ppf
+    (fun ppf -> Sample.print ppf s)
+
+
 let print_value ppf v =
   Location.protect ppf (fun ppf -> Value.print ppf v)
 
@@ -70,17 +75,13 @@ let rec print_exn ppf = function
         print_norm t;
       Format.fprintf ppf "but its inferred type is:@\n%a@\n" 
         print_norm s;
-      Format.fprintf ppf "which is not a subtype, as shown by the sample:@\n" ;
-      Location.protect ppf
-	(fun ppf ->
-	   Sample.print ppf (Sample.get (Types.diff s t)));
-      Format.fprintf ppf "@\n"
+      Format.fprintf ppf "which is not a subtype, as shown by the sample:@\n%a@\n" 
+	print_sample (Sample.get (Types.diff s t))
   | Typer.NonExhaustive t ->
       Format.fprintf ppf "This pattern matching is not exhaustive@\n";
       Format.fprintf ppf "Residual type:@\n%a@\n"
 	print_norm t;
-      Format.fprintf ppf "Sample:@\n%a@\n" 
-	Sample.print (Sample.get t)
+      Format.fprintf ppf "Sample:@\n%a@\n" print_sample (Sample.get t)
   | Typer.UnboundId x ->
       Format.fprintf ppf "Unbound identifier %a@\n" U.print (Id.value x)
   | Wlexer.Illegal_character c ->
@@ -109,9 +110,7 @@ let debug ppf = function
   | `Sample t ->
       Format.fprintf ppf "[DEBUG:sample]@\n";
       let t = Types.descr (Typer.typ t) in
-      Location.protect ppf
-	(fun ppf -> Sample.print ppf (Sample.get t));
-      Format.fprintf ppf "@\n"
+      Format.fprintf ppf "%a@\n" print_sample (Sample.get t)
   | `Filter (t,p) -> 
       Format.fprintf ppf "[DEBUG:filter]@\n";
       let t = Typer.typ t