{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns, MagicHash, TypeOperators, ScopedTypeVariables, FlexibleContexts #-}
{-# LANGUAGE DataKinds, GADTs, TypeApplications #-}
module Clash.Explicit.SimIO
(
mealyIO
, SimIO
, display
, finish
, Reg
, reg
, readReg
, writeReg
, File
, openFile
, closeFile
, getChar
, putChar
, getLine
, isEOF
, flush
, seek
, rewind
, tell
)
where
import Control.Monad (when)
#if __GLASGOW_HASKELL__ < 900
import Data.Coerce
#endif
import Data.IORef
import GHC.TypeLits
#if MIN_VERSION_base(4,18,0)
hiding (SNat)
#endif
import Prelude hiding (getChar, putChar, getLine)
import qualified System.IO as IO
import System.IO.Unsafe
import Clash.Annotations.Primitive (hasBlackBox)
import Clash.Promoted.Nat
import Clash.Signal.Internal
import Clash.Sized.Unsigned
import Clash.Sized.Vector (Vec (..))
import Clash.XException (seqX)
#if __GLASGOW_HASKELL__ >= 900
data SimIO a = SimIO {unSimIO :: !(IO a)}
#else
newtype SimIO a = SimIO {SimIO a -> IO a
unSimIO :: IO a}
#endif
{-# ANN unSimIO hasBlackBox #-}
instance Functor SimIO where
fmap :: (a -> b) -> SimIO a -> SimIO b
fmap = (a -> b) -> SimIO a -> SimIO b
forall a b. (a -> b) -> SimIO a -> SimIO b
fmapSimIO#
fmapSimIO# :: (a -> b) -> SimIO a -> SimIO b
fmapSimIO# :: (a -> b) -> SimIO a -> SimIO b
fmapSimIO# a -> b
f (SimIO IO a
m) = IO b -> SimIO b
forall a. IO a -> SimIO a
SimIO ((a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f IO a
m)
{-# CLASH_OPAQUE fmapSimIO# #-}
{-# ANN fmapSimIO# hasBlackBox #-}
instance Applicative SimIO where
pure :: a -> SimIO a
pure = a -> SimIO a
forall a. a -> SimIO a
pureSimIO#
<*> :: SimIO (a -> b) -> SimIO a -> SimIO b
(<*>) = SimIO (a -> b) -> SimIO a -> SimIO b
forall a b. SimIO (a -> b) -> SimIO a -> SimIO b
apSimIO#
pureSimIO# :: a -> SimIO a
pureSimIO# :: a -> SimIO a
pureSimIO# a
a = IO a -> SimIO a
forall a. IO a -> SimIO a
SimIO (a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a)
{-# CLASH_OPAQUE pureSimIO# #-}
{-# ANN pureSimIO# hasBlackBox #-}
apSimIO# :: SimIO (a -> b) -> SimIO a -> SimIO b
apSimIO# :: SimIO (a -> b) -> SimIO a -> SimIO b
apSimIO# (SimIO IO (a -> b)
f) (SimIO IO a
m) = IO b -> SimIO b
forall a. IO a -> SimIO a
SimIO (IO (a -> b)
f IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IO a
m)
{-# CLASH_OPAQUE apSimIO# #-}
{-# ANN apSimIO# hasBlackBox #-}
instance Monad SimIO where
#if !MIN_VERSION_base(4,16,0)
return :: a -> SimIO a
return = a -> SimIO a
forall a. a -> SimIO a
pureSimIO#
#endif
>>= :: SimIO a -> (a -> SimIO b) -> SimIO b
(>>=) = SimIO a -> (a -> SimIO b) -> SimIO b
forall a b. SimIO a -> (a -> SimIO b) -> SimIO b
bindSimIO#
bindSimIO# :: SimIO a -> (a -> SimIO b) -> SimIO b
#if __GLASGOW_HASKELL__ >= 900
bindSimIO# (SimIO m) k = SimIO (m >>= (\x -> x `seqX` unSimIO (k x)))
#else
bindSimIO# :: SimIO a -> (a -> SimIO b) -> SimIO b
bindSimIO# (SimIO IO a
m) a -> SimIO b
k = IO b -> SimIO b
forall a. IO a -> SimIO a
SimIO (IO a
m IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\a
x -> a
x a -> IO b -> IO b
forall a b. a -> b -> b
`seqX` (a -> SimIO b) -> a -> IO b
coerce a -> SimIO b
k a
x))
#endif
{-# CLASH_OPAQUE bindSimIO# #-}
{-# ANN bindSimIO# hasBlackBox #-}
display
:: String
-> SimIO ()
display :: String -> SimIO ()
display String
s = IO () -> SimIO ()
forall a. IO a -> SimIO a
SimIO (String -> IO ()
putStrLn String
s)
{-# CLASH_OPAQUE display #-}
{-# ANN display hasBlackBox #-}
finish
:: Integer
-> SimIO a
finish :: Integer -> SimIO a
finish Integer
i = a -> SimIO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> a
forall a. HasCallStack => String -> a
error (Integer -> String
forall a. Show a => a -> String
show Integer
i))
{-# CLASH_OPAQUE finish #-}
{-# ANN finish hasBlackBox #-}
#if __GLASGOW_HASKELL__ >= 900
data Reg a = Reg !(IORef a)
#else
newtype Reg a = Reg (IORef a)
#endif
reg
:: a
-> SimIO (Reg a)
reg :: a -> SimIO (Reg a)
reg a
a = IO (Reg a) -> SimIO (Reg a)
forall a. IO a -> SimIO a
SimIO (IORef a -> Reg a
forall a. IORef a -> Reg a
Reg (IORef a -> Reg a) -> IO (IORef a) -> IO (Reg a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
a)
{-# CLASH_OPAQUE reg #-}
{-# ANN reg hasBlackBox #-}
readReg :: Reg a -> SimIO a
readReg :: Reg a -> SimIO a
readReg (Reg IORef a
a) = IO a -> SimIO a
forall a. IO a -> SimIO a
SimIO (IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
a)
{-# CLASH_OPAQUE readReg #-}
{-# ANN readReg hasBlackBox #-}
writeReg
:: Reg a
-> a
-> SimIO ()
writeReg :: Reg a -> a -> SimIO ()
writeReg (Reg IORef a
r) a
a = IO () -> SimIO ()
forall a. IO a -> SimIO a
SimIO (IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
r a
a)
{-# CLASH_OPAQUE writeReg #-}
{-# ANN writeReg hasBlackBox #-}
#if __GLASGOW_HASKELL__ >= 900
data File = File !IO.Handle
#else
newtype File = File IO.Handle
#endif
openFile
:: FilePath
-> String
-> SimIO File
#if __GLASGOW_HASKELL__ >= 900
openFile fp "r" = SimIO $ fmap File (IO.openFile fp IO.ReadMode)
openFile fp "w" = SimIO $ fmap File (IO.openFile fp IO.WriteMode)
openFile fp "a" = SimIO $ fmap File (IO.openFile fp IO.AppendMode)
openFile fp "rb" = SimIO $ fmap File (IO.openBinaryFile fp IO.ReadMode)
openFile fp "wb" = SimIO $ fmap File (IO.openBinaryFile fp IO.WriteMode)
openFile fp "ab" = SimIO $ fmap File (IO.openBinaryFile fp IO.AppendMode)
openFile fp "r+" = SimIO $ fmap File (IO.openFile fp IO.ReadWriteMode)
openFile fp "w+" = SimIO $ fmap File (IO.openFile fp IO.WriteMode)
openFile fp "a+" = SimIO $ fmap File (IO.openFile fp IO.AppendMode)
openFile fp "r+b" = SimIO $ fmap File (IO.openBinaryFile fp IO.ReadWriteMode)
openFile fp "w+b" = SimIO $ fmap File (IO.openBinaryFile fp IO.WriteMode)
openFile fp "a+b" = SimIO $ fmap File (IO.openBinaryFile fp IO.AppendMode)
openFile fp "rb+" = SimIO $ fmap File (IO.openBinaryFile fp IO.ReadWriteMode)
openFile fp "wb+" = SimIO $ fmap File (IO.openBinaryFile fp IO.WriteMode)
openFile fp "ab+" = SimIO $ fmap File (IO.openBinaryFile fp IO.AppendMode)
#else
openFile :: String -> String -> SimIO File
openFile String
fp String
"r" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openFile String
fp IOMode
IO.ReadMode)
openFile String
fp String
"w" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openFile String
fp IOMode
IO.WriteMode)
openFile String
fp String
"a" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openFile String
fp IOMode
IO.AppendMode)
openFile String
fp String
"rb" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openBinaryFile String
fp IOMode
IO.ReadMode)
openFile String
fp String
"wb" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openBinaryFile String
fp IOMode
IO.WriteMode)
openFile String
fp String
"ab" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openBinaryFile String
fp IOMode
IO.AppendMode)
openFile String
fp String
"r+" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openFile String
fp IOMode
IO.ReadWriteMode)
openFile String
fp String
"w+" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openFile String
fp IOMode
IO.WriteMode)
openFile String
fp String
"a+" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openFile String
fp IOMode
IO.AppendMode)
openFile String
fp String
"r+b" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openBinaryFile String
fp IOMode
IO.ReadWriteMode)
openFile String
fp String
"w+b" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openBinaryFile String
fp IOMode
IO.WriteMode)
openFile String
fp String
"a+b" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openBinaryFile String
fp IOMode
IO.AppendMode)
openFile String
fp String
"rb+" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openBinaryFile String
fp IOMode
IO.ReadWriteMode)
openFile String
fp String
"wb+" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openBinaryFile String
fp IOMode
IO.WriteMode)
openFile String
fp String
"ab+" = IO Handle -> SimIO File
coerce (String -> IOMode -> IO Handle
IO.openBinaryFile String
fp IOMode
IO.AppendMode)
#endif
openFile String
_ String
m = String -> SimIO File
forall a. HasCallStack => String -> a
error (String
"openFile unknown mode: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
m)
{-# CLASH_OPAQUE openFile #-}
{-# ANN openFile hasBlackBox #-}
closeFile
:: File
-> SimIO ()
closeFile :: File -> SimIO ()
closeFile (File Handle
fp) = IO () -> SimIO ()
forall a. IO a -> SimIO a
SimIO (Handle -> IO ()
IO.hClose Handle
fp)
{-# CLASH_OPAQUE closeFile #-}
{-# ANN closeFile hasBlackBox #-}
getChar
:: File
-> SimIO Char
getChar :: File -> SimIO Char
getChar (File Handle
fp) = IO Char -> SimIO Char
forall a. IO a -> SimIO a
SimIO (Handle -> IO Char
IO.hGetChar Handle
fp)
{-# CLASH_OPAQUE getChar #-}
{-# ANN getChar hasBlackBox #-}
putChar
:: Char
-> File
-> SimIO ()
putChar :: Char -> File -> SimIO ()
putChar Char
c (File Handle
fp) = IO () -> SimIO ()
forall a. IO a -> SimIO a
SimIO (Handle -> Char -> IO ()
IO.hPutChar Handle
fp Char
c)
{-# CLASH_OPAQUE putChar #-}
{-# ANN putChar hasBlackBox #-}
getLine
:: forall n
. KnownNat n
=> File
-> Reg (Vec n (Unsigned 8))
-> SimIO Int
getLine :: File -> Reg (Vec n (Unsigned 8)) -> SimIO Int
getLine (File Handle
fp) (Reg IORef (Vec n (Unsigned 8))
r) = IO Int -> SimIO Int
forall a. IO a -> SimIO a
SimIO (IO Int -> SimIO Int) -> IO Int -> SimIO Int
forall a b. (a -> b) -> a -> b
$ do
String
s <- Handle -> IO String
IO.hGetLine Handle
fp
let d :: Int
d = SNat n -> Int
forall a (n :: Nat). Num a => SNat n -> a
snatToNum (KnownNat n => SNat n
forall (n :: Nat). KnownNat n => SNat n
SNat @n) Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
s
Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
fp SeekMode
IO.RelativeSeek (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
d))
IORef (Vec n (Unsigned 8))
-> (Vec n (Unsigned 8) -> Vec n (Unsigned 8)) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Vec n (Unsigned 8))
r (String -> Vec n (Unsigned 8) -> Vec n (Unsigned 8)
forall (m :: Nat).
String -> Vec m (Unsigned 8) -> Vec m (Unsigned 8)
rep String
s)
Int -> IO Int
forall (m :: Type -> Type) a. Monad m => a -> m a
return Int
0
where
rep :: String -> Vec m (Unsigned 8) -> Vec m (Unsigned 8)
rep :: String -> Vec m (Unsigned 8) -> Vec m (Unsigned 8)
rep [] Vec m (Unsigned 8)
vs = Vec m (Unsigned 8)
vs
rep (Char
x:String
xs) (Cons Unsigned 8
_ Vec n (Unsigned 8)
vs) = Unsigned 8 -> Vec n (Unsigned 8) -> Vec (n + 1) (Unsigned 8)
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
Cons (Int -> Unsigned 8
forall a. Enum a => Int -> a
toEnum (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
x)) (String -> Vec n (Unsigned 8) -> Vec n (Unsigned 8)
forall (m :: Nat).
String -> Vec m (Unsigned 8) -> Vec m (Unsigned 8)
rep String
xs Vec n (Unsigned 8)
vs)
rep String
_ Vec m (Unsigned 8)
Nil = Vec m (Unsigned 8)
forall a. Vec 0 a
Nil
{-# CLASH_OPAQUE getLine #-}
{-# ANN getLine hasBlackBox #-}
isEOF
:: File
-> SimIO Bool
isEOF :: File -> SimIO Bool
isEOF (File Handle
fp) = IO Bool -> SimIO Bool
forall a. IO a -> SimIO a
SimIO (Handle -> IO Bool
IO.hIsEOF Handle
fp)
{-# CLASH_OPAQUE isEOF #-}
{-# ANN isEOF hasBlackBox #-}
seek
:: File
-> Integer
-> Int
-> SimIO Int
seek :: File -> Integer -> Int -> SimIO Int
seek (File Handle
fp) Integer
pos Int
mode = IO Int -> SimIO Int
forall a. IO a -> SimIO a
SimIO (Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
fp (Int -> SeekMode
forall a. Enum a => Int -> a
toEnum Int
mode) Integer
pos IO () -> IO Int -> IO Int
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (m :: Type -> Type) a. Monad m => a -> m a
return Int
0)
{-# CLASH_OPAQUE seek #-}
{-# ANN seek hasBlackBox #-}
rewind
:: File
-> SimIO Int
rewind :: File -> SimIO Int
rewind (File Handle
fp) = IO Int -> SimIO Int
forall a. IO a -> SimIO a
SimIO (Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
fp SeekMode
IO.AbsoluteSeek Integer
0 IO () -> IO Int -> IO Int
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (m :: Type -> Type) a. Monad m => a -> m a
return Int
0)
{-# CLASH_OPAQUE rewind #-}
{-# ANN rewind hasBlackBox #-}
tell
:: File
-> SimIO Integer
tell :: File -> SimIO Integer
tell (File Handle
fp) = IO Integer -> SimIO Integer
forall a. IO a -> SimIO a
SimIO (Handle -> IO Integer
IO.hTell Handle
fp)
{-# CLASH_OPAQUE tell #-}
{-# ANN tell hasBlackBox #-}
flush
:: File
-> SimIO ()
flush :: File -> SimIO ()
flush (File Handle
fp) = IO () -> SimIO ()
forall a. IO a -> SimIO a
SimIO (Handle -> IO ()
IO.hFlush Handle
fp)
{-# CLASH_OPAQUE flush #-}
{-# ANN flush hasBlackBox #-}
mealyIO
:: KnownDomain dom
=> Clock dom
-> (s -> i -> SimIO o)
-> SimIO s
-> Signal dom i
-> Signal dom o
mealyIO :: Clock dom
-> (s -> i -> SimIO o) -> SimIO s -> Signal dom i -> Signal dom o
mealyIO !Clock dom
_ s -> i -> SimIO o
f (SimIO IO s
i) Signal dom i
inp = IO (Signal dom o) -> Signal dom o
forall a. IO a -> a
unsafePerformIO (IO s
i IO s -> (s -> IO (Signal dom o)) -> IO (Signal dom o)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Signal dom i -> s -> IO (Signal dom o)
go Signal dom i
inp)
where
go :: Signal dom i -> s -> IO (Signal dom o)
go q :: Signal dom i
q@(~(i
k :- Signal dom i
ks)) s
s =
o -> Signal dom o -> Signal dom o
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
(:-) (o -> Signal dom o -> Signal dom o)
-> IO o -> IO (Signal dom o -> Signal dom o)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> SimIO o -> IO o
forall a. SimIO a -> IO a
unSimIO (s -> i -> SimIO o
f s
s i
k) IO (Signal dom o -> Signal dom o)
-> IO (Signal dom o) -> IO (Signal dom o)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IO (Signal dom o) -> IO (Signal dom o)
forall a. IO a -> IO a
unsafeInterleaveIO ((Signal dom i
q Signal dom i -> IO (Signal dom o) -> IO (Signal dom o)
`seq` Signal dom i -> s -> IO (Signal dom o)
go Signal dom i
ks s
s))
{-# CLASH_OPAQUE mealyIO #-}