module SAT ( doStaticArgs ) where
-import DynFlags
import Var
import CoreSyn
-import CoreLint
import CoreUtils
import Type
-import TcType
+import Coercion
import Id
import Name
-import OccName
import VarEnv
import UniqSupply
import Util
\end{code}
\begin{code}
-doStaticArgs :: DynFlags -> UniqSupply -> [CoreBind] -> IO [CoreBind]
-doStaticArgs dflags us binds = do
- showPass dflags "Static argument"
- let binds' = snd $ mapAccumL sat_bind_threaded_us us binds
- endPass dflags "Static argument" Opt_D_verbose_core2core binds'
+doStaticArgs :: UniqSupply -> [CoreBind] -> [CoreBind]
+doStaticArgs us binds = snd $ mapAccumL sat_bind_threaded_us us binds
where
sat_bind_threaded_us us bind =
let (us1, us2) = splitUniqSupply us
return (Rec (zipEqual "satBind" binders rhss'), mergeIdSATInfos sat_info_rhss')
\end{code}
\begin{code}
-data App = VarApp Id | TypeApp Type
+data App = VarApp Id | TypeApp Type | CoApp Coercion
data Staticness a = Static a | NotStatic
type IdAppInfo = (Id, SATInfo)
emptyIdSATInfo = emptyUFM
{-
-pprIdSATInfo id_sat_info = vcat (map pprIdAndSATInfo (fmToList id_sat_info))
+pprIdSATInfo id_sat_info = vcat (map pprIdAndSATInfo (Map.toList id_sat_info))
where pprIdAndSATInfo (v, sat_info) = hang (ppr v <> colon) 4 (pprSATInfo sat_info)
-}
pprStaticness :: Staticness App -> SDoc
pprStaticness (Static (VarApp _)) = ptext (sLit "SV")
pprStaticness (Static (TypeApp _)) = ptext (sLit "ST")
+pprStaticness (Static (CoApp _)) = ptext (sLit "SC")
pprStaticness NotStatic = ptext (sLit "NS")
mergeSATInfo (NotStatic:statics) (_:apps) = NotStatic : mergeSATInfo statics apps
mergeSATInfo (_:statics) (NotStatic:apps) = NotStatic : mergeSATInfo statics apps
mergeSATInfo ((Static (VarApp v)):statics) ((Static (VarApp v')):apps) = (if v == v' then Static (VarApp v) else NotStatic) : mergeSATInfo statics apps
-mergeSATInfo ((Static (TypeApp t)):statics) ((Static (TypeApp t')):apps) = (if t `coreEqType` t' then Static (TypeApp t) else NotStatic) : mergeSATInfo statics apps
+mergeSATInfo ((Static (TypeApp t)):statics) ((Static (TypeApp t')):apps) = (if t `eqType` t' then Static (TypeApp t) else NotStatic) : mergeSATInfo statics apps
+mergeSATInfo ((Static (CoApp c)):statics) ((Static (CoApp c')):apps) = (if c `coreEqCoercion` c' then Static (CoApp c) else NotStatic) : mergeSATInfo statics apps
mergeSATInfo l r = pprPanic "mergeSATInfo" $ ptext (sLit "Left:") <> pprSATInfo l <> ptext (sLit ", ")
<> ptext (sLit "Right:") <> pprSATInfo r
bindersToSATInfo :: [Id] -> SATInfo
bindersToSATInfo vs = map (Static . binderToApp) vs
- where binderToApp v = if isId v
- then VarApp v
- else TypeApp $ mkTyVarTy v
+ where binderToApp v | isId v = VarApp v
+ | isTyVar v = TypeApp $ mkTyVarTy v
+ | otherwise = CoApp $ mkCoVarCo v
finalizeApp :: Maybe IdAppInfo -> IdSATInfo -> IdSATInfo
finalizeApp Nothing id_sat_info = id_sat_info
-- TODO: remove this use of append somehow (use a data structure with O(1) append but a left-to-right kind of interface)
let satRemainderWithStaticness arg_staticness = satRemainder $ Just (fn_id, fn_app_info ++ [arg_staticness])
in case arg of
- Type t -> satRemainderWithStaticness $ Static (TypeApp t)
- Var v -> satRemainderWithStaticness $ Static (VarApp v)
- _ -> satRemainderWithStaticness $ NotStatic
+ Type t -> satRemainderWithStaticness $ Static (TypeApp t)
+ Coercion c -> satRemainderWithStaticness $ Static (CoApp c)
+ Var v -> satRemainderWithStaticness $ Static (VarApp v)
+ _ -> satRemainderWithStaticness $ NotStatic
where
boring :: CoreExpr -> IdSATInfo -> Maybe IdAppInfo -> SatM (CoreExpr, IdSATInfo, Maybe IdAppInfo)
boring fn' sat_info_fn app_info =
satExpr ty@(Type _) _ = do
return (ty, emptyIdSATInfo, Nothing)
+
+satExpr co@(Coercion _) _ = do
+ return (co, emptyIdSATInfo, Nothing)
satExpr (Cast expr coercion) interesting_ids = do
(expr', sat_info_expr, expr_app) <- satExpr expr interesting_ids
[Arity 3]
GHC.Base.until =
\ (@ a_aiK)
- (p_a6T :: a_aiK -> GHC.Bool.Bool)
+ (p_a6T :: a_aiK -> GHC.Types.Bool)
(f_a6V :: a_aiK -> a_aiK)
(x_a6X :: a_aiK) ->
letrec {
\ (x_a6X :: a_aiK) ->
let {
sat_shadow_r17 :: forall a_a3O.
- (a_a3O -> GHC.Bool.Bool) -> (a_a3O -> a_a3O) -> a_a3O -> a_a3O
+ (a_a3O -> GHC.Types.Bool) -> (a_a3O -> a_a3O) -> a_a3O -> a_a3O
[]
sat_shadow_r17 =
\ (@ a_aiK)
- (p_a6T :: a_aiK -> GHC.Bool.Bool)
+ (p_a6T :: a_aiK -> GHC.Types.Bool)
(f_a6V :: a_aiK -> a_aiK)
(x_a6X :: a_aiK) ->
sat_worker_s1aU x_a6X } in
case p_a6T x_a6X of wild_X3y [ALWAYS Dead Nothing] {
- GHC.Bool.False -> GHC.Base.until @ a_aiK p_a6T f_a6V (f_a6V x_a6X);
- GHC.Bool.True -> x_a6X
+ GHC.Types.False -> GHC.Base.until @ a_aiK p_a6T f_a6V (f_a6V x_a6X);
+ GHC.Types.True -> x_a6X
}; } in
sat_worker_s1aU x_a6X
isStaticValue (Static (VarApp _)) = True
isStaticValue _ = False
-\end{code}
\ No newline at end of file
+\end{code}