{-# Language ScopedTypeVariables, FlexibleContexts #-}
module Csound.Typed.Control.Ref(
    Ref(..), writeRef, readRef, newRef, mixRef, modifyRef, sensorsSE, newGlobalRef,
    concatRef, concatRef3, concatRef4, concatRef5,
    newCtrlRef, newGlobalCtrlRef,
    globalSensorsSE, newClearableGlobalRef, newTab, newGlobalTab,
    -- conditionals
    whileRef, whileRefD
) where

import Data.Boolean

import Control.Monad
import Control.Monad.Trans.Class
import Csound.Dynamic hiding (when1, newLocalVars, writeArr, readArr, whileRef)

import Csound.Typed.Types.Prim
import Csound.Typed.Types.Tuple
import Csound.Typed.GlobalState.SE
import Csound.Typed.GlobalState.GE

import qualified Csound.Dynamic as D

-- | It describes a reference to mutable values.
newtype Ref a = Ref [Var]
{-
    { writeRef :: a -> SE ()
    , readRef  :: SE a }
-}

writeRef :: Tuple a => Ref a -> a -> SE ()
writeRef :: Ref a -> a -> SE ()
writeRef (Ref [Var]
vars) a
a = Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ do
    [E]
vals <- a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
a
    Dep () -> GE (Dep ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Dep () -> GE (Dep ())) -> Dep () -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ (Var -> E -> Dep ()) -> [Var] -> [E] -> Dep ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Var -> E -> Dep ()
forall (m :: * -> *). Monad m => Var -> E -> DepT m ()
writeVar [Var]
vars [E]
vals

--    (zipWithM_ writeVar vars) =<< lift (fromTuple a)
--writeVar :: Var -> E -> Dep ()
--[Var] (GE [E])

readRef  :: Tuple a => Ref a -> SE a
readRef :: Ref a -> SE a
readRef (Ref [Var]
vars) = Dep a -> SE a
forall a. Dep a -> SE a
SE (Dep a -> SE a) -> Dep a -> SE a
forall a b. (a -> b) -> a -> b
$ ([E] -> a) -> DepT GE [E] -> Dep a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GE [E] -> a
forall a. Tuple a => GE [E] -> a
toTuple (GE [E] -> a) -> ([E] -> GE [E]) -> [E] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [E] -> GE [E]
forall (m :: * -> *) a. Monad m => a -> m a
return) (DepT GE [E] -> Dep a) -> DepT GE [E] -> Dep a
forall a b. (a -> b) -> a -> b
$ (Var -> DepT GE E) -> [Var] -> DepT GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Var -> DepT GE E
forall (m :: * -> *). Monad m => Var -> DepT m E
readVar [Var]
vars

-- | Allocates a new local (it is visible within the instrument) mutable value and initializes it with value.
-- A reference can contain a tuple of variables.
newRef :: Tuple a => a -> SE (Ref a)
newRef :: a -> SE (Ref a)
newRef a
t = ([Var] -> Ref a) -> SE [Var] -> SE (Ref a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Var] -> Ref a
forall a. [Var] -> Ref a
Ref (SE [Var] -> SE (Ref a)) -> SE [Var] -> SE (Ref a)
forall a b. (a -> b) -> a -> b
$ [Rate] -> GE [E] -> SE [Var]
newLocalVars (a -> [Rate]
forall a. Tuple a => a -> [Rate]
tupleRates a
t) (a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
t)

