gcamllib fix

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/gcaml@6411 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

gcamllib/.depend

@@ -1,2 +1,6 @@
 gcaml.cmo: gcaml.cmi 
 gcaml.cmx: gcaml.cmi 
+gcamltest.cmo: gprint.cmi 
+gcamltest.cmx: gprint.cmx 
+gprint.cmo: gprint.cmi 
+gprint.cmx: gprint.cmi 

gcamllib/gcaml.ml

@@ -12,6 +12,7 @@ generic val coerce : {'a} => dyn -> 'a =
     if ty = ty' (* FIXME *) then Obj.obj v
     else raise (Coercion_failure (ty', ty))
 
+(* Use Gprint.print instead! *)
 generic val print : {'a} => 'a -> unit =
   let rec f ty v =
     match ty with

gcamllib/gcaml.mli

@@ -9,5 +9,6 @@ val dyn : {'a} => 'a -> dyn
 val coerce : {'a} => dyn -> 'a
 
 val print : {'a} => 'a -> unit
+(* use Gprint.print instead! *)
 
 val cast : {'a, 'b} => 'a -> 'b

gcamllib/gcamltest.ml

@@ -1,2 +1,8 @@
-let x = [: int :]
-let y = [: ^x :]
+let x = [: int :];;
+let y = [: ^x :];;
+
+open Format;;
+
+type foo = T of int;;
+
+fprintf std_formatter "%a@." Gprint.print (1,2,"a",[1;2;3],[|1.2;3.4;5.6|], true, (fun x -> x), T 1);;

gcamllib/gprint.ml

@@ -1,6 +1,8 @@
 open Format
 open Rtype
 
+type printer = formatter -> Obj.t -> unit
+
 let rec print_list sep f ppf = function
   | [] -> ()
   | [x] -> f ppf x
@@ -14,16 +16,34 @@ let print_tuple f ppf v =
   print_list (fun ppf () -> fprintf ppf ",@ ") f ppf v
 
 let printers =
-  [ Builtintypes.int, (fun ppf v -> fprintf ppf "%i" (Obj.obj v));
-    Builtintypes.char, (fun ppf v -> fprintf ppf "%C" (Obj.obj v));
-    Builtintypes.string, (fun ppf v -> fprintf ppf "%S" (Obj.obj v));
-    Builtintypes.float, (fun ppf v -> fprintf ppf "%F" (Obj.obj v));
-    Builtintypes.bool, (fun ppf v -> fprintf ppf "%B" (Obj.obj v));
-    Builtintypes.unit, (fun ppf v -> fprintf ppf "()");
-    Builtintypes.exn, (fun ppf v -> fprintf ppf "<exn>");
-    Builtintypes.nativeint, (fun ppf v -> fprintf ppf "%nd" (Obj.obj v));
-    Builtintypes.int32, (fun ppf v -> fprintf ppf "%ld" (Obj.obj v));
-    Builtintypes.int64, (fun ppf v -> fprintf ppf "%Ld" (Obj.obj v));
+  [ Builtintypes.int, ((fun _(*[]*) ppf v -> fprintf ppf "%i" (Obj.obj v)) :
+			 printer list -> printer)
+      ;
+    Builtintypes.char, (fun _(*[]*) ppf v -> fprintf ppf "%C" (Obj.obj v));
+    Builtintypes.string, (fun _(*[]*) ppf v -> fprintf ppf "%S" (Obj.obj v));
+    Builtintypes.float, (fun _(*[]*) ppf v -> fprintf ppf "%F" (Obj.obj v));
+    Builtintypes.bool, (fun _(*[]*) ppf v -> fprintf ppf "%B" (Obj.obj v));
+    Builtintypes.unit, (fun _(*[]*) ppf v -> fprintf ppf "()");
+    Builtintypes.exn, (fun _(*[]*) ppf v -> fprintf ppf "<exn>");
+    Builtintypes.nativeint, (fun _(*[]*) ppf v -> fprintf ppf "%nd" (Obj.obj v));
+    Builtintypes.int32, (fun _(*[]*) ppf v -> fprintf ppf "%ld" (Obj.obj v));
+    Builtintypes.int64, (fun _(*[]*) ppf v -> fprintf ppf "%Ld" (Obj.obj v));
+
+    Builtintypes.list, (fun printers ppf v ->
+      match printers with
+      | [printer] ->
+	  fprintf ppf "@[<2>[ %a ]@]" 
+	    (print_list (fun ppf () -> fprintf ppf ";@ ") printer) (Obj.obj v)
+      | _ -> assert false);
+
+    Builtintypes.array, (fun printers ppf v ->
+      match printers with
+      | [printer] ->
+	  fprintf ppf "@[<2>[| %a |]@]" 
+	    (print_list (fun ppf () -> fprintf ppf ";@ ") printer) 
+	    (Array.to_list (Obj.obj v))
+      | _ -> assert false)
+
   ]
 
 generic val print : {'a} => formatter -> 'a -> unit =
@@ -41,8 +61,9 @@ generic val print : {'a} => formatter -> 'a -> unit =
   	fprintf ppf "(@[%a@])" 
   	  (print_tuple (fun ppf (t,v) -> print t ppf v)) (bind 0 ts)
       | Tconstr ((path, decl), args) -> 
+	  let sub_printers = (List.map print args : printer list) in
 	  begin try
-	    List.assq decl printers ppf v
+	    List.assq decl printers sub_printers ppf v
 	  with
 	  | Not_found -> fprintf ppf "<???>"
 	  end