-----------------------------------------------------------------------------
-- |
-- Module      :  ForSyDe.Deep.Backend.VHDL.TestBench
-- Copyright   :  (c) ES Group, KTH/ICT/ES 2007-2013
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  forsyde-dev@ict.kth.se
-- Stability   :  experimental
-- Portability :  portable
--
-- Functions used to generate a VHDL test bech.
--
-----------------------------------------------------------------------------
module ForSyDe.Deep.Backend.VHDL.TestBench 
 (writeVHDLTestBench,
  parseTestBenchOut) where


import ForSyDe.Deep.Backend.VHDL.Constants
import ForSyDe.Deep.Backend.VHDL.AST
import ForSyDe.Deep.Backend.VHDL.Translate
import ForSyDe.Deep.Backend.VHDL.Traverse.VHDLM
import ForSyDe.Deep.Backend.VHDL.Generate
import ForSyDe.Deep.Backend.VHDL.FileIO

import ForSyDe.Deep.Ids
import ForSyDe.Deep.System.SysDef

import qualified Language.Haskell.TH as TH (Exp)
import Control.Monad.State
import Data.List (transpose)
import System.Directory
import System.FilePath


-- | Parse the output of the testbench (a tab separated files)
--   into strings denoting the individual output signals
parseTestBenchOut :: String -- ^ String containing the complete output file
                  -> VHDLM [[String]] -- ^ output signal values in form 
                                      --   of strings
parseTestBenchOut str = do
     outN <- gets (length.oIface.globalSysDef.global)
     case tabSeparatedRows  of
       [] -> return (replicate outN [])
       _  -> return $ transpose tabSeparatedRows
   where tabSeparatedRows = ((map (unintersperse '\t')).lines) str  
         unintersperse  _ [] = [] 
         unintersperse  e (c:cs) 
           -- the null check makes unintersperse imposible to define with foldr
           -- or unfoldr
           | c == e = if null cs then [[],[]]  
                                 else [] : unintersperse e cs
           | otherwise = let rest = unintersperse e cs in
                         case rest of
                              [] -> [[c]]
                              (a:as) -> (c:a):as

-- | write a test bench, using a clock cycle of 10 ns
--   (Note: the initial and final CWD will be / )
writeVHDLTestBench :: Maybe Int -- ^ Number of cycles to simulate
                                --   if 'Nothing' the number will be determined
                                --   by the length of the input stimulti.
                                --   Useful when the system to simulate doesn't
                                --   have inputs or the inputs provided are 
                                --   infinite
                -> [[TH.Exp]] -- ^ Input stimuli (one list per signal)
                -> VHDLM Int -- ^ Number of cycles simulated
writeVHDLTestBench mCycles stimuli = do
 sys <- gets (globalSysDef.global)
 let sysId = sid sys
     cxt = genVHDLTestBenchContext sysId
     ent = genVHDLTestBenchEntity sysId
 (arch, cycles) <- genVHDLTestBenchArch mCycles stimuli
 let design = DesignFile cxt [LUEntity ent, LUArch arch]
     tbdir = sysId </> "vhdl" </> "test"
     tbpath = tbdir </> (sysId ++ "_tb.vhd")
 liftIO $ createDirectoryIfMissing True tbdir
 liftIO $ writeDesignFile design tbpath
 return cycles

-- | Generate the Context Clause
genVHDLTestBenchContext :: SysId -- ^ Main system Id
                        -> [ContextItem]
genVHDLTestBenchContext id = commonContextClause ++
  [Library libId,
   Use     $ NSelected (NSimple libId :.: SSimple typesId)  :.: All,
   Use     $ NSelected (NSimple stdId :.: SSimple textioId) :.: All]
 where libId = unsafeVHDLBasicId (id ++ "_lib")
  
-- | Generates an empty entity fot the testbench
genVHDLTestBenchEntity :: SysId -- ^ Main system Id 
                       -> EntityDec
genVHDLTestBenchEntity id = EntityDec (unsafeVHDLBasicId (id ++ "_tb")) []

--------------------------
-- Test Bench Architecture
--------------------------


-- | generate the architecture
genVHDLTestBenchArch :: Maybe Int -- ^ Maximum number of cycles
                     -> [[TH.Exp]] -- ^ Input stimuli 
                     -> VHDLM (ArchBody, Int) -- ^ Number of cycles simulated
