[project @ 2003-10-30 10:12:39 by simonpj]

[ghc-hetmet.git] / ghc / compiler / hsSyn / Convert.lhs

diff --git a/ghc/compiler/hsSyn/Convert.lhs b/ghc/compiler/hsSyn/Convert.lhs
index fa48574..a21f364 100644 (file)
--- a/ghc/compiler/hsSyn/Convert.lhs
+++ b/ghc/compiler/hsSyn/Convert.lhs
@@ -19,9 +19,9 @@ import HsSyn as Hs
                HsDecl(..), TyClDecl(..), InstDecl(..), ConDecl(..),
                Stmt(..), HsBinds(..), MonoBinds(..), Sig(..),
                Pat(..), HsConDetails(..), HsOverLit, BangType(..),
-               placeHolderType, HsType(..), 
+               placeHolderType, HsType(..), HsExplicitForAll(..),
                HsTyVarBndr(..), HsContext,
-               mkSimpleMatch, mkHsForAllTy
+               mkSimpleMatch, mkImplicitHsForAllTy, mkExplicitHsForAllTy
        ) 
 
 import RdrName ( RdrName, mkRdrUnqual, mkRdrQual, mkOrig )
@@ -98,9 +98,7 @@ cvt_top (InstanceD tys ty decs)
   = Left $ InstD (InstDecl inst_ty binds sigs loc0)
   where
     (binds, sigs) = cvtBindsAndSigs decs
-    inst_ty = HsForAllTy Nothing 
-                        (cvt_context tys) 
-                        (HsPredTy (cvt_pred ty))
+    inst_ty = mkImplicitHsForAllTy (cvt_context tys) (HsPredTy (cvt_pred ty))
 
 cvt_top (Meta.SigD nm typ) = Left $ Hs.SigD (Sig (vName nm) (cvtType typ) loc0)
 
@@ -304,7 +302,7 @@ cvt_context tys = map cvt_pred tys
 cvt_pred :: Meta.Type -> HsPred RdrName
 cvt_pred ty = case split_ty_app ty of
                (ConT tc, tys) -> HsClassP (tconName tc) (map cvtType tys)
-               other -> panic "Malformed predicate"
+               other -> pprPanic "Malformed predicate" (text (show (Meta.pprType ty)))
 
 cvtType :: Meta.Type -> HsType RdrName
 cvtType ty = trans (root ty [])
@@ -321,9 +319,8 @@ cvtType ty = trans (root ty [])
        trans (VarT nm, args)       = foldl HsAppTy (HsTyVar (tName nm)) args
         trans (ConT tc, args)       = foldl HsAppTy (HsTyVar (tconName tc)) args
 
-       trans (ForallT tvs cxt ty, []) = mkHsForAllTy (Just (cvt_tvs tvs))
-                                                     (cvt_context cxt)
-                                                     (cvtType ty)
+       trans (ForallT tvs cxt ty, []) = mkExplicitHsForAllTy 
+                                               (cvt_tvs tvs) (cvt_context cxt) (cvtType ty)
 
 split_ty_app :: Meta.Type -> (Meta.Type, [Meta.Type])
 split_ty_app ty = go ty []