module LinearScan.Blocks 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.Monad as Monad import qualified LinearScan.UsePos as UsePos type PhysReg = Prelude.Int type VarId = Prelude.Int data VarInfo = Build_VarInfo (Prelude.Either PhysReg VarId) UsePos.VarKind Prelude.Bool varId :: Prelude.Int -> VarInfo -> Prelude.Either PhysReg VarId varId maxReg v = case v of { Build_VarInfo varId0 varKind0 regRequired0 -> varId0} varKind :: Prelude.Int -> VarInfo -> UsePos.VarKind varKind maxReg v = case v of { Build_VarInfo varId0 varKind0 regRequired0 -> varKind0} regRequired :: Prelude.Int -> VarInfo -> Prelude.Bool regRequired maxReg v = case v of { Build_VarInfo varId0 varKind0 regRequired0 -> regRequired0} nat_of_varId :: Prelude.Int -> VarInfo -> Prelude.Int nat_of_varId maxReg v = case varId maxReg v of { Prelude.Left n -> Prelude.id n; Prelude.Right v0 -> (Prelude.+) v0 maxReg} data OpKind = IsNormal | IsCall | IsBranch type OpId = Prelude.Int data OpInfo m opType1 opType2 = Build_OpInfo (opType1 -> OpKind) (opType1 -> [] VarInfo) (PhysReg -> VarId -> PhysReg -> m) (PhysReg -> VarId -> m) (VarId -> PhysReg -> m) (opType1 -> ([] ((,) ((,) VarId UsePos.VarKind) PhysReg)) -> m) (opType1 -> Prelude.String) opKind :: Prelude.Int -> (Monad.Monad a1) -> (OpInfo a1 a2 a3) -> a2 -> OpKind opKind maxReg h o = case o of { Build_OpInfo opKind0 opRefs0 moveOp0 saveOp0 restoreOp0 applyAllocs0 showOp -> opKind0} opRefs :: Prelude.Int -> (Monad.Monad a1) -> (OpInfo a1 a2 a3) -> a2 -> [] VarInfo opRefs maxReg h o = case o of { Build_OpInfo opKind0 opRefs0 moveOp0 saveOp0 restoreOp0 applyAllocs0 showOp -> opRefs0} moveOp :: Prelude.Int -> (Monad.Monad a1) -> (OpInfo a1 a2 a3) -> PhysReg -> VarId -> PhysReg -> a1 moveOp maxReg h o = case o of { Build_OpInfo opKind0 opRefs0 moveOp0 saveOp0 restoreOp0 applyAllocs0 showOp -> moveOp0} saveOp :: Prelude.Int -> (Monad.Monad a1) -> (OpInfo a1 a2 a3) -> PhysReg -> VarId -> a1 saveOp maxReg h o = case o of { Build_OpInfo opKind0 opRefs0 moveOp0 saveOp0 restoreOp0 applyAllocs0 showOp -> saveOp0} restoreOp :: Prelude.Int -> (Monad.Monad a1) -> (OpInfo a1 a2 a3) -> VarId -> PhysReg -> a1 restoreOp maxReg h o = case o of { Build_OpInfo opKind0 opRefs0 moveOp0 saveOp0 restoreOp0 applyAllocs0 showOp -> restoreOp0} applyAllocs :: Prelude.Int -> (Monad.Monad a1) -> (OpInfo a1 a2 a3) -> a2 -> ([] ((,) ((,) VarId UsePos.VarKind) PhysReg)) -> a1 applyAllocs maxReg h o = case o of { Build_OpInfo opKind0 opRefs0 moveOp0 saveOp0 restoreOp0 applyAllocs0 showOp -> applyAllocs0} type BlockId = Prelude.Int data BlockInfo m blockType1 blockType2 opType1 opType2 = Build_BlockInfo (blockType1 -> BlockId) (blockType1 -> [] BlockId) (blockType1 -> blockType1 -> m) (blockType1 -> (,) ((,) ([] opType1) ([] opType1)) ([] opType1)) (blockType1 -> ([] opType2) -> ([] opType2) -> ([] opType2) -> blockType2) blockId :: (Monad.Monad a1) -> (BlockInfo a1 a2 a3 a4 a5) -> a2 -> BlockId blockId h b = case b of { Build_BlockInfo blockId0 blockSuccessors0 splitCriticalEdge0 blockOps0 setBlockOps0 -> blockId0} blockSuccessors :: (Monad.Monad a1) -> (BlockInfo a1 a2 a3 a4 a5) -> a2 -> [] BlockId blockSuccessors h b = case b of { Build_BlockInfo blockId0 blockSuccessors0 splitCriticalEdge0 blockOps0 setBlockOps0 -> blockSuccessors0} splitCriticalEdge :: (Monad.Monad a1) -> (BlockInfo a1 a2 a3 a4 a5) -> a2 -> a2 -> a1 splitCriticalEdge h b = case b of { Build_BlockInfo blockId0 blockSuccessors0 splitCriticalEdge0 blockOps0 setBlockOps0 -> splitCriticalEdge0} blockOps :: (Monad.Monad a1) -> (BlockInfo a1 a2 a3 a4 a5) -> a2 -> (,) ((,) ([] a4) ([] a4)) ([] a4) blockOps h b = case b of { Build_BlockInfo blockId0 blockSuccessors0 splitCriticalEdge0 blockOps0 setBlockOps0 -> blockOps0} setBlockOps :: (Monad.Monad a1) -> (BlockInfo a1 a2 a3 a4 a5) -> a2 -> ([] a5) -> ([] a5) -> ([] a5) -> a3 setBlockOps h b = case b of { Build_BlockInfo blockId0 blockSuccessors0 splitCriticalEdge0 blockOps0 setBlockOps0 -> setBlockOps0} allBlockOps :: (Monad.Monad a5) -> (BlockInfo a5 a1 a2 a3 a4) -> a1 -> [] a3 allBlockOps mDict binfo block = case blockOps mDict binfo block of { (,) p c -> case p of { (,) a b -> (Prelude.++) a ((Prelude.++) b c)}} blockSize :: (Monad.Monad a5) -> (BlockInfo a5 a1 a2 a3 a4) -> a1 -> Prelude.Int blockSize mDict binfo block = Data.List.length (allBlockOps mDict binfo block) foldOps :: (Monad.Monad a5) -> (BlockInfo a5 a1 a2 a3 a4) -> (a6 -> a3 -> a6) -> a6 -> ([] a1) -> a6 foldOps mDict binfo f z = Data.List.foldl' (\bacc blk -> Data.List.foldl' f bacc (allBlockOps mDict binfo blk)) z countOps :: (Monad.Monad a5) -> (BlockInfo a5 a1 a2 a3 a4) -> ([] a1) -> Prelude.Int countOps mDict binfo = foldOps mDict binfo (\acc x -> (Prelude.succ) acc) 0