{-# OPTIONS_GHC -XTypeSynonymInstances  #-}

-------------------------------------------------------------------------------
--  $Id: Instance.hs#1 2009/10/01 10:31:09 REDMOND\\satnams $
-------------------------------------------------------------------------------

module Lava.Instance
where 
import Lava.Classes
import Lava.Primitives
import Lava.TypeExpr

import Control.Monad.State
import Data.Array.IArray
import Data.Array.IO

type Wire = Int

data WireExpr
  = Only Wire
  | Bus [WireExpr]
    deriving (Eq, Show)

data Port = InputPort String TypeExpr WireExpr
          | OutputPort String TypeExpr WireExpr
            deriving (Eq, Show)

data InstanceTree
  = Inst Instance
  | LeftOf [InstanceTree] [InstanceTree]
  | Below [InstanceTree] [InstanceTree]


type Instance = (Int, Primitive, [Int], [Int])

type DriverList = [(Int, (Int, Int))]
--type DriverArray = Array Int [(Int, Int)]
type IODriverArray = IOArray Int [(Int, Int)]


type LavaState = (Int, Int, [Port], [InstanceTree], DriverList)

type Out = State LavaState

-------------------------------------------------------------------------------

instance GroundAndPower Wire where
  zero = 0
  one = 1

instance Combinational Out Wire where
  gnd = gnd_nl
  vcc = vcc_nl
  lut1 f = unary_gate (Gate Lut1 "lut1" Unplaced (1,1) (UnaryGate f))
  lut2 f = binary_gate (Gate Lut2 "lut2" Unplaced (1,1) (BinaryGate f))
  lut3 f = three_input_gate (Gate Lut3 "lut3" Unplaced (1,1) (Gate3 f))
  lut4 f = four_input_gate (Gate Lut4 "lut4" Unplaced (1,1) (Gate4 f))

-------------------------------------------------------------------------------

gnd_nl :: Out Wire
gnd_nl = driver_gate (Gate (LeafGate [] ["g"]) "gnd" Unplaced (1,1) (DriverBehaviour False))

-------------------------------------------------------------------------------

vcc_nl :: Out Wire
vcc_nl = driver_gate (Gate (LeafGate [] ["p"]) "vcc" Unplaced (1,1) (DriverBehaviour True))

-------------------------------------------------------------------------------

newNetNumber :: Out Int
newNetNumber 
  = do (netCount, instCount, ports, instances, dl) <- get
       put (netCount+1, instCount, ports, instances, dl)
       return netCount

-------------------------------------------------------------------------------

newInstanceNumber :: Out Int
newInstanceNumber 
  = do (netCount, instCount, ports, instances, dl) <- get
       put (netCount, instCount+1, ports, instances, dl)
       return instCount

-------------------------------------------------------------------------------

addInstance :: Instance -> LavaState -> LavaState
addInstance newInstance (nc, ic, ports, instances, dl)
  = (nc, ic, ports, (Inst newInstance):instances, dl)

-------------------------------------------------------------------------------

addInstanceTree :: InstanceTree -> LavaState -> LavaState
addInstanceTree newInstance (nc, ic, ports, instances, dl)
  = (nc, ic, ports, newInstance:instances, dl)

-------------------------------------------------------------------------------

addDrivers :: [(Int, (Int, Int))] -> LavaState -> LavaState
addDrivers newDrivers (nc, ic, ports, instances, dl)
  = (nc, ic, ports, instances, insertDrivers newDrivers dl)

-------------------------------------------------------------------------------

insertDrivers :: [(Int, (Int, Int))] -> DriverList -> DriverList
insertDrivers drivers driverList = drivers ++ driverList

-------------------------------------------------------------------------------

insertDriver :: (Int, (Int, Int)) -> DriverList -> DriverList
insertDriver dd@(driver, (inst, port)) driverList = dd:driverList

-------------------------------------------------------------------------------

driver_gate :: Primitive -> Out Wire
driver_gate primitive
  = do inst <- newInstanceNumber
       outputNet <- newNetNumber
       modify (addInstance (inst, primitive, [], [outputNet]))
       return outputNet
   
-------------------------------------------------------------------------------

unary_gate :: Primitive -> Wire -> Out Wire
unary_gate primitive i
  = do inst <- newInstanceNumber
       outputNet <- newNetNumber
       modify (addInstance (inst, primitive, [i], [outputNet]))
       modify (addDrivers [(i, (inst, 0))])
       return outputNet
   
-------------------------------------------------------------------------------

binary_gate :: Primitive -> (Wire, Wire) -> Out Wire
binary_gate primitive (i0, i1)
  = do inst <- newInstanceNumber
       outputNet <- newNetNumber
       modify (addInstance (inst, primitive, [i0, i1], [outputNet]))
       modify (addDrivers [(i0, (inst, 0)), (i1, (inst, 1))])
       return outputNet
   
-------------------------------------------------------------------------------

three_input_gate :: Primitive -> (Wire, Wire, Wire) -> Out Wire
three_input_gate primitive (i0, i1, i2)
  = do inst <- newInstanceNumber
       outputNet <- newNetNumber
       modify (addInstance (inst, primitive, [i0, i1, i2], [outputNet]))
       modify (addDrivers [(i0, (inst, 0)), (i1, (inst, 1)), 
                           (i2, (inst, 2))])
       return outputNet
   
-------------------------------------------------------------------------------

four_input_gate :: Primitive -> (Wire, Wire, Wire, Wire) -> 
                   Out Wire
four_input_gate primitive (i0, i1, i2, i3)
  = do inst <- newInstanceNumber
       outputNet <- newNetNumber
       modify (addInstance (inst, primitive, [i0, i1, i2, i3], [outputNet]))
       modify (addDrivers [(i0, (inst, 0)), (i1, (inst, 1)), 
                           (i2, (inst, 2)), (i3, (inst, 3))])
       return outputNet
   
-------------------------------------------------------------------------------

input_bit :: String -> Out Wire
input_bit name
  = do n <- newNetNumber
       (netCount, instCount, ports, instances, dl) <- get
       put (netCount, instCount, (newPort n):ports, instances, dl)
       return n
    where
    newPort n = InputPort name WireType (Only n)

-------------------------------------------------------------------------------

output_bit :: String -> Wire -> Out ()
output_bit name outputNet
  = do (netCount, instCount, ports, instances, dl) <- get
       put (netCount, instCount, newPort:ports, instances, dl)
       modify (addDrivers [(outputNet, (-1, -1))])
    where
    newPort = OutputPort name WireType (Only outputNet)

-------------------------------------------------------------------------------

input_vec :: String -> Int -> Dir -> Int -> Out [Wire]
input_vec name low dir high
  = do -- Generate enough nets to carry the bit-vector.
       ns <- sequence (replicate (length idxs) newNetNumber)
       (netCount, instCount, ports, instances, dl) <- get
       put (netCount, instCount, (newPort ns):ports, instances, dl)
       return ns
    where
    newPort new = InputPort name (BitVec low dir high) (Bus (map Only new))
    idxs = bitvec_indices low dir high

-------------------------------------------------------------------------------

output_vec :: String -> [Wire] -> Int -> Dir -> Int -> Out ()
output_vec name outputNets low dir high
  = do (netCount, instCount, ports, instances, dl) <- get
       put (netCount, instCount, newPort:ports, instances, dl)
       modify (addDrivers [(onet, (-1, -1)) | onet <- outputNets])
    where
    newPort = OutputPort name (BitVec low dir high) (Bus (map Only outputNets))

-------------------------------------------------------------------------------

bitvec_indices :: Int -> Dir -> Int -> [Int]
bitvec_indices low To high = [low..high]
bitvec_indices low Downto high = [high..low]

-------------------------------------------------------------------------------