{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}

-- | Helper functions to convert streams and signal functions from
-- Rattus into Haskell.

module Rattus.ToHaskell
  (runTransducer,
   runSF,
   fromStr,
   toStr,
   Trans(..)
  ) where

import System.IO.Unsafe
import Data.IORef
import Rattus.Primitives
import Rattus.Stream
import Rattus.Yampa
import Rattus.Strict


-- | A state machine that takes inputs of type @a@ and produces output
-- of type @b@. In addition to the output of type @b@ the underlying
-- function also returns the new state of the state machine.
data Trans a b = Trans (a -> (b, Trans a b))

-- | Turn a stream function into a state machine.
runTransducer :: (Str a -> Str b) -> Trans a b
runTransducer :: (Str a -> Str b) -> Trans a b
runTransducer Str a -> Str b
tr = (a -> (b, Trans a b)) -> Trans a b
forall a b. (a -> (b, Trans a b)) -> Trans a b
Trans a -> (b, Trans a b)
run
  where run :: a -> (b, Trans a b)
run a
a = IO (b, Trans a b) -> (b, Trans a b)
forall a. IO a -> a
unsafePerformIO (IO (b, Trans a b) -> (b, Trans a b))
-> IO (b, Trans a b) -> (b, Trans a b)
forall a b. (a -> b) -> a -> b
$ do
          IORef (Str a)
asR <- Str a -> IO (IORef (Str a))
forall a. a -> IO (IORef a)
newIORef Str a
forall a. HasCallStack => a
undefined
          Str a
as <- IO (Str a) -> IO (Str a)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Str a) -> IO (Str a)) -> IO (Str a) -> IO (Str a)
forall a b. (a -> b) -> a -> b
$ IORef (Str a) -> IO (Str a)
forall a. IORef a -> IO a
readIORef IORef (Str a)
asR
          let b
b ::: O (Str b)
bs = Str a -> Str b
tr (a
a a -> O (Str a) -> Str a
forall a. a -> O (Str a) -> Str a
::: Str a -> O (Str a)
forall a. a -> O a
delay Str a
as)
          (b, Trans a b) -> IO (b, Trans a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, (a -> (b, Trans a b)) -> Trans a b
forall a b. (a -> (b, Trans a b)) -> Trans a b
Trans (Str b -> IORef (Str a) -> a -> (b, Trans a b)
forall b a. Str b -> IORef (Str a) -> a -> (b, Trans a b)
run' (O (Str b) -> Str b
forall a. O a -> a
adv O (Str b)
bs) IORef (Str a)
asR))
        run' :: Str b -> IORef (Str a) -> a -> (b, Trans a b)
run' Str b
bs IORef (Str a)
asR a
a = IO (b, Trans a b) -> (b, Trans a b)
forall a. IO a -> a
unsafePerformIO (IO (b, Trans a b) -> (b, Trans a b))
-> IO (b, Trans a b) -> (b, Trans a b)
forall a b. (a -> b) -> a -> b
$ do
          IORef (Str a)
asR' <- Str a -> IO (IORef (Str a))
forall a. a -> IO (IORef a)
newIORef Str a
forall a. HasCallStack => a
undefined
          Str a
as' <- IO (Str a) -> IO (Str a)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Str a) -> IO (Str a)) -> IO (Str a) -> IO (Str a)
forall a b. (a -> b) -> a -> b
$ IORef (Str a) -> IO (Str a)
forall a. IORef a -> IO a
readIORef IORef (Str a)
asR'
          IORef (Str a) -> Str a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Str a)
asR (a
a a -> O (Str a) -> Str a
forall a. a -> O (Str a) -> Str a
::: Str a -> O (Str a)
forall a. a -> O a
delay Str a
as')
          let b
b ::: O (Str b)
bs' = Str b
bs
          (b, Trans a b) -> IO (b, Trans a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, (a -> (b, Trans a b)) -> Trans a b
forall a b. (a -> (b, Trans a b)) -> Trans a b
Trans (Str b -> IORef (Str a) -> a -> (b, Trans a b)
run' (O (Str b) -> Str b
forall a. O a -> a
adv O (Str b)
bs') IORef (Str a)
asR'))

-- | Turn a signal function into a state machine from inputs of type
-- @a@ and time (since last input) to output of type @b@.
runSF :: SF a b -> Trans (a, Double) b
runSF :: SF a b -> Trans (a, Double) b
runSF SF a b
sf = ((a, Double) -> (b, Trans (a, Double) b)) -> Trans (a, Double) b
forall a b. (a -> (b, Trans a b)) -> Trans a b
Trans (\(a
a,Double
t) -> let (O (SF a b)
s:* b
b) = SF a b -> Double -> a -> O (SF a b) :* b
forall a b. SF a b -> Double -> a -> O (SF a b) :* b
stepSF SF a b
sf Double
t a
a in (b
b, SF a b -> Trans (a, Double) b
forall a b. SF a b -> Trans (a, Double) b
runSF (O (SF a b) -> SF a b
forall a. O a -> a
adv O (SF a b)
s)))


-- | Turns a lazy infinite list into a stream.
toStr :: [a] -> Str a
toStr :: [a] -> Str a
toStr (a
x : [a]
xs) = a
x a -> O (Str a) -> Str a
forall a. a -> O (Str a) -> Str a
::: Str a -> O (Str a)
forall a. a -> O a
delay ([a] -> Str a
forall a. [a] -> Str a
toStr [a]
xs)
toStr [a]
_ = [Char] -> Str a
forall a. HasCallStack => [Char] -> a
error [Char]
"toStr: input terminated"

-- | Turns a stream into a lazy infinite list.
fromStr :: Str a -> [a]
fromStr :: Str a -> [a]
fromStr (a
x ::: O (Str a)
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Str a -> [a]
forall a. Str a -> [a]
fromStr (O (Str a) -> Str a
forall a. O a -> a
adv O (Str a)
xs)