module Language.Atom.Language
(
module Language.Atom.Expressions
, Atom
, atom
, period
, getPeriod
, cond
, Assign (..)
, incr
, decr
, var
, var'
, array
, bool
, bool'
, int8
, int8'
, int16
, int16'
, int32
, int32'
, int64
, int64'
, word8
, word8'
, word16
, word16'
, word32
, word32'
, word64
, word64'
, float
, float'
, double
, double'
, action
, probe
, probes
, assert
, cover
, Name
, liftIO
, path
, clock
, nextCoverage
) where
import Control.Monad.Trans
import Data.Int
import Data.List
import Data.Word
import Language.Atom.Elaboration hiding (Atom)
import qualified Language.Atom.Elaboration as E
import Language.Atom.Expressions
infixr 1 <==
type Atom = E.Atom
atom :: Name -> Atom a -> Atom a
atom name design = do
name <- addName name
(g, parent) <- get
(a, (g, child)) <- liftIO $ buildAtom g name design
put (g, parent { atomSubs = atomSubs parent ++ [child] })
return a
period :: Int -> Atom a -> Atom a
period n _ | n <= 0 = error "ERROR: Execution period must be greater than 0."
period n atom = do
(g, a) <- get
put (g { gPeriod = n }, a)
r <- atom
(g', a) <- get
put (g' { gPeriod = gPeriod g }, a)
return r
getPeriod :: Atom Int
getPeriod = do
(g, _) <- get
return $ gPeriod g
path :: Atom String
path = do
(_, atom) <- get
return $ atomName atom
bool :: Name -> Bool -> Atom (V Bool)
bool = var
bool' :: Name -> Atom (V Bool)
bool' name = var' name Bool
int8 :: Name -> Int8 -> Atom (V Int8)
int8 = var
int8' :: Name -> Atom (V Int8)
int8' name = var' name Int8
int16 :: Name -> Int16 -> Atom (V Int16)
int16 = var
int16' :: Name -> Atom (V Int16)
int16' name = var' name Int16
int32 :: Name -> Int32 -> Atom (V Int32)
int32 = var
int32' :: Name -> Atom (V Int32)
int32' name = var' name Int32
int64 :: Name -> Int64 -> Atom (V Int64)
int64 = var
int64' :: Name -> Atom (V Int64)
int64' name = var' name Int64
word8 :: Name -> Word8 -> Atom (V Word8)
word8 = var
word8' :: Name -> Atom (V Word8)
word8' name = var' name Word8
word16 :: Name -> Word16 -> Atom (V Word16)
word16 = var
word16' :: Name -> Atom (V Word16)
word16' name = var' name Word16
word32 :: Name -> Word32 -> Atom (V Word32)
word32 = var
word32' :: Name -> Atom (V Word32)
word32' name = var' name Word32
word64 :: Name -> Word64 -> Atom (V Word64)
word64 = var
word64' :: Name -> Atom (V Word64)
word64' name = var' name Word64
float :: Name -> Float -> Atom (V Float)
float = var
float' :: Name -> Atom (V Float)
float' name = var' name Float
double :: Name -> Double -> Atom (V Double)
double = var
double' :: Name -> Atom (V Double)
double' name = var' name Double
action :: ([String] -> String) -> [UE] -> Atom ()
action f ues = do
(g, a) <- get
put (g, a { atomActions = atomActions a ++ [(f, ues)] })
probe :: Expr a => Name -> E a -> Atom ()
probe name a = do
(g, atom) <- get
if any (\ (n, _, _) -> name == n) $ gProbes g
then error $ "ERROR: Duplicated probe name: " ++ name
else put (g { gProbes = (name, eType a, rawBits a) : gProbes g }, atom)
probes :: Atom [(String, Type, E Word64)]
probes = do
(g, _) <- get
return $ gProbes g
incr :: (Assign a, NumE a) => V a -> Atom ()
incr a = a <== value a + 1
decr :: (Assign a, NumE a) => V a -> Atom ()
decr a = a <== value a 1
class Expr a => Assign a where
(<==) :: V a -> E a -> Atom ()
v <== e = do
(g, atom) <- get
put (g, atom { atomAssigns = (uv v, ue e) : atomAssigns atom })
instance Assign Bool
instance Assign Int8
instance Assign Int16
instance Assign Int32
instance Assign Int64
instance Assign Word8
instance Assign Word16
instance Assign Word32
instance Assign Word64
instance Assign Float
instance Assign Double
cond :: E Bool -> Atom ()
cond c = do
(g, atom) <- get
put (g, atom { atomEnable = uand (atomEnable atom) (ue c) })
clock :: E Word64
clock = value $ V $ UV $ External "__clock" Word64
nextCoverage :: Atom (E Word32, E Word32)
nextCoverage = do
action (const "__coverage_index = (__coverage_index + 1) % __coverage_len") []
return (value $ V $ UV $ External "__coverage_index" Word32, value $ V $ UV $ External "__coverage[__coverage_index]" Word32)
assert :: Name -> E Bool -> Atom ()
assert name check = do
name <- addName name
(g, atom) <- get
put (g, atom { atomAsserts = (name, ue check) : atomAsserts atom })
cover :: Name -> E Bool -> Atom ()
cover name check = do
name <- addName name
(g, atom) <- get
put (g, atom { atomCovers = (name, ue check) : atomCovers atom })