module ShamIV where

import Hardware.Chalk
import Control.Applicative
import Control.Monad.State
import Data.Stream (Stream(..))
import Data.Maybe

data Reg = R0 | R1 | R2 | R3 deriving (Show, Eq)

type Regs = (Int, Int, Int, Int) 

data Cmd = ADD | SUB | INC deriving (Show, Eq)

type Operand = (Reg, Maybe Int)
data Transaction = 
  Transaction {dest :: Operand, cmd :: Cmd, srcs :: [Operand]}
  deriving (Show, Eq)

setDest :: Transaction -> Int -> Transaction
setDest (Transaction (r,_) cmd srcs) i = Transaction (r, Just i) cmd srcs

initRegs :: Regs
initRegs = (0,0,0,0)

regFile :: Signal Transaction -> Signal Transaction -> Signal Transaction
regFile writes reads = 
  loop (regStep <$> writes <*> reads) initRegs

regStep :: Transaction -> Transaction -> Regs -> (Transaction , Regs)
regStep write@(Transaction wrOp _ _) read regs
  = let regs' = updateReg wrOp regs
        read' = updateTransaction regs read
    in (read' , regs')

updateReg (R0, Just x) (a,b,c,d) = (x,b,c,d)
updateReg (R1, Just x) (a,b,c,d) = (a,x,c,d)
updateReg (R2, Just x) (a,b,c,d) = (a,b,x,d)
updateReg (R3, Just x) (a,b,c,d) = (a,b,c,x)

updateTransaction :: Regs -> Transaction -> Transaction
updateTransaction regs t = t {srcs = map (updateOperand regs) (srcs t)}

updateOperand regs (r, _ ) = (r , Just (lookupReg r regs))
lookupReg R0 (a,b,c,d) = a
lookupReg R1 (a,b,c,d) = b
lookupReg R2 (a,b,c,d) = c
lookupReg R3 (a,b,c,d) = d

alu :: Signal Transaction -> Signal Transaction
alu cmds = interpret <$> cmds
  where
  interpret :: Transaction -> Transaction
  interpret trans@(Transaction dest cmd srcs) = 
    setDest trans (eval cmd (map (fromJust . snd) srcs))
  eval :: Cmd -> [Int] -> Int
  eval ADD [x, y] = x + y
  eval SUB [x, y] = x - y
  eval INC [x] = x + 1    

sham :: Signal Transaction -> Signal Transaction
sham instrs = aluOutputD 
  where
  aluInput = regFile aluOutputD instrs
  aluOutput = alu aluInput
  aluOutputD = delay nop aluOutput

nop = Transaction (R0, Just 0) ADD [(R0,Just 0) , (R0,Just 0)]

bypass :: Signal Transaction -> Signal Transaction -> Signal Transaction
bypass ins outs = checkHazard <$> ins <*> outs
  where
  checkHazard t1 t2 =
    let destReg = reg $ dest t2
        sourceRegs = map reg $ srcs t1
        new = t1 {srcs = merge (dest t2) (srcs t1)}
        merge :: Operand -> [Operand] -> [Operand]
        merge o os = map (mergeOp o) os
        mergeOp (r1,x) (r2,y)
          | r1 == r2 = (r2,x)
          | otherwise = (r1,x)
    in if destReg `elem` sourceRegs then new else t1

reg :: Operand -> Reg
reg = fst