{-# LANGUAGE BangPatterns #-}
{-# 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 = \Clock dom
clk Enable dom
en FilePath
file Signal dom (Unsigned n)
rd 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 = \Clock dom
clk Enable dom
gen SNat n
sz FilePath
file Signal dom addr
rd 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
(Signal dom addr
wr,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 SSymbol dom
_) Enable dom
ena !SNat n
_sz FilePath
file Signal dom Int
rd 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 FilePath
"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 BitVector m
o (Bool
re :- Signal dom Bool
res) (Int
r :- Signal dom Int
rs) (Bool
e :- Signal dom Bool
en) (Int
w :- Signal dom Int
wr) (BitVector m
d :- 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 Seq a
ram Bool
we Int
waddr a
d = case Bool -> Maybe Bool
forall a. a -> Maybe a
maybeIsX Bool
we of
Maybe Bool
Nothing -> case Int -> Maybe Int
forall a. a -> Maybe a
maybeIsX Int
waddr of
Maybe Int
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
seq Int
waddr a
d)) Seq a
ram
Just 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 Bool
True -> case Int -> Maybe Int
forall a. a -> Maybe a
maybeIsX Int
waddr of
Maybe Int
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
seq Int
waddr a
d)) Seq a
ram
Just 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
Maybe Bool
_ -> 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 FilePath
s = case FilePath -> Maybe Integer
parseBV' FilePath
s of
Just Integer
i -> Integer -> BitVector n
forall a. Num a => Integer -> a
fromInteger Integer
i
Maybe Integer
Nothing -> FilePath -> BitVector n
forall a. HasCallStack => FilePath -> a
error (FilePath
"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 Integer
2 (Char -> FilePath -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` FilePath
"01") Char -> Int
digitToInt
{-# NOINLINE initMem #-}