Commit 5bca7237 authored by simonmar's avatar simonmar

[project @ 2002-07-29 10:50:43 by simonmar]

Type variables created by the typechecker didn't have the correct
NameSpace: they were in the Var namespace rather than the TyVar
namespace, which can lead to strange warnings about quantified type
variables being not mentioned in the type when DEBUG is on.

Name:
	- added mkSystemNameEncoded for use when the string
	  is already encoded (saves re-encoding the string every
	  time)

	- added mkSystemTvNameEncoded for making a type variable
	  name, as above

Var:
	- use mkSystemTvNameEncoded when making type variables

Id:
	- add mkSysLocalUnencoded for the (rare) case when
	  the string needs encoding

TcMType:
	- use mkSystemTvNameEncoded rather than mkSystemName for
	  making type variables

SetLevels:
	- use mkSysLocalUnencoded since the names generated here
	  need encoding.
parent 157cecc7
...@@ -9,7 +9,7 @@ module Id ( ...@@ -9,7 +9,7 @@ module Id (
-- Simple construction -- Simple construction
mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo, mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo,
mkSysLocal, mkUserLocal, mkVanillaGlobal, mkSysLocal, mkSysLocalUnencoded, mkUserLocal, mkVanillaGlobal,
mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal, mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
mkWorkerId, mkWorkerId,
...@@ -99,7 +99,7 @@ import IdInfo ...@@ -99,7 +99,7 @@ import IdInfo
import qualified Demand ( Demand ) import qualified Demand ( Demand )
import NewDemand ( Demand, StrictSig, topDmd, topSig, isBottomingSig ) import NewDemand ( Demand, StrictSig, topDmd, topSig, isBottomingSig )
import Name ( Name, OccName, import Name ( Name, OccName,
mkSystemName, mkInternalName, mkSystemName, mkSystemNameEncoded, mkInternalName,
getOccName, getSrcLoc getOccName, getSrcLoc
) )
import OccName ( EncodedFS, mkWorkerOcc ) import OccName ( EncodedFS, mkWorkerOcc )
...@@ -162,7 +162,11 @@ mkVanillaGlobal :: Name -> Type -> IdInfo -> Id ...@@ -162,7 +162,11 @@ mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
-- for SysLocal, we assume the base name is already encoded, to avoid -- for SysLocal, we assume the base name is already encoded, to avoid
-- re-encoding the same string over and over again. -- re-encoding the same string over and over again.
mkSysLocal fs uniq ty = mkLocalId (mkSystemName uniq fs) ty 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
mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty
mkVanillaGlobal = mkGlobalId VanillaGlobal mkVanillaGlobal = mkGlobalId VanillaGlobal
\end{code} \end{code}
......
...@@ -10,7 +10,8 @@ module Name ( ...@@ -10,7 +10,8 @@ module Name (
-- The Name type -- The Name type
Name, -- Abstract Name, -- Abstract
mkInternalName, mkSystemName, mkFCallName, mkInternalName, mkSystemName,
mkSystemNameEncoded, mkSystemTvNameEncoded, mkFCallName,
mkIPName, mkIPName,
mkExternalName, mkKnownKeyExternalName, mkWiredInName, mkExternalName, mkKnownKeyExternalName, mkWiredInName,
...@@ -175,9 +176,21 @@ mkKnownKeyExternalName rdr_name uniq ...@@ -175,9 +176,21 @@ mkKnownKeyExternalName rdr_name uniq
mkWiredInName :: Module -> OccName -> Unique -> Name mkWiredInName :: Module -> OccName -> Unique -> Name
mkWiredInName mod occ uniq = mkExternalName uniq mod occ builtinSrcLoc mkWiredInName mod occ uniq = mkExternalName uniq mod occ builtinSrcLoc
mkSystemName :: Unique -> EncodedFS -> Name mkSystemName :: Unique -> UserFS -> Name
mkSystemName uniq fs = Name { n_uniq = uniq, n_sort = System, mkSystemName uniq fs = Name { n_uniq = uniq, n_sort = System,
n_occ = mkVarOcc fs, n_loc = noSrcLoc } n_occ = mkVarOcc fs, n_loc = noSrcLoc }
-- Use this version when the string is already encoded. Avoids duplicating
-- the string each time a new name is created.
mkSystemNameEncoded :: Unique -> EncodedFS -> Name
mkSystemNameEncoded uniq fs = Name { n_uniq = uniq, n_sort = System,
n_occ = mkSysOccFS varName fs,
n_loc = noSrcLoc }
mkSystemTvNameEncoded :: Unique -> EncodedFS -> Name
mkSystemTvNameEncoded uniq fs = Name { n_uniq = uniq, n_sort = System,
n_occ = mkSysOccFS tvName fs,
n_loc = noSrcLoc }
mkFCallName :: Unique -> EncodedString -> Name mkFCallName :: Unique -> EncodedString -> Name
-- The encoded string completely describes the ccall -- The encoded string completely describes the ccall
......
...@@ -41,7 +41,7 @@ import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId, ...@@ -41,7 +41,7 @@ import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId,
import Name ( Name, OccName, NamedThing(..), import Name ( Name, OccName, NamedThing(..),
setNameUnique, setNameOcc, nameUnique, setNameUnique, setNameOcc, nameUnique,
mkSystemName mkSystemTvNameEncoded,
) )
import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey ) import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey )
import FastTypes import FastTypes
...@@ -195,7 +195,7 @@ mkSysTyVar uniq kind = Var { varName = name ...@@ -195,7 +195,7 @@ mkSysTyVar uniq kind = Var { varName = name
, varInfo = pprPanic "mkSysTyVar" (ppr name) , varInfo = pprPanic "mkSysTyVar" (ppr name)
} }
where where
name = mkSystemName uniq FSLIT("t") name = mkSystemTvNameEncoded uniq FSLIT("t")
newMutTyVar :: Name -> Kind -> TyVarDetails -> IO TyVar newMutTyVar :: Name -> Kind -> TyVarDetails -> IO TyVar
newMutTyVar name kind details newMutTyVar name kind details
......
...@@ -58,7 +58,8 @@ import CmdLineOpts ( FloatOutSwitches(..) ) ...@@ -58,7 +58,8 @@ import CmdLineOpts ( FloatOutSwitches(..) )
import CoreUtils ( exprType, exprIsTrivial, exprIsCheap, mkPiTypes ) import CoreUtils ( exprType, exprIsTrivial, exprIsCheap, mkPiTypes )
import CoreFVs -- all of it import CoreFVs -- all of it
import Subst import Subst
import Id ( Id, idType, mkSysLocal, isOneShotLambda, zapDemandIdInfo, import Id ( Id, idType, mkSysLocalUnencoded,
isOneShotLambda, zapDemandIdInfo,
idSpecialisation, idWorkerInfo, setIdInfo idSpecialisation, idWorkerInfo, setIdInfo
) )
import IdInfo ( workerExists, vanillaIdInfo, ) import IdInfo ( workerExists, vanillaIdInfo, )
...@@ -771,7 +772,7 @@ newPolyBndrs dest_lvl env abs_vars bndrs ...@@ -771,7 +772,7 @@ newPolyBndrs dest_lvl env abs_vars bndrs
in in
returnLvl (extendPolyLvlEnv dest_lvl env abs_vars (bndrs `zip` new_bndrs), new_bndrs) returnLvl (extendPolyLvlEnv dest_lvl env abs_vars (bndrs `zip` new_bndrs), new_bndrs)
where where
mk_poly_bndr bndr uniq = mkSysLocal (mkFastString str) uniq poly_ty mk_poly_bndr bndr uniq = mkSysLocalUnencoded (mkFastString str) uniq poly_ty
where where
str = "poly_" ++ occNameUserString (getOccName bndr) str = "poly_" ++ occNameUserString (getOccName bndr)
poly_ty = mkPiTypes abs_vars (idType bndr) poly_ty = mkPiTypes abs_vars (idType bndr)
...@@ -782,7 +783,7 @@ newLvlVar :: String ...@@ -782,7 +783,7 @@ newLvlVar :: String
-> LvlM Id -> LvlM Id
newLvlVar str vars body_ty newLvlVar str vars body_ty
= getUniqueUs `thenLvl` \ uniq -> = getUniqueUs `thenLvl` \ uniq ->
returnUs (mkSysLocal (mkFastString str) uniq (mkPiTypes vars body_ty)) returnUs (mkSysLocalUnencoded (mkFastString str) uniq (mkPiTypes vars body_ty))
-- The deeply tiresome thing is that we have to apply the substitution -- The deeply tiresome thing is that we have to apply the substitution
-- to the rules inside each Id. Grr. But it matters. -- to the rules inside each Id. Grr. But it matters.
......
...@@ -82,8 +82,9 @@ import PrelNames ( cCallableClassKey, cReturnableClassKey, hasKey ) ...@@ -82,8 +82,9 @@ import PrelNames ( cCallableClassKey, cReturnableClassKey, hasKey )
import ForeignCall ( Safety(..) ) import ForeignCall ( Safety(..) )
import FunDeps ( grow ) import FunDeps ( grow )
import PprType ( pprPred, pprSourceType, pprTheta, pprClassPred ) import PprType ( pprPred, pprSourceType, pprTheta, pprClassPred )
import Name ( Name, NamedThing(..), setNameUnique, mkSystemName, import Name ( Name, NamedThing(..), setNameUnique,
mkInternalName, mkDerivedTyConOcc mkInternalName, mkDerivedTyConOcc,
mkSystemTvNameEncoded,
) )
import VarSet import VarSet
import BasicTypes ( Boxity(Boxed) ) import BasicTypes ( Boxity(Boxed) )
...@@ -106,7 +107,7 @@ import Outputable ...@@ -106,7 +107,7 @@ import Outputable
newTyVar :: Kind -> NF_TcM TcTyVar newTyVar :: Kind -> NF_TcM TcTyVar
newTyVar kind newTyVar kind
= tcGetUnique `thenNF_Tc` \ uniq -> = tcGetUnique `thenNF_Tc` \ uniq ->
tcNewMutTyVar (mkSystemName uniq FSLIT("t")) kind VanillaTv tcNewMutTyVar (mkSystemTvNameEncoded uniq FSLIT("t")) kind VanillaTv
newTyVarTy :: Kind -> NF_TcM TcType newTyVarTy :: Kind -> NF_TcM TcType
newTyVarTy kind newTyVarTy kind
...@@ -119,7 +120,7 @@ newTyVarTys n kind = mapNF_Tc newTyVarTy (nOfThem n kind) ...@@ -119,7 +120,7 @@ newTyVarTys n kind = mapNF_Tc newTyVarTy (nOfThem n kind)
newKindVar :: NF_TcM TcKind newKindVar :: NF_TcM TcKind
newKindVar newKindVar
= tcGetUnique `thenNF_Tc` \ uniq -> = tcGetUnique `thenNF_Tc` \ uniq ->
tcNewMutTyVar (mkSystemName uniq FSLIT("k")) superKind VanillaTv `thenNF_Tc` \ kv -> tcNewMutTyVar (mkSystemTvNameEncoded uniq FSLIT("k")) superKind VanillaTv `thenNF_Tc` \ kv ->
returnNF_Tc (TyVarTy kv) returnNF_Tc (TyVarTy kv)
newKindVars :: Int -> NF_TcM [TcKind] newKindVars :: Int -> NF_TcM [TcKind]
...@@ -128,7 +129,7 @@ newKindVars n = mapNF_Tc (\ _ -> newKindVar) (nOfThem n ()) ...@@ -128,7 +129,7 @@ newKindVars n = mapNF_Tc (\ _ -> newKindVar) (nOfThem n ())
newBoxityVar :: NF_TcM TcKind newBoxityVar :: NF_TcM TcKind
newBoxityVar newBoxityVar
= tcGetUnique `thenNF_Tc` \ uniq -> = tcGetUnique `thenNF_Tc` \ uniq ->
tcNewMutTyVar (mkSystemName uniq FSLIT("bx")) superBoxity VanillaTv `thenNF_Tc` \ kv -> tcNewMutTyVar (mkSystemTvNameEncoded uniq FSLIT("bx")) superBoxity VanillaTv `thenNF_Tc` \ kv ->
returnNF_Tc (TyVarTy kv) returnNF_Tc (TyVarTy kv)
\end{code} \end{code}
...@@ -142,7 +143,7 @@ newBoxityVar ...@@ -142,7 +143,7 @@ newBoxityVar
\begin{code} \begin{code}
newHoleTyVarTy :: NF_TcM TcType newHoleTyVarTy :: NF_TcM TcType
= tcGetUnique `thenNF_Tc` \ uniq -> = tcGetUnique `thenNF_Tc` \ uniq ->
tcNewMutTyVar (mkSystemName uniq FSLIT("h")) openTypeKind HoleTv `thenNF_Tc` \ tv -> tcNewMutTyVar (mkSystemTvNameEncoded uniq FSLIT("h")) openTypeKind HoleTv `thenNF_Tc` \ tv ->
returnNF_Tc (TyVarTy tv) returnNF_Tc (TyVarTy tv)
readHoleResult :: TcType -> NF_TcM TcType readHoleResult :: TcType -> NF_TcM TcType
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment