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

-- |
-- Copyright  : Copyright (c) 2008, Emil Axelsson
-- License    : BSD3
-- Maintainer : Emil Axelsson <emax@chalmers.se>
-- Stability  : experimental
--
-- Wired interface to the Nangate45 library.
--
-- The data in this file is derived from Nangate's Open Cell Library,
-- and is subject to the license restrictions stated in
-- "Libs.Nangate45.LICENSE".
module Libs.Nangate45.Wired
  (
    -- * Library type
    Nangate45

    -- * Cells
  , and2_x1
  , and2_x2
  , and2_x4
  , buf_x1
  , buf_x16
  , buf_x2
  , buf_x32
  , buf_x4
  , buf_x8
  , fa_x1
  , fillcell_x1
  , fillcell_x16
  , fillcell_x2
  , fillcell_x32
  , fillcell_x4
  , fillcell_x8
  , ha_x1
  , inv_x1
  , inv_x16
  , inv_x2
  , inv_x32
  , inv_x4
  , inv_x8
  , logic0_x1
  , logic1_x1
  , nand2_x1
  , nand2_x2
  , nand2_x4
  , nor2_x1
  , nor2_x2
  , nor2_x4
  , or2_x1
  , or2_x2
  , or2_x4
  , xnor2_x1
  , xnor2_x2
  , xor2_x1
  , xor2_x2
  ) where

import Data.Hardware.Internal
import Wired.Model
import Wired
import Analysis.Timing.Library
import qualified Libs.Nangate45.Lava as Lava
import Libs.Nangate45.Lava (Nangate45)

instance WiredLibrary Nangate45
  where
    featureSize = R (Length 450)

    guideLength 1 = R (Length 0)
    guideLength 2 = R (Length 0)
    guideLength 3 = R (Length 0)
    guideLength 4 = R (Length 0)
    guideLength 5 = R (Length 0)
    guideLength 6 = R (Length 0)
    guideLength 7 = R (Length 0)
    guideLength 8 = R (Length 0)
    guideLength 9 = R (Length 0)
    guideLength 10 = R (Length 0)

    rowHeight = R (Length 14000)

instance WireTimingLibrary Nangate45
  where
    layerProps 1 = R $ LayerProps (Length 650) 7.71613e-5 3.86e-11
    layerProps 2 = R $ LayerProps (Length 700) 4.08957e-5 2.04e-11
    layerProps 3 = R $ LayerProps (Length 700) 2.7745e-5 1.39e-11
    layerProps 4 = R $ LayerProps (Length 1400) 2.07429e-5 1.04e-11
    layerProps 5 = R $ LayerProps (Length 1400) 1.3527e-5 6.7599999999999995e-12
    layerProps 6 = R $ LayerProps (Length 1400) 1.00359e-5 5.02e-12
    layerProps 7 = R $ LayerProps (Length 4000) 7.97709e-6 3.99e-12
    layerProps 8 = R $ LayerProps (Length 4000) 5.0391e-6 2.5199999999999998e-12
    layerProps 9 = R $ LayerProps (Length 8000) 3.68273e-6 1.84e-12
    layerProps 10 = R $ LayerProps (Length 8000) 2.21236e-6 1.11e-12

-- | Interface:
--
-- >    (A1, A2) -> ZN
--
-- Function:
--
-- >    ZN = and [A1, A2]
and2_x1 :: (Signal, Signal) -> Wired Nangate45 Signal
and2_x1 (a1, a2) = stacked $ do
    zn <- mkCell "AND2_X1" (Length 7600) (Length 14000) $ Lava.and2_x1 (a1, a2)
    translate (Length 625) (Length 4225) $ guide 1 (Length 0) a1
    translate (Length 4025) (Length 8425) $ guide 1 (Length 0) a2
    translate (Length 6325) (Length 2775) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    (A1, A2) -> ZN
--
-- Function:
--
-- >    ZN = and [A1, A2]
and2_x2 :: (Signal, Signal) -> Wired Nangate45 Signal
and2_x2 (a1, a2) = stacked $ do
    zn <- mkCell "AND2_X2" (Length 7600) (Length 14000) $ Lava.and2_x2 (a1, a2)
    translate (Length 625) (Length 4225) $ guide 1 (Length 0) a1
    translate (Length 4425) (Length 8075) $ guide 1 (Length 0) a2
    translate (Length 6325) (Length 3275) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    (A1, A2) -> ZN
