module Csound.Dynamic.Render.Instr(
    renderInstr, renderInstrBody
) where

import Control.Arrow(second)
import Control.Monad.Trans.State.Strict
import Data.List(sort, find)
import qualified Data.Map as M

import Data.Maybe(fromJust)
import Data.Fix(Fix(..), foldFix)
import Data.Fix.Cse(fromDag, cseFramed, FrameInfo(..))

import qualified Text.PrettyPrint.Leijen as P

import Csound.Dynamic.Tfm.DeduceTypes
import Csound.Dynamic.Tfm.UnfoldMultiOuts
import Csound.Dynamic.Tfm.Liveness

import Csound.Dynamic.Types hiding (Var)
import Csound.Dynamic.Build(getRates, isMultiOutSignature)
import Csound.Dynamic.Render.Pretty
import qualified Csound.Dynamic.Types as T(Var)

type Dag f = [(Int, f Int)]

renderInstr :: Instr -> Doc
renderInstr :: Instr -> Doc
renderInstr Instr
a = InstrId -> Doc -> Doc
ppInstr (Instr -> InstrId
instrName Instr
a) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ E -> Doc
renderInstrBody (Instr -> E
instrBody Instr
a)

renderInstrBody :: E -> Doc
renderInstrBody :: E -> Doc
renderInstrBody E
a
  | [(Int, RatedExp Int)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, RatedExp Int)]
dag  = Doc
P.empty
  | Bool
otherwise = [(Int, RatedExp Int)] -> Doc
render [(Int, RatedExp Int)]
dag
    where
      dag :: [(Int, RatedExp Int)]
dag = E -> [(Int, RatedExp Int)]
toDag E
a
      render :: [(Int, RatedExp Int)] -> Doc
render = [Doc] -> Doc
P.vcat ([Doc] -> Doc)
-> ([(Int, RatedExp Int)] -> [Doc]) -> [(Int, RatedExp Int)] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State Int [Doc] -> Int -> [Doc])
-> Int -> State Int [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int [Doc] -> Int -> [Doc]
forall s a. State s a -> s -> a
evalState Int
0 (State Int [Doc] -> [Doc])
-> ([(Int, RatedExp Int)] -> State Int [Doc])
-> [(Int, RatedExp Int)]
-> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([RatedVar], Exp RatedVar) -> StateT Int Identity Doc)
-> [([RatedVar], Exp RatedVar)] -> State Int [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([RatedVar] -> Exp RatedVar -> StateT Int Identity Doc)
-> ([RatedVar], Exp RatedVar) -> StateT Int Identity Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [RatedVar] -> Exp RatedVar -> StateT Int Identity Doc
ppStmt (([RatedVar], Exp RatedVar) -> StateT Int Identity Doc)
-> (([RatedVar], Exp RatedVar) -> ([RatedVar], Exp RatedVar))
-> ([RatedVar], Exp RatedVar)
-> StateT Int Identity Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RatedVar], Exp RatedVar) -> ([RatedVar], Exp RatedVar)
clearEmptyResults) ([([RatedVar], Exp RatedVar)] -> State Int [Doc])
-> ([(Int, RatedExp Int)] -> [([RatedVar], Exp RatedVar)])
-> [(Int, RatedExp Int)]
-> State Int [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, RatedExp Int)] -> [([RatedVar], Exp RatedVar)]
collectRates

-------------------------------------------------------------
-- E -> Dag

toDag :: E -> Dag RatedExp
toDag :: E -> [(Int, RatedExp Int)]
toDag E
expr = [(Int, RatedExp Int)] -> [(Int, RatedExp Int)]
filterDepCases ([(Int, RatedExp Int)] -> [(Int, RatedExp Int)])
-> [(Int, RatedExp Int)] -> [(Int, RatedExp Int)]
forall a b. (a -> b) -> a -> b
$ Dag RatedExp -> [(Int, RatedExp Int)]
forall (f :: * -> *). Dag f -> [(Int, f Int)]
fromDag (Dag RatedExp -> [(Int, RatedExp Int)])
-> Dag RatedExp -> [(Int, RatedExp Int)]
forall a b. (a -> b) -> a -> b
$ (RatedExp Int -> FrameInfo) -> E -> Dag RatedExp
forall (f :: * -> *).
(Eq (f Int), Ord (f Int), Traversable f) =>
(f Int -> FrameInfo) -> Fix f -> Dag f
cseFramed RatedExp Int -> FrameInfo
forall a. RatedExp a -> FrameInfo
getFrameInfo (E -> Dag RatedExp) -> E -> Dag RatedExp
forall a b. (a -> b) -> a -> b
$ E -> E
trimByArgLength E
expr

getFrameInfo :: RatedExp a -> FrameInfo
getFrameInfo :: RatedExp a -> FrameInfo
getFrameInfo RatedExp a
x = case RatedExp a -> Exp a
forall a. RatedExp a -> Exp a
ratedExpExp RatedExp a
x of
    -- Imperative If-then-else
    IfBegin Rate
