reparation d'un bug (dummy_lams -> anonym_lams) + chgmt structutr d'un ml_type

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@2913 85f007b7-540e-0410-9357-904b9bb8a0f7

1 files changed, 7 insertions, 13 deletions

diff --git a/contrib/extraction/haskell.ml b/contrib/extraction/haskell.ml
index 877961018..286747c6f 100644
--- a/contrib/extraction/haskell.ml
+++ b/contrib/extraction/haskell.ml
@@ -70,22 +70,16 @@ let empty_env () = [], P.globals()
 let rec pp_type par vl t =
   let rec pp_rec par = function
     | Tvar i -> (try pr_id (List.nth vl (pred i)) with _ -> (str "a" ++ int i))
-    | Tapp l ->
-	(match collapse_type_app l with
-	   | [] -> assert false
-	   | [t] -> pp_rec par t
-	   | t::l -> 
-	       (open_par par ++
-		  pp_rec false t ++ spc () ++
-		  prlist_with_sep (fun () -> (spc ())) (pp_type true vl) l ++ 
-		  close_par par))
+    | Tglob (r,[]) -> pp_type_global r	
+    | Tglob (r,l) -> 
+	open_par par ++ pp_type_global r ++ spc () ++
+	prlist_with_sep spc (pp_type true vl) l ++ close_par par
     | Tarr (t1,t2) ->
-	(open_par par ++ pp_rec true t1 ++ spc () ++ str "->" ++ spc () ++ 
-	   pp_rec false t2 ++ close_par par)
-    | Tglob r -> pp_type_global r
+	open_par par ++ pp_rec true t1 ++ spc () ++ str "->" ++ spc () ++ 
+	pp_rec false t2 ++ close_par par
     | Tdummy -> str "()"
     | Tunknown -> str "()"
-  in 
+ in 
   hov 0 (pp_rec par t)
 
 (*s Pretty-printing of expressions. [par] indicates whether