{-# OPTIONS_GHC -fno-warn-missing-fields #-}

module Analysis.Timing
  ( TransitionTime
  , Timing (..)
  , TimingLibrary
  , analyzeTiming
  , analyzeTimingW
  ) where



import Control.Arrow ((***))
import Control.Monad
import Data.Function
import Data.List
import qualified Data.Map as Map

import Data.Hardware.Internal
import Lava.Internal
import Layout.Internal
import Wired.Model
import Analysis.Timing.Library



instance Port Time Time
  where
    port   = One
    unport = unOne

instance PortStruct Time Time ()



addTiming :: Timing -> Timing -> Timing
addTiming (Timing ar1 tr1) (Timing ar2 tr2) = Timing (ar1+ar2) (tr1+tr2)

addSig :: (Timing,Capacitance) -> (Timing,Capacitance) -> (Timing,Capacitance)
addSig (tim1,cap1) (tim2,cap2) = (addTiming tim1 tim2, cap1+cap2)

timing0 = Timing 0 0

prop0 = (timing0, 0)

propCap cap = (timing0, cap)

propTim tim = (tim, 0)

getDelay :: (Timing,Capacitance) -> Delay
getDelay = arrivalTime . fst



interpTiming :: TimingLibrary lib => Interpretation lib (Timing,Capacitance)
interpTiming = Interp
    { defaultVal  = prop0
    , accumulator = addSig
    , propagator  = propagate
    }
  where
    propagate cell ss = outs' ++ ins'
      where
        no         = numOuts cell
        (outs,ins) = genericSplitAt no ss

        propagatePath oPin oCap (iPin, (iTim,_)) = maximumByArrival
          [ delay cell iPin oPin Rising  oCap iTim
          , delay cell iPin oPin Falling oCap iTim
          ]

        ins' = map (Just . propCap) (loadCaps cell)

        outs'
          | null ins = map (const (Just prop0)) outs
              -- Cells with no inputs have prop0 on the outputs.

          | otherwise = do
              (oPin, ~(_,oCap)) <- zip [0..] outs
              return
                $ Just
                $ propTim
                $ maximumByArrival
                $ map (propagatePath oPin oCap)
                $ zip [0..]
                $ ins

  -- XXX This (and depthInterp) assumes that there's a path between each
  --     input/output pair in a cell. In general, this might not be true.



analyzeTiming
    :: ( MonadLava lib m
       , TimingLibrary lib
       , PortStruct ps Signal t
       , PortStruct pd Delay  t
       )
    => m ps -> (pd, InterpDesignDB lib (Timing,Capacitance))

analyzeTiming mps
    | hasLoopDB True db = error "analyzeTiming: Combinational feedback loop"
    | otherwise         = pd_idb
  where
    pd_idb@(_,(db,_))
        = (unport . fmap getDelay *** id)
        $ interpret_ interpTiming []
        $ liftM port
        $ toLava
        $ mps



netCap
    :: WireTimingLibrary lib
    => [(Layer_, Position, Position)]
    -> Res lib Capacitance

netCap gs
    = wireCap lay
    $ Length
    $ round
    $ sum
    $ map rectiDistance
    $ rectiSpanning
    $ map (\(_,pos,_) -> pos)  -- XXX Ignoring length of guide
    $ gs
  where
    layss
        = sortBy (compare `on` length)
        $ group
        $ sort
        $ map (\(lay,_,_) -> lay) gs
      -- Sort layers by frequency.

    lay = case layss of
        (lay:_):_ -> lay
        _         -> 1    -- Empty guide list, so layer doesn't matter.
      -- Most common layer (XXX better to use top-most layer?)



analyzeTimingW
    :: forall lib ps t pd
     . ( WireTimingLibrary lib
       , PortStruct ps Signal t
       , PortStruct pd Delay  t
       )
    => Wired lib ps -> (pd, InterpDesignDB lib (Timing,Capacitance))

analyzeTimingW wps
    | hasLoopDB True db = error "analyzeTimingW: Combinational feedback loop"
    | otherwise         = pd_idb
  where
    (ps,(db,fp)) = runWired wps

    res = result :: Res lib Capacitance -> Capacitance

    wireLoads = Map.toList $
        fmap (propCap . res . netCap) $ mkGuideDB fp

    pd_idb
        = (unport . fmap getDelay *** id)
        $ interpret__ interpTiming wireLoads (port ps,db)