_ CondInfo (PrimOr a)
_   -> FrameInfo
StartFrame
--     ElseIfBegin _ -> NextFrame
    Exp a
ElseBegin     -> FrameInfo
NextFrame
    Exp a
IfEnd         -> FrameInfo
StopFrame
    -- looping constructions
    UntilBegin CondInfo (PrimOr a)
_ -> FrameInfo
StartFrame
    Exp a
UntilEnd     -> FrameInfo
StopFrame
    WhileBegin CondInfo (PrimOr a)
_ -> FrameInfo
StartFrame
    WhileRefBegin Var
_ -> FrameInfo
StartFrame
    Exp a
WhileEnd     -> FrameInfo
StopFrame
    Exp a
_            -> FrameInfo
NoFrame


trimByArgLength :: E -> E
trimByArgLength :: E -> E
trimByArgLength = (RatedExp E -> E) -> E -> E
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix ((RatedExp E -> E) -> E -> E) -> (RatedExp E -> E) -> E -> E
forall a b. (a -> b) -> a -> b
$ \RatedExp E
x -> RatedExp E -> E
forall (f :: * -> *). f (Fix f) -> Fix f
Fix RatedExp E
x{ ratedExpExp :: Exp E
ratedExpExp = Exp E -> Exp E
forall a. MainExp a -> MainExp a
phi (Exp E -> Exp E) -> Exp E -> Exp E
forall a b. (a -> b) -> a -> b
$ RatedExp E -> Exp E
forall a. RatedExp a -> Exp a
ratedExpExp RatedExp E
x }
    where phi :: MainExp a -> MainExp a
phi MainExp a
x = case MainExp a
x of
            Tfm Info
info [a]
xs -> Info -> [a] -> MainExp a
forall a. Info -> [a] -> MainExp a
Tfm (Info
info{infoSignature :: Signature
infoSignature = Signature -> [a] -> Signature
forall (t :: * -> *) a. Foldable t => Signature -> t a -> Signature
trimInfo (Info -> Signature
infoSignature Info
info) [a]
xs}) [a]
xs
            MainExp a
_ -> MainExp a
x
          trimInfo :: Signature -> t a -> Signature
trimInfo Signature
signature t a
args = case Signature
signature of
            SingleRate Map Rate [Rate]
tab -> Map Rate [Rate] -> Signature
SingleRate (Map Rate [Rate] -> Signature) -> Map Rate [Rate] -> Signature
forall a b. (a -> b) -> a -> b
$ ([Rate] -> [Rate]) -> Map Rate [Rate] -> Map Rate [Rate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Rate] -> [Rate]
forall a. [a] -> [a]
trim Map Rate [Rate]
tab
            MultiRate [Rate]
outs [Rate]
ins -> [Rate] -> [Rate] -> Signature
MultiRate [Rate]
outs ([Rate] -> [Rate]
forall a. [a] -> [a]
trim [Rate]
ins)
            where trim :: [a] -> [a]
trim = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
args)

clearEmptyResults :: ([RatedVar], Exp RatedVar) -> ([RatedVar], Exp RatedVar)
clearEmptyResults :: ([RatedVar], Exp RatedVar) -> ([RatedVar], Exp RatedVar)
clearEmptyResults ([RatedVar]
res, Exp RatedVar
expr) = ((RatedVar -> Bool) -> [RatedVar] -> [RatedVar]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
/= Rate
Xr) (Rate -> Bool) -> (RatedVar -> Rate) -> RatedVar -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatedVar -> Rate
ratedVarRate) [RatedVar]
res, Exp RatedVar
expr)

collectRates :: Dag RatedExp -> [([RatedVar], Exp RatedVar)]
collectRates :: [(Int, RatedExp Int)] -> [([RatedVar], Exp RatedVar)]
collectRates [(Int, RatedExp Int)]
dag = (Exp RatedExp -> ([RatedVar], Exp RatedVar))
-> [Exp RatedExp] -> [([RatedVar], Exp RatedVar)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RatedExp RatedVar -> Exp RatedVar)
-> Exp RatedExp -> ([RatedVar], Exp RatedVar)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second RatedExp RatedVar -> Exp RatedVar
forall a. RatedExp a -> Exp a
ratedExpExp) [Exp RatedExp]
res2
    where res2 :: [Exp RatedExp]
res2 = Int -> [Exp RatedExp] -> [Exp RatedExp]
forall (f :: * -> *). Traversable f => Int -> Dag f -> Dag f
liveness Int
lastFreshId1 [Exp RatedExp]
res1
          ([Exp RatedExp]
res1, Int
lastFreshId1)= UnfoldMultiOuts RatedExp Rate
-> Int -> [SingleStmt RatedExp Rate] -> ([Exp RatedExp], Int)
forall (f :: * -> *) a.
UnfoldMultiOuts f a
-> Int -> [SingleStmt f a] -> ([MultiStmt f a], Int)
unfoldMultiOuts UnfoldMultiOuts RatedExp Rate
unfoldSpec Int
lastFreshId [SingleStmt RatedExp Rate]
dag1
          ([SingleStmt RatedExp Rate]
dag1, Int
lastFreshId) = [(Int, RatedExp Int)] -> ([SingleStmt RatedExp Rate], Int)
rateGraph [(Int, RatedExp Int)]
dag

