module LinearScan.Main 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.Allocate as Allocate import qualified LinearScan.Applicative as Applicative import qualified LinearScan.Assign as Assign import qualified LinearScan.Blocks as Blocks import qualified LinearScan.Build as Build import qualified LinearScan.IntMap as IntMap import qualified LinearScan.Interval as Interval import qualified LinearScan.LiveSets as LiveSets import qualified LinearScan.Loops as Loops import qualified LinearScan.Maybe as Maybe import qualified LinearScan.Monad as Monad import qualified LinearScan.Resolve as Resolve import qualified LinearScan.ScanState as ScanState import qualified LinearScan.Trace as Trace import qualified LinearScan.Vector0 as Vector0 import qualified LinearScan.Verify as Verify import qualified LinearScan.Ssrnat as Ssrnat data FinalStage = BuildingIntervalsFailed | AllocatingRegistersFailed data ScanStateDescSet = Build_ScanStateDescSet Prelude.Int ([] Interval.IntervalDesc) ([] (Prelude.Maybe Interval.IntervalDesc)) ([] ((,) Prelude.Int Prelude.Int)) ([] ((,) Prelude.Int Prelude.Int)) ([] ((,) Prelude.Int Prelude.Int)) ([] ((,) Prelude.Int (Prelude.Maybe Prelude.Int))) toScanStateDescSet :: Prelude.Int -> ScanState.ScanStateDesc -> ScanStateDescSet toScanStateDescSet maxReg sd = Build_ScanStateDescSet (ScanState.nextInterval maxReg sd) (Prelude.map (\x -> Interval.getIntervalDesc ( x)) (Vector0.vec_to_seq (ScanState.nextInterval maxReg sd) (ScanState.intervals maxReg sd))) (Prelude.map (\mx -> case mx of { Prelude.Just x -> Prelude.Just (Interval.getIntervalDesc ( x)); Prelude.Nothing -> Prelude.Nothing}) (Vector0.vec_to_seq maxReg (ScanState.fixedIntervals maxReg sd))) (Prelude.map (\i -> (,) (Prelude.id (Prelude.fst i)) (Prelude.snd i)) (ScanState.unhandled maxReg sd)) (Prelude.map (\i -> (,) (Prelude.id (Prelude.fst i)) (Prelude.id (Prelude.snd i))) (ScanState.active maxReg sd)) (Prelude.map (\i -> (,) (Prelude.id (Prelude.fst i)) (Prelude.id (Prelude.snd i))) (ScanState.inactive maxReg sd)) (Prelude.map (\i -> (,) (Prelude.id (Prelude.fst i)) (Maybe.option_map (\x -> Prelude.id x) (Prelude.snd i))) (ScanState.handled maxReg sd)) data Details blockType1 blockType2 = Build_Details (Prelude.Maybe ((,) ([] Trace.SSTrace) FinalStage)) (IntMap.IntMap LiveSets.BlockLiveSets) (IntMap.IntMap ([] Resolve.ResolvingMoveSet)) ([] blockType1) ([] blockType1) (Prelude.Either ((,) ((,) (IntMap.IntMap ((,) Verify.RegStateDescSet ([] Verify.AllocError))) (IntMap.IntMap Verify.RegStateDescSet)) (IntMap.IntMap Verify.RegStateDescSet)) ([] blockType2)) (Prelude.Maybe ScanStateDescSet) (Prelude.Maybe ScanStateDescSet) Loops.LoopState linearScan :: (Monad.Monad a1) -> Prelude.Int -> (Blocks.BlockInfo a1 a2 a3 a4 a5) -> (Blocks.OpInfo a1 a4 a5) -> Verify.UseVerifier -> ([] a2) -> a1 linearScan dict maxReg binfo oinfo useVerifier blocks = Monad.bind dict (\z -> case z of { (,) loops blocks1 -> let { liveSets = LiveSets.computeLocalLiveSets maxReg dict binfo oinfo blocks1} in let { liveSets' = LiveSets.computeGlobalLiveSetsRecursively dict binfo blocks1 liveSets} in let { ssig = Build.buildIntervals maxReg dict binfo oinfo blocks1 loops liveSets'} in let {opCount = (Prelude.succ) (Blocks.countOps dict binfo blocks1)} in case Allocate.walkIntervals maxReg ( ssig) ((Prelude.succ) (Ssrnat.double opCount)) of { Prelude.Left p -> case p of { (,) err ssig' -> Applicative.pure (Monad.is_applicative dict) (Build_Details (Prelude.Just ((,) err AllocatingRegistersFailed)) liveSets' IntMap.emptyIntMap blocks blocks1 (Prelude.Right []) (Prelude.Just (toScanStateDescSet maxReg ( ssig))) (Prelude.Just (toScanStateDescSet maxReg ( ssig'))) loops)}; Prelude.Right ssig' -> case Allocate.finalizeScanState maxReg ( ssig') (Ssrnat.double opCount) of { Prelude.Left err -> Applicative.pure (Monad.is_applicative dict) (Build_Details (Prelude.Just ((,) err AllocatingRegistersFailed)) liveSets' IntMap.emptyIntMap blocks blocks1 (Prelude.Right []) (Prelude.Just (toScanStateDescSet maxReg ( ssig))) (Prelude.Just (toScanStateDescSet maxReg ( ssig'))) loops); Prelude.Right s -> let {allocs = Allocate.determineAllocations maxReg s} in let { mappings = Resolve.resolveDataFlow maxReg dict binfo allocs blocks1 liveSets'} in Monad.bind dict (\res -> case res of { (,) moves blocks2 -> let { blockInfo = case blocks2 of { Prelude.Left vs -> Prelude.Left ((,) ((,) (Verify.verErrors maxReg vs) (IntMap.coq_IntMap_map (\x -> Verify.fromRegStateDesc maxReg ( x)) (Verify.verInit maxReg vs))) (IntMap.coq_IntMap_map (\x -> Verify.fromRegStateDesc maxReg ( x)) (Verify.verFinal maxReg vs))); Prelude.Right xs -> Prelude.Right xs}} in Applicative.pure (Monad.is_applicative dict) (Build_Details Prelude.Nothing liveSets' moves blocks blocks1 blockInfo (Prelude.Just (toScanStateDescSet maxReg ( ssig))) (Prelude.Just (toScanStateDescSet maxReg s)) loops)}) (Assign.assignRegNum maxReg dict binfo oinfo useVerifier allocs liveSets' mappings loops blocks1)}}}) (Loops.computeBlockOrder dict binfo blocks)