Complete OccName->FS change in TcIface

[ghc-hetmet.git] / compiler / iface / TcIface.lhs

diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 04154ef..e72742b 100644 (file)
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -35,7 +35,7 @@ import HscTypes               ( ExternalPackageState(..),
                          emptyModDetails, lookupTypeEnv, lookupType, typeEnvIds )
 import InstEnv         ( Instance(..), mkImportedInstance )
 import CoreSyn
-import CoreUtils       ( exprType )
+import CoreUtils       ( exprType, dataConRepFSInstPat )
 import CoreUnfold
 import CoreLint                ( lintUnfolding )
 import WorkWrap                ( mkWrapper )
@@ -53,11 +53,12 @@ import Var          ( TyVar, mkTyVar, tyVarKind )
 import Name            ( Name, nameModule, nameIsLocalOrFrom, isWiredInName,
                          nameOccName, wiredInNameTyThing_maybe )
 import NameEnv
-import OccName         ( OccName, mkVarOccFS, mkTyVarOccoccNameSpace, pprNameSpace  )
+import OccName         ( OccName, mkVarOccFS, mkTyVarOcc, occNameSpace, 
+                         pprNameSpace, occNameFS  )
 import FastString       ( FastString )
 import Module          ( Module, moduleName )
 import UniqFM          ( lookupUFM )
-import UniqSupply      ( initUs_ )
+import UniqSupply      ( initUs_, uniqsFromSupply )
 import Outputable      
 import ErrUtils                ( Message )
 import Maybes          ( MaybeErr(..) )
@@ -452,7 +453,7 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
 tcIfaceEqSpec spec
   = mapM do_item spec
   where
-    do_item (occ, if_ty) = do { tv <- tcIfaceTyVar occ
+    do_item (occ, if_ty) = do { tv <- tcIfaceTyVar (occNameFS occ)
                               ; ty <- tcIfaceType if_ty
                               ; return (tv,ty) }
 \end{code}     
@@ -678,18 +679,13 @@ tcIfaceAlt (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs)
        ; tcIfaceDataAlt data_con inst_tys arg_occs rhs }
 
 tcIfaceDataAlt con inst_tys arg_strs rhs
-  = do { arg_names <- newIfaceNames (map mkVarOccFS arg_strs)
-        ; let (tyvar_strs, id_strs) = splitAtList (dataConTyVars con) arg_strs
-        ; tyvar_names <- mapM (newIfaceName . mkTyVarOcc) tyvar_strs
-        ; id_names    <- mapM (newIfaceName . mkVarOccFS) id_strs
-       ; let   ex_tvs  = [ mkTyVar name (tyVarKind tv) 
-                          | (name,tv) <- tyvar_names `zip` dataConExTyVars con ]
-               arg_tys  = dataConInstArgTys con (inst_tys ++ mkTyVarTys ex_tvs)
-               arg_ids  = ASSERT2( equalLength id_names arg_tys,
-                                   ppr (con, tyvar_names++id_names, rhs) $$ ppr ex_tvs $$ ppr arg_tys )
-                          zipWith mkLocalId id_names arg_tys
-               
-       ; rhs' <- extendIfaceTyVarEnv ex_tvs    $
+  = do { us <- newUniqueSupply
+       ; let uniqs = uniqsFromSupply us
+       ; let (ex_tvs, co_tvs, arg_ids) = 
+               dataConRepFSInstPat arg_strs uniqs con inst_tys
+              all_tvs                   = ex_tvs ++ co_tvs
+
+       ; rhs' <- extendIfaceTyVarEnv all_tvs   $
                  extendIfaceIdEnv arg_ids      $
                  tcIfaceExpr rhs
        ; return (DataAlt con, ex_tvs ++ arg_ids, rhs') }
@@ -973,7 +969,5 @@ mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
 mk_iface_tyvar name ifKind = do { kind <- tcIfaceType ifKind
                                 ; return (mkTyVar name kind)
                                 }
-
-mk_iface_tyvar name kind = mkTyVar name kind
 \end{code}