-----------------------------------------------------------
-- Dag -> Dag

filterDepCases :: Dag RatedExp -> Dag RatedExp
filterDepCases :: [(Int, RatedExp Int)] -> [(Int, RatedExp Int)]
filterDepCases = ((Int, RatedExp Int) -> Bool)
-> [(Int, RatedExp Int)] -> [(Int, RatedExp Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Int, RatedExp Int) -> Bool) -> (Int, RatedExp Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatedExp Int -> Bool
forall a. RatedExp a -> Bool
isDepCase (RatedExp Int -> Bool)
-> ((Int, RatedExp Int) -> RatedExp Int)
-> (Int, RatedExp Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, RatedExp Int) -> RatedExp Int
forall a b. (a, b) -> b
snd)
  where isDepCase :: RatedExp a -> Bool
isDepCase RatedExp a
x = case RatedExp a -> Exp a
forall a. RatedExp a -> Exp a
ratedExpExp RatedExp a
x of
          Exp a
Starts  -> Bool
True
          Seq PrimOr a
_ PrimOr a
_ -> Bool
True
          Ends PrimOr a
_  -> Bool
True
          Exp a
_       -> Bool
False

-----------------------------------------------------------
-- deduces types

rateGraph :: [Stmt RatedExp Int] -> ([Stmt RatedExp (Var Rate)], Int)
rateGraph :: [(Int, RatedExp Int)] -> ([SingleStmt RatedExp Rate], Int)
rateGraph [(Int, RatedExp Int)]
dag = ([SingleStmt RatedExp Rate]
stmts, Int
lastId)
     where ([SingleStmt RatedExp Rate]
stmts, Int
lastId) = TypeGraph RatedExp Rate
-> [(Int, RatedExp Int)] -> ([SingleStmt RatedExp Rate], Int)
forall a (f :: * -> *).
(Show a, Ord a, Traversable f) =>
TypeGraph f a -> [Stmt f Int] -> ([Stmt f (Var a)], Int)
deduceTypes TypeGraph RatedExp Rate
algSpec [(Int, RatedExp Int)]
dag
           algSpec :: TypeGraph RatedExp Rate
algSpec = (Convert Rate -> SingleStmt RatedExp Rate)
-> ((Int, RatedExp Int)
    -> [Rate] -> ([Rate], SingleStmt RatedExp Rate))
-> TypeGraph RatedExp Rate
forall (f :: * -> *) a.
(Convert a -> Stmt f (Var a))
-> (Stmt f Int -> [a] -> ([a], Stmt f (Var a))) -> TypeGraph f a
TypeGraph Convert Rate -> SingleStmt RatedExp Rate
mkConvert' (Int, RatedExp Int) -> [Rate] -> ([Rate], SingleStmt RatedExp Rate)
defineType'

           mkConvert' :: Convert Rate -> SingleStmt RatedExp Rate
mkConvert' Convert Rate
a = (RatedVar
to, Maybe Rate -> Maybe Int -> Exp RatedVar -> RatedExp RatedVar
forall a. Maybe Rate -> Maybe Int -> Exp a -> RatedExp a
RatedExp Maybe Rate
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing (Exp RatedVar -> RatedExp RatedVar)
-> Exp RatedVar -> RatedExp RatedVar
forall a b. (a -> b) -> a -> b
$
                   Rate -> Rate -> PrimOr RatedVar -> Exp RatedVar
forall a. Rate -> Rate -> a -> MainExp a
ConvertRate (RatedVar -> Rate
ratedVarRate RatedVar
to) (RatedVar -> Rate
ratedVarRate RatedVar
from) (PrimOr RatedVar -> Exp RatedVar)
-> PrimOr RatedVar -> Exp RatedVar
forall a b. (a -> b) -> a -> b
$ Either Prim RatedVar -> PrimOr RatedVar
forall a. Either Prim a -> PrimOr a
PrimOr (Either Prim RatedVar -> PrimOr RatedVar)
-> Either Prim RatedVar -> PrimOr RatedVar
forall a b. (a -> b) -> a -> b
$ RatedVar -> Either Prim RatedVar
forall a b. b -> Either a b
Right RatedVar
from)
               where from :: RatedVar
from = Convert Rate -> RatedVar
forall a. Convert a -> Var a
convertFrom Convert Rate
a
                     to :: RatedVar
to   = Convert Rate -> RatedVar
forall a. Convert a -> Var a
convertTo   Convert Rate
a

           defineType' :: (Int, RatedExp Int) -> [Rate] -> ([Rate], SingleStmt RatedExp Rate)
