X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FId.lhs;h=c7ce818adb64b34fe7e59fc5ca7542377fd50cd2;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=0d15b20f22c750da90563caf1686279fc8ef4de3;hpb=36436bc62a98f53e126ec02fe946337c4c766c3f;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 0d15b20..c7ce818 100644
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -9,7 +9,7 @@ module Id (
 
 	-- Simple construction
 	mkGlobalId, mkLocalId, mkLocalIdWithInfo, 
-	mkSysLocal, mkSysLocalUnencoded, mkUserLocal, mkVanillaGlobal,
+	mkSysLocal, mkUserLocal, mkVanillaGlobal,
 	mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
 	mkWorkerId, mkExportedLocalId,
 
@@ -30,7 +30,7 @@ module Id (
 	isClassOpId_maybe,
 	isPrimOpId, isPrimOpId_maybe, 
 	isFCallId, isFCallId_maybe,
-	isDataConWorkId, isDataConWorkId_maybe, idDataCon,
+	isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
 	isBottomingId, idIsFrom,
 	hasNoBinding, 
 
@@ -105,15 +105,15 @@ import qualified Demand	( Demand )
 import DataCon		( DataCon, isUnboxedTupleCon )
 import NewDemand	( Demand, StrictSig, topDmd, topSig, isBottomingSig )
 import Name	 	( Name, OccName, nameIsLocalOrFrom, 
-			  mkSystemVarName, mkSystemVarNameEncoded, mkInternalName,
-			  getOccName, getSrcLoc
-			) 
+			  mkSystemVarName, mkInternalName, getOccName,
+			  getSrcLoc ) 
 import Module		( Module )
-import OccName		( EncodedFS, mkWorkerOcc )
+import OccName		( mkWorkerOcc )
 import Maybes		( orElse )
 import SrcLoc		( SrcLoc )
 import Outputable
 import Unique		( Unique, mkBuiltinUnique )
+import FastString	( FastString )
 import StaticFlags	( opt_NoStateHack )
 
 -- infixl so you can say (id `set` a `set` b)
@@ -162,15 +162,10 @@ mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
 -- SysLocal: for an Id being created by the compiler out of thin air...
 -- UserLocal: an Id with a name the user might recognize...
 mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
-mkSysLocal  :: EncodedFS  -> Unique -> Type -> Id
+mkSysLocal  :: FastString  -> Unique -> Type -> Id
 mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
 
--- for SysLocal, we assume the base name is already encoded, to avoid
--- re-encoding the same string over and over again.
-mkSysLocal fs uniq ty = mkLocalId (mkSystemVarNameEncoded uniq fs) ty
-
--- version to use when the faststring needs to be encoded
-mkSysLocalUnencoded fs uniq ty = mkLocalId (mkSystemVarName uniq fs)  ty
+mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty
 
 mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
 mkVanillaGlobal 	    = mkGlobalId VanillaGlobal
@@ -269,8 +264,11 @@ isDataConWorkId_maybe id = case globalIdDetails id of
 			  DataConWorkId con -> Just con
 			  other	            -> Nothing
 
-isDictId :: Id -> Bool
-isDictId id = isDictTy (idType id)
+isDataConId_maybe :: Id -> Maybe DataCon
+isDataConId_maybe id = case globalIdDetails id of
+		 	 DataConWorkId con -> Just con
+			 DataConWrapId con -> Just con
+			 other		    -> Nothing
 
 idDataCon :: Id -> DataCon
 -- Get from either the worker or the wrapper to the DataCon
@@ -283,6 +281,9 @@ idDataCon id = case globalIdDetails id of
 		  other		    -> pprPanic "idDataCon" (ppr id)
 
 
+isDictId :: Id -> Bool
+isDictId id = isDictTy (idType id)
+
 -- hasNoBinding returns True of an Id which may not have a
 -- binding, even though it is defined in this module.  
 -- Data constructor workers used to be things of this kind, but