-- The multiplier from Mary's FMCAD'04 paper.

import Lava
import Lava.Patterns
import Lava.Arithmetic
import Lava.Smv



-- A tuple of the components that will be needed for building the multiplier
type Components s =
    ( s                   -- low
    , s                   -- high
    , (s,s) -> s          -- and2
    , (s,s) -> (s,s)      -- halfAdd
    , (s,(s,s)) -> (s,s)  -- fullAdd
    )

-- Components for logic simulation
logicComps :: Components (Signal Bool)
logicComps = (low,high,and2,halfAdd,fullAdd)

-- Components for delay estimation
delayComps :: Components (Signal Int)
delayComps = (0,0,an,ha,fa)
  where
    an (a,b)     = 1 + max a b
    ha (a,b)     = let x = 2 + max a b in (x,x)
    fa (c,(a,b)) = let x = 3 + maximum [a,b,c] in (x,x)

-- Partial products, grouped by weight
prods_by_weight :: Components s -> ([s],[s]) -> [[s]]
prods_by_weight (l,h,an,ha,fa) (as,bs)
    = [[an (a,b) | (a,m) <- number as,
                   (b,n) <- number bs,
                   m+n == w] | w <- [0 .. 2*length as-2]]
 where
    number cs = zip cs [0 .. length cs-1]

(|-) col hc (as,bs) = (cs,d:ds)
  where
    (cs',d) = hc bs
    (cs,ds) = col (as,cs')

(-|) col wc (a:as,bs) = (cs,ds)
  where
    cs'     = wc (a,bs)
    (cs,ds) = col (as,cs')

insert a bs = a:bs  -- Stick to front: array mult
-- insert a bs = bs ++ [a]  -- Stick to end: Dadda

hcell :: Components s -> [s] -> ([s],s)
hcell (l,h,an,ha,fa) (b1:b2:bs) = (insert s bs, c)
  where
    (s,c) = ha (b1,b2)

fcell :: Components s -> (s,[s]) -> ([s],s)
fcell (l,h,an,ha,fa) (ci,bs) = (insert s xs, c)
  where
    x1:x2:x3:xs = insert ci bs
    (s,c)       = fa (x1,(x2,x3))

wcell :: (s,[s]) -> [s]
wcell (a,bs) = insert a bs

compress :: Components s -> ([s],[s]) -> ([s],[s])
compress comps (as,bs)
    | diff >  2 = (compress comps |- hcell comps) (as,bs)
    | diff == 2 = column (fcell comps)            (as,bs)
    | diff <  2 = (compress comps -| wcell)       (as,bs)
  where
    diff = length bs - length as

redArray :: Components s -> [[s]] -> [[s]]
redArray comps ps = is
  where
    (is,[]) = row (compress comps) ([],ps)

binaryAdder :: Components s -> [(s,s)] -> [s]
-- binaryAdder (l,h,an,ha,fa) abs = ss ++ [c]
binaryAdder (l,h,an,ha,fa) abs = map an abs  -- To short-cut adder in depth calculation
  where
    (ss,c) = row fa (l,abs)

multBin :: Components s -> ([s],[s]) -> [s]
multBin comps (as,bs) = p1:ss
  where
    ([p1]:[p2,p3]:ps) = prods_by_weight comps (as,bs)
    is                = [(i1,i2) | [i1,i2] <- redArray comps ps]
    ss                = binaryAdder comps ((p2,p3):is)

prop_mult n =
    forAll (list n) $ \as ->
    forAll (list n) $ \bs ->
      multBin logicComps (as,bs) <==> multi (as,bs)

delays :: Int -> Signal Int -> [Signal Int]
delays n inp = multBin delayComps (replicate n inp, replicate n inp)

totDelay :: Int -> Signal Int -> Signal Int
totDelay n inp = maximum (delays n inp)