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

module Analysis.STA
  ( TransitionTime
  , Timing (..)
  , STALibrary
  , Prop
  , analyzeTiming
  ) where



import Control.Arrow ((***))
import Control.Monad

import Data.Hardware
import Lava.Internal
import Analysis.STA.Library



data Prop = Prop
       { riseTiming  :: Timing
       , fallTiming  :: Timing
       , capacitance :: Capacitance
       }



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

addProp :: Prop -> Prop -> Prop
addProp (Prop timR1 timF1 cap1) (Prop timR2 timF2 cap2) =
    Prop (addTiming timR1 timR2) (addTiming timF1 timF2) (cap1+cap2)

timing0 = Timing 0 0

prop0 = Prop timing0 timing0 0

propCap cap = prop0 {capacitance = cap}

propRiseFall timR timF = prop0 {riseTiming = timR, fallTiming = timF}

getDelay :: Prop -> Delay
getDelay (Prop timR timF _) = maxArrival timR timF



interpTiming :: STALibrary lib => Interpretation lib Prop
interpTiming = Interp
    { defaultVal  = prop0
    , accumulator = addProp
    , propagator  = propagate
    }
  where
    propagate cell ss = outs' ++ ins'
      where
        no         = numOuts cell
        (outs,ins) = splitAt no ss

        propagatePath oPin oCap (iPin, Prop iTimR iTimF _) = (oTimR,oTimF)
          where
            oTimR = maximumByArrival
              [ delay cell iPin oPin Rising oCap iTimR
              , delay cell iPin oPin Rising oCap iTimF
              ]

            oTimF = maximumByArrival
              [ delay cell iPin oPin Falling oCap iTimF
              , delay cell iPin oPin Falling oCap iTimR
              ]

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

        outs' = do
          (oPin, Prop _ _ oCap) <- zip [0..] outs
          let (timRs,timFs) =
                unzip $ map (propagatePath oPin oCap) $ zip [icast no ..] ins
          return $ Just $ propRiseFall
            (maximumByArrival timRs)
            (maximumByArrival timFs)



analyzeTiming
    :: ( STALibrary lib
       , PortStruct ps Signal t
       , PortStruct pd Delay  t
       )
    => Lava lib ps -> (pd, InterpDesignDB lib Prop)

analyzeTiming = (unport . fmap getDelay *** id) . interpret_ interpTiming [] . liftM port
  -- *** Check for loop.
  -- *** Add wire loads.