import Outputable
import FastString
import UniqFM
-import qualified LazyUniqFM as L
import MonadUtils
import Control.Monad ( zipWithM )
import Data.List
-#if __GLASGOW_HASKELL__ > 609
import Data.Data ( Data, Typeable )
-#else
-import Data.Generics ( Data, Typeable )
-#endif
\end{code}
-----------------------------------------------------
-- Domain is OutIds (*after* applying the substitution)
-- Used even for top-level bindings (but not imported ones)
- sc_annotations :: L.UniqFM SpecConstrAnnotation
+ sc_annotations :: UniqFM SpecConstrAnnotation
}
---------------------
ppr LambdaVal = ptext (sLit "<Lambda>")
---------------------
-initScEnv :: DynFlags -> L.UniqFM SpecConstrAnnotation -> ScEnv
+initScEnv :: DynFlags -> UniqFM SpecConstrAnnotation -> ScEnv
initScEnv dflags anns
= SCE { sc_size = specConstrThreshold dflags,
sc_count = specConstrCount dflags,
ignoreTyCon :: ScEnv -> TyCon -> Bool
ignoreTyCon env tycon
- = L.lookupUFM (sc_annotations env) tycon == Just NoSpecConstr
+ = lookupUFM (sc_annotations env) tycon == Just NoSpecConstr
ignoreType :: ScEnv -> Type -> Bool
ignoreType env ty
forceSpecArgTy env ty
| Just (tycon, tys) <- splitTyConApp_maybe ty
, tycon /= funTyCon
- = L.lookupUFM (sc_annotations env) tycon == Just ForceSpecConstr
+ = lookupUFM (sc_annotations env) tycon == Just ForceSpecConstr
|| any (forceSpecArgTy env) tys
forceSpecArgTy _ _ = False
argToPat env in_scope val_env (Let _ arg) arg_occ
= argToPat env in_scope val_env arg arg_occ
+ -- See Note [Matching lets] in Rule.lhs
-- Look through let expressions
- -- e.g. f (let v = rhs in \y -> ...v...)
- -- Here we can specialise for f (\y -> ...)
+ -- e.g. f (let v = rhs in (v,w))
+ -- Here we can specialise for f (v,w)
-- because the rule-matcher will look through the let.
+{- Disabled; see Note [Matching cases] in Rule.lhs
+argToPat env in_scope val_env (Case scrut _ _ [(_, _, rhs)]) arg_occ
+ | exprOkForSpeculation scrut -- See Note [Matching cases] in Rule.hhs
+ = argToPat env in_scope val_env rhs arg_occ
+-}
+
argToPat env in_scope val_env (Cast arg co) arg_occ
| not (ignoreType env ty2)
= do { (interesting, arg') <- argToPat env in_scope val_env arg arg_occ