{-# LANGUAGE FlexibleContexts #-}
--
-- BitData.hs --- Linking registers to bitdata.
--
-- Copyright (C) 2013, Galois, Inc.
-- All Rights Reserved.
--

module Ivory.HW.BitData where

import Numeric (showHex)
import Data.List (intercalate)

import Ivory.Language
import Ivory.HW.Prim
import Ivory.HW.Reg

-- | A register associated with a bit data type.
data BitDataReg d =
  BitDataReg
    { bdr_reg  :: Reg (BitDataRep d)
    , bdr_name :: Maybe String
    }

bdrComment :: BitDataReg d -> String -> String -> Ivory eff ()
bdrComment r c c' =
  comment ("reg " ++ c ++ " " ++ regname ++ ": " ++ c' )
  where
  regname = case bdr_name r of
    Just n -> n
    Nothing -> "0x" ++ (showHex regaddr "")
  regaddr = case bdr_reg r of Reg a -> a

-- | Create a bit data register given its address.
mkBitDataReg :: IvoryIOReg (BitDataRep d) => Integer -> BitDataReg d
mkBitDataReg a = BitDataReg { bdr_reg = mkReg a, bdr_name = Nothing }

-- | Create a bit data register given its address and name.
mkBitDataRegNamed :: IvoryIOReg (BitDataRep d) => Integer -> String -> BitDataReg d
mkBitDataRegNamed a n = BitDataReg { bdr_reg = mkReg a, bdr_name = Just n }

getReg :: (BitData d, IvoryIOReg (BitDataRep d))
       => BitDataReg d -> Ivory eff d
getReg r = do
  bdrComment r "get" ""
  val <- readReg (bdr_reg r)
  return $ fromRep val

-- | Set a register to a value taken from a block of bit
-- modifications.  The previous value is discarded.
setReg :: (BitData d, IvoryIOReg (BitDataRep d))
       => BitDataReg d -> BitDataM d a -> Ivory eff a
setReg r mf = do
  let (result, val, ss) = runBits 0 mf
  bdrComment r "set" (intercalate ", " ss)
  writeReg (bdr_reg r) val
  return result

-- | Modify a register by a set of bit modification actions.
modifyReg :: (BitData d, IvoryIOReg (BitDataRep d))
          => BitDataReg d -> BitDataM d a -> Ivory eff a
modifyReg r mf = do
  val <- readReg (bdr_reg r)
  let (result, val', ss) = runBits val mf
  bdrComment r "modify" (intercalate ", " ss)
  writeReg (bdr_reg r) val'
  return result