genVHDLTestBenchArch mCycles stimuli = do
 sys <- gets (globalSysDef.global)
 let sysId    = sid sys
     iface    = iIface sys
     oface    = oIface sys
     l        = logic sys
     iIds     = map fst iface
     iVHDLIds = map unsafeVHDLExtId iIds
     oIds     = map fst oface
 -- Get the signal declarations for the input signals
 iDecs <- mapM 
     (\(pId, t) -> transVHDLName2SigDec (unsafeVHDLExtId pId) t Nothing) iface
 let finalIDecs = iDecs ++ 
                  [SigDec clockId std_logicTM (Just $ PrimLit "'0'"),
                   SigDec resetId std_logicTM (Just $ PrimLit "'0'")]
 -- Get the component instantiation and the signal declarations for the output
 -- signals
 (mIns, outDecs) <- 
     transSysIns2CompIns l
                         (unsafeVHDLBasicId "totest") 
                         iVHDLIds 
                         (map (\(id, t) -> (unsafeVHDLExtId id,t)) oface)
                         sysId
                         iIds
                         oIds
 -- Generate the signal assignments
 (stimuliAssigns, cycles) <- genStimuliAssigns mCycles stimuli iVHDLIds
 -- Add an assignment to turn off the reset signal after 3 ns
 -- (everything lower than 5 ns should work)
 let finalAssigns = 
      (NSimple resetId :<==: 
        ConWforms [] 
                  (Wform [WformElem (PrimLit "'1'") (Just $ PrimLit "3 ns")])
                  Nothing) : stimuliAssigns
 -- Get the two processes (clock and output)
     clkProc = genClkProc
     outputProc = genOutputProc (map unsafeVHDLExtId oIds)
 -- return the architecture
 return $ (ArchBody 
            (unsafeVHDLBasicId "test") 
            (NSimple $ unsafeVHDLBasicId (sysId ++ "_tb"))
            (map BDISD (finalIDecs ++ outDecs))
            ( maybe [] (\s -> [CSISm s]) mIns ++ 
             ( (CSPSm clkProc) : (CSPSm outputProc) : (map CSSASm finalAssigns) ) ),
            cycles)

-- | generate the assignments for the input stimuli
genStimuliAssigns :: Maybe Int -- ^ Maximum number of cycles
                  -> [[TH.Exp]] -- ^ Input stimuli 
                  -> [VHDLId] -- ^ Input signal ids
                  -> VHDLM ([ConSigAssignSm], Int) -- ^ (Assignments,
                                                   --    number of cycles 
                                                   --    simulated)
-- if the number of input signas is zero
genStimuliAssigns mCycles [] _ = return ([], maybe 0 id mCycles)

-- if the nu,ber of input signals is /= zero
genStimuliAssigns mCycles stimuli signals = do
  let genWformElem time thExp  = 
         do vExp <- transExp2VHDL thExp
            return (WformElem vExp (Just $ PrimLit (show time ++ " ns")))
  wformElems <- mapM (zipWithM  genWformElem ([0,10..] :: [Int])) stimuli
  let (normWformElems, cycles) = normalize maxCycles wformElems
  if cycles == 0 
   then return ([],0)
   else return 
          (zipWith 
                (\s elems -> NSimple s :<==: ConWforms [] (Wform elems) Nothing)
                signals 
                normWformElems,
           cycles)
 where maxCycles = maybe (-1) id mCycles 
       -- FIXME: this is not efficient at all
       -- Normalize a matrix. Make sure that all the rows in a matrix have the
       -- same length, setting a maximum row length (0 establishes no limit)
       normalize :: Int     -- ^ maximum row-length to process 
                 -> [[a]]   -- ^ input matrix
                 -> ([[a]], Int) -- ^ (output matrix, maximum row length)
       normalize max xss
         | any null xss || max == 0 = (replicate l [], 0)
         | otherwise = let (transres, acum) = normalize' max (transpose xss)
                       in (transpose transres, acum)
        where l = length xss
              normalize' max (xs:xss)
                 | length xs == l && max /= 0 =
                     let (nextlist, nextacum) = normalize' (max-1)  xss
                     in (xs : nextlist, nextacum+1)
              normalize' _ _ = ([], 0)

-- | generates a clock process with a period of 10ns
genClkProc :: ProcSm
genClkProc = ProcSm (unsafeVHDLBasicId "clkproc") [] sms
 where sms = -- wait for 5 ns -- (half a cycle)
             [WaitFor $ PrimLit "5 ns",
              -- clk <= not clk;
              NSimple clockId `SigAssign` 
                 Wform [WformElem (Not (PrimName $ NSimple clockId)) Nothing]]

-- | generate the output process
genOutputProc :: [VHDLId] -- ^ output signals
              -> ProcSm  
genOutputProc outs = 
  ProcSm (unsafeVHDLBasicId "writeoutput") 
         [clockId]
         [IfSm clkPred (writeOuts outs) [] Nothing]
 where clkPred = PrimName (NAttribute $ AttribName (NSimple clockId) 
                                                   eventId
                                                   Nothing          ) `And` 
                 (PrimName (NSimple clockId) :=: PrimLit "'1'")
       writeOuts []  = []
       writeOuts [i] = [writeOut i (PrimLit "LF")]
       writeOuts (i:is) = writeOut i (PrimLit "HT") : writeOuts is
       writeOut outSig suffix = 
         genExprProcCall2 writeId 
                          (PrimName $ NSimple outputId)
                          (genExprFCall1 showId (PrimName $ NSimple outSig) :&: 
                           suffix)