From f43ebad1020dccdf6fde2fddc91994b27d0f565e Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 7 Dec 2000 08:28:05 +0000
Subject: [PATCH] [project @ 2000-12-07 08:28:05 by simonpj] Workers get local
 names initially; nuke mkDerivedName

---
 ghc/compiler/basicTypes/MkId.lhs    |   10 +++++++---
 ghc/compiler/basicTypes/Name.lhs    |   10 +---------
 ghc/compiler/basicTypes/RdrName.lhs |    2 +-
 ghc/compiler/typecheck/TcType.lhs   |   10 +++++++---
 4 files changed, 16 insertions(+), 16 deletions(-)

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index ccc56cc..bda97b4 100644
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -54,9 +54,9 @@ import TyCon		( TyCon, isNewTyCon, tyConTyVars, tyConDataCons,
 import Class		( Class, classTyCon, classTyVars, classSelIds )
 import Var		( Id, TyVar )
 import VarSet		( isEmptyVarSet )
-import Name		( mkDerivedName, mkWiredInName, mkLocalName, 
+import Name		( mkWiredInName, mkLocalName, 
 			  mkWorkerOcc, mkCCallName,
-			  Name, NamedThing(..),
+			  Name, NamedThing(..), getSrcLoc
 			)
 import OccName		( mkVarOcc )
 import PrimOp		( PrimOp(DataToTagOp, CCallOp), 
@@ -148,8 +148,12 @@ mkDefaultMethodId dm_name rec_c ty
              -- type is wired-in (see comment at TcClassDcl.tcClassSig), so
              -- do not generalise it
 
+mkWorkerId :: Unique -> Id -> Type -> Id
+-- A worker gets a local name.  CoreTidy will globalise it if necessary.
 mkWorkerId uniq unwrkr ty
-  = mkVanillaId (mkDerivedName mkWorkerOcc (getName unwrkr) uniq) ty
+  = mkVanillaId wkr_name ty
+  where
+    wkr_name = mkLocalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
 \end{code}
 
 %************************************************************************
diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index 2dcc009..aef8355 100644
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -12,7 +12,7 @@ module Name (
 	Name,					-- Abstract
 	mkLocalName, mkSysLocalName, mkCCallName,
 	mkIPName,
-	mkDerivedName, mkGlobalName, mkKnownKeyGlobal, mkWiredInName,
+	mkGlobalName, mkKnownKeyGlobal, mkWiredInName,
 
 	nameUnique, setNameUnique,
 	nameOccName, nameModule, nameModule_maybe,
@@ -198,14 +198,6 @@ mkIPName uniq occ
 	   n_sort = Local,
 	   n_occ  = occ,
 	   n_loc = noSrcLoc }
-
----------------------------------------------------------------------
-mkDerivedName :: (OccName -> OccName)
-	      -> Name		-- Base name
-	      -> Unique		-- New unique
-	      -> Name		-- Result is always a value name
-
-mkDerivedName f name uniq = name {n_uniq = uniq, n_occ = f (n_occ name)}
 \end{code}
 
 \begin{code}
diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs
index dab3594..a6d7a2c 100644
--- a/ghc/compiler/basicTypes/RdrName.lhs
+++ b/ghc/compiler/basicTypes/RdrName.lhs
@@ -100,7 +100,7 @@ mkIfaceOrig ns (m,n) = RdrName (Orig (mkSysModuleNameFS m)) (mkSysOccFS ns n)
 
 	-- These two are used when parsing source files
 	-- They do encode the module and occurrence names
-mkUnqual :: NameSpace -> FAST_STRING -> RdrName
+mkUnqual :: NameSpace -> UserFS -> RdrName
 mkUnqual sp n = RdrName Unqual (mkOccFS sp n)
 
 mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index 9710d72..d03f6f5 100644
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -61,9 +61,10 @@ import TcMonad          -- TcType, amongst others
 import TysWiredIn	( voidTy )
 
 import Name		( Name, NamedThing(..), setNameUnique, mkSysLocalName,
-			  mkDerivedName, mkDerivedTyConOcc
+			  mkLocalName, mkDerivedTyConOcc
 			)
 import Unique		( Uniquable(..) )
+import SrcLoc		( noSrcLoc )
 import Util		( nOfThem )
 import Outputable
 \end{code}
@@ -339,9 +340,12 @@ zonkTcTypeToType ty = zonkType zonk_unbound_tyvar ty
     mk_void_tycon tv kind	-- Make a new TyCon with the same kind as the 
 				-- type variable tv.  Same name too, apart from
 				-- making it start with a colon (sigh)
-	= mkPrimTyCon tc_name kind 0 [] VoidRep
+		-- I dread to think what will happen if this gets out into an 
+		-- interface file.  Catastrophe likely.  Major sigh.
+	= pprTrace "Urk! Inventing strangely-kinded void TyCon" (ppr tc_name) $
+	  mkPrimTyCon tc_name kind 0 [] VoidRep
 	where
-	  tc_name = mkDerivedName mkDerivedTyConOcc (getName tv) (getUnique tv)
+	  tc_name = mkLocalName (getUnique tv) (mkDerivedTyConOcc (getOccName tv)) noSrcLoc
 
 -- zonkTcTyVarToTyVar is applied to the *binding* occurrence 
 -- of a type variable, at the *end* of type checking.  It changes
-- 
1.7.10.4