DF.hs

{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, FlexibleInstances #-}
module DF where

import CLaSH.Prelude hiding (parNDF, LockStep (..))
import CLaSH.Prelude.Explicit
import qualified Data.List as DL

-- The workaround begins here
parNDF :: (KnownSymbol nm, KnownNat rate, KnownNat n)
       => Vec n (DataFlow' ('Clk nm rate) aEn bEn a b)
       -> DataFlow' ('Clk nm rate)
                    (Vec n aEn)
                    (Vec n bEn)
                    (Vec n a)
                    (Vec n b)
parNDF fs =
  DF (\as aVs bRs ->
        let clk  = sclock
            as'  = unbundle' clk as
            aVs' = unbundle' clk aVs
            bRs' = unbundle' clk bRs
            (bs,bVs,aRs) = unzip3 (zipWith (\k (a,b,r) -> df k a b r) fs
                                  (zip3 (lazyV as') (lazyV aVs') bRs'))
        in  (bundle' clk bs,bundle' clk bVs, bundle' clk aRs)
     )


class LockStep a b where
  lockStep :: (KnownNat rate,KnownSymbol nm)
           => DataFlow' ('Clk nm rate) a Bool b b

  stepLock :: (KnownNat rate,KnownSymbol nm)
           => DataFlow' ('Clk nm rate) Bool a b b

instance LockStep Bool c where
  lockStep = idDF
  stepLock = idDF

instance (LockStep a x, LockStep b y) => LockStep (a,b) (x,y) where
  lockStep = (lockStep `parDF` lockStep) `seqDF`
                (DF (\xy xyV rdy -> let clk       = sclock
                                        (xV,yV)   = unbundle' clk xyV
                                        val       = xV .&&. yV
                                        xR        = yV .&&. rdy
                                        yR        = xV .&&. rdy
                                        xyR       = bundle' clk (xR,yR)
                                    in  (xy,val,xyR)))

  stepLock = (DF (\xy val xyR -> let clk     = sclock
                                     (xR,yR) = unbundle' clk xyR
                                     rdy     = xR  .&&. yR
                                     xV      = val .&&. yR
                                     yV      = val .&&. xR
                                     xyV     = bundle' clk (xV,yV)
                                 in  (xy,xyV,rdy))) `seqDF` (stepLock `parDF` stepLock)

instance (LockStep en a, KnownNat m, m ~ (n + 1), KnownNat (n+1)) =>
  LockStep (Vec m en) (Vec m a) where
  lockStep = parNDF (repeat lockStep) `seqDF`
    DF (\xs vals rdy ->
          let val  = and <$> vals
              rdys = allReady <$> rdy <*> (repeat <$> vals)
          in  (xs,val,rdys)
       )
  stepLock =
    DF (\xs val rdys ->
          let rdy  = and <$> rdys
              vals = allReady <$> val <*> (repeat <$> rdys)
          in  (xs,vals,rdy)
       ) `seqDF` parNDF (repeat stepLock)


allReady :: KnownNat (n+1) => Bool -> Vec (n+1) (Vec (n+1) Bool)
         -> Vec (n+1) Bool
allReady b vs = map (and . (b :>) . tail) (smap (flip rotateLeftS) vs)
-- The workaround ends here


-- The original code
dataFlowDriver :: DataFlow iEn oEn i o
               -> (Signal (i,iEn,oEn) -> Signal (o,oEn,iEn))
dataFlowDriver fl i = o where
  f = df fl
  (i', xs, r) = unbundle i
  (oS, xs', r') = f i' xs r
  o = bundle (oS, xs', r')

addM :: Num b => a -> b -> (a,b)
addM s i = (s, i + 1)

addDF :: Num a => DataFlow Bool Bool a a
addDF = mealyDF addM 0

fifoAddDF :: Num a => DataFlow Bool Bool a a
fifoAddDF = fifoDF d4 Nil `seqDF` addDF `seqDF` fifoDF d4 Nil

addNDF :: DataFlow (Vec 4 Bool) (Vec 4 Bool) (Vec 4 Int) (Vec 4 Int)
addNDF = parNDF $ repeat fifoAddDF

demuxAdd :: Vec 4 Int -> (Int,Int) -> (Vec 4 Int, Vec 4 Int)
demuxAdd xs (i,j) = (xs,o) where
  o = replace i j xs

demuxAddDF :: DataFlow Bool Bool (Int,Int) (Vec 4 Int)
demuxAddDF = mealyDF demuxAdd (repeat 1)

addDF' :: DataFlow Bool (Vec 4 Bool) (Int,Int) (Vec 4 Int)
addDF' = demuxAddDF `seqDF` stepLock `seqDF` addNDF

addNDFMachine :: Signal (Vec 4 Int, Vec 4 Bool, Vec 4 Bool)
              -> Signal (Vec 4 Int, Vec 4 Bool, Vec 4 Bool)
addNDFMachine = dataFlowDriver addNDF

addDFMachine :: Signal ((Int,Int), Bool, Vec 4 Bool)
             -> Signal (Vec 4 Int, Vec 4 Bool, Bool)
addDFMachine = dataFlowDriver addDF'

testDF = DL.drop 2
       $ sampleN 10
       $ simulate addDFMachine (DL.repeat ((0,1), True, repeat True))