X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fspecialise%2FSpecUtils.lhs;h=bd7ec63d06df63d8546164ad964db31a7e5a8b2b;hb=26741ec416bae2c502ef00a2ba0e79050a32cb67;hp=7af0cc7eb7e461d1f54f6a1b2df23b99e08ccb85;hpb=5cf27e8f1731c52fe63a5b9615f927484164c61b;p=ghc-hetmet.git

diff --git a/ghc/compiler/specialise/SpecUtils.lhs b/ghc/compiler/specialise/SpecUtils.lhs
index 7af0cc7..bd7ec63 100644
--- a/ghc/compiler/specialise/SpecUtils.lhs
+++ b/ghc/compiler/specialise/SpecUtils.lhs
@@ -8,7 +8,7 @@
 
 module SpecUtils (
 	specialiseCallTys,
-	ConstraintVector(..),
+	SYN_IE(ConstraintVector),
 	getIdOverloading,
 	mkConstraintVector,
 	isUnboxedSpecialisation,
@@ -21,7 +21,7 @@ module SpecUtils (
 	pprSpecErrs
     ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
 import Bag		( isEmptyBag, bagToList )
 import Class		( classOpString, GenClass{-instance NamedThing-} )
@@ -33,12 +33,11 @@ import Id		( idType, isDictFunId, isConstMethodId_maybe,
 			  GenId {-instance NamedThing -}
 			)
 import Maybes		( maybeToBool, catMaybes, firstJust )
-import Name		( isLexVarSym, isLexSpecialSym, pprNonSym, moduleNamePair )
+import Name		( origName, isLexVarSym, isLexSpecialSym, pprNonSym )
 import PprStyle		( PprStyle(..) )
 import PprType		( pprGenType, pprParendGenType, pprMaybeTy,
 			  TyCon{-ditto-}, GenType{-ditto-}, GenTyVar
 			)
-import PrelMods		( fromPrelude, pRELUDE )
 import Pretty		-- plenty of it
 import TyCon		( tyConTyVars, TyCon{-instance NamedThing-} )
 import Type		( splitSigmaTy, mkTyVarTy, mkForAllTys,
@@ -235,18 +234,16 @@ pprSpecErrs this_mod spec_errs spec_warn spec_tyerrs
 
       | isDictFunId id || maybeToBool (isConstMethodId_maybe id)
       = let get_mod = getInstIdModule id
-	    use_mod = if fromPrelude get_mod
-		      then pRELUDE
-		      else get_mod
+	    use_mod = get_mod
 	in (use_mod, _NIL_)
 
       | otherwise
-      = moduleNamePair id
+      = case (origName "get_id_name" id) of { OrigName m n -> (m, n) }
 
     get_ty_data (ty, tys)
       = (mod_name, [(ty_name, ty, tys)])
       where
-	(mod_name,ty_name) = moduleNamePair ty
+	(OrigName mod_name ty_name) = origName "get_ty_data" ty
 
     module_names    = concat [keysFM idspecs_fm, keysFM tyspecs_fm]
     mods            = map head (equivClasses _CMP_STRING_ module_names)
@@ -257,8 +254,7 @@ pprSpecErrs this_mod spec_errs spec_warn spec_tyerrs
 			    EQ_   -> ([_NIL_], tail mods)
 			    other -> ([], mods)
 
-    (prels, others) = partition fromPrelude known
-    use_modules     = unks ++ prels ++ others
+    use_modules     = unks ++ known
 
     pp_module_specs :: FAST_STRING -> Pretty
     pp_module_specs mod
@@ -313,7 +309,7 @@ pp_idspec sty pp_mod (_, id, tys, is_err)
   | is_const_method_id
   = let
 	Just (cls, clsty, clsop) = const_method_maybe
-    	(_, cls_str) = moduleNamePair cls
+    	(OrigName _ cls_str) = origName "pp_idspec" cls
 	clsop_str    = classOpString clsop
     in
     ppCat [pp_mod,
@@ -327,7 +323,7 @@ pp_idspec sty pp_mod (_, id, tys, is_err)
   | is_default_method_id
   = let
 	Just (cls, clsop, _) = default_method_maybe
-    	(_, cls_str) = moduleNamePair cls
+    	(OrigName _ cls_str) = origName "pp_idspec2" cls
 	clsop_str    = classOpString clsop
     in
     ppCat [pp_mod,