-- | The Atom language.
module Language.Atom.Language
  (
    module Language.Atom.Expressions
  -- * Primary Language Containers
  , Atom
  -- * Hierarchical Rule Declarations
  , atom
  , period
  , getPeriod
  -- * Action Directives
  , cond
  , Assign (..)
  , incr
  , decr
  -- ** Performance Constraints
  --, required
  --, priority
  -- * Variable Declarations
  , var
  , var'
  , bool
  , bool'
  , int8
  , int8'
  , int16
  , int16'
  , int32
  , int32'
  , int64
  , int64'
  , word8
  , word8'
  , word16
  , word16'
  , word32
  , word32'
  , word64
  , word64'
  , float
  , float'
  , double
  , double'
  -- * Custom Actions
  , action
  -- * Assertions
  , assert
  -- * Probing
  , probe
  , probes
  -- * Utilities
  , Name
  , liftIO
  , path
  , clock
  -- * Code Coverage
  , 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 <==

-- | The Atom monad captures variable and transition rule declarations.
type Atom = E.Atom

-- | Creates a hierarical node, where each node could be a atomic rule.
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

-- | Defines the period of execution of sub rules as a factor of the base rate of the system.
--   Rule period is bound by the closest period assertion.  For example:
--
--   > period 10 $ period 2 a   -- Rules in 'a' have a period of 2, not 10.
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

-- | Returns the execution period of the current scope.
getPeriod :: Atom Int
getPeriod = do
  (g, _) <- get
  return $ gPeriod g

-- | Returns the current atom heirarchical path.
path :: Atom String
path = do
  (_, atom) <- get
  return $ atomName atom

-- | Local boolean variable declaration.
bool :: Name -> Bool -> Atom (V Bool)
bool name init = var name $ CBool init

-- | External boolean variable declaration.
bool' :: Name -> Atom (V Bool)
bool' name = var' name Bool

-- | Local int8 variable declaration.
int8 :: Name -> Int8 -> Atom (V Int8)
int8 name init = var name $ CInt8 init

-- | External int8 variable declaration.
int8' :: Name -> Atom (V Int8)
int8' name = var' name Int8

-- | Local int16 variable declaration.
int16 :: Name -> Int16 -> Atom (V Int16)
int16 name init = var name $ CInt16 init

-- | External int16 variable declaration.
int16' :: Name -> Atom (V Int16)
int16' name = var' name Int16

-- | Local int32 variable declaration.
int32 :: Name -> Int32 -> Atom (V Int32)
int32 name init = var name $ CInt32 init

-- | External int32 variable declaration.
int32' :: Name -> Atom (V Int32)
int32' name = var' name Int32

-- | Local int64 variable declaration.
int64 :: Name -> Int64 -> Atom (V Int64)
int64 name init = var name $ CInt64 init

-- | External int64 variable declaration.
int64' :: Name -> Atom (V Int64)
int64' name = var' name Int64

-- | Local word8 variable declaration.
word8 :: Name -> Word8 -> Atom (V Word8)
word8 name init = var name $ CWord8 init

-- | External word8 variable declaration.
word8' :: Name -> Atom (V Word8)
word8' name = var' name Word8

-- | Local word16 variable declaration.
word16 :: Name -> Word16 -> Atom (V Word16)
word16 name init = var name $ CWord16 init

-- | External word16 variable declaration.
word16' :: Name -> Atom (V Word16)
word16' name = var' name Word16

-- | Local word32 variable declaration.
word32 :: Name -> Word32 -> Atom (V Word32)
word32 name init = var name $ CWord32 init

-- | External word32 variable declaration.
word32' :: Name -> Atom (V Word32)
word32' name = var' name Word32

-- | Local word64 variable declaration.
word64 :: Name -> Word64 -> Atom (V Word64)
word64 name init = var name $ CWord64 init

-- | External word64 variable declaration.
word64' :: Name -> Atom (V Word64)
word64' name = var' name Word64

-- | Local float variable declaration.
float :: Name -> Float -> Atom (V Float)
float name init = var name $ CFloat init

-- | External float variable declaration.
float' :: Name -> Atom (V Float)
float' name = var' name Float

-- | Local double variable declaration.
double :: Name -> Double -> Atom (V Double)
double name init = var name $ CDouble init

-- | External double variable declaration.
double' :: Name -> Atom (V Double)
double' name = var' name Double

-- | Declares an action.
action :: ([String] -> String) -> [UE] -> Atom ()
action f ues = do
  (g, a) <- get
  put (g, a { atomActions = atomActions a ++ [(f, ues)] })

-- | Asserts expression must always be true.
assert :: Name -> E Bool -> Atom ()
assert name a = do
  name <- addName name
  (g, atom) <- get
  put (g { gAsserts = gAsserts g ++ [(name, ue a)] }, atom)

-- | Declares a probe.
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)


-- | Fetches all declared probes to current design point.
probes :: Atom [(String, Type, E Word64)]
probes = do
  (g, _) <- get
  return $ gProbes g


-- | Increments a NumE 'V'.
incr :: (Assign a, NumE a) => V a -> Atom ()
incr a = a <== value a + 1

-- | Decrements a NumE 'V'.
decr :: (Assign a, NumE a) => V a -> Atom ()
decr a = a <== value a - 1


class Expr a => Assign a where
  -- | Assigns a 'E' to a 'V'.
  (<==) :: 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

-- | Adds an enabling condition to an atom subtree of rules.
--   This condition must be true before any rules in heirarchy
--   are allowed to execute.
cond :: E Bool -> Atom ()
cond c = do
  (g, atom) <- get
  put (g, atom { atomEnable = uand (atomEnable atom) (ue c) })

-- | Reference to the 64-bit free running clock.
clock :: E Word64
clock = value (V (UV (-1) "__clock" (External Word64)))

-- | Rule coverage information.  (current coverage index, coverage data)
nextCoverage :: Atom (E Word32, E Word32)
nextCoverage = do
  action (\_ -> "__coverage_index = (__coverage_index + 1) % __coverage_len") []
  return (value (V (UV (-2) "__coverage_index" (External Word32))), value (V (UV (-3) "__coverage[__coverage_index]" (External Word32))))