{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
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
data Trans a b = Trans (a -> (b, Trans a b))
runTransducer :: (Str a -> Str b) -> Trans a b
runTransducer :: forall a b. (Str a -> Str b) -> Trans a b
runTransducer Str a -> Str b
tr = 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 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
IORef (Str a)
asR <- forall a. a -> IO (IORef a)
newIORef forall a. HasCallStack => a
undefined
Str a
as <- forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ 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 forall a. a -> O (Str a) -> Str a
::: forall a. a -> O a
delay Str a
as)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, forall a b. (a -> (b, Trans a b)) -> Trans a b
Trans (forall {b} {a}. Str b -> IORef (Str a) -> a -> (b, Trans a b)
run' (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 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
IORef (Str a)
asR' <- forall a. a -> IO (IORef a)
newIORef forall a. HasCallStack => a
undefined
Str a
as' <- forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (Str a)
asR'
forall a. IORef a -> a -> IO ()
writeIORef IORef (Str a)
asR (a
a forall a. a -> O (Str a) -> Str a
::: forall a. a -> O a
delay Str a
as')
let b
b ::: O (Str b)
bs' = Str b
bs
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, forall a b. (a -> (b, Trans a b)) -> Trans a b
Trans (Str b -> IORef (Str a) -> a -> (b, Trans a b)
run' (forall a. O a -> a
adv O (Str b)
bs') IORef (Str a)
asR'))
runSF :: SF a b -> Trans (a, Double) b
runSF :: forall a b. SF a b -> Trans (a, Double) b
runSF SF a b
sf = forall a b. (a -> (b, Trans a b)) -> Trans a b
Trans (\(a
a,Double
t) -> let (O (SF a b)
s:* 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, forall a b. SF a b -> Trans (a, Double) b
runSF (forall a. O a -> a
adv O (SF a b)
s)))
toStr :: [a] -> Str a
toStr :: forall a. [a] -> Str a
toStr (a
x : [a]
xs) = a
x forall a. a -> O (Str a) -> Str a
::: forall a. a -> O a
delay (forall a. [a] -> Str a
toStr [a]
xs)
toStr [a]
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"toStr: input terminated"
fromStr :: Str a -> [a]
fromStr :: forall a. Str a -> [a]
fromStr (a
x ::: O (Str a)
xs) = a
x forall a. a -> [a] -> [a]
: forall a. Str a -> [a]
fromStr (forall a. O a -> a
adv O (Str a)
xs)