Fix recursive superclasses (again). Fixes Trac #4809.

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

diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs
index 3640693..fd65fe4 100644 (file)
--- a/compiler/basicTypes/Id.lhs
+++ b/compiler/basicTypes/Id.lhs
@@ -49,7 +49,7 @@ module Id (
        isImplicitId, isDeadBinder, isDictId, isStrictId,
        isExportedId, isLocalId, isGlobalId,
        isRecordSelector, isNaughtyRecordSelector,
-       isClassOpId_maybe, isDFunId,
+        isClassOpId_maybe, isDFunId, dfunNSilent,
        isPrimOpId, isPrimOpId_maybe, 
        isFCallId, isFCallId_maybe,
        isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
@@ -76,6 +76,7 @@ module Id (
        idOccInfo,
 
        -- ** Writing 'IdInfo' fields
+       setIdUnfoldingLazily,
        setIdUnfolding,
        setIdArity,
        setIdDemandInfo, 
@@ -119,7 +120,8 @@ import Util( count )
 import StaticFlags
 
 -- infixl so you can say (id `set` a `set` b)
-infixl         1 `setIdUnfolding`,
+infixl         1 `setIdUnfoldingLazily`,
+         `setIdUnfolding`,
          `setIdArity`,
          `setIdOccInfo`,
          `setIdDemandInfo`,
@@ -170,7 +172,7 @@ localiseId :: Id -> Id
 -- Make an with the same unique and type as the 
 -- incoming Id, but with an *Internal* Name and *LocalId* flavour
 localiseId id 
-  | isLocalId id && isInternalName name
+  | ASSERT( isId id ) isLocalId id && isInternalName name
   = id
   | otherwise
   = mkLocalIdWithInfo (localiseName name) (idType id) (idInfo id)
@@ -330,8 +332,13 @@ isPrimOpId id = case Var.idDetails id of
                         _          -> False
 
 isDFunId id = case Var.idDetails id of
-                        DFunId _ -> True
-                        _        -> False
+                        DFunId {} -> True
+                        _         -> False
+
+dfunNSilent :: Id -> Int
+dfunNSilent id = case Var.idDetails id of
+                   DFunId ns _ -> ns
+                   _ -> pprTrace "dfunSilent: not a dfun:" (ppr id) 0
 
 isPrimOpId_maybe id = case Var.idDetails id of
                         PrimOpId op -> Just op
@@ -496,6 +503,9 @@ realIdUnfolding :: Id -> Unfolding
 -- Expose the unfolding if there is one, including for loop breakers
 realIdUnfolding id = unfoldingInfo (idInfo id)
 
+setIdUnfoldingLazily :: Id -> Unfolding -> Id
+setIdUnfoldingLazily id unfolding = modifyIdInfo (`setUnfoldingInfoLazily` unfolding) id
+
 setIdUnfolding :: Id -> Unfolding -> Id
 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id