defineType' (Int
outVar, RatedExp Int
expr) [Rate]
desiredRates = ([Rate]
ratesForConversion, (RatedVar
outVar', RatedExp RatedVar
expr'))
               where possibleRate :: Rate
possibleRate = [Rate] -> RatedExp Int -> Rate
deduceRate [Rate]
desiredRates RatedExp Int
expr
                     ratesForConversion :: [Rate]
ratesForConversion = (Rate -> Bool) -> [Rate] -> [Rate]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Rate -> Bool) -> Rate -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rate -> Rate -> Bool) -> Rate -> Rate -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rate -> Rate -> Bool
coherentRates Rate
possibleRate) [Rate]
desiredRates
                     expr' :: RatedExp RatedVar
expr' = Maybe Rate -> Maybe Int -> Exp RatedVar -> RatedExp RatedVar
forall a. Maybe Rate -> Maybe Int -> Exp a -> RatedExp a
RatedExp Maybe Rate
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing (Exp RatedVar -> RatedExp RatedVar)
-> Exp RatedVar -> RatedExp RatedVar
forall a b. (a -> b) -> a -> b
$ Rate -> Exp Int -> Exp RatedVar
rateExp Rate
possibleRate (Exp Int -> Exp RatedVar) -> Exp Int -> Exp RatedVar
forall a b. (a -> b) -> a -> b
$ RatedExp Int -> Exp Int
forall a. RatedExp a -> Exp a
ratedExpExp RatedExp Int
expr
                     outVar' :: RatedVar
outVar' = Rate -> Int -> RatedVar
ratedVar Rate
possibleRate Int
outVar

----------------------------------------------------------
-- unfolds multiple rates

unfoldSpec :: UnfoldMultiOuts RatedExp Rate
unfoldSpec :: UnfoldMultiOuts RatedExp Rate
unfoldSpec = (RatedExp RatedVar -> Maybe (Selector Rate))
-> (RatedExp RatedVar -> Maybe [Rate])
-> UnfoldMultiOuts RatedExp Rate
forall (f :: * -> *) a.
(f (Var a) -> Maybe (Selector a))
-> (f (Var a) -> Maybe [a]) -> UnfoldMultiOuts f a
UnfoldMultiOuts RatedExp RatedVar -> Maybe (Selector Rate)
forall a. RatedExp (Var a) -> Maybe (Selector a)
getSelector' RatedExp RatedVar -> Maybe [Rate]
forall a. RatedExp a -> Maybe [Rate]
getParentTypes'
    where getSelector' :: RatedExp (Var a) -> Maybe (Selector a)
getSelector' RatedExp (Var a)
x = case RatedExp (Var a) -> Exp (Var a)
forall a. RatedExp a -> Exp a
ratedExpExp RatedExp (Var a)
x of
                Select Rate
_ Int
order (PrimOr (Right Var a
parent)) -> Selector a -> Maybe (Selector a)
forall a. a -> Maybe a
Just (Selector a -> Maybe (Selector a))
-> Selector a -> Maybe (Selector a)
forall a b. (a -> b) -> a -> b
$ Var a -> Int -> Selector a
forall a. Var a -> Int -> Selector a
Selector Var a
parent Int
order
                Exp (Var a)
_ -> Maybe (Selector a)
forall a. Maybe a
Nothing
          getParentTypes' :: RatedExp a -> Maybe [Rate]
getParentTypes' RatedExp a
x = case RatedExp a -> Exp a
forall a. RatedExp a -> Exp a
ratedExpExp RatedExp a
x of
                Tfm Info
i [PrimOr a]
_ -> if (Signature -> Bool
isMultiOutSignature (Signature -> Bool) -> Signature -> Bool
forall a b. (a -> b) -> a -> b
$ Info -> Signature
infoSignature Info
i)
                           then [Rate] -> Maybe [Rate]
forall a. a -> Maybe a
Just (Exp a -> [Rate]
forall a. MainExp a -> [Rate]
getRates (Exp a -> [Rate]) -> Exp a -> [Rate]
forall a b. (a -> b) -> a -> b
$ RatedExp a -> Exp a
forall a. RatedExp a -> Exp a
ratedExpExp RatedExp a
x)
                           else Maybe [Rate]
forall a. Maybe a
Nothing
                Exp a
_ -> Maybe [Rate]
forall a. Maybe a
Nothing

coherentRates :: Rate -> Rate -> Bool
coherentRates :: Rate -> Rate -> Bool
coherentRates Rate
to Rate
from = case (Rate
to, Rate
from) of
    (Rate
a, Rate
b)  | Rate
a Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
b    -> Bool
True
    (Rate
Xr, Rate
_)             -> Bool
True
    (Rate
Kr, Rate
Ir)            -> Bool
True
    (Rate, Rate)
_                   -> Bool
False

deduceRate :: [Rate] -> RatedExp Int -> Rate
deduceRate :: [Rate] -> RatedExp Int -> Rate
deduceRate [Rate]
desiredRates RatedExp Int
expr = case RatedExp Int -> Exp Int
forall a. RatedExp a -> Exp a
ratedExpExp RatedExp Int
expr of
    ExpPrim Prim
