[project @ 1996-06-26 10:26:00 by partain]

SLPJ 1.3 changes through 96/06/25

ghc/compiler/HsVersions.h

@@ -10,14 +10,6 @@ you will screw up the layout where they are used in case expressions!
 
 #endif
 
-#ifdef __GLASGOW_HASKELL__
-#define TAG_ Int#
-#define LT_ -1#
-#define EQ_ 0#
-#define GT_ 1#
-#endif
-#define GT__ _
-
 #define COMMA ,
 
 #ifdef DEBUG
@@ -35,25 +27,38 @@ you will screw up the layout where they are used in case expressions!
 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 200
 # define REALLY_HASKELL_1_3
 # define SYN_IE(a) a
+# define EXP_MODULE(a) module a
 # define IMPORT_DELOOPER(mod) import CAT2(mod,_1_3)
 # define IMPORT_1_3(mod) import mod
 # define _tagCmp compare
 # define _LT LT
 # define _EQ EQ
 # define _GT GT
+# define _Addr GHCbase.Addr
 # define Text Show
+# define IMP_Ubiq() IMPORT_DELOOPER(Ubiq); import qualified GHCbase
+# define CHK_Ubiq() IMPORT_DELOOPER(Ubiq); import qualified GHCbase
+# define minInt (minBound::Int)
+# define maxInt (maxBound::Int)
 #else
 # define SYN_IE(a) a(..)
+# define EXP_MODULE(a) a..
 # define IMPORT_DELOOPER(mod) import mod
 # define IMPORT_1_3(mod) {--}
+# define IMP_Ubiq() IMPORT_DELOOPER(Ubiq)
+# define CHK_Ubiq() IMPORT_DELOOPER(Ubiq)
 #endif
-#define IMP_Ubiq() IMPORT_DELOOPER(Ubiq)
-#define CHK_Ubiq() IMPORT_DELOOPER(Ubiq)
 
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 26
+#if __GLASGOW_HASKELL__ >= 26 && __GLASGOW_HASKELL__ < 200
 #define trace _trace
 #endif
 
+#define TAG_ Int#
+#define LT_ -1#
+#define EQ_ 0#
+#define GT_ 1#
+#define GT__ _
+
 #if defined(__GLASGOW_HASKELL__)
 #define FAST_INT Int#
 #define ILIT(x) (x#)
@@ -100,36 +105,53 @@ you will screw up the layout where they are used in case expressions!
 #endif  {- ! __GLASGOW_HASKELL__ -}
 
 #if __GLASGOW_HASKELL__ >= 23
-#define USE_FAST_STRINGS 1
-#define FAST_STRING _PackedString
-#define SLIT(x)	    (_packCString (A# x#))
-#define _CMP_STRING_ cmpPString
-#define _NULL_	    _nullPS
-#define _NIL_	    _nilPS
-#define _CONS_	    _consPS
-#define _HEAD_	    _headPS
-#define _TAIL_	    _tailPS
-#define _LENGTH_    _lengthPS
-#define _PK_	    _packString
-#define _UNPK_	    _unpackPS
-#define _SUBSTR_    _substrPS
-#define _APPEND_    `_appendPS`
-#define _CONCAT_    _concatPS
+# define USE_FAST_STRINGS 1
+# if __GLASGOW_HASKELL__ < 200
+#  define FAST_STRING	_PackedString
+#  define SLIT(x)	(_packCString (A# x#))
+#  define _CMP_STRING_	cmpPString
+#  define _NULL_	_nullPS
+#  define _NIL_		_nilPS
+#  define _CONS_	_consPS
+#  define _HEAD_	_headPS
+#  define _TAIL_	_tailPS
+#  define _LENGTH_	_lengthPS
+#  define _PK_		_packString
+#  define _UNPK_	_unpackPS
+#  define _SUBSTR_	_substrPS
+#  define _APPEND_	`_appendPS`
+#  define _CONCAT_	_concatPS
+# else
+#  define FAST_STRING	GHCbase.PackedString
+#  define SLIT(x)	(packCString (GHCbase.A# x#))
+#  define _CMP_STRING_	cmpPString
+#  define _NULL_	nullPS
+#  define _NIL_		nilPS
+#  define _CONS_	consPS
+#  define _HEAD_	headPS
+#  define _TAIL_	tailPS
+#  define _LENGTH_	lengthPS
+#  define _PK_		packString
+#  define _UNPK_	unpackPS
+#  define _SUBSTR_	substrPS
+#  define _APPEND_	`appendPS`
+#  define _CONCAT_	concatPS
+# endif
 #else