--
-- Function:
--
-- >    ZN = and [A1, A2]
and2_x4 :: (Signal, Signal) -> Wired Nangate45 Signal
and2_x4 (a1, a2) = stacked $ do
    zn <- mkCell "AND2_X4" (Length 7600) (Length 14000) $ Lava.and2_x4 (a1, a2)
    translate (Length 625) (Length 7025) $ guide 1 (Length 0) a1
    translate (Length 4250) (Length 7375) $ guide 1 (Length 0) a2
    translate (Length 6250) (Length 8775) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    A -> Z
--
-- Function:
--
-- >    Z = A
buf_x1 :: Signal -> Wired Nangate45 Signal
buf_x1 a = stacked $ do
    z <- mkCell "BUF_X1" (Length 5700) (Length 14000) $ Lava.buf_x1 a
    translate (Length 2400) (Length 5975) $ guide 1 (Length 0) a
    translate (Length 4200) (Length 7375) $ guide 1 (Length 0) z
    return z

-- | Interface:
--
-- >    A -> Z
--
-- Function:
--
-- >    Z = A
buf_x16 :: Signal -> Wired Nangate45 Signal
buf_x16 a = stacked $ do
    z <- mkCell "BUF_X16" (Length 11400) (Length 14000) $ Lava.buf_x16 a
    translate (Length 2650) (Length 7375) $ guide 1 (Length 0) a
    translate (Length 5300) (Length 5975) $ guide 1 (Length 0) z
    return z

-- | Interface:
--
-- >    A -> Z
--
-- Function:
--
-- >    Z = A
buf_x2 :: Signal -> Wired Nangate45 Signal
buf_x2 a = stacked $ do
    z <- mkCell "BUF_X2" (Length 5700) (Length 14000) $ Lava.buf_x2 a
    translate (Length 2400) (Length 5975) $ guide 1 (Length 0) a
    translate (Length 4350) (Length 7375) $ guide 1 (Length 0) z
    return z

-- | Interface:
--
-- >    A -> Z
--
-- Function:
--
-- >    Z = A
buf_x32 :: Signal -> Wired Nangate45 Signal
buf_x32 a = stacked $ do
    z <- mkCell "BUF_X32" (Length 17100) (Length 14000) $ Lava.buf_x32 a
    translate (Length 2500) (Length 7375) $ guide 1 (Length 0) a
    translate (Length 12200) (Length 4100) $ guide 1 (Length 0) z
    return z

-- | Interface:
--
-- >    A -> Z
--
-- Function:
--
-- >    Z = A
buf_x4 :: Signal -> Wired Nangate45 Signal
buf_x4 a = stacked $ do
    z <- mkCell "BUF_X4" (Length 5700) (Length 14000) $ Lava.buf_x4 a
    translate (Length 2400) (Length 7375) $ guide 1 (Length 0) a
    translate (Length 4350) (Length 8775) $ guide 1 (Length 0) z
    return z

-- | Interface:
--
-- >    A -> Z
--
-- Function:
--
-- >    Z = A
buf_x8 :: Signal -> Wired Nangate45 Signal
buf_x8 a = stacked $ do
    z <- mkCell "BUF_X8" (Length 7600) (Length 14000) $ Lava.buf_x8 a
    translate (Length 2475) (Length 8425) $ guide 1 (Length 0) a
    translate (Length 4425) (Length 2250) $ guide 1 (Length 0) z
    return z

-- | Interface:
--
-- >    (CI, (A, B)) -> (S, CO)
--
-- Function:
--
-- >    S = or [and [or [and [A, B'], and [A', B]], CI'], and [(or [and [A, B'], and [A', B]])', CI]]
-- >    CO = or [and [A, B], and [A, CI], and [B, CI]]
fa_x1 :: (Signal, (Signal, Signal)) -> Wired Nangate45 (Signal, Signal)
fa_x1 (ci, (a, b)) = stacked $ do
    (s, co) <- mkCell "FA_X1" (Length 34200) (Length 14000) $ Lava.fa_x1 (ci, (a, b))
    translate (Length 19450) (Length 9325) $ guide 1 (Length 0) ci
    translate (Length 6300) (Length 6200) $ guide 1 (Length 0) a
    translate (Length 18375) (Length 4225) $ guide 1 (Length 0) b
    translate (Length 32850) (Length 2400) $ guide 1 (Length 0) s
    translate (Length 700) (Length 5575) $ guide 1 (Length 0) co
    return (s, co)

