{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Peripherals.Ram(
  initRamFromFile,
  RamAddr,
  Ram,
  RamLine,
  bytesInRam,
  read,
  write) where

import Clash.Prelude hiding (read)
import qualified Prelude as P
import qualified Data.ByteString.Lazy as BL
import Data.Binary.Get
import Data.Int (Int32)
import qualified Clash.Sized.Vector as Vec
import Types(Addr,
             Byte, HalfWord, FullWord, DoubleWord, QuadWord)
import BusTypes(
    BusError(..),
    TransactionSize(..),
    Request(..),
    BusResponse(..),
    BusVal(..),
    ReadResponse(..),
    WriteResponse(..)
  )

-- vector depth has to be known statically at compile time
#ifndef _RAM_DEPTH
#define _RAM_DEPTH 1024
#endif

-- TODO : replace Unsigned 32 with BusVal types later...
type Ram = Vec _RAM_DEPTH (Unsigned 32)
type RamAddr = Unsigned (CLog 2 _RAM_DEPTH)
type RamLine = Unsigned 32
bytesInRam :: Addr
bytesInRam = _RAM_DEPTH * 4

read :: TransactionSize -> RamAddr -> Ram -> BusVal
read SizeByte addr ram = BusByte $ unpack byte
  where
    word = ram !! addr
    byteOffset :: BitVector 2
    byteOffset = slice d1 d0 addr
    byte = case byteOffset of
      0b00 -> slice d31 d24 word
      0b01 -> slice d23 d16 word
      0b10 -> slice d15 d8 word
      0b11 -> slice d7 d0 word

read SizeHalfWord addr ram = BusHalfWord $ unpack halfWord
  where
    word = ram !! addr
    halfWordOffset :: Unsigned 1
    halfWordOffset = unpack $ slice d0 d0 addr
    halfWord = case halfWordOffset of
      0b0 -> slice d31 d16 word
      0b1 -> slice d15 d0 word

read SizeFullWord addr ram = BusFullWord fullWord
  where
    fullWord = ram !! addr

read SizeDoubleWord addr ram = BusDoubleWord doubleWord
  where
    doubleWord = bitCoerce $ bitCoerce word0 ++# bitCoerce word1
    word0 = readFullWordHelper ram addr
    word1 = readFullWordHelper ram (addr + 1)

read SizeQuadWord addr ram = BusQuadWord quadWord
  where
    quadWord = bitCoerce $ bitCoerce dword0 ++# bitCoerce dword1
    dword0 = readDoubleWordHelper ram addr
    dword1 = readDoubleWordHelper ram (addr + 2)

readFullWordHelper :: Ram -> RamAddr -> FullWord
readFullWordHelper ram addr = ram !! addr

readDoubleWordHelper :: Ram -> RamAddr -> DoubleWord
readDoubleWordHelper ram addr = bitCoerce $ bitCoerce word0 ++# bitCoerce word1
  where
    word0 = readFullWordHelper ram addr
    word1 = readFullWordHelper ram (addr + 1)

write :: Ram -> RamAddr -> RamLine -> Ram
write ram addr value = replace addr value ram

initRamFromFile :: FilePath -> IO (Maybe Ram)
initRamFromFile filePath =
    let
      initRam = Vec.replicate (SNat :: SNat _RAM_DEPTH) 0
    in
      do
      bs <- readFileIntoByteString filePath
      let ints = getInts bs
      pure $ populateVectorFromInt32 ints initRam

readFileIntoByteString :: FilePath -> IO BL.ByteString
readFileIntoByteString filePath = BL.readFile filePath

-- Define a function to read a ByteString and convert to [Int32]
getInts :: BL.ByteString -> [Int32]
getInts bs = runGet listOfInts bs
  where
    listOfInts = do
      empty <- isEmpty
      if empty
        then pure []
      else do
        i <- getInt32le    -- Parse a single Int32 from the stream
        rest <- listOfInts -- Recursively parse the rest
        pure (i : rest)

-- Adjusts the length of a list of integers by either truncating or padding with zeros
populateVectorFromInt32 ::
    KnownNat n =>
    [Int32] ->
    Vec n (Unsigned 32) ->
    Maybe (Vec n (Unsigned 32))
populateVectorFromInt32 ls v = Vec.fromList adjustedLs
  where
    vecLen = length v
    adjustedLs = fromIntegral <$> adjustLength vecLen ls
    adjustLength :: Int -> [Int32] -> [Int32]
    adjustLength n xs = P.take n (xs P.++ P.repeat 0)