-#define FAST_STRING String
-#define SLIT(x)	    (x)
-#define _CMP_STRING_ cmpString
-#define _NULL_	    null
-#define _NIL_	    ""
-#define _CONS_	    (:)
-#define _HEAD_	    head
-#define _TAIL_	    tail
-#define _LENGTH_    length
-#define _PK_	    (\x->x)
-#define _UNPK_	    (\x->x)
-#define _SUBSTR_    substr{-from Utils-}
-#define _APPEND_    ++
-#define _CONCAT_    concat
+# define FAST_STRING String
+# define SLIT(x)      (x)
+# define _CMP_STRING_ cmpString
+# define _NULL_	      null
+# define _NIL_	      ""
+# define _CONS_	      (:)
+# define _HEAD_	      head
+# define _TAIL_	      tail
+# define _LENGTH_     length
+# define _PK_	      (\x->x)
+# define _UNPK_	      (\x->x)
+# define _SUBSTR_     substr{-from Utils-}
+# define _APPEND_     ++
+# define _CONCAT_     concat
 #endif
 
 #endif

ghc/compiler/Jmakefile

@@ -25,7 +25,6 @@ SUBDIRS = __ghc_compiler_tests_dir
 */
 SuffixRules_flexish()
 SuffixRule_c_o()
-LitSuffixRule(.lprl,.prl) /* for makeSymbolList.prl */
 
 .SUFFIXES: .lhi
 .lhi.hi:
@@ -231,9 +230,7 @@ stranal/StrictAnal.lhs \
 stranal/SaLib.lhs \
 stranal/SaAbsInt.lhs \
 stranal/WwLib.lhs \
-stranal/WorkWrap.lhs \
-\
-profiling/SCCauto.lhs DEFORESTER_SRCS_LHS
+stranal/WorkWrap.lhs DEFORESTER_SRCS_LHS
 
 #define STG_SRCS_LHS \
 stgSyn/CoreToStg.lhs \
@@ -606,7 +603,6 @@ compile(prelude/PrimOp,lhs,-K3m -H10m)
 compile(prelude/TysPrim,lhs,)
 compile(prelude/TysWiredIn,lhs,)
 
-compile(profiling/SCCauto,lhs,)
 compile(profiling/SCCfinal,lhs,)
 compile(profiling/CostCentre,lhs,)
 
@@ -820,6 +816,11 @@ InstallBinaryTarget(hsp,$(INSTLIBDIR_GHC))
 
 YaccRunWithExpectMsg(parser/hsparser,12,0)
 
+parser/hslexer.o : parser/hslexer.c parser/hsparser.tab.h
+	$(RM) $@
+	$(CC) $(CFLAGS) -c $<
+	@if [ \( $(@D) != '.' \) -a \( $(@D) != './' \) ] ; then echo mv $(@F) $@ ; mv $(@F) $@ ; else exit 0 ;	fi
+
 UgenTarget(parser,constr)
 UgenTarget(parser,binding)
 UgenTarget(parser,pbinding)

ghc/compiler/absCSyn/AbsCLoop_1_3.lhi

