linearscan-0.11: LinearScan/Main.hs

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.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.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)