module LinearScan.Main where import Debug.Trace (trace, traceShow) 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 LinearScan.Utils import qualified LinearScan.Allocate as Allocate 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.LiveSets as LiveSets import qualified LinearScan.Loops as Loops import qualified LinearScan.Morph as Morph import qualified LinearScan.Resolve as Resolve import qualified LinearScan.ScanState as ScanState import qualified LinearScan.Ssrnat as Ssrnat data FinalStage = BuildingIntervalsFailed | AllocatingRegistersFailed data Details blockType1 blockType2 opType1 opType2 accType = Build_Details (Prelude.Maybe ((,) Morph.SSError FinalStage)) (IntMap.IntMap LiveSets.BlockLiveSets) ([] blockType1) ([] blockType2) accType (Prelude.Maybe ScanState.ScanStateDesc) (Prelude.Maybe ScanState.ScanStateDesc) (Blocks.BlockInfo blockType1 blockType2 opType1 opType2) (Blocks.OpInfo accType opType1 opType2) Loops.LoopState linearScan :: Prelude.Int -> (Blocks.BlockInfo a1 a2 a3 a4) -> (Blocks.OpInfo a5 a3 a4) -> ([] a1) -> a5 -> Details a1 a2 a3 a4 a5 linearScan maxReg binfo oinfo blocks accum = case Loops.computeBlockOrder binfo blocks of { (,) loops blocks1 -> let {liveSets = LiveSets.computeLocalLiveSets maxReg binfo oinfo blocks1} in let { liveSets' = LiveSets.computeGlobalLiveSetsRecursively binfo blocks1 liveSets} in case Build.buildIntervals maxReg binfo oinfo blocks1 loops liveSets' of { Prelude.Left err -> Build_Details (Prelude.Just ((,) err BuildingIntervalsFailed)) liveSets' blocks1 [] accum Prelude.Nothing Prelude.Nothing binfo oinfo loops; Prelude.Right ssig -> let {opCount = (Prelude.succ) (Blocks.countOps binfo blocks1)} in case Allocate.walkIntervals maxReg ( ssig) opCount of { Prelude.Left p -> case p of { (,) err ssig' -> Build_Details (Prelude.Just ((,) err AllocatingRegistersFailed)) liveSets' blocks1 [] accum (Prelude.Just ( ssig)) (Prelude.Just ( ssig')) binfo oinfo loops}; Prelude.Right ssig' -> let { sd = Allocate.finalizeScanState maxReg ( ssig') (Ssrnat.double opCount)} in let {allocs = Resolve.determineAllocations maxReg sd} in let { mappings = Resolve.resolveDataFlow maxReg binfo allocs blocks1 liveSets'} in case Assign.assignRegNum maxReg binfo oinfo allocs liveSets' mappings blocks1 accum of { (,) blocks2 accum' -> Build_Details Prelude.Nothing liveSets' blocks1 blocks2 accum' (Prelude.Just ( ssig)) (Prelude.Just sd) binfo oinfo loops}}}}