[project @ 2000-12-07 08:28:05 by simonpj]

Workers get local names initially; nuke mkDerivedName

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index ccc56cc..bda97b4 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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