module Lava.ApplyLayout
where
import Data.Array.ST
import Control.Monad.State
import Data.Array.Unboxed
import Control.Monad.ST
import Lava.Netlist
applyLayout :: Netlist -> Netlist
applyLayout state
= state{computedShifts = runST (applyLayout' state)}
type MutablePositions s = STUArray s Int Int
applyLayout' :: Netlist -> ST s (Array Int Int, Array Int Int)
applyLayout' state
= do xs <- newArray (0, n1) 0 :: ST s (STUArray s Int Int)
ys <- newArray (0, n1) 0 :: ST s (STUArray s Int Int)
applyLayoutElements state (layout state) xs ys
xsf <- freeze xs
ysf <- freeze ys
return (xsf, ysf)
where
n = instCount state
applyLayoutElements :: Netlist -> [Layout] ->
MutablePositions s -> MutablePositions s ->
ST s ()
applyLayoutElements state [] xs ys = return ()
applyLayoutElements state (l:ls) xs ys
= do applyLayoutElement state l xs ys
applyLayoutElements state ls xs ys
applyLayoutElement :: Netlist -> Layout -> MutablePositions s ->
MutablePositions s -> ST s ()
applyLayoutElement state (Beside (a0,a1) (b0,b1)) xs ys
= if maybeASize == Nothing then
return ()
else
translateInstances (b0,b1) (dx, 0) xs ys
where
insts = instances state
l = layout state
maybeASize = sizeOfBlock a0 a1 insts
Just (dx,dy) = maybeASize
applyLayoutElement state (Below (a0,a1) (b0,b1)) xs ys
= if maybeASize == Nothing then
return ()
else
translateInstances (b0,b1) (0, dy) xs ys
where
insts = instances state
l = layout state
maybeASize = sizeOfBlock a0 a1 insts
Just (dx,dy) = maybeASize
sizeOfBlock :: Int -> Int -> [Instance] -> Maybe (Int, Int)
sizeOfBlock a0 a1 instances
= if xy == [] then
Nothing
else
Just (maximum xPositions minimum xPositions + 1,
maximum yPosiitons minimum yPosiitons + 1)
where
positions = [position inst
| inst <- instances, instanceNumber inst >= a0 &&
instanceNumber inst <= a1]
xy = [(x,y) | At (x, y) <- positions]
xPositions = map fst xy
yPosiitons = map snd xy
translateInstances :: (Int, Int) -> (Int, Int) ->
MutablePositions s -> MutablePositions s -> ST s ()
translateInstances (a,b) dxy xs ys
= sequence_ [translateInstance i dxy xs ys | i <- [a..b]]
translateInstance :: Int -> (Int, Int) ->
MutablePositions s -> MutablePositions s ->
ST s ()
translateInstance i (dx, dy) xs ys
= do x <- readArray xs i
writeArray xs i (x+dx)
y <- readArray ys i
writeArray ys i (y+dy)