module Analysis.Timing.Library where



import Data.Function
import Data.List
import Foreign.C

import Data.Hardware.Internal
import Lava
import Wired.Model



data Slope = Rising | Falling
     deriving (Eq, Show)

data Timing = Timing
       { arrivalTime    :: Time
       , transitionTime :: TransitionTime
       }
     deriving (Eq, Show)

data LayerProps = LayerProps
       { layerWidth :: Width   -- Default width
       , capPerArea :: Double  -- Area capacitance [F/m²]
       , edgeCap    :: Double  -- Edge capacitance [F/m]
       }
     deriving (Eq, Show)
  -- XXX All wires are currently assumed to have default width.



class CellLibrary lib => TimingLibrary lib
  where
    loadCaps :: lib -> [Capacitance]

    delay
      :: lib
      -> InPin
      -> OutPin
      -> Slope        -- For output
      -> Capacitance  -- For output
      -> Timing       -- For input
      -> Timing       -- For output

class TimingLibrary lib => WireTimingLibrary lib
  where
    layerProps :: Layer_ -> Res lib LayerProps



maximumByArrival :: [Timing] -> Timing
maximumByArrival = maximumBy (compare `on` arrivalTime)



linearDelay
    :: Delay        -- Intrinsic delay
    -> Double       -- Transition time coefficient for output arrival
    -> Double       -- Transition time coefficient for output transition
    -> Resistance   -- Load capacitance coefficient for output arrival
    -> Resistance   -- Load capacitance coefficient for output transition
    -> Capacitance
    -> Timing
    -> Timing

linearDelay intrDel kAr kTr resAr resTr cap (Timing ar tr) = Timing
    (ar + intrDel + timeCast (kAr><tr) + resAr><cap)
    (kTr><tr + timeCast (resTr><cap))



tableDelay
    :: Table2D CInt TransitionTime Capacitance Time
    -> Table2D CInt TransitionTime Capacitance TransitionTime
    -> (Capacitance -> Timing -> Timing)
tableDelay arLut trLut cap (Timing ar tr) = Timing ar' tr'
  where
    ar' = bilinInterpolate arLut tr cap + ar
    tr' = bilinInterpolate trLut tr cap



mkTimingTable
    :: ( Fractional x
       , Fractional y
       , Fractional q
       )
    => CInt
    -> CInt
    -> (CInt -> CDouble)
    -> (CInt -> CDouble)
    -> (CInt -> CInt -> CDouble)
    -> Table2D CInt x y q

mkTimingTable xLen yLen xAxis yAxis vals = Table2D
    xLen
    yLen
    (realToFrac . xAxis)
    (realToFrac . yAxis)
    (\i1 i2 -> realToFrac (vals i1 i2))



wireCap
    :: forall lib . WireTimingLibrary lib
    => Layer_ -> Length -> Res lib Capacitance
wireCap lay len = R $ dcast
    $ cArea * l*w
    + (cEdge * 2 * (l+w))
  where
    LayerProps wit cArea cEdge = result (layerProps lay :: Res lib LayerProps)

    l = fromRational $ value len
    w = fromRational $ value wit
  -- Formula taken from the LEF/DEF 5.5 Language Reference.
  -- The 2*(l+w) part probably assumes a rectangular segment, but it seems to be
  -- an OK approximation for other shapes too (and w is usually very small).