Split the Id related functions out from Var into Id, document Var and some of Id

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

diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs
index dbbaeac..676ccef 100644 (file)
--- a/compiler/basicTypes/IdInfo.lhs
+++ b/compiler/basicTypes/IdInfo.lhs
@@ -77,9 +77,6 @@ module IdInfo (
         TickBoxOp(..), TickBoxId,
     ) where
 
-#include "HsVersions.h"
-
-import CoreSyn
 import Class
 import PrimOp
 import Name
@@ -92,7 +89,7 @@ import ForeignCall
 import NewDemand
 import Outputable      
 import Module
-import Pretty (Doc)
+import FastString
 
 import Data.Maybe
 
@@ -153,9 +150,9 @@ seqNewStrictnessInfo :: Maybe StrictSig -> ()
 seqNewStrictnessInfo Nothing = ()
 seqNewStrictnessInfo (Just ty) = seqStrictSig ty
 
-pprNewStrictness :: Maybe StrictSig -> PprStyle -> Doc
+pprNewStrictness :: Maybe StrictSig -> SDoc
 pprNewStrictness Nothing = empty
-pprNewStrictness (Just sig) = ftext FSLIT("Str:") <+> ppr sig
+pprNewStrictness (Just sig) = ftext (fsLit "Str:") <+> ppr sig
 
 #ifdef OLD_STRICTNESS
 oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
@@ -263,15 +260,15 @@ notGlobalId :: GlobalIdDetails
 notGlobalId = NotGlobalId
 
 instance Outputable GlobalIdDetails where
-    ppr NotGlobalId       = ptext SLIT("[***NotGlobalId***]")
-    ppr VanillaGlobal     = ptext SLIT("[GlobalId]")
-    ppr (DataConWorkId _) = ptext SLIT("[DataCon]")
-    ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]")
-    ppr (ClassOpId _)     = ptext SLIT("[ClassOp]")
-    ppr (PrimOpId _)      = ptext SLIT("[PrimOp]")
-    ppr (FCallId _)       = ptext SLIT("[ForeignCall]")
-    ppr (TickBoxOpId _)   = ptext SLIT("[TickBoxOp]")
-    ppr (RecordSelId {})  = ptext SLIT("[RecSel]")
+    ppr NotGlobalId       = ptext (sLit "[***NotGlobalId***]")
+    ppr VanillaGlobal     = ptext (sLit "[GlobalId]")
+    ppr (DataConWorkId _) = ptext (sLit "[DataCon]")
+    ppr (DataConWrapId _) = ptext (sLit "[DataConWrapper]")
+    ppr (ClassOpId _)     = ptext (sLit "[ClassOp]")
+    ppr (PrimOpId _)      = ptext (sLit "[PrimOp]")
+    ppr (FCallId _)       = ptext (sLit "[ForeignCall]")
+    ppr (TickBoxOpId _)   = ptext (sLit "[TickBoxOp]")
+    ppr (RecordSelId {})  = ptext (sLit "[RecSel]")
 \end{code}
 
 
@@ -451,9 +448,9 @@ type ArityInfo = Arity
 unknownArity :: Arity
 unknownArity = 0 :: Arity
 
-ppArityInfo :: Int -> PprStyle -> Doc
+ppArityInfo :: Int -> SDoc
 ppArityInfo 0 = empty
-ppArityInfo n = hsep [ptext SLIT("Arity"), int n]
+ppArityInfo n = hsep [ptext (sLit "Arity"), int n]
 \end{code}
 
 %************************************************************************
@@ -505,9 +502,7 @@ specInfoRules (SpecInfo rules _) = rules
 
 setSpecInfoHead :: Name -> SpecInfo -> SpecInfo
 setSpecInfoHead fn (SpecInfo rules fvs)
-  = SpecInfo (map set_head rules) fvs
-  where
-    set_head rule = rule { ru_fn = fn }
+  = SpecInfo (map (setRuleIdName fn) rules) fvs
 
 seqSpecInfo :: SpecInfo -> ()
 seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
@@ -558,9 +553,9 @@ seqWorker :: WorkerInfo -> ()
 seqWorker (HasWorker id a) = id `seq` a `seq` ()
 seqWorker NoWorker        = ()
 
-ppWorkerInfo :: WorkerInfo -> PprStyle -> Doc
+ppWorkerInfo :: WorkerInfo -> SDoc
 ppWorkerInfo NoWorker            = empty
-ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("Worker") <+> ppr wk_id
+ppWorkerInfo (HasWorker wk_id _) = ptext (sLit "Worker") <+> ppr wk_id
 
 workerExists :: WorkerInfo -> Bool
 workerExists NoWorker        = False
@@ -604,8 +599,8 @@ mayHaveCafRefs _           = False
 seqCaf :: CafInfo -> ()
 seqCaf c = c `seq` ()
 
-ppCafInfo :: CafInfo -> PprStyle -> Doc
-ppCafInfo NoCafRefs = ptext SLIT("NoCafRefs")
+ppCafInfo :: CafInfo -> SDoc
+ppCafInfo NoCafRefs = ptext (sLit "NoCafRefs")
 ppCafInfo MayHaveCafRefs = empty
 \end{code}
 
@@ -653,7 +648,7 @@ seqCpr NoCPRInfo  = ()
 noCprInfo       = NoCPRInfo
 
 ppCprInfo NoCPRInfo  = empty
-ppCprInfo ReturnsCPR = ptext SLIT("__M")
+ppCprInfo ReturnsCPR = ptext (sLit "__M")
 
 instance Outputable CprInfo where
     ppr = ppCprInfo
@@ -694,9 +689,9 @@ hasNoLBVarInfo IsOneShotLambda = False
 noLBVarInfo :: LBVarInfo
 noLBVarInfo = NoLBVarInfo
 
-pprLBVarInfo :: LBVarInfo -> PprStyle -> Doc
+pprLBVarInfo :: LBVarInfo -> SDoc
 pprLBVarInfo NoLBVarInfo     = empty
-pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot")
+pprLBVarInfo IsOneShotLambda = ptext (sLit "OneShot")
 
 instance Outputable LBVarInfo where
     ppr = pprLBVarInfo
@@ -749,7 +744,7 @@ zapFragileInfo :: IdInfo -> Maybe IdInfo
 zapFragileInfo info 
   = Just (info `setSpecInfo` emptySpecInfo
               `setWorkerInfo` NoWorker
-               `setUnfoldingInfo` NoUnfolding
+               `setUnfoldingInfo` noUnfolding
               `setOccInfo` if isFragileOcc occ then NoOccInfo else occ)
   where
     occ = occInfo info
@@ -769,5 +764,5 @@ data TickBoxOp
           -- ^Tick box for Hpc-style coverage
 
 instance Outputable TickBoxOp where
-    ppr (TickBox mod n)         = ptext SLIT("tick") <+> ppr (mod,n)
+    ppr (TickBox mod n)         = ptext (sLit "tick") <+> ppr (mod,n)
 \end{code}