{-# LANGUAGE TemplateHaskell #-}

-- The following example is designed as tutorial example for the paper.
--
-- It implements a simple ALU, which has the following modes
--   HH: out <- a AND b
--   HL: out <- a OR b
--   LH: (cout, out) <- ADD a b
--   LL: out <- shiftl a 0
--
-- The expressiveness of the compiler could be clearly improved, if the
-- higher-order function 'zipWith' that works on vectors would be synthesizable.
-- Check 'and4BitFun'!
--
-- We could improve the example even further, if we use enumeration types for the
-- multiplexer. So far I have not done it, but should only be a matter of time!

module ALU where

import ForSyDe.Deep
import Data.Bits
import Data.Param.FSVec
import Data.TypeLevel.Num.Reps
import Data.TypeLevel.Num.Aliases


----- AND - 4 Bit

and4BitFun :: ProcFun (FSVec D4 Bit -> FSVec D4 Bit -> FSVec D4 Bit)
and4BitFun = $(newProcFun [d| and4BitFun :: FSVec D4 Bit
                                         -> FSVec D4 Bit
                                         -> FSVec D4 Bit
                              --and4BitFun a b = Data.Param.FSVec.zipWith (.&.) a b
                              and4BitFun a b =  (a!d3 .&. b!d3) +> (a!d2 .&. b!d2) +> (a!d1 .&. b!d1) +> (a!d0 .&. b!d0) +> empty
                            |])


and4BitProc :: Signal (FSVec D4 Bit)
            -> Signal (FSVec D4 Bit)
            -> Signal (FSVec D4 Bit)
and4BitProc = zipWithSY "and4" and4BitFun

and4BitSys :: SysDef (Signal (FSVec D4 Bit)
                   -> Signal (FSVec D4 Bit)
                   -> Signal (FSVec D4 Bit))
and4BitSys =  newSysDef and4BitProc "and4Bit" ["a", "b"] ["y"]

simAnd4Bit :: [FSVec D4 Bit] -> [FSVec D4 Bit] -> [FSVec D4 Bit]
simAnd4Bit = simulate and4BitSys

vhdlAnd4Bit = writeVHDL and4BitSys


----- OR - 4 Bit

or4BitFun :: ProcFun (FSVec D4 Bit -> FSVec D4 Bit -> FSVec D4 Bit)
or4BitFun = $(newProcFun [d| or4BitFun :: FSVec D4 Bit -> FSVec D4 Bit -> FSVec D4 Bit
                              --or4BitFun a b = Data.Param.FSVec.zipWith (.&.) a b
                             or4BitFun a b =  (a!d3 .|. b!d3) +> (a!d2 .|. b!d2) +> (a!d1 .|. b!d1) +> (a!d0 .|. b!d0) +> empty
                            |])


or4BitProc :: Signal (FSVec D4 Bit)
            -> Signal (FSVec D4 Bit)
            -> Signal (FSVec D4 Bit)
or4BitProc = zipWithSY "or4" or4BitFun

or4BitSys :: SysDef (Signal (FSVec D4 Bit)
                   -> Signal (FSVec D4 Bit)
                   -> Signal (FSVec D4 Bit))
or4BitSys =  newSysDef or4BitProc "or4Bit" ["a", "b"] ["y"]

simOr4Bit :: [FSVec D4 Bit] -> [FSVec D4 Bit] -> [FSVec D4 Bit]
simOr4Bit = simulate or4BitSys

vhdlOr4Bit = writeVHDL or4BitSys

----- Logical Shift Left

lslFun :: ProcFun (FSVec D4 Bit -> FSVec D4 Bit)
lslFun = $(newProcFun [d| lslFun :: FSVec D4 Bit -> FSVec D4 Bit
                          lslFun a = shiftl a L
                        |])

lslProc :: Signal (FSVec D4 Bit) -> Signal (FSVec D4 Bit)
lslProc = mapSY "lsl" lslFun

lslSys :: SysDef (Signal (FSVec D4 Bit) -> Signal (FSVec D4 Bit))
lslSys = newSysDef lslProc "lsl" ["in"] ["out"]

simLsl :: [FSVec D4 Bit] -> [FSVec D4 Bit]
simLsl = simulate lslSys

vhdlLsl = writeVHDL lslSys

----- Mux 4/1 (no use of FSVec as input, only for selection)

mux41Fun :: ProcFun (FSVec D2 Bit
                  -> FSVec D4 Bit
                  -> FSVec D4 Bit
                  -> FSVec D4 Bit
                  -> FSVec D4 Bit
                  -> FSVec D4 Bit)
mux41Fun = $(newProcFun [d| mux41Fun :: FSVec D2 Bit
                                     -> FSVec D4 Bit
                                     -> FSVec D4 Bit
                                     -> FSVec D4 Bit
                                     -> FSVec D4 Bit
                                     -> FSVec D4 Bit
                            mux41Fun sel x3 x2 x1 x0
                               = if sel == H +> H +> empty then
                                    x3
                                 else
                                    if sel == H +> L +> empty then
                                       x2
                                    else
                                       if sel == L +> H +> empty then
                                          x1
                                       else
                                          x0
                          |])

mux41Proc :: Signal (FSVec D2 Bit) -> Signal (FSVec D4 Bit)
          -> Signal (FSVec D4 Bit) -> Signal (FSVec D4 Bit)
          -> Signal (FSVec D4 Bit) -> Signal (FSVec D4 Bit)
mux41Proc = zipWith5SY "mux41" mux41Fun

mux41Sys :: SysDef (Signal (FSVec D2 Bit) -> Signal (FSVec D4 Bit)
                 -> Signal (FSVec D4 Bit) -> Signal (FSVec D4 Bit)
                 -> Signal (FSVec D4 Bit) -> Signal (FSVec D4 Bit))
mux41Sys = newSysDef mux41Proc "mux41" ["sel", "d3", "d2", "d1", "d0"] ["out"]

simMux41 :: [FSVec D2 Bit] -> [FSVec D4 Bit] -> [FSVec D4 Bit]
         -> [FSVec D4 Bit] -> [FSVec D4 Bit] -> [FSVec D4 Bit]
simMux41 = simulate mux41Sys

vhdlMux41 = writeVHDL mux41Sys

----- Convert FSVector to Tuple (Size 4)

convFromFSVec4Fun :: ProcFun (FSVec D4 Bit -> (Bit, Bit, Bit, Bit))
convFromFSVec4Fun = $(newProcFun [d| convFromFSVec4Fun :: FSVec D4 Bit -> (Bit, Bit, Bit, Bit)
                                     convFromFSVec4Fun v
                                       = (v!d3, v!d2, v!d1, v!d0)
                                   |])

convFromFSVec4Proc :: Signal (FSVec D4 Bit) -> (Signal Bit, Signal Bit, Signal Bit, Signal Bit)
convFromFSVec4Proc = (unzip4SY "unzip4" . mapSY "conv4" convFromFSVec4Fun)

convFromFSVec4Sys :: SysDef (Signal (FSVec D4 Bit) -> (Signal Bit, Signal Bit, Signal Bit, Signal Bit))
convFromFSVec4Sys = newSysDef convFromFSVec4Proc "convFromFSVec" ["vector4"] ["v3", "v2", "v1", "v0"]

simConvFromFSVec4 :: [FSVec D4 Bit] -> ([Bit], [Bit], [Bit], [Bit])
simConvFromFSVec4 = simulate convFromFSVec4Sys

vhdlConvFromFSVec4 =  writeVHDL convFromFSVec4Sys

----- Convert To FSVector (Size 4)

convToFSVec4Fun :: ProcFun (Bit -> Bit -> Bit -> Bit -> FSVec D4 Bit)
convToFSVec4Fun = $(newProcFun [d| convToFSVec4Fun :: Bit -> Bit -> Bit -> Bit -> FSVec D4 Bit
                                   convToFSVec4Fun x3 x2 x1 x0
                                      = x3 +> x2 +> x1 +> x0 +> empty |])

convToFSVec4Proc :: Signal Bit -> Signal Bit -> Signal Bit -> Signal Bit -> Signal (FSVec D4 Bit)
convToFSVec4Proc = zipWith4SY "toVector4" convToFSVec4Fun

convToFSVec4Sys :: SysDef (Signal Bit -> Signal Bit -> Signal Bit -> Signal Bit -> Signal (FSVec D4 Bit))
convToFSVec4Sys =  newSysDef convToFSVec4Proc "convToFSVec" ["x3", "x2", "x1", "x0"] ["vec4"]

simConvToFSVec4 = simulate convToFSVec4Sys

vhdlConvToFSVec4 = writeVHDL convToFSVec4Sys

------ Full Adder

fullAddFun :: ProcFun (Bit -> Bit -> Bit -> (Bit, Bit))
fullAddFun = $(newProcFun
  [d|fullAddFun :: Bit -> Bit -> Bit -> (Bit, Bit)
     fullAddFun a b c_in = (c_out, sum)
       where c_out :: Bit
             c_out = (a .&. b) .|. (a .&. c_in) .|. (b .&. c_in)
             sum :: Bit
             sum = (a `xor` b) `xor` c_in  |])


--fullAddProc :: Signal Bit -> Signal Bit -> Signal Bit -> Signal (Bit, Bit)
--fullAddProc = zipWith3SY "fulladd" fullAddFun
fullAddProc :: Signal Bit -> Signal Bit -> Signal Bit -> (Signal Bit, Signal Bit)
fullAddProc a b c_in = (unzipSY "unzipSY") $ (zipWith3SY "fulladd" fullAddFun a b c_in)

fullAddSys :: SysDef (Signal Bit -> Signal Bit -> Signal Bit -> (Signal Bit, Signal Bit))
fullAddSys = newSysDef fullAddProc "fullAddSys" ["a", "b", "c_in"] ["cout", "sum"]

simFullAdd :: [Bit] -> [Bit] -> [Bit] -> ([Bit], [Bit])
simFullAdd = simulate fullAddSys

--vhdlFullAdd = writeVHDL fullAddSys

a_in = [L,L,L,L,H,H,H,H]
b_in = [L,H,L,H,L,H,L,H]
c_in = [L,L,H,H,L,L,H,H]

------ 4-bit Adder Chain

fourBitAdder :: Signal Bit   -- C_IN
             -> Signal Bit   -- A3
             -> Signal Bit   -- A2
             -> Signal Bit   -- A1
             -> Signal Bit   -- A0
             -> Signal Bit   -- B3
             -> Signal Bit   -- B2
             -> Signal Bit   -- B1
             -> Signal Bit   -- B0
             -> (Signal Bit, -- C_OUT
                 Signal Bit, -- SUM3
                 Signal Bit, -- SUM2
                 Signal Bit, -- SUM1
                 Signal Bit) -- SUM0
fourBitAdder c_in a3 a2 a1 a0 b3 b2 b1 b0
                = (c_out, sum3, sum2, sum1, sum0)
                  where (c_out, sum3) = (instantiate "add3" fullAddSys) a3 b3 c2
                        (c2, sum2)    = (instantiate "add2" fullAddSys) a2 b2 c1
                        (c1, sum1)    = (instantiate "add1" fullAddSys) a1 b1 c0
                        (c0, sum0)    = (instantiate "add0" fullAddSys) a0 b0 c_in

fourBitAdderSys :: SysDef (Signal Bit   -- C_IN
                        -> Signal Bit   -- A3
                        -> Signal Bit   -- A2
                        -> Signal Bit   -- A1
                        -> Signal Bit   -- A0
                        -> Signal Bit   -- B3
                        -> Signal Bit   -- B2
                        -> Signal Bit   -- B1
                        -> Signal Bit   -- B0
                        -> (Signal Bit, -- C_OUT
                            Signal Bit, -- SUM3
                            Signal Bit, -- SUM2
                            Signal Bit, -- SUM1
                            Signal Bit)) -- SUM0
fourBitAdderSys = newSysDef fourBitAdder "fourBitAdder" ["C_IN", "A3", "A2", "A1", "A0",
                                             "B3", "B2", "B1", "B0"]
                                            ["C_OUT", "SUM3", "SUM2", "SUM1", "SUM0"]

simFourBitAdder = simulate fourBitAdderSys

vhdlFourBitAdder = writeVHDL fourBitAdderSys

a0 = [L,L,L,L,L,L,L,L,H,H,H,H,H,H,H,H]
a1 = [L,L,L,L,H,H,H,H,L,L,L,L,H,H,H,H]
a2 = [L,L,H,H,L,L,H,H,L,L,H,H,L,L,H,H]
a3 = [L,H,L,H,L,H,L,H,L,H,L,H,L,H,L,H]
zero = [L,L,L,L,L,L,L,L,L,L,L,L,L,L,L,L]
one = [H,H,H,H,H,H,H,H,H,H,H,H,H,H,H,H]


simAdd_0 = simFourBitAdder zero a3 a2 a1 a0 a3 a2 a1 a0
simAdd_1 = simFourBitAdder one a3 a2 a1 a0 a3 a2 a1 a0


----- FSVec Adder
add4FSVecProc :: Signal (FSVec D4 Bit)
              -> Signal (FSVec D4 Bit)
              -> (Signal Bit, Signal (FSVec D4 Bit))
add4FSVecProc a b = (cout, sum)
                    where
                       (a3,a2,a1,a0) = (instantiate "split_a" convFromFSVec4Sys) a
                       (b3,b2,b1,b0) = (instantiate "split_b" convFromFSVec4Sys) b
                       (cout, s3, s2, s1, s0) = (instantiate "adder" fourBitAdderSys) zero a3 a2 a1 a0 b3 b2 b1 b0
                       sum = (instantiate "merge" convToFSVec4Sys) s3 s2 s1 s0
                       zero = instantiate "Zero" zeroSys

add4FSVecSys :: SysDef (Signal (FSVec D4 Bit)
              -> Signal (FSVec D4 Bit)
              -> (Signal Bit, Signal (FSVec D4 Bit)))
add4FSVecSys = newSysDef add4FSVecProc "add4FSVec" ["a", "b"] ["cout", "sum"]

simAdd4FSVecSys = simulate add4FSVecSys

vhdlAdd4FSVecSys = writeVHDL add4FSVecSys

----- Constant Signals

-- Constant input 'H' modeled with constSY
oneProc :: Signal Bit
oneProc = constSY "high" H

oneSys :: SysDef (Signal Bit)
oneSys = newSysDef oneProc "one" [] ["one"]

-- Constant input 'L' modeled with constSY
zeroProc :: Signal Bit
zeroProc = constSY "low" L

zeroSys :: SysDef (Signal Bit)
zeroSys = newSysDef zeroProc "zero" [] ["zero"]

----- ALU

aluProc :: Signal(FSVec D2 Bit)
        ->  Signal (FSVec D4 Bit)
        ->  Signal (FSVec D4 Bit)
        ->  (Signal Bit, Signal (FSVec D4 Bit))
aluProc sel a b = (cout, out)
                  where
                     andOut = (instantiate "and" and4BitSys) a b
                     orOut = (instantiate "or" or4BitSys) a b
                     (cout, sum) = (instantiate "add" add4FSVecSys) a b
                     lslOut = (instantiate "lsl" lslSys) a
                     out =  (instantiate "mux" mux41Sys) sel andOut orOut sum lslOut


aluSys :: SysDef (Signal(FSVec D2 Bit)
              ->  Signal (FSVec D4 Bit)
              ->  Signal (FSVec D4 Bit)
              ->  (Signal Bit, Signal (FSVec D4 Bit)))
aluSys = newSysDef aluProc "alu" ["sel", "a", "b"] ["cout", "data"]


simALU :: [FSVec D2 Bit] ->  [FSVec D4 Bit] -> [FSVec D4 Bit] -> ([Bit], [FSVec D4 Bit])
simALU = simulate aluSys

vhdlALU = writeVHDL aluSys

----- Test-Inputs

sel = [reallyUnsafeVector [H,H], -- AND
       reallyUnsafeVector [H,L], -- OR
       reallyUnsafeVector [L,H], -- ADD
       reallyUnsafeVector [L,L]] -- LSL

a = [reallyUnsafeVector [L,H,H,H], -- LSB D1 D2 MSB
     reallyUnsafeVector [L,H,L,H],
     reallyUnsafeVector [H,H,H,H],
     reallyUnsafeVector [L,H,H,H]]

b = [reallyUnsafeVector [H,H,H,H],
     reallyUnsafeVector [H,H,L,H],
     reallyUnsafeVector [H,L,L,L],
     reallyUnsafeVector [H,H,H,H]]