linearscan-0.5.1.0: LinearScan/Main.hs

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.Interval as Interval
import qualified LinearScan.Lib as Lib
import qualified LinearScan.LiveSets as LiveSets
import qualified LinearScan.Loops as Loops
import qualified LinearScan.Monad as Monad
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 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)
    (LinearScan.Utils.vmap (ScanState.nextInterval maxReg sd) (\x ->
      Interval.getIntervalDesc ( x)) (ScanState.intervals maxReg sd))
    (LinearScan.Utils.vmap maxReg (\mx ->
      case mx of {
       Prelude.Just x -> Prelude.Just (Interval.getIntervalDesc ( x));
       Prelude.Nothing -> Prelude.Nothing})
      (ScanState.fixedIntervals maxReg sd))
    (Prelude.map (\i -> (,) ( (Prelude.fst i)) (Prelude.snd i))
      (ScanState.unhandled maxReg sd))
    (Prelude.map (\i -> (,) ( (Prelude.fst i)) ( (Prelude.snd i)))
      (ScanState.active maxReg sd))
    (Prelude.map (\i -> (,) ( (Prelude.fst i)) ( (Prelude.snd i)))
      (ScanState.inactive maxReg sd))
    (Prelude.map (\i -> (,) ( (Prelude.fst i))
      (Lib.option_map (\x ->  x) (Prelude.snd i)))
      (ScanState.handled maxReg sd))

data Details blockType1 blockType2 =
   Build_Details (Prelude.Maybe ((,) Morph.SSError FinalStage)) (IntMap.IntMap
                                                                LiveSets.BlockLiveSets) 
 ([] blockType1) ([] blockType1) ([] 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) -> ([] a2) ->
              ((Details a2 a3) -> a6) -> a1
linearScan dict maxReg binfo oinfo blocks k =
  Monad.bind dict (\z ->
    case z of {
     (,) loops blocks1 ->
      Monad.bind dict (\liveSets ->
        Monad.bind dict (\liveSets' ->
          Monad.bind dict (\ints ->
            case ints of {
             Prelude.Left err ->
              Monad.pure (Monad.is_applicative dict)
                (k (Build_Details (Prelude.Just ((,) err
                  BuildingIntervalsFailed)) liveSets' blocks blocks1 []
                  Prelude.Nothing Prelude.Nothing loops));
             Prelude.Right ssig ->
              let {
               opCount = (Prelude.succ) (Blocks.countOps dict binfo blocks1)}
              in
              case Allocate.walkIntervals maxReg ( ssig) opCount of {
               Prelude.Left p ->
                case p of {
                 (,) err ssig' ->
                  Monad.pure (Monad.is_applicative dict)
                    (k (Build_Details (Prelude.Just ((,) err
                      AllocatingRegistersFailed)) liveSets' blocks blocks1 []
                      (Prelude.Just (toScanStateDescSet maxReg ( ssig)))
                      (Prelude.Just (toScanStateDescSet maxReg ( ssig')))
                      loops))};
               Prelude.Right ssig' ->
                let {
                 sd = Allocate.finalizeScanState maxReg ( ssig')
                        (Ssrnat.double opCount)}
                in
                let {allocs = Allocate.determineAllocations maxReg sd} in
                Monad.bind dict (\mappings ->
                  Monad.bind dict (\blocks2 ->
                    Monad.pure (Monad.is_applicative dict)
                      (k (Build_Details Prelude.Nothing liveSets' blocks
                        blocks1 blocks2 (Prelude.Just
                        (toScanStateDescSet maxReg ( ssig))) (Prelude.Just
                        (toScanStateDescSet maxReg sd)) loops)))
                    (Assign.assignRegNum maxReg dict binfo oinfo allocs
                      liveSets' mappings blocks1))
                  (Resolve.resolveDataFlow maxReg dict binfo allocs blocks1
                    liveSets')}})
            (Build.buildIntervals maxReg dict binfo oinfo blocks1 loops
              liveSets'))
          (LiveSets.computeGlobalLiveSetsRecursively dict binfo blocks1
            liveSets))
        (LiveSets.computeLocalLiveSets maxReg dict binfo oinfo blocks1)})
    (Loops.computeBlockOrder dict binfo blocks)