linearscan-0.9.0: LinearScan/Verify.hs
{-# OPTIONS_GHC -cpp -XMagicHash #-}
{- For Hugs, use the option -F"cpp -P -traditional" -}
module LinearScan.Verify where
import Debug.Trace (trace, traceShow, traceShowId)
import qualified Prelude
import qualified Data.IntMap
import qualified Data.IntSet
import qualified Data.List
import qualified Data.Ord
import qualified Data.Functor.Identity
import qualified Hask.Utils
import qualified LinearScan.Applicative as Applicative
import qualified LinearScan.Blocks as Blocks
import qualified LinearScan.Contravariant as Contravariant
import qualified LinearScan.Functor as Functor
import qualified LinearScan.IntMap as IntMap
import qualified LinearScan.IntSet as IntSet
import qualified LinearScan.Lens as Lens
import qualified LinearScan.List1 as List1
import qualified LinearScan.Loops as Loops
import qualified LinearScan.Maybe as Maybe
import qualified LinearScan.Monad as Monad
import qualified LinearScan.Prelude0 as Prelude0
import qualified LinearScan.Resolve as Resolve
import qualified LinearScan.Ssr as Ssr
import qualified LinearScan.State0 as State0
import qualified LinearScan.UsePos as UsePos
import qualified LinearScan.Vector0 as Vector0
import qualified LinearScan.Eqtype as Eqtype
import qualified LinearScan.Fintype as Fintype
import qualified LinearScan.Seq as Seq
import qualified LinearScan.Ssrnat as Ssrnat
#ifdef __GLASGOW_HASKELL__
import qualified GHC.Base as GHC.Base
import qualified GHC.Prim as GHC.Prim
#else
-- HUGS
import qualified LinearScan.IOExts as IOExts
#endif
#ifdef __GLASGOW_HASKELL__
--unsafeCoerce :: a -> b
unsafeCoerce = GHC.Base.unsafeCoerce#
#else
-- HUGS
--unsafeCoerce :: a -> b
unsafeCoerce = IOExts.unsafeCoerce
#endif
type PhysReg = Prelude.Int
data UseVerifier =
VerifyDisabled
| VerifyEnabled
| VerifyEnabledStrict
type RegAllocations =
Vector0.Vec ((,) (Prelude.Maybe Blocks.VarId) (Prelude.Maybe Blocks.VarId))
data RegStateDesc =
Build_RegStateDesc RegAllocations IntSet.IntSet
rsAllocs :: Prelude.Int -> RegStateDesc -> RegAllocations
rsAllocs maxReg r =
case r of {
Build_RegStateDesc rsAllocs0 rsStack0 -> rsAllocs0}
rsStack :: Prelude.Int -> RegStateDesc -> IntSet.IntSet
rsStack maxReg r =
case r of {
Build_RegStateDesc rsAllocs0 rsStack0 -> rsStack0}
data RegStateDescSet =
Build_RegStateDescSet ([]
((,) (Prelude.Maybe Blocks.VarId)
(Prelude.Maybe Blocks.VarId))) IntSet.IntSet
fromRegStateDesc :: Prelude.Int -> RegStateDesc -> RegStateDescSet
fromRegStateDesc maxReg x =
Build_RegStateDescSet (Vector0.vec_to_seq maxReg (rsAllocs maxReg x))
(rsStack maxReg x)
residency :: (Functor.Functor a1) -> ((Prelude.Maybe Blocks.VarId) -> a1) ->
((,) (Prelude.Maybe Blocks.VarId) (Prelude.Maybe Blocks.VarId))
-> a1
residency h x x0 =
Lens._1 h x x0
reservation :: (Functor.Functor a1) -> ((Prelude.Maybe Blocks.VarId) -> a1)
-> ((,) (Prelude.Maybe Blocks.VarId)
(Prelude.Maybe Blocks.VarId)) -> a1
reservation h x x0 =
Lens._2 h x x0
newRegStateDesc :: Prelude.Int -> RegStateDesc
newRegStateDesc maxReg =
Build_RegStateDesc
(Vector0.vconst maxReg ((,) Prelude.Nothing Prelude.Nothing))
IntSet.emptyIntSet
data AllocError =
VarNotAllocated Blocks.VarId
| VarNotResident Blocks.VarId
| VarNotResidentForReg Blocks.VarId Prelude.Int (Prelude.Maybe Blocks.VarId)
Prelude.Int
| VarNotReservedForReg Blocks.VarId Prelude.Int (Prelude.Maybe Blocks.VarId)
Prelude.Int
| PhysRegAlreadyReservedForVar Prelude.Int Blocks.VarId
| RegAlreadyReservedToVar Prelude.Int Blocks.VarId Blocks.VarId
| BlockWithoutPredecessors Blocks.BlockId
| UnknownPredecessorBlock Blocks.BlockId Blocks.BlockId
| LoopInResolvingMoves Resolve.ResolvingMoveSet
type RegStateSig = RegStateDesc
packRegState :: Prelude.Int -> RegStateDesc -> RegStateDesc
packRegState maxReg rd =
rd
data VerifiedSig a =
Build_VerifiedSig RegStateDesc (IntMap.IntMap RegStateSig) (IntMap.IntMap
RegStateSig)
(IntMap.IntMap ([] Resolve.ResolvingMoveSet)) (IntMap.IntMap
((,) RegStateDescSet
([] AllocError))) a
verDesc :: Prelude.Int -> (VerifiedSig a1) -> RegStateDesc
verDesc maxReg v =
case v of {
Build_VerifiedSig verDesc0 verInit0 verFinal0 verMoves0 verErrors0
verExt0 -> verDesc0}
verInit :: Prelude.Int -> (VerifiedSig a1) -> IntMap.IntMap RegStateSig
verInit maxReg v =
case v of {
Build_VerifiedSig verDesc0 verInit0 verFinal0 verMoves0 verErrors0
verExt0 -> verInit0}
verFinal :: Prelude.Int -> (VerifiedSig a1) -> IntMap.IntMap RegStateSig
verFinal maxReg v =
case v of {
Build_VerifiedSig verDesc0 verInit0 verFinal0 verMoves0 verErrors0
verExt0 -> verFinal0}
verMoves :: Prelude.Int -> (VerifiedSig a1) -> IntMap.IntMap
([] Resolve.ResolvingMoveSet)
verMoves maxReg v =
case v of {
Build_VerifiedSig verDesc0 verInit0 verFinal0 verMoves0 verErrors0
verExt0 -> verMoves0}
verErrors :: Prelude.Int -> (VerifiedSig a1) -> IntMap.IntMap
((,) RegStateDescSet ([] AllocError))
verErrors maxReg v =
case v of {
Build_VerifiedSig verDesc0 verInit0 verFinal0 verMoves0 verErrors0
verExt0 -> verErrors0}
verExt :: Prelude.Int -> (VerifiedSig a1) -> a1
verExt maxReg v =
case v of {
Build_VerifiedSig verDesc0 verInit0 verFinal0 verMoves0 verErrors0
verExt0 -> verExt0}
newVerifiedSig :: Prelude.Int -> a1 -> VerifiedSig a1
newVerifiedSig maxReg i =
Build_VerifiedSig (newRegStateDesc maxReg) IntMap.emptyIntMap
IntMap.emptyIntMap IntMap.emptyIntMap IntMap.emptyIntMap i
_verDesc :: Prelude.Int -> (Functor.Functor a2) ->
(Contravariant.Contravariant a2) -> (RegStateDesc -> a2) ->
(VerifiedSig a1) -> a2
_verDesc maxReg h h0 f s =
Functor.fmap h (Prelude0.const s) (f (verDesc maxReg s))
_verState :: Prelude.Int -> (Functor.Functor a2) -> (RegStateDesc -> a2) ->
(VerifiedSig a1) -> a2
_verState maxReg h f s =
Functor.fmap h (\x -> Build_VerifiedSig ( x) (verInit maxReg s)
(verFinal maxReg s) (verMoves maxReg s) (verErrors maxReg s)
(verExt maxReg s)) (f (verDesc maxReg s))
_verInit :: Prelude.Int -> (Functor.Functor a2) -> ((IntMap.IntMap
RegStateSig) -> a2) -> (VerifiedSig a1) -> a2
_verInit maxReg h f s =
Functor.fmap h (\x -> Build_VerifiedSig (verDesc maxReg s) x
(verFinal maxReg s) (verMoves maxReg s) (verErrors maxReg s)
(verExt maxReg s)) (f (verInit maxReg s))
_verFinal :: Prelude.Int -> (Functor.Functor a2) -> ((IntMap.IntMap
RegStateSig) -> a2) -> (VerifiedSig a1) -> a2
_verFinal maxReg h f s =
Functor.fmap h (\x -> Build_VerifiedSig (verDesc maxReg s)
(verInit maxReg s) x (verMoves maxReg s) (verErrors maxReg s)
(verExt maxReg s)) (f (verFinal maxReg s))
_verMoves :: Prelude.Int -> (Functor.Functor a2) -> ((IntMap.IntMap
([] Resolve.ResolvingMoveSet)) -> a2) -> (VerifiedSig a1) -> a2
_verMoves maxReg h f s =
Functor.fmap h (\x -> Build_VerifiedSig (verDesc maxReg s)
(verInit maxReg s) (verFinal maxReg s) x (verErrors maxReg s)
(verExt maxReg s)) (f (verMoves maxReg s))
_verErrors :: Prelude.Int -> (Functor.Functor a2) -> ((IntMap.IntMap
((,) RegStateDescSet ([] AllocError))) -> a2) -> (VerifiedSig
a1) -> a2
_verErrors maxReg h f s =
Functor.fmap h (\x -> Build_VerifiedSig (verDesc maxReg s)
(verInit maxReg s) (verFinal maxReg s) (verMoves maxReg s) x
(verExt maxReg s)) (f (verErrors maxReg s))
_verExt :: Prelude.Int -> (Functor.Functor a2) -> (a1 -> a2) -> (VerifiedSig
a1) -> a2
_verExt maxReg h f s =
Functor.fmap h (\x -> Build_VerifiedSig (verDesc maxReg s)
(verInit maxReg s) (verFinal maxReg s) (verMoves maxReg s)
(verErrors maxReg s) x) (f (verExt maxReg s))
type Verified mType a a0 = State0.StateT (VerifiedSig a) mType a0
errorsT :: Prelude.Int -> (Monad.Monad a1) -> Blocks.OpId -> ([] AllocError)
-> Verified a1 a2 ()
errorsT maxReg mDict pc errs =
Monad.bind (State0.coq_StateT_Monad mDict) (\st ->
Lens.applyStateT (\_ -> _verErrors maxReg) (\m ->
Prelude0.flip (IntMap.coq_IntMap_insert pc) m
(case IntMap.coq_IntMap_lookup pc m of {
Prelude.Just p ->
case p of {
(,) d prevErrs -> (,) d ((Prelude.++) prevErrs errs)};
Prelude.Nothing -> (,) (fromRegStateDesc maxReg st) errs})) mDict)
(Lens.use (Lens.stepdowng (\_ -> _verDesc maxReg)) mDict)
errorT :: Prelude.Int -> (Monad.Monad a1) -> Blocks.OpId -> AllocError ->
Verified a1 a2 ()
errorT maxReg mDict pc err =
errorsT maxReg mDict pc ((:) err [])
addMove :: Prelude.Int -> (Monad.Monad a1) -> Blocks.OpId ->
Resolve.ResolvingMoveSet -> Verified a1 a2 ()
addMove maxReg mDict pc mv =
Lens.applyStateT (\_ -> _verMoves maxReg)
(IntMap.coq_IntMap_alter (\mxs -> Prelude.Just
(case mxs of {
Prelude.Just xs -> Seq.rcons xs mv;
Prelude.Nothing -> (:) mv []})) pc) mDict
reserveReg :: Prelude.Int -> (Monad.Monad a1) -> Blocks.OpId -> PhysReg ->
Blocks.VarId -> Verified a1 a2 ()
reserveReg maxReg mDict pc reg var =
Monad.bind (State0.coq_StateT_Monad mDict) (\x ->
Monad.bind (State0.coq_StateT_Monad mDict) (\st ->
case Ssr.prop
(Eqtype.eq_op (Eqtype.option_eqType Ssrnat.nat_eqType)
(Lens.view
(Lens.stepdownl' (unsafeCoerce (\_ -> reservation)))
(Vector0.vnth maxReg (rsAllocs maxReg st) reg))
(unsafeCoerce Prelude.Nothing)) of {
Prelude.Just _ ->
Lens.modifyStateT (\_ -> _verState maxReg)
(packRegState maxReg (Build_RegStateDesc
(Vector0.vmodify maxReg (rsAllocs maxReg st) reg
(Lens.set (\_ -> reservation) (Prelude.Just var)))
(rsStack maxReg st))) mDict;
Prelude.Nothing ->
case Lens.view (Lens.stepdownl' (\_ -> reservation))
(Vector0.vnth maxReg (rsAllocs maxReg st) reg) of {
Prelude.Just v ->
Monad.when (State0.coq_StateT_Monad mDict)
(Prelude.not
(Eqtype.eq_op Ssrnat.nat_eqType (unsafeCoerce v)
(unsafeCoerce var)))
(errorT maxReg mDict pc (RegAlreadyReservedToVar ( reg) v var));
Prelude.Nothing ->
Applicative.pure (State0.coq_StateT_Applicative mDict) ()}})
(Lens.use (Lens.stepdowng (\_ -> _verDesc maxReg)) mDict))
(addMove maxReg mDict pc (Resolve.RSAllocReg var ( reg)))
isReserved :: Prelude.Int -> (Monad.Monad a1) -> PhysReg -> Blocks.VarId ->
Verified a1 a2 (Prelude.Maybe Blocks.VarId)
isReserved maxReg mDict reg var =
Monad.bind (State0.coq_StateT_Monad mDict) (\st ->
Applicative.pure (State0.coq_StateT_Applicative mDict)
(Lens.view (Lens.stepdownl' (\_ -> reservation))
(Vector0.vnth maxReg (rsAllocs maxReg st) reg)))
(Lens.use (Lens.stepdowng (\_ -> _verDesc maxReg)) mDict)
checkReservation :: Prelude.Int -> (Monad.Monad a1) -> Blocks.OpId ->
UseVerifier -> PhysReg -> Blocks.VarId -> Verified
a1 a2 ()
checkReservation maxReg mDict pc useVerifier reg var =
Monad.bind (State0.coq_StateT_Monad mDict) (\st ->
let {
err = errorT maxReg mDict pc (VarNotReservedForReg var ( reg)
(Lens.view (Lens.stepdownl' (\_ -> reservation))
(Vector0.vnth maxReg (rsAllocs maxReg st) reg))
((Prelude.succ) 0))}
in
Monad.bind (State0.coq_StateT_Monad mDict) (\res ->
case res of {
Prelude.Just var' ->
Monad.unless (State0.coq_StateT_Monad mDict)
(Eqtype.eq_op Ssrnat.nat_eqType (unsafeCoerce var) var') err;
Prelude.Nothing ->
case useVerifier of {
VerifyEnabledStrict -> err;
_ -> Applicative.pure (State0.coq_StateT_Applicative mDict) ()}})
(isReserved maxReg mDict reg var))
(Lens.use (Lens.stepdowng (\_ -> _verDesc maxReg)) mDict)
releaseReg :: Prelude.Int -> (Monad.Monad a1) -> Blocks.OpId -> UseVerifier
-> PhysReg -> Blocks.VarId -> Verified a1 a2 ()
releaseReg maxReg mDict pc useVerifier reg var =
Monad.bind (State0.coq_StateT_Monad mDict) (\x ->
Monad.bind (State0.coq_StateT_Monad mDict) (\st ->
case Ssr.prop
(Eqtype.eq_op (Eqtype.option_eqType Ssrnat.nat_eqType)
(Lens.view
(Lens.stepdownl' (unsafeCoerce (\_ -> reservation)))
(Vector0.vnth maxReg (rsAllocs maxReg st) reg))
(unsafeCoerce (Prelude.Just var))) of {
Prelude.Just _ ->
Lens.modifyStateT (\_ -> _verState maxReg)
(packRegState maxReg (Build_RegStateDesc
(Vector0.vmodify maxReg (rsAllocs maxReg st) reg
(Lens.set (\_ -> reservation) Prelude.Nothing))
(rsStack maxReg st))) mDict;
Prelude.Nothing ->
let {
err = errorT maxReg mDict pc (VarNotReservedForReg var ( reg)
(Lens.view (Lens.stepdownl' (\_ -> reservation))
(Vector0.vnth maxReg (rsAllocs maxReg st) reg))
((Prelude.succ) ((Prelude.succ) 0)))}
in
case useVerifier of {
VerifyEnabledStrict -> err;
_ ->
case Lens.view (Lens.stepdownl' (\_ -> reservation))
(Vector0.vnth maxReg (rsAllocs maxReg st) reg) of {
Prelude.Just v -> err;
Prelude.Nothing ->
Applicative.pure (State0.coq_StateT_Applicative mDict) ()}}})
(Lens.use (Lens.stepdowng (\_ -> _verDesc maxReg)) mDict))
(addMove maxReg mDict pc (Resolve.RSFreeReg ( reg) var))
assignReg :: Prelude.Int -> (Monad.Monad a1) -> Blocks.OpId -> UseVerifier ->
PhysReg -> Blocks.VarId -> Verified a1 a2 ()
assignReg maxReg mDict pc useVerifier reg var =
Monad.bind (State0.coq_StateT_Monad mDict) (\x ->
Monad.bind (State0.coq_StateT_Monad mDict) (\st ->
case Ssr.prop
(Eqtype.eq_op (Eqtype.option_eqType Ssrnat.nat_eqType)
(Lens.view
(Lens.stepdownl' (unsafeCoerce (\_ -> reservation)))
(Vector0.vnth maxReg (rsAllocs maxReg st) reg))
(unsafeCoerce (Prelude.Just var))) of {
Prelude.Just _ ->
Lens.modifyStateT (\_ -> _verState maxReg)
(packRegState maxReg (Build_RegStateDesc
(Vector0.vmodify maxReg (rsAllocs maxReg st) reg
(Lens.set (\_ -> residency) (Prelude.Just var)))
(rsStack maxReg st))) mDict;
Prelude.Nothing ->
let {
err = errorT maxReg mDict pc (VarNotReservedForReg var ( reg)
(Lens.view (Lens.stepdownl' (\_ -> reservation))
(Vector0.vnth maxReg (rsAllocs maxReg st) reg))
((Prelude.succ) ((Prelude.succ) ((Prelude.succ) 0))))}
in
case useVerifier of {
VerifyEnabledStrict -> err;
_ ->
case Lens.view (Lens.stepdownl' (\_ -> reservation))
(Vector0.vnth maxReg (rsAllocs maxReg st) reg) of {
Prelude.Just v -> err;
Prelude.Nothing ->
Applicative.pure (State0.coq_StateT_Applicative mDict) ()}}})
(Lens.use (Lens.stepdowng (\_ -> _verDesc maxReg)) mDict))
(addMove maxReg mDict pc (Resolve.RSAssignReg var ( reg)))
isResident :: Prelude.Int -> (Monad.Monad a1) -> PhysReg -> Blocks.VarId ->
Verified a1 a2 (Prelude.Maybe Blocks.VarId)
isResident maxReg mDict reg var =
Monad.bind (State0.coq_StateT_Monad mDict) (\st ->
Applicative.pure (State0.coq_StateT_Applicative mDict)
(Lens.view (Lens.stepdownl' (\_ -> residency))
(Vector0.vnth maxReg (rsAllocs maxReg st) reg)))
(Lens.use (Lens.stepdowng (\_ -> _verDesc maxReg)) mDict)
checkResidency :: Prelude.Int -> (Monad.Monad a1) -> Blocks.OpId ->
UseVerifier -> PhysReg -> Blocks.VarId -> Verified
a1 a2 ()
checkResidency maxReg mDict pc useVerifier reg var =
Monad.bind (State0.coq_StateT_Monad mDict) (\st ->
Monad.bind (State0.coq_StateT_Monad mDict) (\res ->
let {
err = errorT maxReg mDict pc (VarNotResidentForReg var ( reg) res
((Prelude.succ) 0))}
in
case useVerifier of {
VerifyEnabledStrict ->
case res of {
Prelude.Just var' ->
Monad.unless (State0.coq_StateT_Monad mDict)
(Eqtype.eq_op Ssrnat.nat_eqType (unsafeCoerce var)
(unsafeCoerce var')) err;
Prelude.Nothing -> err};
_ -> Applicative.pure (State0.coq_StateT_Applicative mDict) ()})
(isResident maxReg mDict reg var))
(Lens.use (Lens.stepdowng (\_ -> _verDesc maxReg)) mDict)
checkLiveness :: Prelude.Int -> (Monad.Monad a1) -> Blocks.OpId ->
UseVerifier -> IntSet.IntSet -> Verified a1 a2 ()
checkLiveness maxReg mDict pc useVerifier vars =
case useVerifier of {
VerifyEnabledStrict ->
Monad.bind (State0.coq_StateT_Monad mDict) (\st ->
Monad.forM_ (State0.coq_StateT_Monad mDict)
(IntSet.coq_IntSet_toList vars) (\var ->
Monad.unless (State0.coq_StateT_Monad mDict)
(Vector0.vfoldl_with_index maxReg (\reg b p ->
(Prelude.||) b
(case Lens.view (Lens.stepdownl' (\_ -> residency)) p of {
Prelude.Just var0 -> Prelude.True;
Prelude.Nothing -> Prelude.False})) Prelude.False
(rsAllocs maxReg st))
(errorT maxReg mDict pc (VarNotResident var))))
(Lens.use (Lens.stepdowng (\_ -> _verDesc maxReg)) mDict);
_ -> Applicative.pure (State0.coq_StateT_Applicative mDict) ()}
verifyBlockBegin :: Prelude.Int -> (Monad.Monad a1) -> Blocks.OpId ->
UseVerifier -> Prelude.Int -> IntSet.IntSet ->
Loops.LoopState -> Verified a1 a2 ()
verifyBlockBegin maxReg mDict pc useVerifier bid liveIns loops =
case useVerifier of {
VerifyDisabled ->
Applicative.pure (State0.coq_StateT_Applicative mDict) ();
VerifyEnabled ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x0 ->
Monad.bind (State0.coq_StateT_Monad mDict) (\allocs ->
Lens.applyStateT (\_ -> _verInit maxReg)
(IntMap.coq_IntMap_insert bid allocs) mDict)
(Lens.use (Lens.stepdownl' (\_ -> _verState maxReg)) mDict))
(checkLiveness maxReg mDict pc useVerifier liveIns))
(case IntMap.coq_IntMap_lookup bid (Loops.forwardBranches loops) of {
Prelude.Just fwds ->
Monad.forM_ (State0.coq_StateT_Monad mDict)
(IntSet.coq_IntSet_toList fwds) (\pred ->
Monad.bind (State0.coq_StateT_Monad mDict) (\exits ->
case IntMap.coq_IntMap_lookup pred exits of {
Prelude.Just allocs ->
Lens.modifyStateT (\_ -> _verState maxReg) allocs mDict;
Prelude.Nothing ->
errorT maxReg mDict pc (UnknownPredecessorBlock bid pred)})
(Lens.use (Lens.stepdownl' (\_ -> _verFinal maxReg)) mDict));
Prelude.Nothing ->
case useVerifier of {
VerifyEnabledStrict ->
Monad.when (State0.coq_StateT_Monad mDict)
((Prelude.<=) ((Prelude.succ) 0)
(IntSet.coq_IntSet_size liveIns))
(errorT maxReg mDict pc (BlockWithoutPredecessors bid));
_ -> Applicative.pure (State0.coq_StateT_Applicative mDict) ()}});
VerifyEnabledStrict ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x0 ->
Monad.bind (State0.coq_StateT_Monad mDict) (\allocs ->
Lens.applyStateT (\_ -> _verInit maxReg)
(IntMap.coq_IntMap_insert bid allocs) mDict)
(Lens.use (Lens.stepdownl' (\_ -> _verState maxReg)) mDict))
(checkLiveness maxReg mDict pc useVerifier liveIns))
(case IntMap.coq_IntMap_lookup bid (Loops.forwardBranches loops) of {
Prelude.Just fwds ->
Monad.forM_ (State0.coq_StateT_Monad mDict)
(IntSet.coq_IntSet_toList fwds) (\pred ->
Monad.bind (State0.coq_StateT_Monad mDict) (\exits ->
case IntMap.coq_IntMap_lookup pred exits of {
Prelude.Just allocs ->
Lens.modifyStateT (\_ -> _verState maxReg) allocs mDict;
Prelude.Nothing ->
errorT maxReg mDict pc (UnknownPredecessorBlock bid pred)})
(Lens.use (Lens.stepdownl' (\_ -> _verFinal maxReg)) mDict));
Prelude.Nothing ->
case useVerifier of {
VerifyEnabledStrict ->
Monad.when (State0.coq_StateT_Monad mDict)
((Prelude.<=) ((Prelude.succ) 0)
(IntSet.coq_IntSet_size liveIns))
(errorT maxReg mDict pc (BlockWithoutPredecessors bid));
_ -> Applicative.pure (State0.coq_StateT_Applicative mDict) ()}})}
verifyBlockEnd :: Prelude.Int -> (Monad.Monad a1) -> Blocks.OpId ->
UseVerifier -> Prelude.Int -> IntSet.IntSet -> Verified
a1 a2 ()
verifyBlockEnd maxReg mDict pc useVerifier bid liveOuts =
case useVerifier of {
VerifyDisabled ->
Applicative.pure (State0.coq_StateT_Applicative mDict) ();
_ ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x ->
Monad.bind (State0.coq_StateT_Monad mDict) (\allocs ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x0 ->
Lens.modifyStateT (\_ -> _verState maxReg)
(packRegState maxReg (newRegStateDesc maxReg)) mDict)
(Lens.applyStateT (\_ -> _verFinal maxReg)
(IntMap.coq_IntMap_insert bid allocs) mDict))
(Lens.use (Lens.stepdownl' (\_ -> _verState maxReg)) mDict))
(checkLiveness maxReg mDict pc useVerifier liveOuts)}
verifyAllocs :: Prelude.Int -> (Monad.Monad a3) -> (Blocks.OpInfo a3
a1 a2) -> Blocks.OpId -> UseVerifier -> a1 -> ([]
((,) ((,) Blocks.VarId UsePos.VarKind) PhysReg)) -> Verified
a3 a4 ()
verifyAllocs maxReg mDict oinfo pc useVerifier op allocs =
case useVerifier of {
VerifyDisabled ->
Applicative.pure (State0.coq_StateT_Applicative mDict) ();
VerifyEnabled ->
Monad.forM_ (State0.coq_StateT_Monad mDict)
(Blocks.opRefs maxReg mDict oinfo op) (\ref ->
case Blocks.varId maxReg ref of {
Prelude.Left reg ->
Applicative.pure (State0.coq_StateT_Applicative mDict) ();
Prelude.Right var ->
case List1.maybeLookup
(Eqtype.prod_eqType Ssrnat.nat_eqType
UsePos.coq_VarKind_eqType) (unsafeCoerce allocs)
(unsafeCoerce ((,) var (Blocks.varKind maxReg ref))) of {
Prelude.Just reg ->
case Blocks.varKind maxReg ref of {
UsePos.Input -> checkResidency maxReg mDict pc useVerifier reg var;
UsePos.Temp ->
checkReservation maxReg mDict pc useVerifier reg var;
UsePos.Output -> assignReg maxReg mDict pc useVerifier reg var};
Prelude.Nothing -> errorT maxReg mDict pc (VarNotAllocated var)}});
VerifyEnabledStrict ->
Monad.forM_ (State0.coq_StateT_Monad mDict)
(Blocks.opRefs maxReg mDict oinfo op) (\ref ->
case Blocks.varId maxReg ref of {
Prelude.Left reg ->
Applicative.pure (State0.coq_StateT_Applicative mDict) ();
Prelude.Right var ->
case List1.maybeLookup
(Eqtype.prod_eqType Ssrnat.nat_eqType
UsePos.coq_VarKind_eqType) (unsafeCoerce allocs)
(unsafeCoerce ((,) var (Blocks.varKind maxReg ref))) of {
Prelude.Just reg ->
case Blocks.varKind maxReg ref of {
UsePos.Input -> checkResidency maxReg mDict pc useVerifier reg var;
UsePos.Temp ->
checkReservation maxReg mDict pc useVerifier reg var;
UsePos.Output -> assignReg maxReg mDict pc useVerifier reg var};
Prelude.Nothing -> errorT maxReg mDict pc (VarNotAllocated var)}})}
verifyResolutions :: Prelude.Int -> (Monad.Monad a1) -> Blocks.OpId ->
UseVerifier -> ([] Resolve.ResolvingMove) -> Verified
a1 a2 ([] Resolve.ResolvingMove)
verifyResolutions maxReg mDict pc useVerifier moves =
case useVerifier of {
VerifyDisabled ->
Applicative.pure (State0.coq_StateT_Applicative mDict) moves;
_ ->
Monad.forFoldM (State0.coq_StateT_Monad mDict) [] moves (\acc mv ->
Monad.bind (State0.coq_StateT_Monad mDict) (\st ->
case mv of {
Resolve.Move fromReg fromVar toReg ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x0 ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x1 ->
Monad.bind (State0.coq_StateT_Monad mDict) (\check ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x2 ->
Applicative.pure (State0.coq_StateT_Applicative mDict)
(Seq.rcons acc mv))
(case useVerifier of {
VerifyEnabledStrict ->
Monad.when (State0.coq_StateT_Monad mDict)
(Maybe.isJust check)
(assignReg maxReg mDict pc useVerifier toReg
fromVar);
_ ->
assignReg maxReg mDict pc useVerifier toReg fromVar}))
(isResident maxReg mDict fromReg fromVar))
(addMove maxReg mDict pc
(Resolve.weakenResolvingMove maxReg mv)))
(reserveReg maxReg mDict pc toReg fromVar))
(Monad.unless (State0.coq_StateT_Monad mDict)
(Eqtype.eq_op (Fintype.ordinal_eqType maxReg)
(unsafeCoerce fromReg) (unsafeCoerce toReg))
(releaseReg maxReg mDict pc useVerifier fromReg fromVar));
Resolve.Transfer fromReg fromVar toReg ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x0 ->
Applicative.pure (State0.coq_StateT_Applicative mDict) acc)
(reserveReg maxReg mDict pc toReg fromVar))
(Monad.unless (State0.coq_StateT_Monad mDict)
(Eqtype.eq_op (Fintype.ordinal_eqType maxReg)
(unsafeCoerce fromReg) (unsafeCoerce toReg))
(releaseReg maxReg mDict pc useVerifier fromReg fromVar));
Resolve.Spill fromReg toSpillSlot ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x ->
Monad.bind (State0.coq_StateT_Monad mDict) (\check ->
case Maybe.isJust check of {
Prelude.True ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x0 ->
Applicative.pure (State0.coq_StateT_Applicative mDict)
(Seq.rcons acc mv))
(addMove maxReg mDict pc
(Resolve.weakenResolvingMove maxReg mv));
Prelude.False ->
Applicative.pure (State0.coq_StateT_Applicative mDict) acc})
(isResident maxReg mDict fromReg toSpillSlot))
(releaseReg maxReg mDict pc useVerifier fromReg toSpillSlot);
Resolve.Restore fromSpillSlot toReg ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x0 ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x1 ->
Applicative.pure (State0.coq_StateT_Applicative mDict)
(Seq.rcons acc mv))
(assignReg maxReg mDict pc useVerifier toReg fromSpillSlot))
(addMove maxReg mDict pc
(Resolve.weakenResolvingMove maxReg mv)))
(reserveReg maxReg mDict pc toReg fromSpillSlot);
Resolve.AllocReg toVar toReg ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x ->
Applicative.pure (State0.coq_StateT_Applicative mDict) acc)
(reserveReg maxReg mDict pc toReg toVar);
Resolve.FreeReg fromReg fromVar ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x ->
Applicative.pure (State0.coq_StateT_Applicative mDict) acc)
(releaseReg maxReg mDict pc useVerifier fromReg fromVar);
Resolve.Looped x ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x0 ->
Monad.bind (State0.coq_StateT_Monad mDict) (\x1 ->
Applicative.pure (State0.coq_StateT_Applicative mDict)
(Seq.rcons acc mv))
(addMove maxReg mDict pc
(Resolve.weakenResolvingMove maxReg mv)))
(errorT maxReg mDict pc (LoopInResolvingMoves
(Resolve.weakenResolvingMove maxReg x)))})
(Lens.use (Lens.stepdowng (\_ -> _verDesc maxReg)) mDict))}