[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.

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 45b8b42..2ef248a 100644 (file)
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -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}

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index 6993cec..035a499 100644 (file)
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -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

diff --git a/ghc/compiler/basicTypes/Var.lhs b/ghc/compiler/basicTypes/Var.lhs
index deff82a..8002471 100644 (file)
--- a/ghc/compiler/basicTypes/Var.lhs
+++ b/ghc/compiler/basicTypes/Var.lhs
@@ -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 

diff --git a/ghc/compiler/simplCore/SetLevels.lhs b/ghc/compiler/simplCore/SetLevels.lhs
index 5c9cb1e..6108b8b 100644 (file)
--- a/ghc/compiler/simplCore/SetLevels.lhs
+++ b/ghc/compiler/simplCore/SetLevels.lhs
@@ -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.

diff --git a/ghc/compiler/typecheck/TcMType.lhs b/ghc/compiler/typecheck/TcMType.lhs
index faa7827..c13993a 100644 (file)
--- a/ghc/compiler/typecheck/TcMType.lhs
+++ b/ghc/compiler/typecheck/TcMType.lhs
@@ -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