Con(..),
conType, conPrimRep,
conOkForApp, conOkForAlt, isWHNFCon, isDataCon,
- conIsTrivial, conIsCheap,
+ conIsTrivial, conIsCheap, conIsDupable, conStrictness,
+ conOkForSpeculation, hashCon,
DataCon, PrimOp, -- For completeness
import TysPrim ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
)
-import PrimOp ( PrimOp, primOpType, primOpIsCheap )
+import Name ( hashName )
+import PrimOp ( PrimOp, primOpType, primOpIsDupable, primOpTag,
+ primOpIsCheap, primOpStrictness, primOpOkForSpeculation )
import PrimRep ( PrimRep(..) )
-import DataCon ( DataCon, dataConType, dataConTyCon, isNullaryDataCon )
+import DataCon ( DataCon, dataConName, dataConType, dataConTyCon, isNullaryDataCon, dataConRepStrictness )
import TyCon ( isNewTyCon )
import Type ( Type, typePrimRep )
import PprType ( pprParendType )
+import Demand ( Demand )
import CStrings ( stringToC, charToC, charToEasyHaskell )
import Outputable
import Util ( thenCmp )
-#if __HASKELL1__ > 4
-import Ratio (numerator, denominator)
-#endif
+import Ratio ( numerator, denominator )
+import FastString ( uniqueOfFS )
+import Char ( ord )
\end{code}
conType (Literal lit) = literalType lit
conType (PrimOp op) = primOpType op
+conStrictness :: Con -> ([Demand], Bool)
+conStrictness (DataCon dc) = (dataConRepStrictness dc, False)
+conStrictness (PrimOp op) = primOpStrictness op
+conStrictness (Literal lit) = ([], False)
+
conPrimRep :: Con -> PrimRep -- Only data valued constants
conPrimRep (DataCon dc) = ASSERT( isNullaryDataCon dc) PtrRep
conPrimRep (Literal lit) = literalPrimRep lit
conIsCheap (Literal lit) = not (isNoRepLit lit)
conIsCheap (DataCon con) = True
conIsCheap (PrimOp op) = primOpIsCheap op
+
+-- conIsDupable is true for constants whose applications we are willing
+-- to duplicate in different case branches; i.e no issue about loss of
+-- work, just space
+conIsDupable (Literal lit) = not (isNoRepLit lit)
+conIsDupable (DataCon con) = True
+conIsDupable (PrimOp op) = primOpIsDupable op
+
+-- Similarly conOkForSpeculation
+conOkForSpeculation (Literal lit) = True
+conOkForSpeculation (DataCon con) = True
+conOkForSpeculation (PrimOp op) = primOpOkForSpeculation op
\end{code}
-- thin air. Integer is, so the type here is really redundant.
\end{code}
-
\begin{code}
instance Outputable Literal where
ppr lit = pprLit lit
text "out of range",
brackets (ppr range_min <+> text ".."
<+> ppr range_max)])
+ -- in interface files, parenthesize raw negative ints.
+ -- this avoids problems like {-1} being interpreted
+ -- as a comment starter. -}
+ | ifaceStyle sty && i < 0 -> parens (integer i)
+ -- avoid a problem whereby gcc interprets the constant
+ -- minInt as unsigned.
+ | code_style && i == (toInteger (minBound :: Int))
+ -> parens (hcat [integer (i+1), text "-1"])
| otherwise -> integer i
where
MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> rational f
| otherwise -> ptext SLIT("__float") <+> rational f
- MachDouble d -> rational d
+ MachDouble d | ifaceStyle sty && d < 0 -> parens (rational d)
+ | otherwise -> rational d
MachAddr p | code_style -> ptext SLIT("(void*)") <> integer p
| otherwise -> ptext SLIT("__addr") <+> integer p
pprFSAsString s,
pprParendType ty])
\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Hashing
+%* *
+%************************************************************************
+
+Hash values should be zero or a positive integer. No negatives please.
+(They mess up the UniqFM for some reason.)
+
+\begin{code}
+hashCon :: Con -> Int
+hashCon (DataCon dc) = hashName (dataConName dc)
+hashCon (PrimOp op) = primOpTag op + 500 -- Keep it out of range of common ints
+hashCon (Literal lit) = hashLiteral lit
+hashCon other = pprTrace "hashCon" (ppr other) 0
+
+hashLiteral :: Literal -> Int
+hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints
+hashLiteral (MachStr s) = hashFS s
+hashLiteral (MachAddr i) = hashInteger i
+hashLiteral (MachInt i _) = hashInteger i
+hashLiteral (MachInt64 i _) = hashInteger i
+hashLiteral (MachFloat r) = hashRational r
+hashLiteral (MachDouble r) = hashRational r
+hashLiteral (MachLitLit s _) = hashFS s
+hashLiteral (NoRepStr s _) = hashFS s
+hashLiteral (NoRepInteger i _) = hashInteger i
+hashLiteral (NoRepRational r _) = hashRational r
+
+hashRational :: Rational -> Int
+hashRational r = hashInteger (numerator r)
+
+hashInteger :: Integer -> Int
+hashInteger i = abs (fromInteger (i `rem` 10000))
+
+hashFS :: FAST_STRING -> Int
+hashFS s = IBOX( uniqueOfFS s )
+\end{code}
+