import CmdLineOpts ( opt_AllStrict, opt_NumbersStrict )
import CoreSyn
-import CoreUnfold ( Unfolding, maybeUnfoldingTemplate )
-import Id ( Id, idType, idArity, idStrictness, idUnfolding, isDataConId_maybe )
+import CoreUnfold ( maybeUnfoldingTemplate )
+import Id ( Id, idType, idStrictness, idUnfolding, isDataConId_maybe )
import DataCon ( dataConTyCon, splitProductType_maybe, dataConRepArgTys )
import IdInfo ( StrictnessInfo(..) )
-import Demand ( Demand(..), wwPrim, wwStrict, wwEnum, wwUnpackData, wwLazy, wwUnpackNew,
+import Demand ( Demand(..), wwPrim, wwStrict, wwUnpack, wwLazy,
mkStrictnessInfo, isLazy
)
import SaLib
-import TyCon ( isProductTyCon, isRecursiveTyCon, isEnumerationTyCon, isNewTyCon )
-import BasicTypes ( Arity, NewOrData(..) )
+import TyCon ( isProductTyCon, isRecursiveTyCon )
import Type ( splitTyConApp_maybe,
isUnLiftedType, Type )
import TyCon ( tyConUnique )
evalStrictness WwStrict val = isBot val
evalStrictness WwEnum val = isBot val
-evalStrictness (WwUnpack NewType _ (demand:_)) val
- = evalStrictness demand val
-
-evalStrictness (WwUnpack DataType _ demand_info) val
+evalStrictness (WwUnpack _ demand_info) val
= case val of
AbsTop -> False
AbsBot -> True
evalAbsence (WwLazy True) _ = False -- Can't possibly hit poison
-- with Absent demand
-evalAbsence (WwUnpack NewType _ (demand:_)) val
- = evalAbsence demand val
-
-evalAbsence (WwUnpack DataType _ demand_info) val
+evalAbsence (WwUnpack _ demand_info) val
= case val of
AbsTop -> False -- No poison in here
AbsBot -> True -- Pure poison
-- See notes with WwLib.worthSplitting
= find_strictness id str_ds str_res abs_ds
-findStrictness id str_val abs_val = NoStrictnessInfo
+findStrictness id str_val abs_val
+ | isBot str_val = mkStrictnessInfo ([], True)
+ | otherwise = NoStrictnessInfo
-- The list of absence demands passed to combineDemands
-- can be shorter than the list of absence demands
-- to be strict in it. Unless the function diverges.
WwLazy True -- Best of all
- mk_dmd (WwUnpack nd u str_ds)
- (WwUnpack _ _ abs_ds) = WwUnpack nd u (go str_ds abs_ds)
+ mk_dmd (WwUnpack u str_ds)
+ (WwUnpack _ abs_ds) = WwUnpack u (go str_ds abs_ds)
mk_dmd str_dmd abs_dmd = str_dmd
\end{code}
-- we don't exploit it yet, so don't bother
Just (tycon,_,data_con,cmpnt_tys) -- Single constructor case
- | isNewTyCon tycon -- A newtype!
- -> ASSERT( null (tail cmpnt_tys) )
- let
- demand = findRecDemand str_fn abs_fn (head cmpnt_tys)
- in
- wwUnpackNew demand
+ | isRecursiveTyCon tycon -- Recursive data type; don't unpack
+ -> wwStrict -- (this applies to newtypes too:
+ -- e.g. data Void = MkVoid Void)
| null compt_strict_infos -- A nullary data type
- || isRecursiveTyCon tycon -- Recursive data type; don't unpack
-> wwStrict
| otherwise -- Some other data type
- -> wwUnpackData compt_strict_infos
+ -> wwUnpack compt_strict_infos
where
prod_len = length cmpnt_tys
AbsAnal -> AbsBot
\end{code}
-\begin{verbatim}
-mkLookupFun :: (key -> key -> Bool) -- Equality predicate
- -> (key -> key -> Bool) -- Less-than predicate
- -> [(key,val)] -- The assoc list
- -> key -- The key
- -> Maybe val -- The corresponding value
-
-mkLookupFun eq lt alist s
- = case [a | (s',a) <- alist, s' `eq` s] of
- [] -> Nothing
- (a:_) -> Just a
-\end{verbatim}
-
\begin{code}
fixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]