fillcell_x1 :: a -> Wired Nangate45 a
fillcell_x1 = mkCell "FILLCELL_X1" (Length 1900) (Length 14000) . Lava.fillcell_x1

fillcell_x16 :: a -> Wired Nangate45 a
fillcell_x16 = mkCell "FILLCELL_X16" (Length 30400) (Length 14000) . Lava.fillcell_x16

fillcell_x2 :: a -> Wired Nangate45 a
fillcell_x2 = mkCell "FILLCELL_X2" (Length 3800) (Length 14000) . Lava.fillcell_x2

fillcell_x32 :: a -> Wired Nangate45 a
fillcell_x32 = mkCell "FILLCELL_X32" (Length 60800) (Length 14000) . Lava.fillcell_x32

fillcell_x4 :: a -> Wired Nangate45 a
fillcell_x4 = mkCell "FILLCELL_X4" (Length 7600) (Length 14000) . Lava.fillcell_x4

fillcell_x8 :: a -> Wired Nangate45 a
fillcell_x8 = mkCell "FILLCELL_X8" (Length 15200) (Length 14000) . Lava.fillcell_x8

-- | Interface:
--
-- >    (A, B) -> (S, CO)
--
-- Function:
--
-- >    S = or [and [A, B'], and [A', B]]
-- >    CO = and [A, B]
ha_x1 :: (Signal, Signal) -> Wired Nangate45 (Signal, Signal)
ha_x1 (a, b) = stacked $ do
    (s, co) <- mkCell "HA_X1" (Length 20900) (Length 14000) $ Lava.ha_x1 (a, b)
    translate (Length 7175) (Length 4675) $ guide 1 (Length 0) a
    translate (Length 2575) (Length 6225) $ guide 1 (Length 0) b
    translate (Length 15725) (Length 4925) $ guide 1 (Length 0) s
    translate (Length 19925) (Length 6975) $ guide 1 (Length 0) co
    return (s, co)

-- | Interface:
--
-- >    A -> ZN
--
-- Function:
--
-- >    ZN = A'
inv_x1 :: Signal -> Wired Nangate45 Signal
inv_x1 a = stacked $ do
    zn <- mkCell "INV_X1" (Length 3800) (Length 14000) $ Lava.inv_x1 a
    translate (Length 625) (Length 7025) $ guide 1 (Length 0) a
    translate (Length 2300) (Length 5575) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    A -> ZN
--
-- Function:
--
-- >    ZN = A'
inv_x16 :: Signal -> Wired Nangate45 Signal
inv_x16 a = stacked $ do
    zn <- mkCell "INV_X16" (Length 9500) (Length 14000) $ Lava.inv_x16 a
    translate (Length 625) (Length 5925) $ guide 1 (Length 0) a
    translate (Length 6100) (Length 6625) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    A -> ZN
--
-- Function:
--
-- >    ZN = A'
inv_x2 :: Signal -> Wired Nangate45 Signal
inv_x2 a = stacked $ do
    zn <- mkCell "INV_X2" (Length 3800) (Length 14000) $ Lava.inv_x2 a
    translate (Length 625) (Length 5625) $ guide 1 (Length 0) a
    translate (Length 2300) (Length 4175) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    A -> ZN
--
-- Function:
--
-- >    ZN = A'
inv_x32 :: Signal -> Wired Nangate45 Signal
inv_x32 a = stacked $ do
    zn <- mkCell "INV_X32" (Length 15200) (Length 14000) $ Lava.inv_x32 a
    translate (Length 1275) (Length 5225) $ guide 1 (Length 0) a
    translate (Length 9900) (Length 4850) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    A -> ZN
--
-- Function:
--
-- >    ZN = A'
inv_x4 :: Signal -> Wired Nangate45 Signal
inv_x4 a = stacked $ do
    zn <- mkCell "INV_X4" (Length 3800) (Length 14000) $ Lava.inv_x4 a
    translate (Length 625) (Length 4225) $ guide 1 (Length 0) a
    translate (Length 2300) (Length 8425) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    A -> ZN
--
-- Function:
--
-- >    ZN = A'
inv_x8 :: Signal -> Wired Nangate45 Signal
inv_x8 a = stacked $ do
    zn <- mkCell "INV_X8" (Length 5700) (Length 14000) $ Lava.inv_x8 a
    translate (Length 1275) (Length 7375) $ guide 1 (Length 0) a
    translate (Length 2950) (Length 8775) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    Z
