Haskell/Kansas Lava shift register errors

Question

I got a piece of code from a kansas-lava paper, that works.

counter :: Signal CLK Bool -> Signal CLK Bool -> Signal CLK Int
counter restart inc = loop
  where
    reg = register 0 loop
    reg' = mux restart (0, reg)
    loop = mux inc (reg' + 1, reg')

Now I tried to do the same in another function, with another functionality, this doesn't work.

shiftReg_d2f :: Signal CLK Bool -> Signal CLK Bool -> [Signal CLK Bool] -> [Signal CLK Bool] -> [Signal CLK Bool]
shiftReg_d2f load shift wordIn fieldIn = fieldOut
  where
    fieldOut = register 0 fieldOut''
    shiftField = drop (length wordIn) fieldOut ++ wordIn
    fieldOut' = muxl shift fieldOut shiftField
    fieldOut'' = muxl load fieldOut' fieldIn

Now I'm getting the following errors:

• Couldn't match expected type [Signal i0 Bool] with actual type Signal clk0 a0 (3x)
• Couldn't match expected type Signal i0 Bool with actual type [Signal i0 Bool]
• Couldn't match expected type Signal i Bool -> Signal i Bool -> Signal i Bool with actual type Signal i Bool

What do I do wrong?

Thanks for the help

Answer 1

The problem is you are mixing up Signal clk [a] with [Signal clk a]. The former is basically unworkable in the HDL setting since its width is unbounded and could change from cycle to cycle.

What you can do instead is define fieldOut wire-by-wire. The key insight is that given inputs

fieldIn =  [x0, x1, x2, x3]
wordIn =   [w0, w1, w2]
fieldOut = [y0, y1, y2, y3]

your output needs to be one of

if load:   [x0, x1, x2, x3] = fieldIn
if shift:  [y3, w0, w1, w2] = drop (lenght wordIn) fieldOut ++ wordIn
otherwise: [y0, y1, y2, y3] = fieldOut

So by zipping over fieldIn and drop (length wordIn) fieldOut ++ wordIn we can generate it bit by bit:

shiftReg_d2f :: Signal CLK Bool -> Signal CLK Bool -> [Signal CLK Bool] -> [Signal CLK Bool] -> [Signal CLK Bool]
shiftReg_d2f load shift wordIn fieldIn = fieldOut
  where
    fieldOut = zipWith toOutput fieldIn (drop (length wordIn) fieldOut ++ wordIn)
    toOutput input shifted = r
      where
        r = register False $ mux load (mux shift (r, shifted), input)