-- | 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
  , bool
  , int8
  , int16
  , int32
  , int64
  , word8
  , word16
  , word32
  , word64
  , float
  , double
  -- * Custom Actions
  , action
  -- * Assertions
  , assert
  -- * Probing
  , probe
  , probes
  -- * Utilities
  , 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 <==

-- | A Atom captures declarations including inputs, outputs, variables, and assertions
--   and actions including guard conditions and variable assignments.
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

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

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

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

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

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

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

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

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

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

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

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

-- | 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 = Cust "globalClock"