_ -> case [Rate]
desiredRates of
        [Rate
Sr] -> Rate
Sr
        [Rate]
_ -> Rate
Ir

    Tfm Info
info [PrimOr Int]
_ -> case Info -> Signature
infoSignature Info
info of
        MultiRate [Rate]
_ [Rate]
_ -> Rate
Xr
        SingleRate Map Rate [Rate]
tab ->
            let r1 :: Rate
r1 = Name -> [Rate] -> Map Rate [Rate] -> Rate
forall t a. t -> [Rate] -> Map Rate a -> Rate
tfmNoRate (Info -> Name
infoName Info
info) [Rate]
desiredRates Map Rate [Rate]
tab
            in  case RatedExp Int -> Maybe Rate
forall a. RatedExp a -> Maybe Rate
ratedExpRate RatedExp Int
expr of
                    Just Rate
r | Rate -> Map Rate [Rate] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Rate
r Map Rate [Rate]
tab -> Rate
r
                    Just Rate
_ -> Rate
r1
                    Maybe Rate
Nothing -> Rate
r1

    ExpNum NumExp (PrimOr Int)
_ -> case RatedExp Int -> Maybe Rate
forall a. RatedExp a -> Maybe Rate
ratedExpRate RatedExp Int
expr of
        Just Rate
r  -> Rate
r
        Maybe Rate
Nothing -> case [Rate] -> Rate
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Rate
Ar Rate -> [Rate] -> [Rate]
forall a. a -> [a] -> [a]
: [Rate]
desiredRates) of
            Rate
Xr -> Rate
Ar
            Rate
r -> Rate
r

    Select Rate
rate Int
_ PrimOr Int
_ -> Rate
rate
    If CondInfo (PrimOr Int)
_ PrimOr Int
_ PrimOr Int
_ -> case [Rate] -> Rate
forall a. [a] -> a
head ([Rate] -> Rate) -> [Rate] -> Rate
forall a b. (a -> b) -> a -> b
$ [Rate] -> [Rate]
forall a. Ord a => [a] -> [a]
sort [Rate]
desiredRates of
        Rate
Xr -> Rate
Ar
        Rate
r  -> Rate
r
    ReadVar Var
v -> Var -> Rate
varRate Var
v
    ReadArr Var
v [PrimOr Int]
_ -> Var -> Rate
varRate Var
v
    ReadMacrosString Name
_ -> Rate
Sr
    ReadMacrosDouble Name
_ -> Rate
Ir
    ReadMacrosInt Name
_ -> Rate
Ir
    Exp Int
_  -> Rate
Xr
    where tfmNoRate :: t -> [Rate] -> Map Rate a -> Rate
tfmNoRate t
name [Rate]
rates Map Rate a
tab = case [Rate] -> [Rate]
forall a. Ord a => [a] -> [a]
sort [Rate]
rates of
              [Rate
Xr]  -> t -> [Rate] -> Map Rate a -> Rate
tfmNoRate t
name [Rate
Ar] Map Rate a
tab
              Rate
Xr:[Rate]
as -> t -> [Rate] -> Map Rate a -> Rate
tfmNoRate t
name [Rate]
as Map Rate a
tab
              [Rate]
as | (Rate -> Bool) -> [Rate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Ir) [Rate]
as  -> Maybe Rate -> Rate
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Rate -> Rate) -> Maybe Rate -> Rate
forall a b. (a -> b) -> a -> b
$ (Rate -> Bool) -> [Rate] -> Maybe Rate
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Rate -> Map Rate a -> Bool) -> Map Rate a -> Rate -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rate -> Map Rate a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Map Rate a
tab) (Rate
Ir Rate -> [Rate] -> [Rate]
forall a. a -> [a] -> [a]
: [Rate]
as [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ [Rate
forall a. Bounded a => a
minBound .. Rate
forall a. Bounded a => a
maxBound])
              [Rate]
as -> Maybe Rate -> Rate
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Rate -> Rate) -> Maybe Rate -> Rate
forall a b. (a -> b) -> a -> b
$ (Rate -> Bool) -> [Rate] -> Maybe Rate
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Rate -> Map Rate a -> Bool) -> Map Rate a -> Rate -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rate -> Map Rate a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Map Rate a
tab) ([Rate]
as [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ [Rate
forall a. Bounded a => a
minBound .. Rate
forall a. Bounded a => a
maxBound])

rateExp :: Rate -> Exp Int -> Exp RatedVar
rateExp :: Rate -> Exp Int -> Exp RatedVar
rateExp Rate
curRate Exp Int
expr = case Exp Int
expr of
    ExpPrim (P Int
n) | Rate
curRate Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Sr -> Prim -> Exp RatedVar
forall a. Prim -> MainExp a
ExpPrim (Int -> Prim
PString Int
n)
    Tfm Info
i [PrimOr Int]
xs -> Info -> [PrimOr RatedVar] -> Exp RatedVar
forall a. Info -> [a] -> MainExp a
Tfm Info
i ([PrimOr RatedVar] -> Exp RatedVar)
-> [PrimOr RatedVar] -> Exp RatedVar
forall a b. (a -> b) -> a -> b
$ [Rate] -> [PrimOr Int] -> [PrimOr RatedVar]
mergeWithPrimOr (Rate -> Signature -> [Rate]
ratesFromSignature Rate
curRate (Info -> Signature
infoSignature Info
i)) [PrimOr Int]
xs
    Select Rate
rate Int
pid PrimOr Int
a -> Rate -> Int -> PrimOr RatedVar -> Exp RatedVar
forall a. Rate -> Int -> a -> MainExp a
Select Rate
rate Int
pid ((Int -> RatedVar) -> PrimOr Int -> PrimOr RatedVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rate -> Int -> RatedVar
ratedVar Rate
Xr) PrimOr Int
a)
    If CondInfo (PrimOr Int)
