module CsoundExpr.Base.SideEffect
(SideEffect, se,
se1, se2, se3, se4)
where
import CsoundExpr.Base.Types
import CsoundExpr.Translator.ExprTree.ExprTree
import CsoundExpr.Translator.Cs.CsTree
import CsoundExpr.Translator.Cs.IM
data SideEffect a = SideEffect Int a
instance IM CsTree a => IM CsTree (SideEffect a) where
from = SideEffect 0 . from . (mapPurity (const $ Unpure Nothing))
to (SideEffect _ a) = to a
labelSE :: IM CsTree a => SideEffect a -> (a, SideEffect a)
labelSE (SideEffect id a) = (from $ f id $ to a, SideEffect (id+1) a)
where f :: Label -> CsTree -> CsTree
f = labelUnpure
se :: IM CsTree a => Int -> SideEffect a -> ([a], SideEffect a)
se n x = foldl f ([], x) [0 .. n]
where f (vs, x0) _ = let (v, x1) = se1 x0
in (vs ++ [v], x1)
se1 :: IM CsTree a => SideEffect a -> (a, SideEffect a)
se1 = labelSE
se2 :: IM CsTree a => SideEffect a -> ((a, a), SideEffect a)
se2 x0 = ((y0, y1), x2)
where (y0, x1) = se1 x0
(y1, x2) = se1 x1
se3 :: IM CsTree a => SideEffect a -> ((a, a, a), SideEffect a)
se3 x0 = ((y0, y1, y2), x2)
where ((y0, y1), x1) = se2 x0
( y2 , x2) = se1 x1
se4 :: IM CsTree a => SideEffect a -> ((a, a, a, a), SideEffect a)
se4 x0 = ((y0, y1, y2, y3), x2)
where ((y0, y1, y2), x1) = se3 x0
( y3 , x2) = se1 x1