remove empty dir

[ghc-hetmet.git] / ghc / compiler / basicTypes / Id.lhs

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 85c474d..c7ce818 100644 (file)
--- 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,
 
@@ -26,11 +26,11 @@ module Id (
        -- Predicates
        isImplicitId, isDeadBinder, isDictId,
        isExportedId, isLocalId, isGlobalId,
-       isRecordSelector,
+       isRecordSelector, isNaughtyRecordSelector,
        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
@@ -230,13 +225,17 @@ idPrimRep id = typePrimRep (idType id)
 \begin{code}
 recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
 recordSelectorFieldLabel id = case globalIdDetails id of
-                                RecordSelId tycon lbl -> (tycon,lbl)
+                                RecordSelId tycon lbl _ -> (tycon,lbl)
                                 other -> panic "recordSelectorFieldLabel"
 
 isRecordSelector id = case globalIdDetails id of
-                       RecordSelId _ _ -> True
+                       RecordSelId {}  -> True
                        other           -> False
 
+isNaughtyRecordSelector id = case globalIdDetails id of
+                       RecordSelId { sel_naughty = n } -> n
+                       other                           -> False
+
 isClassOpId_maybe id = case globalIdDetails id of
                        ClassOpId cls -> Just cls
                        _other        -> Nothing
@@ -265,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
@@ -279,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
@@ -297,7 +302,7 @@ isImplicitId :: Id -> Bool
        -- file, even if it's mentioned in some other interface unfolding.
 isImplicitId id
   = case globalIdDetails id of
-       RecordSelId _ _ -> True
+       RecordSelId {}  -> True
         FCallId _       -> True
         PrimOpId _      -> True
        ClassOpId _     -> True