module Wired.Model where
import Control.Monad.Reader
import Control.Monad.Writer
import Data.Function
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.String
import Data.Hardware.Internal
import Lava.Internal
import Layout.Internal
class CellLibrary lib => WiredLibrary lib
where
featureSize :: Res lib Length
guideLength :: Layer -> Res lib Length
rowHeight :: Res lib Height
type Guide = (Signal, Layer_, Direction, Length)
type Wired lib = LayoutT Guide CellId (Lava lib)
class ( MonadLava lib m
, WiredLibrary lib
, MonadLayout Guide CellId m
)
=> MonadWired lib m
instance ( MonadLava lib m
, WiredLibrary lib
, MonadLayout Guide CellId m
)
=> MonadWired lib m
runWired
:: CellLibrary lib
=> Wired lib a -> (a, (DesignDB lib, Floorplan Guide CellId))
runWired w = (a,(db,fp))
where
((a,fp),db) = runLava $ runLayoutT w
instance MonadLava lib m => MonadLava lib (LayoutT s b m)
where
newPrimInpId = lift newPrimInpId
newCellId = lift newCellId
declare = lift . declare
listenDecls (LayoutT ma) = LayoutT $ do
pl <- ask
((a,fps),decls) <- lift $ lift $
listenDecls $ runWriterT $ runReaderT ma pl
tell fps
return (a,decls)
toLava = toLava . liftM fst . runLayoutT
instance Value Length
where
value (Length l) = fromIntegral l * 1e-10
convertGuide
:: (Position, AbsBlock Guide CellId)
-> (Signal, (Layer_,Position,Position))
convertGuide bl = (sig,(lay,pos1,pos2))
where
(_, Space _ (Just (sig,lay,dir,len))) = bl
pos1@(x,y) = blockCenter bl
pos2 = case dir of
Rightwards -> (x+len, y)
Leftwards -> (x+len, y)
Upwards -> (x, ylen)
Downwards -> (x, ylen)
mkGuideDB
:: Floorplan Guide CellId -> Map Signal [(Layer_,Position,Position)]
mkGuideDB fp = Map.fromListWith (++)
[ (sig,[g])
| bl@(_, Space _ (Just _)) <- fst $ absolutize fp
, let (sig,g) = convertGuide bl
]
renderWired :: forall lib a . WiredLibrary lib => Name -> Wired lib a -> IO ()
renderWired title w = renderFloorplan_ (feat`divLen`2) title fp []
where
feat = result (featureSize :: Res lib Length)
fp = snd $ snd $ runWired w
fpToLines
:: (Signal -> Maybe Color)
-> Floorplan Guide CellId
-> [([(Position,Position)], Color)]
fpToLines sigCol fp =
[ (rectiSpanning [pos | (_,pos,_) <- guides], col)
| (sig,guides) <- Map.toList $ mkGuideDB fp
, Just col <- [sigCol sig]
, length guides >= 2
]
renderWiredWithNetsCol :: forall lib a . WiredLibrary lib =>
Maybe Color -> (Tag -> Maybe Color) -> Name -> Wired lib a -> IO ()
renderWiredWithNetsCol defaultCol tagCol title w =
renderFloorplan_ (feat`divLen`2) title fp (fpToLines sigCol fp)
where
feat = result (featureSize :: Res lib Length)
(db,fp) = snd $ runWired w
sigCol sig = case totalLookup sig (sigTagDB db) of
t:_ -> tagCol t
_ -> defaultCol
renderWiredWithNets :: forall lib a .
WiredLibrary lib => Name -> Wired lib a -> IO ()
renderWiredWithNets = renderWiredWithNetsCol (Just black) (const Nothing)
wire__
:: (MonadWired lib m, PortStruct p Signal t)
=> Direction -> Length -> Layer_ -> Width -> (p -> m p)
wire__ dir len lay pitch = mapPortM $ \sig -> do
space_ pitch (Just (sig,lay,dir,len))
return sig
wire_
:: (MonadWired lib m, PortStruct p Signal t)
=> Direction -> Length -> Layer -> Width -> (p -> m p)
wire_ dir len lay wit = wire__ dir len (icast lay) wit
wireN, wireS, wireW, wireE
:: (MonadWired lib m, PortStruct p Signal t)
=> Length -> Layer -> Width -> (p -> m p)
wireN = wire_ Upwards
wireS = wire_ Downwards
wireW = wire_ Leftwards
wireE = wire_ Rightwards
guide__ :: forall lib m p t
. (MonadWired lib m, PortStruct p Signal t)
=> Direction -> Layer_ -> Width -> (p -> m p)
guide__ dir lay pitch = mapPortM $ \sig -> do
space_
pitch
(Just (sig,lay,dir, result (guideLength (icast lay) :: Res lib Length)))
return sig
guide_
:: (MonadWired lib m, PortStruct p Signal t)
=> Direction -> Layer -> Width -> (p -> m p)
guide_ dir lay pitch = guide__ dir (icast lay) pitch
guide, guideN, guideS, guideW, guideE
:: (MonadWired lib m, PortStruct p Signal t)
=> Layer -> Width -> (p -> m p)
guide = guide_ Downwards
guideN = guide_ Upwards
guideS = guide_ Downwards
guideW = guide_ Leftwards
guideE = guide_ Rightwards
mkCell
:: MonadWired lib m
=> Name
-> Width
-> Height
-> m a
-> m a
mkCell nm x y ma = do
(a, [Cell cid _ _]) <- listenDecls ma
block x y nm cid a