import Lava
import Lava.Patterns
import Lava.Arithmetic
import VhdlNew11 -- not included in chalmers-lava2000, available
                    -- on the Schedule page along with this Lava2.hs file
                    -- put in same directory as Lava2.hs and uncomment import
                    -- and function calls in VHDL gen. section below
                    -- to get slightly nicer VHDL netlist generation
                    -- Windows friendly too




--- A first example ------------------------------------------------------------
halfAdder (a, b) = (sum, carry)
  where
    sum   = xor2 (a, b)
    carry = and2 (a, b)


--- A second example -----------------------------------------------------------
type Bit = Signal Bool   -- convenient abbreviation


fullAdder :: (Bit,(Bit,Bit)) -> (Bit,Bit)
fullAdder (carryIn, (a, b)) = (sum, carryOut)
  where
    (s1,  c1) = halfAdder (a, b)
    (sum, c2) = halfAdder (carryIn, s1)
    carryOut  = xor2 (c2, c1)



-- Formal verification of generic circuits

prop_AdderCommutative (as,bs) = ok
  where
    out1 = binAdder (as,bs)
    out2 = binAdder (bs,as)
    ok    = out1 <==> out2

prop_AdderCommutative_ForSize n =
    forAll (list n) $ \ as ->
      forAll (list n) $ \ bs ->
        prop_AdderCommutative (as,bs)


fv_binAdd_Comm = smv (prop_AdderCommutative_ForSize 16)


-- Another way to do the same thing --------------------------------------------

prop_AdderComm1 n = prop_AdderCommutative (varList n "a", varList n "b")


fv_binAdd_Comm1 = smv (prop_AdderComm1 16)


-- sequential ciruits ----------------------------------------------------------

bad inp = out
  where
    out = nand2(inp,out)

nand2D = nand2 ->- delay low

good a = out
  where
    out = nand2D(a,out)


delNand2 = delay (high,high) ->- nand2



sim0 = simulateSeq nand2D [(low,low),(high,low),(high,high),(low,low)]
sim1 = simulateSeq delNand2 [(low,low),(high,low),(high,high),(low,low)]


reg init (w,din) = dout
  where
    dout = delay init m
    m = mux (w,(dout,din))

-- using Haskell to generate inputs

-- infinite lists
lh :: [Bit]
lh =  low : high : lh

ins :: Int -> [[Signal Int]]
ins n = map (replicate n) [1..]

regtst n = simulateSeq (reg (zeroList n)) (take 10 (zip lh (ins n)))


-- Uses of serial composition --------------------------------------------------

doubSum :: [Signal Int] -> Signal Int
doubSum = map (*2) ->- sum

-- could also have written

doubSum1 :: [Signal Int] -> Signal Int
doubSum1 as = sum (map double as)
  where
    double a = a * 2



-- Connection patterns. See Lava.Patterns.hs for compose, composeN---------------

composeNR :: Int -> (a -> a) -> a -> a
composeNR 0 circ = id
composeNR n circ = circ ->- composeNR (n-1) circ


doubN :: Int -> Signal Int -> Signal Int
doubN n = composeN n (*2)


red :: ((a,b) -> a) -> (a, [b]) -> a
red f (a,[])      = a
red f (a, (b:bs)) = red f (f(a,b), bs)

lin f (a:as) = red f (a,as)
lin _ []     = error "lin: empty list"

redtst = simulate (red plus) (3,[1..5])

lintst = simulate (lin plus) [1..5]

downtri f = reverse ->- tri f ->- reverse


msbbin2int  =  map bit2int ->- downtri (*2) ->- lin plus

msbbin2int'  =  map bit2int ->- lin cell
  where
    cell (a,b)  =  2*a + b


withtri f = downtri (delay low) ->- lin f

piped f = lin cell
  where
    cell (a,b) = f (delay low a, b)





--- Generating VHDL ------------------------------------------------------------

-- from Lecture 1
rcAdder0 :: (Bit,([Bit],[Bit])) -> ([Bit],Bit)
rcAdder0 (c0, ([], [])) = ([], c0)
rcAdder0 (c0, (a0:as, b0:bs)) = (s1:ss, cOut)
  where
    (s1, c1)   = fullAdder (c0, (a0, b0))
    (ss, cOut) = rcAdder0 (c1, (as, bs))


rcAdder1 :: (Bit,([Bit],[Bit])) -> ([Bit],Bit)
rcAdder1 (c0, (as, bs)) = (sum, cOut)
  where
    (sum, cOut) = row fullAdder (c0, zipp (as,bs))

vhdl1 = writeVhdl "fullAdder" fullAdder

-- vhdl1b = writeVhdlNoClk "fullAdder" fullAdder

-- Assigning names to the inputs

vhdl2 = writeVhdlInput "fullAdder" fullAdder (var "carryIn",(var "a",var "b"))

-- Assigning names also to the outputs

vhdl3 = writeVhdlInputOutput "fullAdder" fullAdder
                             (var "carryIn",(var "a",var "b"))
             (var "sum",var "carryOut")

-- Generic circuits are not supported, so you need to pick a size

vhdl4 = writeVhdlInputOutput "rippleCarryAdder" rcAdder1
       (var "carryIn",(varList 8 "a",varList 8 "b"))
           (varList 8 "sum",var "carryOut")

-- vhdl4b n = writeVhdlInputOutputNoClk "rippleCarryAdder" rcAdder1
--             (var "carryIn",(varList n "a",varList n "b"))
--           (varList n "sum",var "carryOut")






--- Formal Verification --------------------------------------------------------



-- A general function for equivalence testing
propEQ circ1 circ2 inp = ok
  where
    out1 = circ1 inp
    out2 = circ2 inp
    ok = out1 <==> out2

propEQS circ1 circ2  n = propEQ circ1 circ2 (varList n "a")




prop0 = propEQ nand2D delNand2

fv_prop0 = smv prop0

pipetst = smv (propEQS (withtri and2) (piped and2)  8)