p PrimOr Int
t PrimOr Int
e -> CondInfo (PrimOr RatedVar)
-> PrimOr RatedVar -> PrimOr RatedVar -> Exp RatedVar
forall a. CondInfo a -> a -> a -> MainExp a
If (Rate -> CondInfo (PrimOr Int) -> CondInfo (PrimOr RatedVar)
forall (f :: * -> *) (f :: * -> *).
(Functor f, Functor f) =>
Rate -> f (f Int) -> f (f RatedVar)
rec2 Rate
condRate CondInfo (PrimOr Int)
p) (Rate -> PrimOr Int -> PrimOr RatedVar
forall (f :: * -> *). Functor f => Rate -> f Int -> f RatedVar
rec1 Rate
curRate PrimOr Int
t) (Rate -> PrimOr Int -> PrimOr RatedVar
forall (f :: * -> *). Functor f => Rate -> f Int -> f RatedVar
rec1 Rate
curRate PrimOr Int
e)
    ExpNum NumExp (PrimOr Int)
_ -> Rate -> Exp Int -> Exp RatedVar
forall (f :: * -> *) (f :: * -> *).
(Functor f, Functor f) =>
Rate -> f (f Int) -> f (f RatedVar)
rec2 Rate
curRate Exp Int
expr

    ReadVar Var
v -> Var -> Exp RatedVar
forall a. Var -> MainExp a
ReadVar Var
v
    WriteVar Var
v PrimOr Int
a -> Var -> PrimOr RatedVar -> Exp RatedVar
forall a. Var -> a -> MainExp a
WriteVar Var
v (PrimOr RatedVar -> Exp RatedVar)
-> PrimOr RatedVar -> Exp RatedVar
forall a b. (a -> b) -> a -> b
$ Rate -> PrimOr Int -> PrimOr RatedVar
forall (f :: * -> *). Functor f => Rate -> f Int -> f RatedVar
rec1 (Var -> Rate
varRate Var
v) PrimOr Int
a
    InitVar Var
v PrimOr Int
a -> Var -> PrimOr RatedVar -> Exp RatedVar
forall a. Var -> a -> MainExp a
InitVar Var
v (PrimOr RatedVar -> Exp RatedVar)
-> PrimOr RatedVar -> Exp RatedVar
forall a b. (a -> b) -> a -> b
$ Rate -> PrimOr Int -> PrimOr RatedVar
forall (f :: * -> *). Functor f => Rate -> f Int -> f RatedVar
rec1 Rate
Ir PrimOr Int
a -- rec1 (varRate v) a

    ReadArr Var
v [PrimOr Int]
as -> Var -> [PrimOr RatedVar] -> Exp RatedVar
forall a. Var -> [a] -> MainExp a
ReadArr Var
v ([PrimOr RatedVar] -> Exp RatedVar)
-> [PrimOr RatedVar] -> Exp RatedVar
forall a b. (a -> b) -> a -> b
$ Var -> [PrimOr Int] -> [PrimOr RatedVar]
forall (f :: * -> *) (f :: * -> *).
(Functor f, Functor f) =>
Var -> f (f Int) -> f (f RatedVar)
arrIndex Var
v [PrimOr Int]
as
    WriteArr Var
v [PrimOr Int]
as PrimOr Int
b -> Var -> [PrimOr RatedVar] -> PrimOr RatedVar -> Exp RatedVar
forall a. Var -> [a] -> a -> MainExp a
WriteArr Var
v (Var -> [PrimOr Int] -> [PrimOr RatedVar]
forall (f :: * -> *) (f :: * -> *).
(Functor f, Functor f) =>
Var -> f (f Int) -> f (f RatedVar)
arrIndex Var
v [PrimOr Int]
as) (Rate -> PrimOr Int -> PrimOr RatedVar
forall (f :: * -> *). Functor f => Rate -> f Int -> f RatedVar
rec1 (Var -> Rate
varRate Var
v) PrimOr Int
b)
    WriteInitArr Var
