module Export.DEF
  ( exportDEF
  ) where



import qualified Data.Map as Map
import qualified Data.Foldable as Fold
import Data.List
import Data.String

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



type ComponentDEF =
       ( CellId
       , Name
       , Position
       , Orientation
       )

type NetDEF =
       ( Name
           -- Net identifier. The actual number is only important for connecting
           -- exports.
       , [(CellId, Name)]
           -- Like Signal type, but referring to cell pin by name and may also
           -- refer to inputs.
       , [(Layer_, Position, Position)]
           -- Guides
       , [Tag]
           -- Labels
       )

type ExportDEF =
       ( Name  -- Identifier. Can be anything as long as it's unique.
       , Name  -- Net name
       )



showPos :: Position -> ShowS
showPos (x,y) = unwordS
    [ "("
    , shows x'
    , shows y'
    , ")"
    ]
  where
    x' = round (value x / 1e-9) :: Integer
    y' = round (value y / 1e-9) :: Integer

showOri :: IsString str => Orientation -> str
showOri (flipped,dir) = fromString $
    (if flipped then "F" else "") ++ showDir dir
  where
    showDir Rightwards = "E"
    showDir Leftwards  = "W"
    showDir Upwards    = "N"
    showDir Downwards  = "S"



top title (x,y) =
    "VERSION 5.5 ;                                \n\
    \NAMESCASESENSITIVE ON ;                      \n\
    \DIVIDERCHAR \"/\" ;                          \n\
    \BUSBITCHARS  \"[]\" ;                        \n\
    \DESIGN " .+ title .+ " ;                     \n\
    \DIEAREA ( 0 0 ) " .+ showPos topRight .+ " ; \n\
    \UNITS DISTANCE MICRONS 1000 ;                \n\
    \                                             \n"
  where
    topRight = (addLen x (x`divLen`5), addLen y (y`divLen`5))
      -- Add 20%.
      -- XXX Round to grid?



renderDEF
    :: [ComponentDEF]
    -> [NetDEF]
    -> [ExportDEF]  -- Input exports
    -> [ExportDEF]  -- Output exports
    -> [ExportDEF]  -- In/out exports
    -> Position -> Name -> IO ()

renderDEF comps nets iExps oExps ioExps topRight title
     = writeFile (title ++ ".def")
     $ top (showString title) topRight
    .+ wrapper "COMPONENTS" (length comps) (map renderComp comps)
    .+ wrapper "NETS"       (length nets)  (map renderNet nets)
    .+ wrapper "PINS"       lExps          renderExports
     $ "END DESIGN\n"
  where
    wrapper kind n lines = unlineS
       $ [kind .+ " " .+ shows n .+ " ;"]
      ++ lines
      ++ ["END " .+ kind .+ "\n\n"]

    renderComp (nid, nm, pos, ori) = unwordS
      [ "- CELL" .+ shows (toInt nid)
      , showString nm
      , "+ PLACED"
      , showPos pos
      , showOri ori .+ " ;"
      ]

    renderNet (nm,ps,gs,ts) = unwordS
         $ ["- " .+ showString nm]
        ++ map renderPin ps
        -- XXX Temporarily ignoring guides ++ map renderGuide gs
        ++ [";"]
        ++ tags
      where
        tags = if null ts then [] else "#" : map showString ts

    renderPin (nid,cnm) = unwordS
      [ "( CELL" .+ shows (toInt nid), showString cnm, ")" ]

    renderGuide (lay,pos1,pos2)
       = "+ ROUTED M"
      .+ shows (toInt lay)
      .+ " " .+ showPos pos1
      .+ if pos1==pos2
            then ""
            else " " .+ showPos pos2

    lExps = length (iExps++oExps++ioExps)

    iExps'  = zip iExps  (repeat "INPUT")
    oExps'  = zip oExps  (repeat "OUTPUT")
    ioExps' = zip ioExps (repeat "INOUT")

    renderExports = map renderExport $ zip [0..] (iExps'++oExps'++ioExps')

    renderExport (p,((pinName,netName),dir)) = unwordS
      [ "- " .+ showString pinName
      , "+ NET " .+ showString netName
      , "+ DIRECTION"
      , dir
      , ";"
      ]



exportDEF
    :: (CellLibrary lib, Port p Signal)
    => Name -> Wired lib p -> IO ()
exportDEF title wp =
    renderDEF compsDEF netsDEF iExpsDEF oExpsDEF ioExpsDEF topRight title
  where
    (p,(db,fp))    = runWired wp
    (afp,topRight) = absolutize fp
    cellType       = fst . (cellDB db Map.!)

    netName (PrimInpSig iid)  = "inp" ++ show (toInt iid)
    netName (CellSig cid pin) =
        "sig" ++ show (toInt cid) ++ "-" ++ show (toInt pin)

    compsDEF = [ (cid,nm,pos,ori) | (pos, Box _ ori nm cid) <- afp ]

    netsDEF = do
        (driver,loads) <- Map.toList $ fanoutDB db
        let net = mkNet driver loads
            gs  = totalLookup driver (mkGuideDB fp)
            ts  = totalLookup driver (sigTagDB db)
        return (netName driver, net ,gs, ts)
      where
        mkNet driver loads
             = driverPin
            ++ [ (cid, inPinName (cellType cid) pin) | (cid,pin) <- loads ]
          where
            driverPin = case driver of
                PrimInpSig _    -> []
                CellSig cid pin -> [(cid, outPinName (cellType cid) pin)]

    filterInps is = [i | i <- is, not $ null $ totalLookup i $ fanoutDB db]
      -- Filter out inputs that are not connected to anything,

    isInput (PrimInpSig _) = True
    isInput _              = False

    (ios_,os) = partition isInput $ Fold.toList (port p)
    ios       = filterInps ios_
    is        = filterInps (primIns db) \\ ios

    expName pre n sig
      = concat
      $ intersperse "_"
      $ ((pre++show n):)
      $ totalLookup sig
      $ sigTagDB db

    listExports typ ss =
      [(expName typ n s, netName s) | (n,s) <- [0..] `zip` ss]

    iExpsDEF  = listExports "in"    is
    oExpsDEF  = listExports "out"   os
    ioExpsDEF = listExports "inout" ios