module Language.Atom.Language
(
module Language.Atom.Expressions
, Atom
, atom
, period
, getPeriod
, cond
, Assign (..)
, incr
, decr
, var
, bool
, int8
, int16
, int32
, int64
, word8
, word16
, word32
, word64
, float
, double
, action
, assert
, probe
, probes
, Name
, liftIO
, path
, clock
) where
import Control.Monad.State hiding (join)
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 name init = var name $ CBool init
int8 :: Name -> Int8 -> Atom (V Int8)
int8 name init = var name $ CInt8 init
int16 :: Name -> Int16 -> Atom (V Int16)
int16 name init = var name $ CInt16 init
int32 :: Name -> Int32 -> Atom (V Int32)
int32 name init = var name $ CInt32 init
int64 :: Name -> Int64 -> Atom (V Int64)
int64 name init = var name $ CInt64 init
word8 :: Name -> Word8 -> Atom (V Word8)
word8 name init = var name $ CWord8 init
word16 :: Name -> Word16 -> Atom (V Word16)
word16 name init = var name $ CWord16 init
word32 :: Name -> Word32 -> Atom (V Word32)
word32 name init = var name $ CWord32 init
word64 :: Name -> Word64 -> Atom (V Word64)
word64 name init = var name $ CWord64 init
float :: Name -> Float -> Atom (V Float)
float name init = var name $ CFloat init
double :: Name -> Double -> Atom (V Double)
double name init = var name $ CDouble init
action :: ([String] -> String) -> [UE] -> Atom ()
action f ues = do
(g, a) <- get
put (g, a { atomActions = atomActions a ++ [(f, ues)] })
assert :: Name -> E Bool -> Atom ()
assert name a = do
name <- addName name
(g, atom) <- get
put (g { gAsserts = gAsserts g ++ [(name, ue a)] }, atom)
probe :: Expr a => Name -> E a -> Atom ()
probe name a = do
(g, atom) <- get
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 = Cust "globalClock"