[project @ 1996-04-10 18:10:47 by partain]

[ghc-hetmet.git] / ghc / compiler / basicTypes / Id.lhs

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index adbd61f..2046335 100644 (file)
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -103,7 +103,7 @@ import IdInfo
 import Maybes          ( maybeToBool )
 import Name            ( appendRdr, nameUnique, mkLocalName, isLocalName,
                          isLocallyDefinedName, isPreludeDefinedName,
-                         nameOrigName,
+                         nameOrigName, mkTupleDataConName,
                          isAvarop, isAconop, getLocalName,
                          isLocallyDefined, isPreludeDefined,
                          getOrigName, getOccName,
@@ -129,7 +129,7 @@ import TyVar                ( alphaTyVars, isEmptyTyVarSet, TyVarEnv(..) )
 import UniqFM
 import UniqSet         -- practically all of it
 import UniqSupply      ( getBuiltinUniques )
-import Unique          ( mkTupleDataConUnique, pprUnique, showUnique,
+import Unique          ( pprUnique, showUnique,
                          Unique{-instance Ord3-}
                        )
 import Util            ( mapAccumL, nOfThem, zipEqual,
@@ -1409,8 +1409,8 @@ mkTupleCon :: Arity -> Id
 mkTupleCon arity
   = Id unique ty (TupleConId n arity) NoPragmaInfo tuplecon_info 
   where
-    n          = panic "mkTupleCon: its Name (Id)"
-    unique      = mkTupleDataConUnique arity
+    n          = mkTupleDataConName arity
+    unique      = uniqueOf n
     ty                 = mkSigmaTy tyvars []
                   (mkFunTys tyvar_tys (applyTyCon tycon tyvar_tys))
     tycon      = mkTupleTyCon arity
@@ -1800,17 +1800,23 @@ instance NamedThing (GenId ty) where
     getName this_id@(Id u _ details _ _)
       = get details
       where
-       get (LocalId      n _)  = n
-       get (SysLocalId   n _)  = n
-       get (SpecPragmaId n _ _)= n
-       get (ImportedId   n)    = n
-       get (PreludeId    n)    = n
-       get (TopLevId     n)    = n
-       get (InstId       n _)  = n
+       get (LocalId      n _)          = n
+       get (SysLocalId   n _)          = n
+       get (SpecPragmaId n _ _)        = n
+       get (ImportedId   n)            = n
+       get (PreludeId    n)            = n
+       get (TopLevId     n)            = n
+       get (InstId       n _)          = n
        get (DataConId n _ _ _ _ _ _ _) = n
-       get (TupleConId n _)    = n
-       get (RecordSelId l)     = getName l
---     get _ = pprPanic "Id.Id.NamedThing.getName:" (pprId PprDebug this_id)
+       get (TupleConId n _)            = n
+       get (RecordSelId l)             = getName l
+       get (SuperDictSelId c sc)       = panic "Id.getName.SuperDictSelId"
+       get (MethodSelId c op)          = panic "Id.getName.MethodSelId"
+       get (DefaultMethodId c op _)    = panic "Id.getName.DefaultMethodId"
+       get (DictFunId c ty _ _)        = panic "Id.getName.DictFunId"
+       get (ConstMethodId c ty op _ _) = panic "Id.getName.ConstMethodId"
+       get (SpecId i tys _)            = panic "Id.getName.SpecId"
+       get (WorkerId i)                = panic "Id.getName.WorkerId"
 
 {- LATER:
        get (MethodSelId c op)  = case (getOrigName c) of -- ToDo; better ???