-- | Allocates a new local (it is visible within the instrument) mutable value and initializes it with value.
-- A reference can contain a tuple of variables.
-- It contains control signals (k-rate) and constants for numbers (i-rates).
newCtrlRef :: Tuple a => a -> SE (Ref a)
newCtrlRef :: a -> SE (Ref a)
newCtrlRef a
t = ([Var] -> Ref a) -> SE [Var] -> SE (Ref a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Var] -> Ref a
forall a. [Var] -> Ref a
Ref (SE [Var] -> SE (Ref a)) -> SE [Var] -> SE (Ref a)
forall a b. (a -> b) -> a -> b
$ [Rate] -> GE [E] -> SE [Var]
newLocalVars ((Rate -> Rate) -> [Rate] -> [Rate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rate -> Rate
toCtrlRate ([Rate] -> [Rate]) -> [Rate] -> [Rate]
forall a b. (a -> b) -> a -> b
$ a -> [Rate]
forall a. Tuple a => a -> [Rate]
tupleRates a
t) (a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
t)

toCtrlRate :: Rate -> Rate
toCtrlRate :: Rate -> Rate
toCtrlRate Rate
x = case Rate
x of
    Rate
Ar -> Rate
Kr
    Rate
Kr -> Rate
Ir
    Rate
_  -> Rate
x

concatRef :: (Tuple a, Tuple b) => Ref a -> Ref b -> Ref (a, b)
concatRef :: Ref a -> Ref b -> Ref (a, b)
concatRef (Ref [Var]
a) (Ref [Var]
b) = [Var] -> Ref (a, b)
forall a. [Var] -> Ref a
Ref ([Var]
a [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
b)

concatRef3 :: (Tuple a, Tuple b, Tuple c) => Ref a -> Ref b -> Ref c -> Ref (a, b, c)
concatRef3 :: Ref a -> Ref b -> Ref c -> Ref (a, b, c)
concatRef3 (Ref [Var]
a) (Ref [Var]
b) (Ref [Var]
c) = [Var] -> Ref (a, b, c)
forall a. [Var] -> Ref a
Ref ([Var]
a [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
b [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
c)

concatRef4 :: (Tuple a, Tuple b, Tuple c, Tuple d) => Ref a -> Ref b -> Ref c -> Ref d -> Ref (a, b, c, d)
concatRef4 :: Ref a -> Ref b -> Ref c -> Ref d -> Ref (a, b, c, d)
concatRef4 (Ref [Var]
a) (Ref [Var]
b) (Ref [Var]
c) (Ref [Var]
d) = [Var] -> Ref (a, b, c, d)
forall a. [Var] -> Ref a
Ref ([Var]
a [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
b [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
c [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
d)

concatRef5 :: (Tuple a, Tuple b, Tuple c, Tuple d, Tuple e) => Ref a -> Ref b -> Ref c -> Ref d -> Ref e -> Ref (a, b, c, d, e)
concatRef5 :: Ref a -> Ref b -> Ref c -> Ref d -> Ref e -> Ref (a, b, c, d, e)
concatRef5 (Ref [Var]
a) (Ref [Var]
b) (Ref [Var]
c) (Ref [Var]
d) (Ref [Var]
e) = [Var] -> Ref (a, b, c, d, e)
forall a. [Var] -> Ref a
Ref ([Var]
a [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
b [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
c [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
d [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
e)


-- | Adds the given signal to the value that is contained in the
-- reference.
mixRef :: (Num a, Tuple a) => Ref a -> a -> SE ()
mixRef :: Ref a -> a -> SE ()
mixRef Ref a
ref a
asig = Ref a -> (a -> a) -> SE ()
forall a. Tuple a => Ref a -> (a -> a) -> SE ()
modifyRef Ref a
ref (a -> a -> a
forall a. Num a => a -> a -> a
+ a
asig)

-- | Modifies the Ref value with given function.
modifyRef :: Tuple a => Ref a -> (a -> a) -> SE ()
modifyRef :: Ref a -> (a -> a) -> SE ()
modifyRef Ref a
ref a -> a
f = do
    a
v <- Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
ref
    Ref a -> a -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref (a -> a
f a
v)

-- | An alias for the function @newRef@. It returns not the reference
-- to mutable value but a pair of reader and writer functions.
sensorsSE :: Tuple a => a -> SE (SE a, a -> SE ())
sensorsSE :: a -> SE (SE a, a -> SE ())
sensorsSE a
a = do
    Ref a
ref <- a -> SE (Ref a)
forall a. Tuple a => a -> SE (Ref a)
newRef a
a
    (SE a, a -> SE ()) -> SE (SE a, a -> SE ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((SE a, a -> SE ()) -> SE (SE a, a -> SE ()))
-> (SE a, a -> SE ()) -> SE (SE a, a -> SE ())
forall a b. (a -> b) -> a -> b
$ (Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
ref, Ref a -> a -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref)

-- | Allocates a new global mutable value and initializes it with value.
-- A reference can contain a tuple of variables.
newGlobalRef :: Tuple a => a -> SE (Ref a)
newGlobalRef :: a -> SE (Ref a)
newGlobalRef a
t = ([Var] -> Ref a) -> SE [Var] -> SE (Ref a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Var] -> Ref a
forall a. [Var] -> Ref a
Ref (SE [Var] -> SE (Ref a)) -> SE [Var] -> SE (Ref a)
forall a b. (a -> b) -> a -> b
$ [Rate] -> GE [E] -> SE [Var]
newGlobalVars (a -> [Rate]
forall a. Tuple a => a -> [Rate]
tupleRates a
t) (a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
t)

-- | Allocates a new global mutable value and initializes it with value.
-- A reference can contain a tuple of variables.
-- It contains control signals (k-rate) and constants for numbers (i-rates).
newGlobalCtrlRef :: Tuple a => a -> SE (Ref a)
newGlobalCtrlRef :: a -> SE (Ref a)
newGlobalCtrlRef a
t = ([Var] -> Ref a) -> SE [Var] -> SE (Ref a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Var] -> Ref a
forall a. [Var] -> Ref a
Ref (SE [Var] -> SE (Ref a)) -> SE [Var] -> SE (Ref a)
forall a b. (a -> b) -> a -> b
$ [Rate] -> GE [E] -> SE [Var]
newGlobalVars ((Rate -> Rate) -> [Rate] -> [Rate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rate -> Rate
toCtrlRate ([Rate] -> [Rate]) -> [Rate] -> [Rate]
forall a b. (a -> b) -> a -> b
$ a -> [Rate]
forall a. Tuple a => a -> [Rate]
tupleRates a
t) (a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
t)

-- | An alias for the function @newRef@. It returns not the reference
-- to mutable value but a pair of reader and writer functions.
globalSensorsSE :: Tuple a => a -> SE (SE a, a -> SE ())
globalSensorsSE :: a -> SE (SE a, a -> SE ())
globalSensorsSE a
a = do
    Ref a
ref <- a -> SE (Ref a)
forall a. Tuple a => a -> SE (Ref a)
newRef a
a
    (SE a, a -> SE ()) -> SE (SE a, a -> SE ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((SE a, a -> SE ()) -> SE (SE a, a -> SE ()))
-> (SE a, a -> SE ()) -> SE (SE a, a -> SE ())
forall a b. (a -> b) -> a -> b
$ (Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
ref, Ref a -> a -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref)

-- | Allocates a new clearable global mutable value and initializes it with value.
-- A reference can contain a tuple of variables.
-- The variable is set to zero at the end of every iteration.
-- It's useful for accumulation of audio values from several instruments.
newClearableGlobalRef :: Tuple a => a -> SE (Ref a)
newClearableGlobalRef :: a -> SE (Ref a)
newClearableGlobalRef a
t = ([Var] -> Ref a) -> SE [Var] -> SE (Ref a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Var] -> Ref a
forall a. [Var] -> Ref a
Ref (SE [Var] -> SE (Ref a)) -> SE [Var] -> SE (Ref a)
forall a b. (a -> b) -> a -> b
$ [Rate] -> GE [E] -> SE [Var]
newClearableGlobalVars (a -> [Rate]
forall a. Tuple a => a -> [Rate]
tupleRates a
t) (a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
t)

-------------------------------------------------------------------------------
-- writable tables

-- | Creates a new table. The Tab could be used while the instrument
-- is playing. When the instrument is retriggered the new tab is allocated.
--
-- > newTab size
newTab :: D -> SE Tab
newTab :: D -> SE Tab
newTab D
size = D -> D -> D -> D -> D -> [D] -> SE Tab
ftgentmp D
0 D
0 D
size D
7 D
0 [D
size, D
0]

-- | Creates a new global table.
-- It's generated only once. It's persisted between instrument calls.
--
-- > newGlobalTab identifier size
newGlobalTab :: Int -> SE Tab
newGlobalTab :: Int -> SE Tab
newGlobalTab Int
size = do
    Ref D
ref <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newGlobalCtrlRef ((GE E -> D
forall a. Val a => GE E -> a
fromGE (GE E -> D) -> GE E -> D
forall a b. (a -> b) -> a -> b
$ Int -> GE E
saveWriteTab Int
size) :: D)
    (D -> Tab) -> SE D -> SE Tab
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GE E -> Tab
forall a. Val a => GE E -> a
fromGE (GE E -> Tab) -> (D -> GE E) -> D -> Tab
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> GE E
forall a. Val a => a -> GE E
toGE) (SE D -> SE Tab) -> SE D -> SE Tab
forall a b. (a -> b) -> a -> b
$ Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
ref

-----------------------------------------------------------------------
-- some opcodes that I have to define upfront

-- |
-- Generate a score function table from within the orchestra, which is deleted at the end of the note.
--
-- Generate a score function table from within the orchestra,
--     which is optionally deleted at the end of the note.
--
-- > ifno  ftgentmp  ip1, ip2dummy, isize, igen, iarga, iargb, ...
--
-- csound doc: <http://www.csounds.com/manual/html/ftgentmp.html>
ftgentmp ::  D -> D -> D -> D -> D -> [D] -> SE Tab
ftgentmp :: D -> D -> D -> D -> D -> [D] -> SE Tab
ftgentmp D
b1 D
b2 D
b3 D
b4 D
b5 [D]
b6 = (E -> Tab) -> SE E -> SE Tab
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( GE E -> Tab
Tab (GE E -> Tab) -> (E -> GE E) -> E -> Tab
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> GE E
forall (m :: * -> *) a. Monad m => a -> m a
return) (SE E -> SE Tab) -> SE E -> SE Tab
forall a b. (a -> b) -> a -> b
$ DepT GE E -> SE E
forall a. Dep a -> SE a
SE (DepT GE E -> SE E) -> DepT GE E -> SE E
forall a b. (a -> b) -> a -> b
$ (E -> DepT GE E
forall (m :: * -> *). Monad m => E -> DepT m E
depT (E -> DepT GE E) -> DepT GE E -> DepT GE E
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (DepT GE E -> DepT GE E) -> DepT GE E -> DepT GE E
forall a b. (a -> b) -> a -> b
$ GE E -> DepT GE E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> DepT GE E) -> GE E -> DepT GE E
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E -> E -> [E] -> E
f (E -> E -> E -> E -> E -> [E] -> E)
-> GE E -> GE (E -> E -> E -> E -> [E] -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1 GE (E -> E -> E -> E -> [E] -> E)
-> GE E -> GE (E -> E -> E -> [E] -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2 GE (E -> E -> E -> [E] -> E) -> GE E -> GE (E -> E -> [E] -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b3 GE (E -> E -> [E] -> E) -> GE E -> GE (E -> [E] -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b4 GE (E -> [E] -> E) -> GE E -> GE ([E] -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b5 GE ([E] -> E) -> GE [E] -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (D -> GE E) -> [D] -> GE [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM D -> GE E
unD [D]
b6
    where f :: E -> E -> E -> E -> E -> [E] -> E
f E
a1 E
a2 E
a3 E
a4 E
a5 [E]
a6 = Name -> Spec1 -> [E] -> E
opcs Name
"ftgentmp" [(Rate
Ir,(Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Ir))] ([E
a1,E
a2,E
a3,E
a4,E
a5] [E] -> [E] -> [E]
forall a. [a] -> [a] -> [a]
++ [E]
a6)

--------------------------------------------------------------------

whileRef :: forall st . Tuple st => st -> (st -> SE BoolSig) -> (st -> SE st) -> SE ()
whileRef :: st -> (st -> SE BoolSig) -> (st -> SE st) -> SE ()
whileRef st
initVal st -> SE BoolSig
c st -> SE st
body = do
    Ref st
refSt   <- st -> SE (Ref st)
forall a. Tuple a => a -> SE (Ref a)
newCtrlRef st
initVal
    Ref Sig
refCond <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newRef (Sig -> SE (Ref Sig)) -> SE Sig -> SE (Ref Sig)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< st -> SE Sig
condSig (st -> SE Sig) -> SE st -> SE Sig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref st -> SE st
forall a. Tuple a => Ref a -> SE a
readRef Ref st
refSt
    Ref Sig -> SE ()
forall a. SigOrD a => Ref a -> SE ()
whileRefBegin Ref Sig
refCond
    Ref st -> st -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref st
refSt   (st -> SE ()) -> SE st -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< st -> SE st
body    (st -> SE st) -> SE st -> SE st
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref st -> SE st
forall a. Tuple a => Ref a -> SE a
readRef Ref st
refSt
    Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
refCond (Sig -> SE ()) -> SE Sig -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< st -> SE Sig
condSig (st -> SE Sig) -> SE st -> SE Sig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref st -> SE st
forall a. Tuple a => Ref a -> SE a
readRef Ref st
refSt
    Dep () -> SE ()
fromDep_ Dep ()
forall (m :: * -> *). Monad m => DepT m ()
whileEnd
    where
        condSig :: st -> SE Sig
        condSig :: st -> SE Sig
condSig   = (BoolSig -> Sig) -> SE BoolSig -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\BoolSig
b -> BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB BoolSig
b Sig
1 Sig
0) (SE BoolSig -> SE Sig) -> (st -> SE BoolSig) -> st -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st -> SE BoolSig
c


whileRefD :: forall st . Tuple st => st -> (st -> SE BoolD) -> (st -> SE st) -> SE ()
whileRefD :: st -> (st -> SE BoolD) -> (st -> SE st) -> SE ()
whileRefD st
initVal st -> SE BoolD
c st -> SE st
body = do
    Ref st
refSt   <- st -> SE (Ref st)
forall a. Tuple a => a -> SE (Ref a)
newCtrlRef st
initVal
    Ref D
refCond <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newRef (D -> SE (Ref D)) -> SE D -> SE (Ref D)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< st -> SE D
condSig (st -> SE D) -> SE st -> SE D
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref st -> SE st
forall a. Tuple a => Ref a -> SE a
readRef Ref st
refSt
    Ref D -> SE ()
forall a. SigOrD a => Ref a -> SE ()
whileRefBegin Ref D
refCond
    Ref st -> st -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref st
refSt   (st -> SE ()) -> SE st -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< st -> SE st
body    (st -> SE st) -> SE st -> SE st
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref st -> SE st
forall a. Tuple a => Ref a -> SE a
readRef Ref st
refSt
    Ref D -> D -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref D
refCond (D -> SE ()) -> SE D -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< st -> SE D
condSig (st -> SE D) -> SE st -> SE D
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref st -> SE st
forall a. Tuple a => Ref a -> SE a
readRef Ref st
refSt
    Dep () -> SE ()
fromDep_ Dep ()
forall (m :: * -> *). Monad m => DepT m ()
whileEnd
    where
        condSig :: st -> SE D
        condSig :: st -> SE D
condSig   = (BoolD -> D) -> SE BoolD -> SE D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\BoolD
b -> BoolD -> D -> D -> D
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB BoolD
b D
1 D
0) (SE BoolD -> SE D) -> (st -> SE BoolD) -> st -> SE D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st -> SE BoolD
c

whileRefBegin :: SigOrD a => Ref a -> SE ()
whileRefBegin :: Ref a -> SE ()
whileRefBegin (Ref [Var]
vars) = Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ Var -> Dep ()
forall (m :: * -> *). Monad m => Var -> DepT m ()
D.whileRef (Var -> Dep ()) -> Var -> Dep ()
forall a b. (a -> b) -> a -> b
$ [Var] -> Var
forall a. [a] -> a
head [Var]
vars