remove empty dir
[ghc-hetmet.git] / ghc / compiler / basicTypes / Id.lhs
index 8761762..c7ce818 100644 (file)
@@ -8,28 +8,29 @@ module Id (
        Id, DictId,
 
        -- Simple construction
-       mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo, 
-       mkSysLocal, mkSysLocalUnencoded, mkUserLocal, mkVanillaGlobal,
+       mkGlobalId, mkLocalId, mkLocalIdWithInfo, 
+       mkSysLocal, mkUserLocal, mkVanillaGlobal,
        mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
        mkWorkerId, mkExportedLocalId,
 
        -- Taking an Id apart
        idName, idType, idUnique, idInfo,
-       idPrimRep, isId, globalIdDetails,
+       isId, globalIdDetails, idPrimRep,
        recordSelectorFieldLabel,
 
        -- Modifying an Id
-       setIdName, setIdUnique, Id.setIdType, setIdLocalExported, 
+       setIdName, setIdUnique, Id.setIdType, setIdExported, setIdNotExported, 
        setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
        zapLamIdInfo, zapDemandIdInfo, 
 
        -- Predicates
-       isImplicitId, isDeadBinder,
-       isSpecPragmaId, isExportedId, isLocalId, isGlobalId,
-       isRecordSelector,
+       isImplicitId, isDeadBinder, isDictId,
+       isExportedId, isLocalId, isGlobalId,
+       isRecordSelector, isNaughtyRecordSelector,
+       isClassOpId_maybe,
        isPrimOpId, isPrimOpId_maybe, 
        isFCallId, isFCallId_maybe,
-       isDataConWorkId, isDataConWorkId_maybe, 
+       isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
        isBottomingId, idIsFrom,
        hasNoBinding, 
 
@@ -79,39 +80,41 @@ module Id (
 #include "HsVersions.h"
 
 
-import CoreSyn         ( Unfolding, CoreRules, IdCoreRule, rulesRules )
+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, setIdLocalExported,
+                         setIdName, setIdType, setIdUnique, 
+                         setIdExported, setIdNotExported,
                          setIdInfo, lazySetIdInfo, modifyIdInfo, 
                          maybeModifyIdInfo,
                          globalIdDetails
                        )
-import qualified Var   ( mkLocalId, mkGlobalId, mkSpecPragmaId, mkExportedLocalId )
-import Type            ( Type, typePrimRep, addFreeTyVars, seqType, splitTyConApp_maybe )
+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 
 
 #ifdef OLD_STRICTNESS
 import qualified Demand        ( Demand )
 #endif
-import DataCon         ( isUnboxedTupleCon )
+import DataCon         ( DataCon, isUnboxedTupleCon )
 import NewDemand       ( Demand, StrictSig, topDmd, topSig, isBottomingSig )
 import Name            ( Name, OccName, nameIsLocalOrFrom, 
-                         mkSystemName, mkSystemNameEncoded, mkInternalName,
-                         getOccName, getSrcLoc
-                       ) 
+                         mkSystemVarName, mkInternalName, getOccName,
+                         getSrcLoc ) 
 import Module          ( Module )
-import OccName         ( EncodedFS, mkWorkerOcc )
-import PrimRep         ( PrimRep )
-import FieldLabel      ( FieldLabel )
+import OccName         ( mkWorkerOcc )
 import Maybes          ( orElse )
 import SrcLoc          ( SrcLoc )
 import Outputable
 import Unique          ( Unique, mkBuiltinUnique )
-import CmdLineOpts     ( opt_NoStateHack )
+import FastString      ( FastString )
+import StaticFlags     ( opt_NoStateHack )
 
 -- infixl so you can say (id `set` a `set` b)
 infixl         1 `setIdUnfolding`,
@@ -145,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
 
@@ -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 (mkSystemNameEncoded uniq fs) ty
-
--- version to use when the faststring needs to be encoded
-mkSysLocalUnencoded fs uniq ty = mkLocalId (mkSystemName 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
@@ -227,27 +222,24 @@ 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 -> FieldLabel
+recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
 recordSelectorFieldLabel id = case globalIdDetails id of
-                                RecordSelId lbl -> lbl
+                                RecordSelId tycon lbl _ -> (tycon,lbl)
                                 other -> panic "recordSelectorFieldLabel"
 
 isRecordSelector id = case globalIdDetails id of
-                       RecordSelId lbl -> 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
+
 isPrimOpId id = case globalIdDetails id of
                    PrimOpId op -> True
                    other       -> False
@@ -272,6 +264,26 @@ isDataConWorkId_maybe id = case globalIdDetails id of
                          DataConWorkId con -> Just con
                          other             -> Nothing
 
+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
+-- Currently used only in the desugarer
+--      INVARIANT: idDataCon (dataConWrapId d) = d
+-- (Remember, dataConWrapId can return either the wrapper or the worker.)
+idDataCon id = case globalIdDetails id of
+                 DataConWorkId con -> con
+                 DataConWrapId con -> con
+                 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
@@ -290,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
@@ -391,13 +403,13 @@ setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
 
        ---------------------------------
        -- SPECIALISATION
-idSpecialisation :: Id -> CoreRules
+idSpecialisation :: Id -> SpecInfo
 idSpecialisation id = specInfo (idInfo id)
 
-idCoreRules :: Id -> [IdCoreRule]
-idCoreRules id = [(id,rule) | rule <- rulesRules (idSpecialisation id)]
+idCoreRules :: Id -> [CoreRule]
+idCoreRules id = specInfoRules (idSpecialisation id)
 
-setIdSpecialisation :: Id -> CoreRules -> Id
+setIdSpecialisation :: Id -> SpecInfo -> Id
 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
 
        ---------------------------------