module Csound.Dynamic.Types.Exp(
E, RatedExp(..), isEmptyExp, RatedVar, ratedVar, ratedVarRate, ratedVarId,
ratedExp, noRate, withRate, setRate,
Exp, toPrimOr, toPrimOrTfm, PrimOr(..), MainExp(..), Name,
InstrId(..), intInstrId, ratioInstrId, stringInstrId,
VarType(..), Var(..), Info(..), OpcFixity(..), Rate(..),
Signature(..), isInfix, isPrefix,
Prim(..), Gen(..),
Inline(..), InlineExp(..), PreInline(..),
BoolExp, CondInfo, CondOp(..), isTrue, isFalse,
NumExp, NumOp(..), Note,
MultiOut
) where
import Control.Applicative
import Data.Traversable
import Data.Foldable hiding (concat)
import Data.Map(Map)
import Data.Maybe(isNothing)
import qualified Data.IntMap as IM
import Data.Fix
import qualified Csound.Dynamic.Tfm.DeduceTypes as R(Var(..))
type Name = String
type LineNum = Int
data InstrId
= InstrId
{ instrIdFrac :: Maybe Int
, instrIdCeil :: Int }
| InstrLabel String
deriving (Show, Eq, Ord)
intInstrId :: Int -> InstrId
intInstrId n = InstrId Nothing n
ratioInstrId :: Int -> Int -> InstrId
ratioInstrId beforeDot afterDot = InstrId (Just $ afterDot) beforeDot
stringInstrId :: String -> InstrId
stringInstrId = InstrLabel
type E = Fix RatedExp
data RatedExp a = RatedExp
{ ratedExpRate :: Maybe Rate
, ratedExpDepends :: Maybe LineNum
, ratedExpExp :: Exp a
} deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
type RatedVar = R.Var Rate
ratedVar :: Rate -> Int -> RatedVar
ratedVar = flip R.Var
ratedVarRate :: RatedVar -> Rate
ratedVarRate = R.varType
ratedVarId :: RatedVar -> Int
ratedVarId = R.varId
ratedExp :: Maybe Rate -> Exp E -> E
ratedExp r = Fix . RatedExp r Nothing
noRate :: Exp E -> E
noRate = ratedExp Nothing
withRate :: Rate -> Exp E -> E
withRate r = ratedExp (Just r)
setRate :: Rate -> E -> E
setRate r a = Fix $ (\x -> x { ratedExpRate = Just r }) $ unFix a
newtype PrimOr a = PrimOr { unPrimOr :: Either Prim a }
deriving (Show, Eq, Ord, Functor)
toPrimOr :: E -> PrimOr E
toPrimOr a = PrimOr $ case ratedExpExp $ unFix a of
ExpPrim (PString _) -> Right a
ExpPrim p -> Left p
ReadVar v | noDeps -> Left (PrimVar (varRate v) v)
_ -> Right a
where
noDeps = isNothing $ ratedExpDepends $ unFix a
toPrimOrTfm :: Rate -> E -> PrimOr E
toPrimOrTfm r a = PrimOr $ case ratedExpExp $ unFix a of
ExpPrim (PString _) -> Right a
ExpPrim p | (r == Ir || r == Sr) -> Left p
ReadVar v | noDeps -> Left (PrimVar (varRate v) v)
_ -> Right a
where
noDeps = isNothing $ ratedExpDepends $ unFix a
type Exp a = MainExp (PrimOr a)
data MainExp a
= EmptyExp
| ExpPrim Prim
| Tfm Info [a]
| ConvertRate Rate Rate a
| Select Rate Int a
| If (CondInfo a) a a
| ExpBool (BoolExp a)
| ExpNum (NumExp a)
| InitVar Var a
| ReadVar Var
| WriteVar Var a
| IfBegin (CondInfo a)
| ElseBegin
| IfEnd
| UntilBegin (CondInfo a)
| UntilEnd
| Verbatim String
| Starts
| Seq a a
| Ends a
deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
isEmptyExp :: E -> Bool
isEmptyExp e = isNothing (ratedExpDepends re) && (ratedExpExp re == EmptyExp)
where re = unFix e
data Var
= Var
{ varType :: VarType
, varRate :: Rate
, varName :: Name }
| VarVerbatim
{ varRate :: Rate
, varName :: Name
} deriving (Show, Eq, Ord)
data VarType = LocalVar | GlobalVar
deriving (Show, Eq, Ord)
data Info = Info
{ infoName :: Name
, infoSignature :: Signature
, infoOpcFixity :: OpcFixity
} deriving (Show, Eq, Ord)
isPrefix, isInfix :: Info -> Bool
isPrefix = (Prefix ==) . infoOpcFixity
isInfix = (Infix ==) . infoOpcFixity
data OpcFixity = Prefix | Infix | Opcode
deriving (Show, Eq, Ord)
data Rate
= Xr
| Ar
| Kr
| Ir
| Sr
| Fr
| Wr
| Tvar
deriving (Show, Eq, Ord, Enum, Bounded)
data Signature
= SingleRate (Map Rate [Rate])
| MultiRate
{ outMultiRate :: [Rate]
, inMultiRate :: [Rate] }
deriving (Show, Eq, Ord)
data Prim
= P Int
| PString Int
| PrimInt Int
| PrimDouble Double
| PrimString String
| PrimInstrId InstrId
| PrimVar
{ primVarTargetRate :: Rate
, primVar :: Var }
deriving (Show, Eq, Ord)
data Gen = Gen
{ genSize :: Int
, genId :: Int
, genArgs :: [Double]
, genFile :: Maybe String
} deriving (Show, Eq, Ord)
type Note = [Prim]
data Inline a b = Inline
{ inlineExp :: InlineExp a
, inlineEnv :: IM.IntMap b
} deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
data InlineExp a
= InlinePrim Int
| InlineExp a [InlineExp a]
deriving (Show, Eq, Ord)
data PreInline a b = PreInline a [b]
deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
type BoolExp a = PreInline CondOp a
type CondInfo a = Inline CondOp a
data CondOp
= TrueOp | FalseOp | And | Or
| Equals | NotEquals | Less | Greater | LessEquals | GreaterEquals
deriving (Show, Eq, Ord)
isTrue, isFalse :: CondInfo a -> Bool
isTrue = isCondOp TrueOp
isFalse = isCondOp FalseOp
isCondOp :: CondOp -> CondInfo a -> Bool
isCondOp op = maybe False (op == ) . getCondInfoOp
getCondInfoOp :: CondInfo a -> Maybe CondOp
getCondInfoOp x = case inlineExp x of
InlineExp op _ -> Just op
_ -> Nothing
type NumExp a = PreInline NumOp a
data NumOp = Add | Sub | Neg | Mul | Div | Pow | Mod
deriving (Show, Eq, Ord)
instance Foldable PrimOr where foldMap = foldMapDefault
instance Traversable PrimOr where
traverse f x = case unPrimOr x of
Left p -> pure $ PrimOr $ Left p
Right a -> PrimOr . Right <$> f a
type MultiOut a = Int -> a