module Sham where

import Hawk
import Control.Applicative
import Control.Monad.State
import Data.Stream (Stream(..))

data Reg = R0 | R1 | R2 | R3

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

data Cmd = ADD | SUB | INC

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

regFile = rf initRegs

rf :: Regs ->
  (Signal Reg, Signal Int)      -- write ports
  -> Signal Reg                 -- first read port
  -> Signal Reg                 -- second read port
  -> (Signal Int, Signal Int)   -- read port outputs
rf regs 
  (Signal (Cons write writes), (Signal (Cons val vals))) 
  (Signal (Cons rd1 rd1s)) 
  (Signal (Cons rd2 rd2s)) = 
  let ((x,y), regs') = regStep regs (write,val) rd1 rd2
      (outs1, outs2) = rf regs' (Signal writes, Signal vals) (Signal rd1s) (Signal rd2s)
  in (delay x outs1, delay y outs2)

regStep :: Regs -> (Reg, Int) -> Reg -> Reg -> ((Int, Int), Regs)
regStep regs (wr,x) rd1 rd2 =
  let regs' = update (wr,x) regs
  in ((lookupReg rd1 regs', lookupReg rd2 regs'), regs')  

alu :: Signal Cmd -> Signal Int -> Signal Int -> Signal Int
alu cmds xs ys = interpret <$> cmds <*> xs <*> ys
  where
  interpret ADD x y = x + y
  interpret SUB x y = x - y
  interpret INC x _ = x + 1

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

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

sham :: (Signal Cmd, Signal Reg, Signal Reg, Signal Reg) -> (Signal Reg, Signal Int)
sham (cmd, dest, srcA, srcB) = (dest' , aluOutput')
  where
  aluOutput = alu cmd aluInputA aluInputB
  (aluInputA, aluInputB) = regFile (dest' , aluOutput') srcA srcB
  dest' = delay R0 dest
  aluOutput' = delay 0 aluOutput