[project @ 2001-06-28 14:41:19 by simonmar]

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

diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index bef0d4a..29e644d 100644 (file)
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -77,7 +77,7 @@ module IdInfo (
 
 
 import CoreSyn
-import Type            ( Type, usOnce )
+import Type            ( Type, usOnce, eqUsage )
 import PrimOp          ( PrimOp )
 import NameEnv         ( NameEnv, lookupNameEnv )
 import Name            ( Name )
@@ -88,6 +88,7 @@ import BasicTypes     ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBrea
                          Arity
                        )
 import DataCon         ( DataCon )
+import ForeignCall     ( ForeignCall )
 import FieldLabel      ( FieldLabel )
 import Type            ( usOnce, usMany )
 import Demand          -- Lots of stuff
@@ -134,6 +135,7 @@ data GlobalIdDetails
                                --     Id back to the data con]
 
   | PrimOpId PrimOp            -- The Id for a primitive operator
+  | FCallId ForeignCall                -- The Id for a foreign call
 
   | NotGlobalId                        -- Used as a convenient extra return value from globalIdDetails
     
@@ -145,6 +147,7 @@ instance Outputable GlobalIdDetails where
     ppr (DataConId _)     = ptext SLIT("[DataCon]")
     ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]")
     ppr (PrimOpId _)      = ptext SLIT("[PrimOp]")
+    ppr (FCallId _)       = ptext SLIT("[ForeignCall]")
     ppr (RecordSelId _)   = ptext SLIT("[RecSel]")
 \end{code}
 
@@ -392,8 +395,6 @@ data TyGenInfo
                              -- preserve specified usage annotations
 
   | TyGenNever               -- never generalise the type of this Id
-
-  deriving ( Eq )
 \end{code}
 
 For TyGenUInfo, the list has one entry for each usage annotation on
@@ -425,9 +426,9 @@ ppTyGenInfo (TyGenUInfo us) = ptext SLIT("__G") <+> text (tyGenInfoString us)
 ppTyGenInfo  TyGenNever     = ptext SLIT("__G N")
 
 tyGenInfoString us = map go us
-  where go  Nothing               = 'x'  -- for legibility, choose
-        go (Just u) | u == usOnce = '1'  -- chars with identity
-                    | u == usMany = 'M'  -- Z-encoding.
+  where go  Nothing                     = 'x'  -- for legibility, choose
+        go (Just u) | u `eqUsage` usOnce = '1'  -- chars with identity
+                    | u `eqUsage` usMany = 'M'  -- Z-encoding.
         go other = pprPanic "IdInfo.tyGenInfoString: unexpected annotation" (ppr other)
 
 instance Outputable TyGenInfo where
@@ -511,6 +512,15 @@ downstream, by the code generator.
 data CgInfo = CgInfo 
                !Arity          -- Exact arity for calling purposes
                !CafInfo
+#ifdef DEBUG
+           | NoCgInfo          -- In debug mode we don't want a black hole here
+                               -- See Id.idCgInfo
+
+       -- noCgInfo is used for local Ids, which shouldn't need any CgInfo
+noCgInfo = NoCgInfo
+#else
+noCgInfo = panic "NoCgInfo!"
+#endif
 
 cgArity   (CgInfo arity _)    = arity
 cgCafInfo (CgInfo _ caf_info) = caf_info
@@ -523,9 +533,6 @@ setCgArity info arity =
   case cgInfo info of { CgInfo _ caf_info  -> 
        info `setCgInfo` CgInfo arity caf_info }
 
-       -- Used for local Ids, which shouldn't need any CgInfo
-noCgInfo = panic "noCgInfo!"
-
 cgMayHaveCafRefs (CgInfo _ caf_info) = mayHaveCafRefs caf_info
 
 seqCg c = c `seq` ()  -- fields are strict anyhow
@@ -661,7 +668,7 @@ noLBVarInfo = NoLBVarInfo
 -- not safe to print or parse LBVarInfo because it is not really a
 -- property of the definition, but a property of the context.
 pprLBVarInfo NoLBVarInfo     = empty
-pprLBVarInfo (LBVarInfo u)   | u == usOnce
+pprLBVarInfo (LBVarInfo u)   | u `eqUsage` usOnce
                              = getPprStyle $ \ sty ->
                                if ifaceStyle sty
                                then empty
@@ -753,7 +760,7 @@ This got shorted out to:
      #-}
 
 And now we get an infinite loop in the rule system 
-       iterate f x -> build (\cn -> iterateFB c f x
+       iterate f x -> build (\cn -> iterateFB c f x)
                    -> iterateFB (:) f x
                    -> iterate f x