--
-- Function:
--
-- >    Z = 0
logic0_x1 :: Wired Nangate45 Signal
logic0_x1 = stacked $ do
    z <- mkCell "LOGIC0_X1" (Length 3800) (Length 14000) Lava.logic0_x1
    translate (Length 625) (Length 2825) $ guide 1 (Length 0) z
    return z

-- | Interface:
--
-- >    Z
--
-- Function:
--
-- >    Z = 1
logic1_x1 :: Wired Nangate45 Signal
logic1_x1 = stacked $ do
    z <- mkCell "LOGIC1_X1" (Length 3800) (Length 14000) Lava.logic1_x1
    translate (Length 625) (Length 8425) $ guide 1 (Length 0) z
    return z

-- | Interface:
--
-- >    (A1, A2) -> ZN
--
-- Function:
--
-- >    ZN = (and [A1, A2])'
nand2_x1 :: (Signal, Signal) -> Wired Nangate45 Signal
nand2_x1 (a1, a2) = stacked $ do
    zn <- mkCell "NAND2_X1" (Length 5700) (Length 14000) $ Lava.nand2_x1 (a1, a2)
    translate (Length 2525) (Length 4225) $ guide 1 (Length 0) a1
    translate (Length 625) (Length 7025) $ guide 1 (Length 0) a2
    translate (Length 4200) (Length 7025) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    (A1, A2) -> ZN
--
-- Function:
--
-- >    ZN = (and [A1, A2])'
nand2_x2 :: (Signal, Signal) -> Wired Nangate45 Signal
nand2_x2 (a1, a2) = stacked $ do
    zn <- mkCell "NAND2_X2" (Length 5700) (Length 14000) $ Lava.nand2_x2 (a1, a2)
    translate (Length 2525) (Length 4225) $ guide 1 (Length 0) a1
    translate (Length 625) (Length 7025) $ guide 1 (Length 0) a2
    translate (Length 3175) (Length 8375) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    (A1, A2) -> ZN
--
-- Function:
--
-- >    ZN = (and [A1, A2])'
nand2_x4 :: (Signal, Signal) -> Wired Nangate45 Signal
nand2_x4 (a1, a2) = stacked $ do
    zn <- mkCell "NAND2_X4" (Length 9500) (Length 14000) $ Lava.nand2_x4 (a1, a2)
    translate (Length 8225) (Length 7125) $ guide 1 (Length 0) a1
    translate (Length 6325) (Length 4175) $ guide 1 (Length 0) a2
    translate (Length 4425) (Length 8425) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    (A1, A2) -> ZN
--
-- Function:
--
-- >    ZN = (or [A1, A2])'
nor2_x1 :: (Signal, Signal) -> Wired Nangate45 Signal
nor2_x1 (a1, a2) = stacked $ do
    zn <- mkCell "NOR2_X1" (Length 5700) (Length 14000) $ Lava.nor2_x1 (a1, a2)
    translate (Length 4425) (Length 7025) $ guide 1 (Length 0) a1
    translate (Length 625) (Length 8425) $ guide 1 (Length 0) a2
    translate (Length 3050) (Length 9625) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    (A1, A2) -> ZN
--
-- Function:
--
-- >    ZN = (or [A1, A2])'
nor2_x2 :: (Signal, Signal) -> Wired Nangate45 Signal
nor2_x2 (a1, a2) = stacked $ do
    zn <- mkCell "NOR2_X2" (Length 5700) (Length 14000) $ Lava.nor2_x2 (a1, a2)
    translate (Length 4425) (Length 4225) $ guide 1 (Length 0) a1
    translate (Length 625) (Length 4225) $ guide 1 (Length 0) a2
    translate (Length 4200) (Length 8425) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    (A1, A2) -> ZN
--
-- Function:
--
-- >    ZN = (or [A1, A2])'
nor2_x4 :: (Signal, Signal) -> Wired Nangate45 Signal
nor2_x4 (a1, a2) = stacked $ do
    zn <- mkCell "NOR2_X4" (Length 9500) (Length 14000) $ Lava.nor2_x4 (a1, a2)
    translate (Length 4425) (Length 5625) $ guide 1 (Length 0) a1
    translate (Length 6325) (Length 8000) $ guide 1 (Length 0) a2
    translate (Length 3775) (Length 7625) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    (A1, A2) -> ZN