+\begin{code}
+interface AbsCLoop_1_3 1
+__exports__
+MachMisc fixedHdrSizeInWords (..)
+MachMisc varHdrSizeInWords   (..)
+CgRetConv ctrlReturnConvAlg (..)
+CgRetConv CtrlReturnConvention(..)
+\end{code}

ghc/compiler/absCSyn/AbsCSyn.lhs

@@ -42,8 +42,8 @@ import CgCompInfo   	( mAX_Vanilla_REG, mAX_Float_REG,
 			  lIVENESS_R3, lIVENESS_R4, lIVENESS_R5,
 			  lIVENESS_R6, lIVENESS_R7, lIVENESS_R8
 			)
-import HeapOffs		( VirtualSpAOffset(..), VirtualSpBOffset(..),
-			  VirtualHeapOffset(..)
+import HeapOffs		( SYN_IE(VirtualSpAOffset), SYN_IE(VirtualSpBOffset),
+			  SYN_IE(VirtualHeapOffset)
 			)
 import Literal		( mkMachInt )
 import PrimRep		( isFollowableRep, PrimRep(..) )

ghc/compiler/absCSyn/AbsCUtils.lhs

@@ -26,7 +26,7 @@ import AbsCSyn
 import CLabel		( mkReturnPtLabel )
 import Digraph		( stronglyConnComp )
 import HeapOffs		( possiblyEqualHeapOffset )
-import Id		( fIRST_TAG, ConTag(..) )
+import Id		( fIRST_TAG, SYN_IE(ConTag) )
 import Literal		( literalPrimRep, Literal(..) )
 import PrimRep		( getPrimRepSize, PrimRep(..) )
 import Unique		( Unique{-instance Eq-} )

ghc/compiler/absCSyn/CLabel.lhs

@@ -61,16 +61,16 @@ import Id		( externallyVisibleId, cmpId_withSpecDataCon,
 			  isConstMethodId_maybe,
 			  isDefaultMethodId_maybe,
 			  isSuperDictSelId_maybe, fIRST_TAG,
-			  ConTag(..), GenId{-instance Outputable-}
+			  SYN_IE(ConTag), GenId{-instance Outputable-}
 			)
 import Maybes		( maybeToBool )
 import PprStyle		( PprStyle(..) )
 import PprType		( showTyCon, GenType{-instance Outputable-} )
-import Pretty		( prettyToUn )
+import Pretty		( prettyToUn, ppPStr{-ToDo:rm-} )
 import TyCon		( TyCon{-instance Eq-} )
 import Unique		( showUnique, pprUnique, Unique{-instance Eq-} )
 import Unpretty		-- NOTE!! ********************
-import Util		( assertPanic )
+import Util		( assertPanic, pprTrace{-ToDo:rm-} )
 \end{code}
 
 things we want to find out:
@@ -335,11 +335,11 @@ pprCLabel (PprForAsm prepend_cSEP _) lbl
     prLbl = pprCLabel PprForC lbl
 
 pprCLabel sty (TyConLabel tc UnvecConUpdCode)
-  = uppBesides [uppPStr SLIT("ret"), pp_cSEP, uppStr (showTyCon sty tc),
+  = uppBesides [uppPStr SLIT("ret"), pp_cSEP, ppr_tycon sty tc,
 	       pp_cSEP, uppPStr SLIT("upd")]
 
 pprCLabel sty (TyConLabel tc (VecConUpdCode tag))
-  = uppBesides [uppPStr SLIT("ret"), pp_cSEP, uppStr (showTyCon sty tc), pp_cSEP,
+  = uppBesides [uppPStr SLIT("ret"), pp_cSEP, ppr_tycon sty tc, pp_cSEP,
 		     uppInt tag, pp_cSEP, uppPStr SLIT("upd")]
 
 pprCLabel sty (TyConLabel tc (StdUpdCode tag))
@@ -348,10 +348,10 @@ pprCLabel sty (TyConLabel tc (StdUpdCode tag))
     	VectoredReturn _ -> uppBeside (uppPStr SLIT("IndUpdRetV")) (uppInt (tag - fIRST_TAG))
 
 pprCLabel sty (TyConLabel tc InfoTblVecTbl)
-  = uppBesides [uppStr (showTyCon sty tc), pp_cSEP, uppPStr SLIT("itblvtbl")]
+  = uppBesides [ppr_tycon sty tc, pp_cSEP, uppPStr SLIT("itblvtbl")]
 
 pprCLabel sty (TyConLabel tc StdUpdVecTbl)
-  = uppBesides [uppPStr SLIT("vtbl"), pp_cSEP, uppStr (showTyCon sty tc),
+  = uppBesides [uppPStr SLIT("vtbl"), pp_cSEP, ppr_tycon sty tc,
     	       pp_cSEP, uppPStr SLIT("upd")]
 
 pprCLabel sty (CaseLabel u CaseReturnPt)
@@ -382,6 +382,13 @@ pprCLabel sty (IdLabel (CLabelId id) flavor)
 
 ppr_u u = prettyToUn (pprUnique u)
 
+ppr_tycon sty tc
+  = let
+	str = showTyCon sty tc
+    in
+    --pprTrace "ppr_tycon:" (ppStr str) $
+    uppStr str
+
 ppFlavor :: IdLabelInfo -> Unpretty
 
 ppFlavor x = uppBeside pp_cSEP

ghc/compiler/absCSyn/HeapOffs.lhs

@@ -26,9 +26,9 @@ module HeapOffs (
 	hpRelToInt,
 #endif
 
-	VirtualHeapOffset(..), HpRelOffset(..),
-	VirtualSpAOffset(..), VirtualSpBOffset(..),
-	SpARelOffset(..), SpBRelOffset(..)
+	SYN_IE(VirtualHeapOffset), SYN_IE(HpRelOffset),
+	SYN_IE(VirtualSpAOffset), SYN_IE(VirtualSpBOffset),
+	SYN_IE(SpARelOffset), SYN_IE(SpBRelOffset)
     ) where
 
 IMP_Ubiq(){-uitous-}

ghc/compiler/absCSyn/PprAbsC.lhs

@@ -48,7 +48,7 @@ import SMRep		( getSMInfoStr, getSMInitHdrStr, getSMUpdInplaceHdrStr,
 			)
 import Unique		( pprUnique, Unique{-instance NamedThing-} )
 import UniqSet		( emptyUniqSet, elementOfUniqSet,
-			  addOneToUniqSet, UniqSet(..)
+			  addOneToUniqSet, SYN_IE(UniqSet)
 			)
 import Unpretty		-- ********** NOTE **********
 import Util		( nOfThem, panic, assertPanic )

ghc/compiler/basicTypes/FieldLabel.lhs

@@ -11,7 +11,7 @@ module FieldLabel where
 IMP_Ubiq(){-uitous-}
 
 import Name		( Name{-instance Eq/Outputable-} )
-import Type		( Type(..) )
+import Type		( SYN_IE(Type) )
 \end{code}
 
 \begin{code}

ghc/compiler/basicTypes/Id.lhs

@@ -6,102 +6,138 @@
 \begin{code}
 #include "HsVersions.h"
 
-module Id {- (
-	GenId, Id(..),		-- Abstract
-	StrictnessMark(..),	-- An enumaration
-	ConTag(..), DictVar(..), DictFun(..), DataCon(..),
+module Id (
+	-- TYPES
+	GenId(..), -- *naughtily* used in some places (e.g., TcHsSyn)
+	SYN_IE(Id), IdDetails,
+	StrictnessMark(..),
+	SYN_IE(ConTag), fIRST_TAG,
+	SYN_IE(DataCon), SYN_IE(DictFun), SYN_IE(DictVar),
 
 	-- CONSTRUCTION
-	mkSysLocal, mkUserLocal,
-	mkSpecPragmaId,
-	mkSpecId, mkSameSpecCon,
-	selectIdInfoForSpecId,
-	mkTemplateLocals,
-	mkImported,
-	mkDataCon, mkTupleCon,
+	mkConstMethodId,
+	mkDataCon,
+	mkDefaultMethodId,
+	mkDictFunId,
 	mkIdWithNewUniq,
-	mkMethodSelId, mkSuperDictSelId, mkDefaultMethodId,
-	mkConstMethodId, getConstMethodId,
-
-	updateIdType,
-	mkId, mkDictFunId, mkInstId,
+	mkImported,
+	mkInstId,
+	mkMethodSelId,
+	mkRecordSelId,
+	mkSuperDictSelId,
+	mkSysLocal,
+	mkTemplateLocals,
+	mkTupleCon,
+	mkUserId,
+	mkUserLocal,
 	mkWorkerId,
-	localiseId,
 
-	-- DESTRUCTION
+	-- MANGLING
+	unsafeGenId2Id,
+
+	-- DESTRUCTION (excluding pragmatic info)
+	idPrimRep,
 	idType,
-	getIdInfo, replaceIdInfo,
-	getPragmaInfo,
-	idPrimRep, getInstIdModule,
-	getMentionedTyConsAndClassesFromId,
+	idUnique,
 
-	dataConTag, dataConStrictMarks,
-	dataConSig, dataConRawArgTys, dataConArgTys,
-	dataConTyCon, dataConArity,
+	dataConArgTys,
+	dataConArity,
+	dataConNumFields,
 	dataConFieldLabels,
+	dataConRawArgTys,
+	dataConSig,
+	dataConStrictMarks,
+	dataConTag,
+	dataConTyCon,
 
 	recordSelectorFieldLabel,
 
 	-- PREDICATES
-	isDataCon, isTupleCon,
-	isNullaryDataCon,
-	isSpecId_maybe, isSpecPragmaId_maybe,
-	toplevelishId, externallyVisibleId,
-	isTopLevId, isWorkerId, isWrapperId,
-	isImportedId, isSysLocalId,
-	isBottomingId,
-	isMethodSelId, isDefaultMethodId_maybe, isSuperDictSelId_maybe,
-	isDictFunId,
---???	isInstId_maybe,
-	isConstMethodId_maybe,
+	cmpEqDataCon,
+	cmpId,
 	cmpId_withSpecDataCon,
-	myWrapperMaybe,
-	whatsMentionedInId,
-	unfoldingUnfriendlyId,	-- ToDo: rm, eventually
+	externallyVisibleId,
+	idHasNoFreeTyVars,
 	idWantsToBeINLINEd,
---	dataConMentionsNonPreludeTyCon,
+	isBottomingId,
+	isConstMethodId,
+	isConstMethodId_maybe,
+	isDataCon,
+	isDefaultMethodId,
+	isDefaultMethodId_maybe,
+	isDictFunId,
+	isImportedId,
+	isMethodSelId,
+	isNullaryDataCon,
+	isSpecPragmaId,
+	isSuperDictSelId_maybe,
+	isSysLocalId,
+	isTopLevId,
+	isTupleCon,
+	isWorkerId,
+	toplevelishId,
+	unfoldingUnfriendlyId,
 
 	-- SUBSTITUTION
-	applySubstToId, applyTypeEnvToId,
--- not exported:	apply_to_Id, -- please don't use this, generally
-
-	-- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
-	getIdArity, addIdArity,
-	getIdDemandInfo, addIdDemandInfo,
-	getIdSpecialisation, addIdSpecialisation,
-	getIdStrictness, addIdStrictness,
-	getIdUnfolding, addIdUnfolding,
-	getIdUpdateInfo, addIdUpdateInfo,
-	getIdArgUsageInfo, addIdArgUsageInfo,
-	getIdFBTypeInfo, addIdFBTypeInfo,
-	-- don't export the types, lest OptIdInfo be dragged in!
-
-	-- MISCELLANEOUS
-	unlocaliseId,
-	fIRST_TAG,
-	showId,
-	pprIdInUnfolding,
-
+	applyTypeEnvToId,
+	apply_to_Id,
+	
+	-- PRINTING and RENUMBERING
+	addId,
+	nmbrDataCon,
 	nmbrId,
+	pprId,
+	showId,
 
-	-- "Environments" keyed off of Ids, and sets of Ids
-	IdEnv(..),
-	lookupIdEnv, lookupNoFailIdEnv, nullIdEnv, unitIdEnv, mkIdEnv,
-	growIdEnv, growIdEnvList, isNullIdEnv, addOneToIdEnv,
-	delOneFromIdEnv, delManyFromIdEnv, modifyIdEnv, combineIdEnvs,
-	rngIdEnv, mapIdEnv,
+	-- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
+	addIdArity,
+	addIdDemandInfo,
+	addIdStrictness,
+	addIdUpdateInfo,
+	getIdArity,
+	getIdDemandInfo,
+	getIdInfo,
+	getIdStrictness,
+	getIdUnfolding,
+	getIdUpdateInfo,
+	getPragmaInfo,
 
-	-- and to make the interface self-sufficient...
-	GenIdSet(..), IdSet(..)
-    )-} where
+	-- IdEnvs AND IdSets
+	SYN_IE(IdEnv), SYN_IE(GenIdSet), SYN_IE(IdSet),
+	addOneToIdEnv,
+	addOneToIdSet,
+	combineIdEnvs,
+	delManyFromIdEnv,
+	delOneFromIdEnv,
+	elementOfIdSet,
+	emptyIdSet,
+	growIdEnv,
+	growIdEnvList,
+	idSetToList,
+	intersectIdSets,
+	isEmptyIdSet,
+	isNullIdEnv,
+	lookupIdEnv,
+	lookupNoFailIdEnv,
+	mapIdEnv,
+	minusIdSet,
+	mkIdEnv,
+	mkIdSet,
+	modifyIdEnv,
+	nullIdEnv,
+	rngIdEnv,
+	unionIdSets,
+	unionManyIdSets,
+	unitIdEnv,
+	unitIdSet
+    ) where
 
 IMP_Ubiq()
 IMPORT_DELOOPER(IdLoop)   -- for paranoia checking
 IMPORT_DELOOPER(TyLoop)   -- for paranoia checking
 
 import Bag
-import Class		( classOpString, Class(..), GenClass, ClassOp(..), GenClassOp )
-import CStrings		( identToC, cSEP )
+import Class		( classOpString, SYN_IE(Class), GenClass, SYN_IE(ClassOp), GenClassOp )
 import IdInfo
 import Maybes		( maybeToBool )
 import Name		( appendRdr, nameUnique, mkLocalName, isLocalName,
@@ -115,7 +151,7 @@ import Name		( appendRdr, nameUnique, mkLocalName, isLocalName,
 			)
 import FieldLabel	( fieldLabelName, FieldLabel(..){-instances-} )
 import PragmaInfo	( PragmaInfo(..) )
-import PprEnv		-- ( NmbrM(..), NmbrEnv(..) )
+import PprEnv		-- ( SYN_IE(NmbrM), NmbrEnv(..) )
 import PprType		( getTypeString, typeMaybeString, specMaybeTysSuffix,
 			  nmbrType, nmbrTyVar,
 			  GenType, GenTyVar
@@ -125,11 +161,11 @@ import Pretty
 import SrcLoc		( mkBuiltinSrcLoc )
 import TyCon		( TyCon, mkTupleTyCon, tyConDataCons )
 import Type		( mkSigmaTy, mkTyVarTys, mkFunTys, mkDictTy,
-			  applyTyCon, isPrimType, instantiateTy,
+			  applyTyCon, instantiateTy,
 			  tyVarsOfType, applyTypeEnvToTy, typePrimRep,
-			  GenType, ThetaType(..), TauType(..), Type(..)
+			  GenType, SYN_IE(ThetaType), SYN_IE(TauType), SYN_IE(Type)
 			)
-import TyVar		( alphaTyVars, isEmptyTyVarSet, TyVarEnv(..) )
+import TyVar		( alphaTyVars, isEmptyTyVarSet, SYN_IE(TyVarEnv) )
 import UniqFM
 import UniqSet		-- practically all of it
 import Unique		( getBuiltinUniques, pprUnique, showUnique,
@@ -797,30 +833,15 @@ externallyVisibleId :: Id -> Bool
 
 externallyVisibleId id@(Id _ _ _ details _ _)
   = if isLocallyDefined id then
-	toplevelishId id && isExported id && not (weird_datacon details)
+	toplevelishId id && (isExported id || isDataCon id)
+	-- NB: the use of "isExported" is most dodgy;
+	-- We may eventually move to a situation where
+	-- every Id is "externallyVisible", even if the
+	-- module system's namespace control renders it
+	-- "not exported".
     else
-	not (weird_tuplecon details)
+	True
 	-- if visible here, it must be visible elsewhere, too.
-  where
-    -- If it's a DataCon, it's not enough to know it (meaning
-    -- its TyCon) is exported; we need to know that it might
-    -- be visible outside.  Consider:
-    --
-    --	data Foo a = Mumble | BigFoo a WeirdLocalType
-    --
-    -- We can't tell the outside world *anything* about Foo, because
-    -- of WeirdLocalType; but we need to know this when asked if
-    -- "Mumble" is externally visible...
-
-{- LATER: if at all:
-    weird_datacon (DataConId _ _ _ _ _ _ tycon)
-      = maybeToBool (maybePurelyLocalTyCon tycon)
--}
-    weird_datacon not_a_datacon_therefore_not_weird = False
-
-    weird_tuplecon (TupleConId arity)
-      = arity > 32 -- sigh || isBigTupleTyCon tycon -- generated *purely* for local use
-    weird_tuplecon _ = False
 \end{code}
 
 \begin{code}
@@ -1050,12 +1071,19 @@ mk_classy_id details str op_str u rec_c ty info
 mkDictFunId u c ity full_ty from_here locn mod info
   = Id u n full_ty (DictFunId c ity mod) NoPragmaInfo info
   where
-    n = mkCompoundName2 u mod SLIT("dfun") (Left (origName "mkDictFunId" c) : map Right (getTypeString ity)) from_here locn
+    n = mkCompoundName2 u mod SLIT("dfun") (Left (origName "mkDictFunId" c) : renum_type_string full_ty ity) from_here locn
 
 mkConstMethodId	u c op ity full_ty from_here locn mod info
   = Id u n full_ty (ConstMethodId c ity op mod) NoPragmaInfo info
   where
-    n = mkCompoundName2 u mod SLIT("const") (Left (origName "mkConstMethodId" c) : Right (classOpString op) : map Right (getTypeString ity)) from_here locn
+    n = mkCompoundName2 u mod SLIT("const") (Left (origName "mkConstMethodId" c) : Right (classOpString op) : renum_type_string full_ty ity) from_here locn
+
+renum_type_string full_ty ity
+  = initNmbr (
+	nmbrType full_ty    `thenNmbr` \ _ -> -- so all the tyvars get added to renumbering...
+	nmbrType ity	    `thenNmbr` \ rn_ity ->
+	returnNmbr (getTypeString rn_ity)
+    )
 
 mkWorkerId u unwrkr ty info
   = Id u n ty (WorkerId unwrkr) NoPragmaInfo info
@@ -1209,16 +1237,24 @@ besides the code-generator need arity info!)
 
 \begin{code}
 getIdArity :: Id -> ArityInfo