-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
module SpecConstr(
import PprCore ( pprRules )
import WwLib ( mkWorkerArgs )
import DataCon ( dataConRepArity, dataConUnivTyVars )
-import Type ( Type, tyConAppArgs )
-import Coercion ( coercionKind )
+import Coercion
+import Type hiding( substTy )
import Id ( Id, idName, idType, isDataConWorkId_maybe, idArity,
mkUserLocal, mkSysLocal, idUnfolding, isLocalId )
-import Var ( Var )
+import Var
import VarEnv
import VarSet
import Name
%************************************************************************
\begin{code}
-data ScEnv = SCE { sc_size :: Int, -- Size threshold
+data ScEnv = SCE { sc_size :: Maybe Int, -- Size threshold
- sc_subst :: Subst, -- Current substitution
+ sc_subst :: Subst, -- Current substitution
sc_how_bound :: HowBoundEnv,
-- Binds interesting non-top-level variables
---------------------
initScEnv dflags
- = SCE { sc_size = specThreshold dflags,
+ = SCE { sc_size = specConstrThreshold dflags,
sc_subst = emptySubst,
sc_how_bound = emptyVarEnv,
sc_vals = emptyVarEnv }
----------------------
scBind :: ScEnv -> CoreBind -> UniqSM (ScEnv, ScUsage, CoreBind)
scBind env (Rec prs)
- | not (all (couldBeSmallEnoughToInline (sc_size env)) rhss)
+ | Just threshold <- sc_size env
+ , not (all (couldBeSmallEnoughToInline threshold) rhss)
-- No specialisation
= do { let (rhs_env,bndrs') = extendRecBndrs env bndrs
; (rhs_usgs, rhss') <- mapAndUnzipUs (scExpr rhs_env) rhss
argToPat in_scope val_env (Cast arg co) arg_occ
= do { (interesting, arg') <- argToPat in_scope val_env arg arg_occ
- ; if interesting then
- return (interesting, Cast arg' co)
- else
- wildCardPat (snd (coercionKind co)) }
+ ; let (ty1,ty2) = coercionKind co
+ ; if not interesting then
+ wildCardPat ty2
+ else do
+ { -- Make a wild-card pattern for the coercion
+ uniq <- getUniqueUs
+ ; let co_name = mkSysTvName uniq FSLIT("sg")
+ co_var = mkCoVar co_name (mkCoKind ty1 ty2)
+ ; return (interesting, Cast arg' (mkTyVarTy co_var)) } }
{- Disabling lambda specialisation for now
It's fragile, and the spec_loop can be infinite
same e1 e2 = WARN( bad e1 || bad e2, ppr e1 $$ ppr e2)
False -- Let, lambda, case should not occur
-#ifdef DEBUG
bad (Case {}) = True
bad (Let {}) = True
bad (Lam {}) = True
bad other = False
-#endif
\end{code}
Note [Ignore type differences]