X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2FbasicTypes%2FId.lhs;fp=ghc%2Fcompiler%2FbasicTypes%2FId.lhs;h=85c474d1c3c55f8285f24001e4799eaac192e8c0;hb=a7ecdf96844404b7bc8273d4ff6d85759278427c;hp=62c722a352e20c73e08ec8408a3c605f8eb73592;hpb=8a9aba1ff5e66aad02aba0997339ea6ec60d6b1e;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 62c722a..85c474d 100644
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -8,7 +8,7 @@ module Id (
 	Id, DictId,
 
 	-- Simple construction
-	mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo, 
+	mkGlobalId, mkLocalId, mkLocalIdWithInfo, 
 	mkSysLocal, mkSysLocalUnencoded, mkUserLocal, mkVanillaGlobal,
 	mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
 	mkWorkerId, mkExportedLocalId,
@@ -24,8 +24,8 @@ module Id (
 	zapLamIdInfo, zapDemandIdInfo, 
 
 	-- Predicates
-	isImplicitId, isDeadBinder,
-	isSpecPragmaId,	isExportedId, isLocalId, isGlobalId,
+	isImplicitId, isDeadBinder, isDictId,
+	isExportedId, isLocalId, isGlobalId,
 	isRecordSelector,
 	isClassOpId_maybe,
 	isPrimOpId, isPrimOpId_maybe, 
@@ -83,7 +83,7 @@ module Id (
 import CoreSyn		( Unfolding, CoreRule )
 import BasicTypes	( Arity )
 import Var		( Id, DictId,
-			  isId, isExportedId, isSpecPragmaId, isLocalId,
+			  isId, isExportedId, isLocalId,
 			  idName, idType, idUnique, idInfo, isGlobalId,
 			  setIdName, setIdType, setIdUnique, 
 			  setIdExported, setIdNotExported,
@@ -91,10 +91,11 @@ import Var		( Id, DictId,
 			  maybeModifyIdInfo,
 			  globalIdDetails
 			)
-import qualified Var	( mkLocalId, mkGlobalId, mkSpecPragmaId, mkExportedLocalId )
+import qualified Var	( mkLocalId, mkGlobalId, mkExportedLocalId )
 import TyCon		( FieldLabel, TyCon )
 import Type		( Type, typePrimRep, addFreeTyVars, seqType, 
 			  splitTyConApp_maybe, PrimRep )
+import TcType		( isDictTy )
 import TysPrim		( statePrimTyCon )
 import IdInfo 
 
@@ -147,9 +148,6 @@ where it can easily be found.
 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
 mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info
 
-mkSpecPragmaId :: Name -> Type -> Id
-mkSpecPragmaId name ty = Var.mkSpecPragmaId name (addFreeTyVars ty) vanillaIdInfo
-
 mkExportedLocalId :: Name -> Type -> Id
 mkExportedLocalId name ty = Var.mkExportedLocalId name (addFreeTyVars ty) vanillaIdInfo
 
@@ -229,17 +227,6 @@ idPrimRep id = typePrimRep (idType id)
 %*									*
 %************************************************************************
 
-The @SpecPragmaId@ exists only to make Ids that are
-on the *LHS* of bindings created by SPECIALISE pragmas; 
-eg:		s = f Int d
-The SpecPragmaId is never itself mentioned; it
-exists solely so that the specialiser will find
-the call to f, and make specialised version of it.
-The SpecPragmaId binding is discarded by the specialiser
-when it gathers up overloaded calls.
-Meanwhile, it is not discarded as dead code.
-
-
 \begin{code}
 recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
 recordSelectorFieldLabel id = case globalIdDetails id of
@@ -278,6 +265,9 @@ isDataConWorkId_maybe id = case globalIdDetails id of
 			  DataConWorkId con -> Just con
 			  other	            -> Nothing
 
+isDictId :: Id -> Bool
+isDictId id = isDictTy (idType id)
+
 idDataCon :: Id -> DataCon
 -- Get from either the worker or the wrapper to the DataCon
 -- Currently used only in the desugarer