StreamSignal.hs

{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

module StreamSignal ( Stream(..), streamSignal, applying ) where

import Debug.Trace
import Data.Maybe
import System.IO
import qualified Data.List as L
import Control.Monad hiding (fail)
import Control.Monad.Fail
import System.IO.Unsafe
import Data.IORef
import Prelude ()
import Clash.Prelude hiding (fail)

data Stream i o = Stream o (i -> Stream i o)

applying :: [i] -> Stream i o -> [o]
applying (i:rest) (Stream o k) = o : applying rest (k i)
applying []       _            = []

-- | Convert a 'Signal' to a 'Stream', where the input to each timestep can be
-- computed as a function of previous outputs.
--
-- Note that the 'Stream' must be consumed linearly; that is, you can apply
-- the continuation associated with a particular stream element only once.
streamSignal :: forall clk i o. Show o => (Signal clk i -> Signal clk o) -> i -> Stream i o
streamSignal dut input0 = unsafePerformIO $ mdo
    -- oh the horror...
    inputRefs <- infiniteRefList Nothing
    let goOut :: Int -> [IORef (Maybe i)] -> [o] -> IO (Stream i o)
        goOut !n (inRef:inRefs) (out:rest) = do
            print ("goOut", n)
            let next :: i -> Stream i o
                next i = unsafePerformIO $ do
                    print ("wrote", n, out)
                    hFlush stdout
                    old <- atomicModifyIORef inRef (\old -> (Just i, old))
                    case old of
                      Nothing -> return ()
                      Just _  -> fail "streamIt: non-linear usage"
                    print ("hi")
                    unsafeInterleaveIO $ goOut (n+1) inRefs rest
            return $ traceShow ("forcing", n) $ Stream (traceShow ("out",n) out) next
        goOut _ _  [] = fail "reached end of Signal"
        goOut _ [] _  = fail "impossible"

    let inputs = input0 : fmap readInput inputRefs
        readInput ref = unsafePerformIO $ do
            putStrLn "reading"
            hFlush stdout
            val <- readIORef ref
            case val of
              Nothing -> fail "bad news bears"
              Just x -> return x
    goOut 0 inputRefs $ simulate_lazy dut inputs
{-# NOINLINE streamSignal #-}

infiniteRefList :: a -> IO [IORef a]
infiniteRefList val = go
  where
    go = do
        rest <- unsafeInterleaveIO go
        ref <- newIORef val
        return (ref : rest)