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 (
-- Simple construction
mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo,
mkSysLocal, mkUserLocal, mkVanillaGlobal,
mkSysLocal, mkSysLocalUnencoded, mkUserLocal, mkVanillaGlobal,
mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
mkWorkerId,
......@@ -99,7 +99,7 @@ import IdInfo
import qualified Demand ( Demand )
import NewDemand ( Demand, StrictSig, topDmd, topSig, isBottomingSig )
import Name ( Name, OccName,
mkSystemName, mkInternalName,
mkSystemName, mkSystemNameEncoded, mkInternalName,
getOccName, getSrcLoc
)
import OccName ( EncodedFS, mkWorkerOcc )
......@@ -162,7 +162,11 @@ 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 (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
mkVanillaGlobal = mkGlobalId VanillaGlobal
\end{code}
......
......@@ -10,7 +10,8 @@ module Name (
-- The Name type
Name, -- Abstract
mkInternalName, mkSystemName, mkFCallName,
mkInternalName, mkSystemName,
mkSystemNameEncoded, mkSystemTvNameEncoded, mkFCallName,
mkIPName,
mkExternalName, mkKnownKeyExternalName, mkWiredInName,
......@@ -175,9 +176,21 @@ mkKnownKeyExternalName rdr_name uniq
mkWiredInName :: Module -> OccName -> Unique -> Name
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,
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
-- The encoded string completely describes the ccall
......
......@@ -41,7 +41,7 @@ import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId,
import Name ( Name, OccName, NamedThing(..),
setNameUnique, setNameOcc, nameUnique,
mkSystemName
mkSystemTvNameEncoded,
)
import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey )
import FastTypes
......@@ -195,7 +195,7 @@ mkSysTyVar uniq kind = Var { varName = name
, varInfo = pprPanic "mkSysTyVar" (ppr name)
}
where
name = mkSystemName uniq FSLIT("t")
name = mkSystemTvNameEncoded uniq FSLIT("t")
newMutTyVar :: Name -> Kind -> TyVarDetails -> IO TyVar
newMutTyVar name kind details
......
......@@ -58,7 +58,8 @@ import CmdLineOpts ( FloatOutSwitches(..) )
import CoreUtils ( exprType, exprIsTrivial, exprIsCheap, mkPiTypes )
import CoreFVs -- all of it
import Subst
import Id ( Id, idType, mkSysLocal, isOneShotLambda, zapDemandIdInfo,
import Id ( Id, idType, mkSysLocalUnencoded,
isOneShotLambda, zapDemandIdInfo,
idSpecialisation, idWorkerInfo, setIdInfo
)
import IdInfo ( workerExists, vanillaIdInfo, )
......@@ -771,7 +772,7 @@ newPolyBndrs dest_lvl env abs_vars bndrs
in
returnLvl (extendPolyLvlEnv dest_lvl env abs_vars (bndrs `zip` new_bndrs), new_bndrs)
where
mk_poly_bndr bndr uniq = mkSysLocal (mkFastString str) uniq poly_ty
mk_poly_bndr bndr uniq = mkSysLocalUnencoded (mkFastString str) uniq poly_ty
where
str = "poly_" ++ occNameUserString (getOccName bndr)
poly_ty = mkPiTypes abs_vars (idType bndr)
......@@ -782,7 +783,7 @@ newLvlVar :: String
-> LvlM Id
newLvlVar str vars body_ty
= 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
-- to the rules inside each Id. Grr. But it matters.
......
......@@ -82,8 +82,9 @@ import PrelNames ( cCallableClassKey, cReturnableClassKey, hasKey )
import ForeignCall ( Safety(..) )
import FunDeps ( grow )
import PprType ( pprPred, pprSourceType, pprTheta, pprClassPred )
import Name ( Name, NamedThing(..), setNameUnique, mkSystemName,
mkInternalName, mkDerivedTyConOcc
import Name ( Name, NamedThing(..), setNameUnique,
mkInternalName, mkDerivedTyConOcc,
mkSystemTvNameEncoded,
)
import VarSet
import BasicTypes ( Boxity(Boxed) )
......@@ -106,7 +107,7 @@ import Outputable
newTyVar :: Kind -> NF_TcM TcTyVar
newTyVar kind
= 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
......@@ -119,7 +120,7 @@ newTyVarTys n kind = mapNF_Tc newTyVarTy (nOfThem n kind)
newKindVar :: NF_TcM TcKind
newKindVar
= 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)
newKindVars :: Int -> NF_TcM [TcKind]
......@@ -128,7 +129,7 @@ newKindVars n = mapNF_Tc (\ _ -> newKindVar) (nOfThem n ())
newBoxityVar :: NF_TcM TcKind
newBoxityVar
= 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)
\end{code}
......@@ -142,7 +143,7 @@ newBoxityVar
\begin{code}
newHoleTyVarTy :: NF_TcM TcType
= 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)
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