{-# LANGUAGE GADTs #-}
{-# LANGUAGE Unsafe #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# OPTIONS_GHC -fno-cpr-anal #-}
module Clash.Explicit.BlockRam.File
(
blockRamFile
, blockRamFilePow2
, blockRamFile#
, initMem
)
where
import Data.Char (digitToInt)
import Data.Maybe (isJust, listToMaybe)
import qualified Data.Sequence as Seq
import GHC.Stack (HasCallStack, withFrozenCallStack)
import GHC.TypeLits (KnownNat)
import Numeric (readInt)
import System.IO.Unsafe (unsafePerformIO)
import Clash.Promoted.Nat (SNat (..), pow2SNat)
import Clash.Sized.BitVector (BitVector)
import Clash.Signal.Internal
(Clock(..), Signal (..), Enable, KnownDomain, fromEnable, (.&&.))
import Clash.Signal.Bundle (unbundle)
import Clash.Sized.Unsigned (Unsigned)
import Clash.XException (errorX, maybeIsX, seqX, fromJustX)
blockRamFilePow2
:: forall dom n m
. (KnownDomain dom, KnownNat m, KnownNat n, HasCallStack)
=> Clock dom
-> Enable dom
-> FilePath
-> Signal dom (Unsigned n)
-> Signal dom (Maybe (Unsigned n, BitVector m))
-> Signal dom (BitVector m)
blockRamFilePow2 :: Clock dom
-> Enable dom
-> FilePath
-> Signal dom (Unsigned n)
-> Signal dom (Maybe (Unsigned n, BitVector m))
-> Signal dom (BitVector m)
blockRamFilePow2 = \clk :: Clock dom
clk en :: Enable dom
en file :: FilePath
file rd :: Signal dom (Unsigned n)
rd wrM :: Signal dom (Maybe (Unsigned n, BitVector m))
wrM -> (HasCallStack => Signal dom (BitVector m))
-> Signal dom (BitVector m)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack
(Clock dom
-> Enable dom
-> SNat (2 ^ n)
-> FilePath
-> Signal dom (Unsigned n)
-> Signal dom (Maybe (Unsigned n, BitVector m))
-> Signal dom (BitVector m)
forall (dom :: Domain) (m :: Nat) addr (n :: Nat).
(KnownDomain dom, KnownNat m, Enum addr, HasCallStack) =>
Clock dom
-> Enable dom
-> SNat n
-> FilePath
-> Signal dom addr
-> Signal dom (Maybe (addr, BitVector m))
-> Signal dom (BitVector m)
blockRamFile Clock dom
clk Enable dom
en (SNat n -> SNat (2 ^ n)
forall (a :: Nat). SNat a -> SNat (2 ^ a)
pow2SNat (KnownNat n => SNat n
forall (n :: Nat). KnownNat n => SNat n
SNat @ n)) FilePath
file Signal dom (Unsigned n)
rd Signal dom (Maybe (Unsigned n, BitVector m))
wrM)
{-# INLINE blockRamFilePow2 #-}
blockRamFile
:: (KnownDomain dom, KnownNat m, Enum addr, HasCallStack)
=> Clock dom
-> Enable dom
-> SNat n
-> FilePath
-> Signal dom addr
-> Signal dom (Maybe (addr, BitVector m))
-> Signal dom (BitVector m)
blockRamFile :: Clock dom
-> Enable dom
-> SNat n
-> FilePath
-> Signal dom addr
-> Signal dom (Maybe (addr, BitVector m))
-> Signal dom (BitVector m)
blockRamFile = \clk :: Clock dom
clk gen :: Enable dom
gen sz :: SNat n
sz file :: FilePath
file rd :: Signal dom addr
rd wrM :: Signal dom (Maybe (addr, BitVector m))
wrM ->
let en :: Signal dom Bool
en = Maybe (addr, BitVector m) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (addr, BitVector m) -> Bool)
-> Signal dom (Maybe (addr, BitVector m)) -> Signal dom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (addr, BitVector m))
wrM
(wr :: Signal dom addr
wr,din :: Signal dom (BitVector m)
din) = Signal dom (addr, BitVector m) -> Unbundled dom (addr, BitVector m)
forall a (dom :: Domain).
Bundle a =>
Signal dom a -> Unbundled dom a
unbundle (Maybe (addr, BitVector m) -> (addr, BitVector m)
forall a. HasCallStack => Maybe a -> a
fromJustX (Maybe (addr, BitVector m) -> (addr, BitVector m))
-> Signal dom (Maybe (addr, BitVector m))
-> Signal dom (addr, BitVector m)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (addr, BitVector m))
wrM)
in (HasCallStack => Signal dom (BitVector m))
-> Signal dom (BitVector m)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack
(Clock dom
-> Enable dom
-> SNat n
-> FilePath
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom (BitVector m)
-> Signal dom (BitVector m)
forall (m :: Nat) (dom :: Domain) (n :: Nat).
(KnownDomain dom, KnownNat m, HasCallStack) =>
Clock dom
-> Enable dom
-> SNat n
-> FilePath
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom (BitVector m)
-> Signal dom (BitVector m)
blockRamFile# Clock dom
clk Enable dom
gen SNat n
sz FilePath
file (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal dom addr -> Signal dom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
rd) Signal dom Bool
en (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal dom addr -> Signal dom Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
wr) Signal dom (BitVector m)
din)
{-# INLINE blockRamFile #-}
blockRamFile#
:: forall m dom n
. (KnownDomain dom, KnownNat m, HasCallStack)
=> Clock dom
-> Enable dom
-> SNat n
-> FilePath
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom (BitVector m)
-> Signal dom (BitVector m)
blockRamFile# :: Clock dom
-> Enable dom
-> SNat n
-> FilePath
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom (BitVector m)
-> Signal dom (BitVector m)
blockRamFile# (Clock _) ena :: Enable dom
ena _sz :: SNat n
_sz file :: FilePath
file rd :: Signal dom Int
rd wen :: Signal dom Bool
wen =
Seq (BitVector m)
-> BitVector m
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom (BitVector m)
-> Signal dom (BitVector m)
go
Seq (BitVector m)
ramI
((HasCallStack => BitVector m) -> BitVector m
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (FilePath -> BitVector m
forall a. HasCallStack => FilePath -> a
errorX "blockRamFile#: intial value undefined"))
(Enable dom -> Signal dom Bool
forall (dom :: Domain). Enable dom -> Signal dom Bool
fromEnable Enable dom
ena)
Signal dom Int
rd
(Enable dom -> Signal dom Bool
forall (dom :: Domain). Enable dom -> Signal dom Bool
fromEnable Enable dom
ena Signal dom Bool -> Signal dom Bool -> Signal dom Bool
forall (f :: Type -> Type).
Applicative f =>
f Bool -> f Bool -> f Bool
.&&. Signal dom Bool
wen)
where
go
:: Seq.Seq (BitVector m)
-> BitVector m
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom (BitVector m)
-> Signal dom (BitVector m)
go :: Seq (BitVector m)
-> BitVector m
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom (BitVector m)
-> Signal dom (BitVector m)
go !Seq (BitVector m)
ram o :: BitVector m
o (re :: Bool
re :- res :: Signal dom Bool
res) (r :: Int
r :- rs :: Signal dom Int
rs) (e :: Bool
e :- en :: Signal dom Bool
en) (w :: Int
w :- wr :: Signal dom Int
wr) (d :: BitVector m
d :- din :: Signal dom (BitVector m)
din) =
let ram' :: Seq (BitVector m)
ram' = Seq (BitVector m)
-> Bool -> Int -> BitVector m -> Seq (BitVector m)
forall a. Seq a -> Bool -> Int -> a -> Seq a
upd Seq (BitVector m)
ram Bool
e (Int -> Int
forall a. Enum a => a -> Int
fromEnum Int
w) BitVector m
d
o' :: BitVector m
o' = if Bool
re then Seq (BitVector m)
ram Seq (BitVector m) -> Int -> BitVector m
forall a. Seq a -> Int -> a
`Seq.index` Int
r else BitVector m
o
in BitVector m
o BitVector m -> Signal dom (BitVector m) -> Signal dom (BitVector m)
forall a b. a -> b -> b
`seqX` BitVector m
o BitVector m -> Signal dom (BitVector m) -> Signal dom (BitVector m)
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Seq (BitVector m)
-> BitVector m
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom (BitVector m)
-> Signal dom (BitVector m)
go Seq (BitVector m)
ram' BitVector m
o' Signal dom Bool
res Signal dom Int
rs Signal dom Bool
en Signal dom Int
wr Signal dom (BitVector m)
din
upd :: Seq a -> Bool -> Int -> a -> Seq a
upd ram :: Seq a
ram we :: Bool
we waddr :: Int
waddr d :: a
d = case Bool -> Maybe Bool
forall a. a -> Maybe a
maybeIsX Bool
we of
Nothing -> case Int -> Maybe Int
forall a. a -> Maybe a
maybeIsX Int
waddr of
Nothing -> (a -> a) -> Seq a -> Seq a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a b. a -> b -> a
const (Int -> a -> a
forall a b. a -> b -> b
seq Int
waddr a
d)) Seq a
ram
Just wa :: Int
wa -> Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
wa a
d Seq a
ram
Just True -> case Int -> Maybe Int
forall a. a -> Maybe a
maybeIsX Int
waddr of
Nothing -> (a -> a) -> Seq a -> Seq a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a b. a -> b -> a
const (Int -> a -> a
forall a b. a -> b -> b
seq Int
waddr a
d)) Seq a
ram
Just wa :: Int
wa -> Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
wa a
d Seq a
ram
_ -> Seq a
ram
content :: [BitVector m]
content = IO [BitVector m] -> [BitVector m]
forall a. IO a -> a
unsafePerformIO (FilePath -> IO [BitVector m]
forall (n :: Nat). KnownNat n => FilePath -> IO [BitVector n]
initMem FilePath
file)
ramI :: Seq.Seq (BitVector m)
ramI :: Seq (BitVector m)
ramI = [BitVector m] -> Seq (BitVector m)
forall a. [a] -> Seq a
Seq.fromList [BitVector m]
content
{-# NOINLINE blockRamFile# #-}
initMem :: KnownNat n => FilePath -> IO [BitVector n]
initMem :: FilePath -> IO [BitVector n]
initMem = (FilePath -> [BitVector n]) -> IO FilePath -> IO [BitVector n]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> BitVector n) -> [FilePath] -> [BitVector n]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> BitVector n
parseBV ([FilePath] -> [BitVector n])
-> (FilePath -> [FilePath]) -> FilePath -> [BitVector n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines) (IO FilePath -> IO [BitVector n])
-> (FilePath -> IO FilePath) -> FilePath -> IO [BitVector n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
readFile
where
parseBV :: FilePath -> BitVector n
parseBV s :: FilePath
s = case FilePath -> Maybe Integer
parseBV' FilePath
s of
Just i :: Integer
i -> Integer -> BitVector n
forall a. Num a => Integer -> a
fromInteger Integer
i
Nothing -> FilePath -> BitVector n
forall a. HasCallStack => FilePath -> a
error ("Failed to parse: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s)
parseBV' :: FilePath -> Maybe Integer
parseBV' = ((Integer, FilePath) -> Integer)
-> Maybe (Integer, FilePath) -> Maybe Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, FilePath) -> Integer
forall a b. (a, b) -> a
fst (Maybe (Integer, FilePath) -> Maybe Integer)
-> (FilePath -> Maybe (Integer, FilePath))
-> FilePath
-> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Integer, FilePath)] -> Maybe (Integer, FilePath)
forall a. [a] -> Maybe a
listToMaybe ([(Integer, FilePath)] -> Maybe (Integer, FilePath))
-> (FilePath -> [(Integer, FilePath)])
-> FilePath
-> Maybe (Integer, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer
-> (Char -> Bool)
-> (Char -> Int)
-> FilePath
-> [(Integer, FilePath)]
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt 2 (Char -> FilePath -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` "01") Char -> Int
digitToInt
{-# NOINLINE initMem #-}