{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-}

-- | Side Effects
--
-- 'SideEffect' @a@ means output value @a@ of opcode is not determined 
-- completely by arguments and opcode itself. @a@ relies on number of
-- appearences in body of instrument. Way out from 'SideEffect' is
-- provided by selectors. Selector gives value and updated 'SideEffect'
--
-- Example a :
--
-- > q = let (a1, a2) = fst $ se2 $ unirandA (1 :: Irate)
-- >     in  outs a1 a2
-- 
-- generates :
--
-- > a1  unirand  1
-- > a2  unirand  1
-- >     outs     a1, a2
--
--
-- Example b :
--
-- > q = let a1 = fst $ se1 $ unirandA (1 :: Irate)
-- >         a2 = fst $ se1 $ unirandA (1 :: Irate)
-- >     in  outs a1 a2
-- 
-- generates :
--
-- > a1  unirand  1
-- >     outs     a1, a1
--
-- Example c :
--
-- > q = let v0 = unirandA (1 :: Irate)
-- >         (a1, v1) = se1 v0
-- >         (a2,  _) = se1 v1
-- >     in  outs a1 a2
-- 
-- generates :
--
-- > a1  unirand  1
-- > a2  unirand  1
-- >     outs     a1, a2
--
--
  
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