{-# Language ScopedTypeVariables #-}
module Csound.Typed.Control.ArrayTraverse(
foreachArr, foreachArrD, forRowArr, forColumnArr, forRowArrD, forColumnArrD,
foldArr, foldRowArr, foldColumnArr, foldRowsArrD, foldColumnsArrD
) where
import Data.Proxy
import Csound.Typed.Types
import Csound.Typed.Control.Ref
import Csound.Typed.GlobalState
import Data.Boolean
import qualified Csound.Dynamic as D
whileRefBegin :: SigOrD a => Ref a -> SE ()
whileRefBegin :: forall a. SigOrD a => 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. HasCallStack => [a] -> a
head [Var]
vars
foreachArr :: (Tuple ix, Tuple a) => Arr ix a -> ((ix, a) -> SE ()) -> SE ()
foreachArr :: forall ix a.
(Tuple ix, Tuple a) =>
Arr ix a -> ((ix, a) -> SE ()) -> SE ()
foreachArr = (Int -> Arr ix a -> Sig) -> Arr ix a -> ((ix, a) -> SE ()) -> SE ()
forall a b ix.
(OrdB b, IfB b, Num b, SigOrD b, Tuple b, Tuple ix, Tuple a) =>
(Int -> Arr ix a -> b) -> Arr ix a -> ((ix, a) -> SE ()) -> SE ()
foreachArrBy Int -> Arr ix a -> Sig
forall ix a. Int -> Arr ix a -> Sig
getArrayLength
where
getArrayLength :: Int -> Arr ix a -> Sig
getArrayLength :: forall ix a. Int -> Arr ix a -> Sig
getArrayLength Int
n Arr ix a
array = Arr ix a -> Sig
forall c a b. SigOrD c => Arr a b -> c
lenarray Arr ix a
array Sig -> D -> Sig
forall a. Tuple a => a -> D -> a
`withD` (Int -> D
int Int
n)
foreachArrD :: (Tuple ix, Tuple a) => Arr ix a -> ((ix, a) -> SE ()) -> SE ()
foreachArrD :: forall ix a.
(Tuple ix, Tuple a) =>
Arr ix a -> ((ix, a) -> SE ()) -> SE ()
foreachArrD = (Int -> Arr ix a -> D) -> Arr ix a -> ((ix, a) -> SE ()) -> SE ()
forall a b ix.
(OrdB b, IfB b, Num b, SigOrD b, Tuple b, Tuple ix, Tuple a) =>
(Int -> Arr ix a -> b) -> Arr ix a -> ((ix, a) -> SE ()) -> SE ()
foreachArrBy Int -> Arr ix a -> D
forall ix a. Int -> Arr ix a -> D
getArrayLength
where
getArrayLength :: Int -> Arr ix a -> D
getArrayLength :: forall ix a. Int -> Arr ix a -> D
getArrayLength Int
n Arr ix a
array = Arr ix a -> D
forall c a b. SigOrD c => Arr a b -> c
lenarray Arr ix a
array D -> D -> D
forall a. Tuple a => a -> D -> a
`withD` (Int -> D
int Int
n)
foreachArrBy :: forall a b ix . (OrdB b, IfB b, Num b, SigOrD b, Tuple b, Tuple ix, Tuple a) => (Int -> Arr ix a -> b) -> Arr ix a -> ((ix, a) -> SE ()) -> SE ()
foreachArrBy :: forall a b ix.
(OrdB b, IfB b, Num b, SigOrD b, Tuple b, Tuple ix, Tuple a) =>
(Int -> Arr ix a -> b) -> Arr ix a -> ((ix, a) -> SE ()) -> SE ()
foreachArrBy Int -> Arr ix a -> b
getArrayLength Arr ix a
array (ix, a) -> SE ()
body = do
[Ref b]
vars <- (b -> SE (Ref b)) -> [b] -> SE [Ref b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM b -> SE (Ref b)
forall a. Tuple a => a -> SE (Ref a)
newCtrlRef ([b] -> SE [Ref b]) -> [b] -> SE [Ref b]
forall a b. (a -> b) -> a -> b
$ Int -> b -> [b]
forall a. Int -> a -> [a]
replicate Int
arity (b
0 :: b)
[Ref b]
condVars <- (b -> SE (Ref b)) -> [b] -> SE [Ref b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM b -> SE (Ref b)
forall a. Tuple a => a -> SE (Ref a)
newCtrlRef ([b] -> SE [Ref b]) -> [b] -> SE [Ref b]
forall a b. (a -> b) -> a -> b
$ Int -> b -> [b]
forall a. Int -> a -> [a]
replicate Int
arity (b
1 :: b)
[Ref b] -> [(Int, Ref b, Ref b)] -> SE ()
recWhile [Ref b]
vars ([(Int, Ref b, Ref b)] -> SE ()) -> [(Int, Ref b, Ref b)] -> SE ()
forall a b. (a -> b) -> a -> b
$ [Int] -> [Ref b] -> [Ref b] -> [(Int, Ref b, Ref b)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
1 ..] [Ref b]
vars [Ref b]
condVars
where
recWhile :: [Ref b] -> [(Int, Ref b, Ref b)] -> SE ()
recWhile :: [Ref b] -> [(Int, Ref b, Ref b)] -> SE ()
recWhile [Ref b]
vars [(Int, Ref b, Ref b)]
xs = case [(Int, Ref b, Ref b)]
xs of
[] -> do
ix
ix <- Ref ix -> SE ix
forall a. Tuple a => Ref a -> SE a
readRef (Ref ix -> SE ix) -> Ref ix -> SE ix
forall a b. (a -> b) -> a -> b
$ [Ref b] -> Ref ix
concatRefs [Ref b]
vars
a
val <- Arr ix a -> ix -> SE a
forall a ix. (Tuple a, Tuple ix) => Arr ix a -> ix -> SE a
readArr Arr ix a
array ix
ix
(ix, a) -> SE ()
body (ix
ix, a
val)
(Int
n, Ref b
var, Ref b
condVar) : [(Int, Ref b, Ref b)]
rest -> do
Ref b -> SE ()
forall a. SigOrD a => Ref a -> SE ()
whileRefBegin Ref b
condVar
[Ref b] -> [(Int, Ref b, Ref b)] -> SE ()
recWhile [Ref b]
vars [(Int, Ref b, Ref b)]
rest
Ref b -> (b -> b) -> SE ()
forall a. Tuple a => Ref a -> (a -> a) -> SE ()
modifyRef Ref b
var (b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)
b
ix <- Ref b -> SE b
forall a. Tuple a => Ref a -> SE a
readRef Ref b
var
Ref b -> b -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref b
condVar (BooleanOf b -> b -> b -> b
forall bool. (bool ~ BooleanOf b) => bool -> b -> b -> b
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (b
ix b -> b -> BooleanOf b
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` Int -> Arr ix a -> b
getArrayLength Int
n Arr ix a
array) b
1 b
0)
Dep () -> SE ()
fromDep_ Dep ()
forall (m :: * -> *). Monad m => DepT m ()
D.whileEnd
arity :: Int
arity = Proxy ix -> Int
forall a. Tuple a => Proxy a -> Int
tupleArity (Proxy ix
forall {k} (t :: k). Proxy t
Proxy :: Proxy ix)
concatRefs :: [Ref b] -> Ref ix
concatRefs :: [Ref b] -> Ref ix
concatRefs [Ref b]
vs = [Var] -> Ref ix
forall a. [Var] -> Ref a
Ref ([Var] -> Ref ix) -> [Var] -> Ref ix
forall a b. (a -> b) -> a -> b
$ [Ref b]
vs [Ref b] -> (Ref b -> [Var]) -> [Var]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Ref [Var]
xs) -> [Var]
xs
forRowArr :: (Tuple a) => Sig -> Arr Sig2 a -> ((Sig, a) -> SE ()) -> SE ()
forRowArr :: forall a.
Tuple a =>
Sig -> Arr Sig2 a -> ((Sig, a) -> SE ()) -> SE ()
forRowArr Sig
rowId Arr Sig2 a
array (Sig, a) -> SE ()
phi = Sig -> (Sig -> SE BoolSig) -> (Sig -> SE Sig) -> SE ()
forall st.
Tuple st =>
st -> (st -> SE BoolSig) -> (st -> SE st) -> SE ()
whileRef Sig
0 Sig -> SE (BooleanOf Sig)
Sig -> SE BoolSig
forall {m :: * -> *} {a}.
(Monad m, OrdB a, Tuple a, SigOrD a) =>
a -> m (BooleanOf a)
condition Sig -> SE Sig
body
where
condition :: a -> m (BooleanOf a)
condition a
ix = BooleanOf a -> m (BooleanOf a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BooleanOf a -> m (BooleanOf a)) -> BooleanOf a -> m (BooleanOf a)
forall a b. (a -> b) -> a -> b
$ a
ix a -> a -> BooleanOf a
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` Arr Sig2 a -> a
forall c a b. SigOrD c => Arr a b -> c
lenarray Arr Sig2 a
array a -> D -> a
forall a. Tuple a => a -> D -> a
`withD` D
2
body :: Sig -> SE Sig
body Sig
ix = do
a
val <- Arr Sig2 a -> Sig2 -> SE a
forall a ix. (Tuple a, Tuple ix) => Arr ix a -> ix -> SE a
readArr Arr Sig2 a
array (Sig
rowId, Sig
ix)
(Sig, a) -> SE ()
phi (Sig
ix, a
val)
Sig -> SE Sig
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig
ix Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
1
forColumnArr :: (Tuple a) => Sig -> Arr Sig2 a -> ((Sig, a) -> SE ()) -> SE ()
forColumnArr :: forall a.
Tuple a =>
Sig -> Arr Sig2 a -> ((Sig, a) -> SE ()) -> SE ()
forColumnArr Sig
colId Arr Sig2 a
array (Sig, a) -> SE ()
phi = Sig -> (Sig -> SE BoolSig) -> (Sig -> SE Sig) -> SE ()
forall st.
Tuple st =>
st -> (st -> SE BoolSig) -> (st -> SE st) -> SE ()
whileRef Sig
0 Sig -> SE (BooleanOf Sig)
Sig -> SE BoolSig
forall {m :: * -> *} {a}.
(Monad m, OrdB a, Tuple a, SigOrD a) =>
a -> m (BooleanOf a)
condition Sig -> SE Sig
body
where
condition :: a -> m (BooleanOf a)
condition a
ix = BooleanOf a -> m (BooleanOf a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BooleanOf a -> m (BooleanOf a)) -> BooleanOf a -> m (BooleanOf a)
forall a b. (a -> b) -> a -> b
$ a
ix a -> a -> BooleanOf a
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` Arr Sig2 a -> a
forall c a b. SigOrD c => Arr a b -> c
lenarray Arr Sig2 a
array a -> D -> a
forall a. Tuple a => a -> D -> a
`withD` D
1
body :: Sig -> SE Sig
body Sig
ix = do
a
val <- Arr Sig2 a -> Sig2 -> SE a
forall a ix. (Tuple a, Tuple ix) => Arr ix a -> ix -> SE a
readArr Arr Sig2 a
array (Sig
ix, Sig
colId)
(Sig, a) -> SE ()
phi (Sig
ix, a
val)
Sig -> SE Sig
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig
ix Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
1
forRowArrD :: Tuple a => D -> Arr D2 a -> ((D, a) -> SE ()) -> SE ()
forRowArrD :: forall a. Tuple a => D -> Arr D2 a -> ((D, a) -> SE ()) -> SE ()
forRowArrD D
rowId Arr D2 a
array (D, a) -> SE ()
phi = D -> (D -> SE BoolD) -> (D -> SE D) -> SE ()
forall st.
Tuple st =>
st -> (st -> SE BoolD) -> (st -> SE st) -> SE ()
whileRefD D
0 D -> SE (BooleanOf D)
D -> SE BoolD
forall {m :: * -> *} {a}.
(Monad m, OrdB a, Tuple a, SigOrD a) =>
a -> m (BooleanOf a)
condition D -> SE D
body
where
condition :: a -> m (BooleanOf a)
condition a
ix = BooleanOf a -> m (BooleanOf a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BooleanOf a -> m (BooleanOf a)) -> BooleanOf a -> m (BooleanOf a)
forall a b. (a -> b) -> a -> b
$ a
ix a -> a -> BooleanOf a
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` Arr D2 a -> a
forall c a b. SigOrD c => Arr a b -> c
lenarray Arr D2 a
array a -> D -> a
forall a. Tuple a => a -> D -> a
`withD` D
2
body :: D -> SE D
body D
ix = do
a
val <- Arr D2 a -> D2 -> SE a
forall a ix. (Tuple a, Tuple ix) => Arr ix a -> ix -> SE a
readArr Arr D2 a
array (D
rowId, D
ix)
(D, a) -> SE ()
phi (D
ix, a
val)
D -> SE D
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (D -> SE D) -> D -> SE D
forall a b. (a -> b) -> a -> b
$ D
ix D -> D -> D
forall a. Num a => a -> a -> a
+ D
1
forColumnArrD :: Tuple a => D -> Arr D2 a -> ((D, a) -> SE ()) -> SE ()
forColumnArrD :: forall a. Tuple a => D -> Arr D2 a -> ((D, a) -> SE ()) -> SE ()
forColumnArrD D
colId Arr D2 a
array (D, a) -> SE ()
phi = D -> (D -> SE BoolD) -> (D -> SE D) -> SE ()
forall st.
Tuple st =>
st -> (st -> SE BoolD) -> (st -> SE st) -> SE ()
whileRefD D
0 D -> SE (BooleanOf D)
D -> SE BoolD
forall {m :: * -> *} {a}.
(Monad m, OrdB a, Tuple a, SigOrD a) =>
a -> m (BooleanOf a)
condition D -> SE D
body
where
condition :: a -> m (BooleanOf a)
condition a
ix = BooleanOf a -> m (BooleanOf a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BooleanOf a -> m (BooleanOf a)) -> BooleanOf a -> m (BooleanOf a)
forall a b. (a -> b) -> a -> b
$ a
ix a -> a -> BooleanOf a
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` Arr D2 a -> a
forall c a b. SigOrD c => Arr a b -> c
lenarray Arr D2 a
array a -> D -> a
forall a. Tuple a => a -> D -> a
`withD` D
1
body :: D -> SE D
body D
ix = do
a
val <- Arr D2 a -> D2 -> SE a
forall a ix. (Tuple a, Tuple ix) => Arr ix a -> ix -> SE a
readArr Arr D2 a
array (D
ix, D
colId)
(D, a) -> SE ()
phi (D
ix, a
val)
D -> SE D
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (D -> SE D) -> D -> SE D
forall a b. (a -> b) -> a -> b
$ D
ix D -> D -> D
forall a. Num a => a -> a -> a
+ D
1
foldArr :: (Tuple ix, Tuple a, Tuple b) => ((ix, a) -> b -> SE b) -> b -> Arr ix a -> SE b
foldArr :: forall ix a b.
(Tuple ix, Tuple a, Tuple b) =>
((ix, a) -> b -> SE b) -> b -> Arr ix a -> SE b
foldArr (ix, a) -> b -> SE b
phi b
z Arr ix a
array = do
Ref b
res <- b -> SE (Ref b)
forall a. Tuple a => a -> SE (Ref a)
newRef b
z
Arr ix a -> ((ix, a) -> SE ()) -> SE ()
forall ix a.
(Tuple ix, Tuple a) =>
Arr ix a -> ((ix, a) -> SE ()) -> SE ()
foreachArr Arr ix a
array (((ix, a) -> b -> SE b) -> Ref b -> (ix, a) -> SE ()
forall b a. Tuple b => (a -> b -> SE b) -> Ref b -> a -> SE ()
toFoldFun (ix, a) -> b -> SE b
phi Ref b
res)
Ref b -> SE b
forall a. Tuple a => Ref a -> SE a
readRef Ref b
res
toFoldFun :: Tuple b => (a -> b -> SE b) -> Ref b -> a -> SE ()
toFoldFun :: forall b a. Tuple b => (a -> b -> SE b) -> Ref b -> a -> SE ()
toFoldFun a -> b -> SE b
phi Ref b
ref a
a = Ref b -> b -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref b
ref (b -> SE ()) -> SE b -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> b -> SE b
phi a
a (b -> SE b) -> SE b -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ref b -> SE b
forall a. Tuple a => Ref a -> SE a
readRef Ref b
ref
foldRowArr :: (Tuple a, Tuple b) => ((Sig, a) -> b -> SE b) -> b -> Sig -> Arr Sig2 a -> SE b
foldRowArr :: forall a b.
(Tuple a, Tuple b) =>
((Sig, a) -> b -> SE b) -> b -> Sig -> Arr Sig2 a -> SE b
foldRowArr (Sig, a) -> b -> SE b
phi b
z Sig
rowId Arr Sig2 a
array = do
Ref b
res <- b -> SE (Ref b)
forall a. Tuple a => a -> SE (Ref a)
newRef b
z
Sig -> Arr Sig2 a -> ((Sig, a) -> SE ()) -> SE ()
forall a.
Tuple a =>
Sig -> Arr Sig2 a -> ((Sig, a) -> SE ()) -> SE ()
forRowArr Sig
rowId Arr Sig2 a
array (((Sig, a) -> SE ()) -> SE ()) -> ((Sig, a) -> SE ()) -> SE ()
forall a b. (a -> b) -> a -> b
$ ((Sig, a) -> b -> SE b) -> Ref b -> (Sig, a) -> SE ()
forall b a. Tuple b => (a -> b -> SE b) -> Ref b -> a -> SE ()
toFoldFun (Sig, a) -> b -> SE b
phi Ref b
res
Ref b -> SE b
forall a. Tuple a => Ref a -> SE a
readRef Ref b
res
foldColumnArr :: (Tuple a, Tuple b) => ((Sig, a) -> b -> SE b) -> b -> Sig -> Arr Sig2 a -> SE b
foldColumnArr :: forall a b.
(Tuple a, Tuple b) =>
((Sig, a) -> b -> SE b) -> b -> Sig -> Arr Sig2 a -> SE b
foldColumnArr (Sig, a) -> b -> SE b
phi b
z Sig
rowId Arr Sig2 a
array = do
Ref b
res <- b -> SE (Ref b)
forall a. Tuple a => a -> SE (Ref a)
newRef b
z
Sig -> Arr Sig2 a -> ((Sig, a) -> SE ()) -> SE ()
forall a.
Tuple a =>
Sig -> Arr Sig2 a -> ((Sig, a) -> SE ()) -> SE ()
forColumnArr Sig
rowId Arr Sig2 a
array (((Sig, a) -> SE ()) -> SE ()) -> ((Sig, a) -> SE ()) -> SE ()
forall a b. (a -> b) -> a -> b
$ ((Sig, a) -> b -> SE b) -> Ref b -> (Sig, a) -> SE ()
forall b a. Tuple b => (a -> b -> SE b) -> Ref b -> a -> SE ()
toFoldFun (Sig, a) -> b -> SE b
phi Ref b
res
Ref b -> SE b
forall a. Tuple a => Ref a -> SE a
readRef Ref b
res
foldRowsArrD :: (Tuple a, Tuple b) => ((D, a) -> b -> SE b) -> b -> D -> Arr D2 a -> SE b
foldRowsArrD :: forall a b.
(Tuple a, Tuple b) =>
((D, a) -> b -> SE b) -> b -> D -> Arr D2 a -> SE b
foldRowsArrD (D, a) -> b -> SE b
phi b
z D
rowId Arr D2 a
array = do
Ref b
res <- b -> SE (Ref b)
forall a. Tuple a => a -> SE (Ref a)
newRef b
z
D -> Arr D2 a -> ((D, a) -> SE ()) -> SE ()
forall a. Tuple a => D -> Arr D2 a -> ((D, a) -> SE ()) -> SE ()
forRowArrD D
rowId Arr D2 a
array (((D, a) -> SE ()) -> SE ()) -> ((D, a) -> SE ()) -> SE ()
forall a b. (a -> b) -> a -> b
$ ((D, a) -> b -> SE b) -> Ref b -> (D, a) -> SE ()
forall b a. Tuple b => (a -> b -> SE b) -> Ref b -> a -> SE ()
toFoldFun (D, a) -> b -> SE b
phi Ref b
res
Ref b -> SE b
forall a. Tuple a => Ref a -> SE a
readRef Ref b
res
foldColumnsArrD :: (Tuple a, Tuple b) => ((D, a) -> b -> SE b) -> b -> D -> Arr D2 a -> SE b
foldColumnsArrD :: forall a b.
(Tuple a, Tuple b) =>
((D, a) -> b -> SE b) -> b -> D -> Arr D2 a -> SE b
foldColumnsArrD (D, a) -> b -> SE b
phi b
z D
rowId Arr D2 a
array = do
Ref b
res <- b -> SE (Ref b)
forall a. Tuple a => a -> SE (Ref a)
newRef b
z
D -> Arr D2 a -> ((D, a) -> SE ()) -> SE ()
forall a. Tuple a => D -> Arr D2 a -> ((D, a) -> SE ()) -> SE ()
forColumnArrD D
rowId Arr D2 a
array (((D, a) -> SE ()) -> SE ()) -> ((D, a) -> SE ()) -> SE ()
forall a b. (a -> b) -> a -> b
$ ((D, a) -> b -> SE b) -> Ref b -> (D, a) -> SE ()
forall b a. Tuple b => (a -> b -> SE b) -> Ref b -> a -> SE ()
toFoldFun (D, a) -> b -> SE b
phi Ref b
res
Ref b -> SE b
forall a. Tuple a => Ref a -> SE a
readRef Ref b
res