X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FId.lhs;h=edaeb7a0ab45b7f0f3e43e3f2ce0143c1b148f98;hb=36d207aa8c9cedbf58e739178971292048bd41d0;hp=798bde666cbf691e2acb3478f517e91822cc6c1f;hpb=182ce7e265699c9fd326f59d29767923100a2d16;p=ghc-hetmet.git diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs index 798bde6..edaeb7a 100644 --- a/compiler/basicTypes/Id.lhs +++ b/compiler/basicTypes/Id.lhs @@ -1,4 +1,5 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[Id]{@Ids@: Value and constructor identifiers} @@ -79,42 +80,29 @@ module Id ( #include "HsVersions.h" - -import CoreSyn ( Unfolding, CoreRule ) -import BasicTypes ( Arity ) -import Var ( Id, DictId, - isId, isExportedId, isLocalId, - idName, idType, idUnique, idInfo, isGlobalId, - setIdName, setIdType, setIdUnique, - setIdExported, setIdNotExported, - setIdInfo, lazySetIdInfo, modifyIdInfo, - maybeModifyIdInfo, - globalIdDetails - ) -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 CoreSyn +import BasicTypes +import qualified Var +import Var hiding (mkLocalId, mkGlobalId, mkExportedLocalId) +import TyCon +import Type +import TcType +import TysPrim import IdInfo - #ifdef OLD_STRICTNESS -import qualified Demand ( Demand ) +import qualified Demand #endif -import DataCon ( DataCon, isUnboxedTupleCon ) -import NewDemand ( Demand, StrictSig, topDmd, topSig, isBottomingSig ) -import Name ( Name, OccName, nameIsLocalOrFrom, - mkSystemVarName, mkInternalName, getOccName, - getSrcLoc ) -import Module ( Module ) -import OccName ( mkWorkerOcc ) -import Maybes ( orElse ) -import SrcLoc ( SrcLoc ) +import DataCon +import NewDemand +import Name +import Module +import OccName +import Maybes +import SrcLoc import Outputable -import Unique ( Unique, mkBuiltinUnique ) -import FastString ( FastString ) -import StaticFlags ( opt_NoStateHack ) +import Unique +import FastString +import StaticFlags -- infixl so you can say (id `set` a `set` b) infixl 1 `setIdUnfolding`, @@ -160,13 +148,14 @@ mkLocalId :: Name -> Type -> Id mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo -- SysLocal: for an Id being created by the compiler out of thin air... +mkSysLocal :: FastString -> Unique -> Type -> Id +mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty + + -- UserLocal: an Id with a name the user might recognize... mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id -mkSysLocal :: FastString -> Unique -> Type -> Id mkVanillaGlobal :: Name -> Type -> IdInfo -> Id -mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty - mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty mkVanillaGlobal = mkGlobalId VanillaGlobal \end{code} @@ -525,8 +514,8 @@ clearOneShotLambda id \begin{code} zapLamIdInfo :: Id -> Id -zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id +zapLamIdInfo id = maybeModifyIdInfo (zapLamInfo (idInfo id)) id -zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id +zapDemandIdInfo id = maybeModifyIdInfo (zapDemandInfo (idInfo id)) id \end{code}