clash-prelude-1.3.0: CAES Language for Synchronous Hardware - Prelude library
Copyright(C) 2019 Google Inc
LicenseBSD2 (see the file LICENSE)
MaintainerQBayLogic B.V. <devops@qbaylogic.com>
Safe HaskellNone
LanguageHaskell2010

Clash.Explicit.SimIO

Description

I/O actions that are translatable to HDL

Synopsis

I/O environment for simulation

mealyIO Source #

Arguments

:: KnownDomain dom 
=> Clock dom

Clock at which rate the I/O environment progresses

-> (s -> i -> SimIO o)

Transition function inside an I/O environment

-> SimIO s

I/O action to create the initial state

-> Signal dom i 
-> Signal dom o 

Simulation-level I/O environment that can be synthesized to HDL-level I/O. Note that it is unlikely that the HDL-level I/O can subsequently be synthesized to a circuit.

Example

tbMachine :: (File,File) -> Int -> SimIO Int
tbMachine (fileIn,fileOut) regOut = do
  eofFileOut <- isEOF fileOut
  eofFileIn  <- isEOF fileIn
  when (eofFileIn || eofFileOut) $ do
    display "success"
    finish 0

  goldenIn  <- getChar fileIn
  goldenOut <- getChar fileOut
  res <- if regOut == fromEnum goldenOut then do
           return (fromEnum goldenIn)
         else do
           display "Output doesn't match golden output"
           finish 1
  display ("Output matches golden output")
  return res

tbInit :: (File,File)
tbInit = do
  fileIn  <- openFile "./goldenInput00.txt" "r"
  fileOut <- openFile "./goldenOutput00.txt" "r"
  return (fileIn,fileOut)

topEntity :: Signal System Int
topEntity = regOut
  where
    clk = systemClockGen
    rst = resetGen
    ena = enableGen

    regOut = register clk rst ena (fromEnum 'a') regIn
    regIn  = mealyIO clk tbMachine tbInit regOut

data SimIO a Source #

Simulation-level I/O environment; synthesizable to HDL I/O, which in itself is unlikely to be synthesisable to a digital circuit.

See mealyIO as to its use.

Instances

Instances details
Monad SimIO Source # 
Instance details

Defined in Clash.Explicit.SimIO

Methods

(>>=) :: SimIO a -> (a -> SimIO b) -> SimIO b #

(>>) :: SimIO a -> SimIO b -> SimIO b #

return :: a -> SimIO a #

Functor SimIO Source # 
Instance details

Defined in Clash.Explicit.SimIO

Methods

fmap :: (a -> b) -> SimIO a -> SimIO b #

(<$) :: a -> SimIO b -> SimIO a #

Applicative SimIO Source # 
Instance details

Defined in Clash.Explicit.SimIO

Methods

pure :: a -> SimIO a #

(<*>) :: SimIO (a -> b) -> SimIO a -> SimIO b #

liftA2 :: (a -> b -> c) -> SimIO a -> SimIO b -> SimIO c #

(*>) :: SimIO a -> SimIO b -> SimIO b #

(<*) :: SimIO a -> SimIO b -> SimIO a #

Display on stdout

display Source #

Arguments

:: String

String you want to display

-> SimIO () 

Display a string on stdout

End of simulation

finish Source #

Arguments

:: Integer

The exit code you want to return at the end of the simulation

-> SimIO a 

Finish the simulation with an exit code

Mutable values

data Reg a Source #

Mutable reference

reg Source #

Arguments

:: a

The starting value

-> SimIO (Reg a) 

Create a new mutable reference with the given starting value

readReg :: Reg a -> SimIO a Source #

Read value from a mutable reference

writeReg Source #

Arguments

:: Reg a

The mutable reference

-> a

The new value

-> SimIO () 

Write new value to the mutable reference

File I/O

data File Source #

File handle

openFile Source #

Arguments

:: FilePath

File to open

-> String

File mode:

  • "r": Open for reading
  • "w": Create for writing
  • "a": Append
  • "r+": Open for update (reading and writing)
  • "w+": Create for update
  • "a+": Append, open or create for update at end-of-file
-> SimIO File 

Open a file

closeFile :: File -> SimIO () Source #

Close a file

Reading and writing characters

getChar Source #

Arguments

:: File

File to read from

-> SimIO Char 

Read one character from a file

putChar Source #

Arguments

:: Char

Character to insert

-> File

Buffer to insert to

-> SimIO () 

Insert a character into a buffer specified by the file

Reading strings

getLine Source #

Arguments

:: forall n. KnownNat n 
=> File

File to read from

-> Reg (Vec n (Unsigned 8))

Vector to store the content

-> SimIO Int 

Read one line from a file

Detecting the end of input

isEOF Source #

Arguments

:: File

File we want to inspect

-> SimIO Bool 

Determine whether we've reached the end of the file

Buffering operations

flush :: File -> SimIO () Source #

Write any buffered output to file

Repositioning handles

seek Source #

Arguments

:: File

File to set the position for

-> Integer

Position

-> Int

Mode:

  • 0: From the beginning of the file
  • 1: From the current position
  • 2: From the end of the file
-> SimIO Int 

Set the position of the next operation on the file

rewind :: File -> SimIO Int Source #

Set the position of the next operation to the beginning of the file

tell Source #

Arguments

:: File

File we want to inspect

-> SimIO Integer 

Returns the offset from the beginning of the file (in bytes).