--
-- Function:
--
-- >    ZN = or [A1, A2]
or2_x1 :: (Signal, Signal) -> Wired Nangate45 Signal
or2_x1 (a1, a2) = stacked $ do
    zn <- mkCell "OR2_X1" (Length 7600) (Length 14000) $ Lava.or2_x1 (a1, a2)
    translate (Length 2800) (Length 8025) $ guide 1 (Length 0) a1
    translate (Length 4200) (Length 9425) $ guide 1 (Length 0) a2
    translate (Length 6500) (Length 6625) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    (A1, A2) -> ZN
--
-- Function:
--
-- >    ZN = or [A1, A2]
or2_x2 :: (Signal, Signal) -> Wired Nangate45 Signal
or2_x2 (a1, a2) = stacked $ do
    zn <- mkCell "OR2_X2" (Length 7600) (Length 14000) $ Lava.or2_x2 (a1, a2)
    translate (Length 2475) (Length 5975) $ guide 1 (Length 0) a1
    translate (Length 3375) (Length 8775) $ guide 1 (Length 0) a2
    translate (Length 6325) (Length 2725) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    (A1, A2) -> ZN
--
-- Function:
--
-- >    ZN = or [A1, A2]
or2_x4 :: (Signal, Signal) -> Wired Nangate45 Signal
or2_x4 (a1, a2) = stacked $ do
    zn <- mkCell "OR2_X4" (Length 7600) (Length 14000) $ Lava.or2_x4 (a1, a2)
    translate (Length 2475) (Length 11575) $ guide 1 (Length 0) a1
    translate (Length 3875) (Length 8775) $ guide 1 (Length 0) a2
    translate (Length 6325) (Length 2775) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    (A, B) -> ZN
--
-- Function:
--
-- >    ZN = (or [and [A, B'], and [A', B]])'
xnor2_x1 :: (Signal, Signal) -> Wired Nangate45 Signal
xnor2_x1 (a, b) = stacked $ do
    zn <- mkCell "XNOR2_X1" (Length 11400) (Length 14000) $ Lava.xnor2_x1 (a, b)
    translate (Length 2175) (Length 4575) $ guide 1 (Length 0) a
    translate (Length 5425) (Length 9800) $ guide 1 (Length 0) b
    translate (Length 8575) (Length 10450) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    (A, B) -> ZN
--
-- Function:
--
-- >    ZN = (or [and [A, B'], and [A', B]])'
xnor2_x2 :: (Signal, Signal) -> Wired Nangate45 Signal
xnor2_x2 (a, b) = stacked $ do
    zn <- mkCell "XNOR2_X2" (Length 11400) (Length 14000) $ Lava.xnor2_x2 (a, b)
    translate (Length 3525) (Length 5725) $ guide 1 (Length 0) a
    translate (Length 7875) (Length 8375) $ guide 1 (Length 0) b
    translate (Length 8650) (Length 6325) $ guide 1 (Length 0) zn
    return zn

-- | Interface:
--
-- >    (A, B) -> Z
--
-- Function:
--
-- >    Z = or [and [A, B'], and [A', B]]
xor2_x1 :: (Signal, Signal) -> Wired Nangate45 Signal
xor2_x1 (a, b) = stacked $ do
    z <- mkCell "XOR2_X1" (Length 11400) (Length 14000) $ Lava.xor2_x1 (a, b)
    translate (Length 1900) (Length 7600) $ guide 1 (Length 0) a
    translate (Length 8450) (Length 6625) $ guide 1 (Length 0) b
    translate (Length 6575) (Length 3825) $ guide 1 (Length 0) z
    return z

-- | Interface:
--
-- >    (A, B) -> Z
--
-- Function:
--
-- >    Z = or [and [A, B'], and [A', B]]
xor2_x2 :: (Signal, Signal) -> Wired Nangate45 Signal
xor2_x2 (a, b) = stacked $ do
    z <- mkCell "XOR2_X2" (Length 11400) (Length 14000) $ Lava.xor2_x2 (a, b)
    translate (Length 5425) (Length 8450) $ guide 1 (Length 0) a
    translate (Length 8225) (Length 6500) $ guide 1 (Length 0) b
    translate (Length 8750) (Length 8400) $ guide 1 (Length 0) z
    return z