v [PrimOr Int]
as PrimOr Int
b -> Var -> [PrimOr RatedVar] -> PrimOr RatedVar -> Exp RatedVar
forall a. Var -> [a] -> a -> MainExp a
WriteInitArr Var
v (Var -> [PrimOr Int] -> [PrimOr RatedVar]
forall (f :: * -> *) (f :: * -> *).
(Functor f, Functor f) =>
Var -> f (f Int) -> f (f RatedVar)
arrIndex Var
v [PrimOr Int]
as) (Rate -> PrimOr Int -> PrimOr RatedVar
forall (f :: * -> *). Functor f => Rate -> f Int -> f RatedVar
rec1 Rate
Ir PrimOr Int
b)
    InitArr Var
v [PrimOr Int]
as -> Var -> [PrimOr RatedVar] -> Exp RatedVar
forall a. Var -> [a] -> MainExp a
InitArr Var
v ([PrimOr RatedVar] -> Exp RatedVar)
-> [PrimOr RatedVar] -> Exp RatedVar
forall a b. (a -> b) -> a -> b
$ (PrimOr Int -> PrimOr RatedVar)
-> [PrimOr Int] -> [PrimOr RatedVar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rate -> PrimOr Int -> PrimOr RatedVar
forall (f :: * -> *). Functor f => Rate -> f Int -> f RatedVar
rec1 Rate
Ir) [PrimOr Int]
as
    TfmArr Bool
isInit Var
v Info
i [PrimOr Int]
xs -> Bool -> Var -> Info -> [PrimOr RatedVar] -> Exp RatedVar
forall a. Bool -> Var -> Info -> [a] -> MainExp a
TfmArr Bool
isInit Var
v Info
i ([PrimOr RatedVar] -> Exp RatedVar)
-> [PrimOr RatedVar] -> Exp RatedVar
forall a b. (a -> b) -> a -> b
$ [Rate] -> [PrimOr Int] -> [PrimOr RatedVar]
mergeWithPrimOr (Rate -> Signature -> [Rate]
ratesFromSignature Rate
curRate (Info -> Signature
infoSignature Info
i)) [PrimOr Int]
xs

    ExpPrim Prim
p -> Prim -> Exp RatedVar
forall a. Prim -> MainExp a
ExpPrim Prim
p
    IfBegin Rate
rootRate CondInfo (PrimOr Int)
_ -> Rate -> Exp Int -> Exp RatedVar
forall (f :: * -> *) (f :: * -> *).
(Functor f, Functor f) =>
Rate -> f (f Int) -> f (f RatedVar)
rec2 Rate
rootRate Exp Int
expr
    UntilBegin CondInfo (PrimOr Int)
_ -> Rate -> Exp Int -> Exp RatedVar
forall (f :: * -> *) (f :: * -> *).
(Functor f, Functor f) =>
Rate -> f (f Int) -> f (f RatedVar)
rec2 Rate
condRate Exp Int
expr
    WhileBegin CondInfo (PrimOr Int)
_ -> Rate -> Exp Int -> Exp RatedVar
forall (f :: * -> *) (f :: * -> *).
(Functor f, Functor f) =>
Rate -> f (f Int) -> f (f RatedVar)
rec2 Rate
condRate Exp Int
expr
    WhileRefBegin Var
var -> Var -> Exp RatedVar
forall a. Var -> MainExp a
WhileRefBegin Var
var
--    ElseIfBegin _ -> rec2 condRate expr
    Exp Int
ElseBegin -> Exp RatedVar
forall a. MainExp a
ElseBegin
    Exp Int
IfEnd -> Exp RatedVar
forall a. MainExp a
IfEnd
    Exp Int
UntilEnd -> Exp RatedVar
forall a. MainExp a
UntilEnd
    Exp Int
WhileEnd -> Exp RatedVar
forall a. MainExp a
WhileEnd
    Exp Int
EmptyExp -> Exp RatedVar
forall a. MainExp a
EmptyExp
    Verbatim Name
a -> Name -> Exp RatedVar
forall a. Name -> MainExp a
Verbatim Name
a
    InitMacrosString Name
name Name
initValue -> Name -> Name -> Exp RatedVar
forall a. Name -> Name -> MainExp a
InitMacrosString Name
name Name
initValue
    InitMacrosDouble Name
name Double
initValue -> Name -> Double -> Exp RatedVar
forall a. Name -> Double -> MainExp a
InitMacrosDouble Name
name Double
initValue
    ReadMacrosString Name
name -> Name -> Exp RatedVar
forall a. Name -> MainExp a
ReadMacrosString Name
name
    ReadMacrosDouble Name
name -> Name -> Exp RatedVar
forall a. Name -> MainExp a
ReadMacrosDouble Name
name
    ReadMacrosInt Name
name -> Name -> Exp RatedVar
forall a. Name -> MainExp a
ReadMacrosInt Name
name
    ExpBool BoolExp (PrimOr Int)
_           -> Name -> Exp RatedVar
forall a. HasCallStack => Name -> a
error (Name -> Exp RatedVar) -> Name -> Exp RatedVar
forall a b. (a -> b) -> a -> b
$ Name -> Name
msg Name
"ExpBool expression should be substituted"
    ConvertRate Rate
