linearscan-0.7.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 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.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))
      (Maybe.option_map (\x ->  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.AllocError))
                                 ([] 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 ->
      Monad.bind dict (\liveSets ->
        Monad.bind dict (\liveSets' ->
          Monad.bind dict (\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' ->
                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' ->
              let {
               sd = Allocate.finalizeScanState maxReg ( ssig')
                      (Ssrnat.double opCount)}
              in
              let {allocs = Allocate.determineAllocations maxReg sd} in
              Monad.bind dict (\mappings ->
                Monad.bind dict (\res ->
                  case res of {
                   (,) moves blocks2 ->
                    Applicative.pure (Monad.is_applicative dict)
                      (Build_Details Prelude.Nothing liveSets' moves blocks
                      blocks1 blocks2 (Prelude.Just
                      (toScanStateDescSet maxReg ( ssig))) (Prelude.Just
                      (toScanStateDescSet maxReg sd)) loops)})
                  (Assign.assignRegNum maxReg dict binfo oinfo useVerifier
                    allocs liveSets' mappings loops 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)