+ `setNewStrictnessInfo`,
+ `setAllStrictnessInfo`,
+ `setNewDemandInfo`
+#ifdef OLD_STRICTNESS
+ , `setCprInfo`
+ , `setDemandInfo`
+ , `setStrictnessInfo`
+#endif
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{New strictness info}
+%* *
+%************************************************************************
+
+To be removed later
+
+\begin{code}
+-- setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
+-- Set old and new strictness info
+setAllStrictnessInfo info Nothing
+ = info { newStrictnessInfo = Nothing
+#ifdef OLD_STRICTNESS
+ , strictnessInfo = NoStrictnessInfo
+ , cprInfo = NoCPRInfo
+#endif
+ }
+
+setAllStrictnessInfo info (Just sig)
+ = info { newStrictnessInfo = Just sig
+#ifdef OLD_STRICTNESS
+ , strictnessInfo = oldStrictnessFromNew sig
+ , cprInfo = cprInfoFromNewStrictness sig
+#endif
+ }
+
+seqNewStrictnessInfo Nothing = ()
+seqNewStrictnessInfo (Just ty) = seqStrictSig ty
+
+pprNewStrictness Nothing = empty
+pprNewStrictness (Just sig) = ftext FSLIT("Str:") <+> ppr sig
+
+#ifdef OLD_STRICTNESS
+oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
+oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
+ where
+ (dmds, res_info) = splitStrictSig sig
+
+cprInfoFromNewStrictness :: StrictSig -> CprInfo
+cprInfoFromNewStrictness sig = case strictSigResInfo sig of
+ RetCPR -> ReturnsCPR
+ other -> NoCPRInfo
+
+newStrictnessFromOld :: Name -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig
+newStrictnessFromOld name arity (Demand.StrictnessInfo ds res) cpr
+ | listLengthCmp ds arity /= GT -- length ds <= arity
+ -- Sometimes the old strictness analyser has more
+ -- demands than the arity justifies
+ = mk_strict_sig name arity $
+ mkTopDmdType (map newDemand ds) (newRes res cpr)
+
+newStrictnessFromOld name arity other cpr
+ = -- Either no strictness info, or arity is too small
+ -- In either case we can't say anything useful
+ mk_strict_sig name arity $
+ mkTopDmdType (replicate arity lazyDmd) (newRes False cpr)
+
+mk_strict_sig name arity dmd_ty
+ = WARN( arity /= dmdTypeDepth dmd_ty, ppr name <+> (ppr arity $$ ppr dmd_ty) )
+ mkStrictSig dmd_ty
+
+newRes True _ = BotRes
+newRes False ReturnsCPR = retCPR
+newRes False NoCPRInfo = TopRes
+
+newDemand :: Demand.Demand -> NewDemand.Demand
+newDemand (WwLazy True) = Abs
+newDemand (WwLazy False) = lazyDmd
+newDemand WwStrict = evalDmd
+newDemand (WwUnpack unpk ds) = Eval (Prod (map newDemand ds))
+newDemand WwPrim = lazyDmd
+newDemand WwEnum = evalDmd
+
+oldDemand :: NewDemand.Demand -> Demand.Demand
+oldDemand Abs = WwLazy True
+oldDemand Top = WwLazy False
+oldDemand Bot = WwStrict
+oldDemand (Box Bot) = WwStrict
+oldDemand (Box Abs) = WwLazy False
+oldDemand (Box (Eval _)) = WwStrict -- Pass box only
+oldDemand (Defer d) = WwLazy False
+oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds)
+oldDemand (Eval (Poly _)) = WwStrict
+oldDemand (Call _) = WwStrict
+
+#endif /* OLD_STRICTNESS */
+\end{code}
+
+
+\begin{code}
+seqNewDemandInfo Nothing = ()
+seqNewDemandInfo (Just dmd) = seqDemand dmd
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{GlobalIdDetails
+%* *
+%************************************************************************
+
+This type is here (rather than in Id.lhs) mainly because there's
+an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported
+(recursively) by Var.lhs.
+
+\begin{code}
+data GlobalIdDetails
+ = VanillaGlobal -- Imported from elsewhere, a default method Id.
+
+ | RecordSelId TyCon FieldLabel -- The Id for a record selector
+
+ | DataConWorkId DataCon -- The Id for a data constructor *worker*
+ | DataConWrapId DataCon -- The Id for a data constructor *wrapper*
+ -- [the only reasons we need to know is so that
+ -- a) we can suppress printing a definition in the interface file
+ -- b) when typechecking a pattern we can get from the
+ -- Id back to the data con]
+
+ | ClassOpId Class -- An operation of a class
+
+ | 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
+
+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 (RecordSelId _ _) = ptext SLIT("[RecSel]")