_ Rate
_ PrimOr Int
_   -> Name -> Exp RatedVar
forall a. HasCallStack => Name -> a
error (Name -> Exp RatedVar) -> Name -> Exp RatedVar
forall a b. (a -> b) -> a -> b
$ Name -> Name
msg Name
"ConvertRate couldn't be here. It's introduced on the later stages of processing"
    Seq PrimOr Int
_ PrimOr Int
_           -> Name -> Exp RatedVar
forall a. HasCallStack => Name -> a
error Name
"No rateExp for Seq"
    Ends PrimOr Int
_            -> Name -> Exp RatedVar
forall a. HasCallStack => Name -> a
error Name
"No rateExp for Ends"
    InitMacrosInt Name
_ Int
_ -> Name -> Exp RatedVar
forall a. HasCallStack => Name -> a
error Name
"No rateExp for InitMacrosInt"
    Exp Int
Starts            -> Name -> Exp RatedVar
forall a. HasCallStack => Name -> a
error Name
"No rateExp for Starts"
    where ratesFromSignature :: Rate -> Signature -> [Rate]
ratesFromSignature Rate
rate Signature
signature = case Signature
signature of
              SingleRate Map Rate [Rate]
table -> Map Rate [Rate]
table Map Rate [Rate] -> Rate -> [Rate]
forall k a. Ord k => Map k a -> k -> a
M.! Rate
rate
              MultiRate [Rate]
_ [Rate]
rs   -> [Rate]
rs

          condRate :: Rate
          condRate :: Rate
condRate = Rate -> Rate -> Rate
forall a. Ord a => a -> a -> a
max Rate
Kr Rate
curRate -- Kr

          rec2 :: Rate -> f (f Int) -> f (f RatedVar)
rec2 Rate
r = (f Int -> f RatedVar) -> f (f Int) -> f (f RatedVar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> RatedVar) -> f Int -> f RatedVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rate -> Int -> RatedVar
ratedVar Rate
r))
          rec1 :: Rate -> f Int -> f RatedVar
rec1 Rate
r = (Int -> RatedVar) -> f Int -> f RatedVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rate -> Int -> RatedVar
ratedVar Rate
r)

          arrIndex :: Var -> f (f Int) -> f (f RatedVar)
arrIndex Var
v f (f Int)
as = (f Int -> f RatedVar) -> f (f Int) -> f (f RatedVar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rate -> f Int -> f RatedVar
forall (f :: * -> *). Functor f => Rate -> f Int -> f RatedVar
rec1 (Var -> Rate
arrIndexVarRate Var
v)) f (f Int)
as

          msg :: Name -> Name
msg Name
txt = Name
"Csound.Dynamic.Render.Instr.rateExp: " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
txt

arrIndexVarRate :: T.Var -> Rate
arrIndexVarRate :: Var -> Rate
arrIndexVarRate Var
v = case Var -> Rate
varRate Var
v of
    Rate
Ir -> Rate
Ir
    Rate
_  -> Rate
Kr

mergeWithPrimOr :: [Rate] -> [PrimOr Int] -> [PrimOr (Var Rate)]
mergeWithPrimOr :: [Rate] -> [PrimOr Int] -> [PrimOr RatedVar]
mergeWithPrimOr = (Rate -> PrimOr Int -> PrimOr RatedVar)
-> [Rate] -> [PrimOr Int] -> [PrimOr RatedVar]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Rate -> PrimOr Int -> PrimOr RatedVar
phi
    where
        phi :: Rate -> PrimOr Int -> PrimOr RatedVar
phi Rate
r (PrimOr Either Prim Int
x) = Either Prim RatedVar -> PrimOr RatedVar
forall a. Either Prim a -> PrimOr a
PrimOr (Either Prim RatedVar -> PrimOr RatedVar)
-> Either Prim RatedVar -> PrimOr RatedVar
forall a b. (a -> b) -> a -> b
$ case Either Prim Int
x of
            Left  Prim
p -> Prim -> Either Prim RatedVar
forall a b. a -> Either a b
Left (Prim -> Either Prim RatedVar) -> Prim -> Either Prim RatedVar
forall a b. (a -> b) -> a -> b
$ Rate -> Prim -> Prim
updateVarTargetRate Rate
r Prim
p
            Right Int
n -> RatedVar -> Either Prim RatedVar
forall a b. b -> Either a b
Right (RatedVar -> Either Prim RatedVar)
-> RatedVar -> Either Prim RatedVar
forall a b. (a -> b) -> a -> b
$ Rate -> Int -> RatedVar
ratedVar Rate
r Int
n
        updateVarTargetRate :: Rate -> Prim -> Prim
updateVarTargetRate Rate
r Prim
p = case Prim
p of
            PrimVar Rate
_ Var
v -> Rate -> Var -> Prim
PrimVar Rate
r Var
v
            Prim
_           -> Prim
p