-- | Main types
{-# OPTIONS_GHC -Wno-orphans #-}
{-# Language
        DeriveFunctor, DeriveFoldable, DeriveTraversable,
        DeriveGeneric,
        StandaloneDeriving,
        TypeSynonymInstances, FlexibleInstances,
        TemplateHaskell,
        CPP #-}
module Csound.Dynamic.Types.Exp(
    E, RatedExp(..), isEmptyExp,
    ratedExp, noRate, withRate, setRate,
    toArrRate, removeArrRate,
    Exp, toPrimOr, toPrimOrTfm, PrimOr(..), MainExp(..), Name,
    InstrId(..), intInstrId, ratioInstrId, stringInstrId,
    VarType(..), Var(..), Info(..), OpcFixity(..), Rate(..),
    CodeBlock (..),
    Signature(..), isInfix, isPrefix,
    Prim(..), Gen(..), GenId(..),
    Inline(..), InlineExp(..), PreInline(..),
    BoolExp, CondInfo, CondOp(..), isTrue, isFalse,
    NumExp, NumOp(..), Note,
    MultiOut,
    IsArrInit, ArrSize, ArrIndex,
    IfRate(..), fromIfRate,
    hashE,
    rehashE,
) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Crypto.Hash.SHA256 qualified as Crypto

import GHC.Generics (Generic, Generic1)
import Data.Traversable
import Data.ByteString (ByteString)

import Data.Map.Strict (Map)
import Data.Maybe(isNothing)
import qualified Data.IntMap.Strict as IM
import qualified Data.IntMap.Internal as IM
import Data.Fix
import Data.Eq.Deriving
import Data.Ord.Deriving
import Text.Show.Deriving
import Data.Text (Text)
import Data.Serialize qualified as Cereal
import Data.Serialize.Text ()

type Name = Text
type LineNum = Int

-- | An instrument identifier
data InstrId
    = InstrId
    { InstrId -> Maybe Int
instrIdFrac :: !(Maybe Int)
    , InstrId -> Int
instrIdCeil :: !Int }
    | InstrLabel Text
    deriving (Int -> InstrId -> ShowS
[InstrId] -> ShowS
InstrId -> String
(Int -> InstrId -> ShowS)
-> (InstrId -> String) -> ([InstrId] -> ShowS) -> Show InstrId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstrId -> ShowS
showsPrec :: Int -> InstrId -> ShowS
$cshow :: InstrId -> String
show :: InstrId -> String
$cshowList :: [InstrId] -> ShowS
showList :: [InstrId] -> ShowS
Show, InstrId -> InstrId -> Bool
(InstrId -> InstrId -> Bool)
-> (InstrId -> InstrId -> Bool) -> Eq InstrId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstrId -> InstrId -> Bool
== :: InstrId -> InstrId -> Bool
$c/= :: InstrId -> InstrId -> Bool
/= :: InstrId -> InstrId -> Bool
Eq, Eq InstrId
Eq InstrId =>
(InstrId -> InstrId -> Ordering)
-> (InstrId -> InstrId -> Bool)
-> (InstrId -> InstrId -> Bool)
-> (InstrId -> InstrId -> Bool)
-> (InstrId -> InstrId -> Bool)
-> (InstrId -> InstrId -> InstrId)
-> (InstrId -> InstrId -> InstrId)
-> Ord InstrId
InstrId -> InstrId -> Bool
InstrId -> InstrId -> Ordering
InstrId -> InstrId -> InstrId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InstrId -> InstrId -> Ordering
compare :: InstrId -> InstrId -> Ordering
$c< :: InstrId -> InstrId -> Bool
< :: InstrId -> InstrId -> Bool
$c<= :: InstrId -> InstrId -> Bool
<= :: InstrId -> InstrId -> Bool
$c> :: InstrId -> InstrId -> Bool
> :: InstrId -> InstrId -> Bool
$c>= :: InstrId -> InstrId -> Bool
>= :: InstrId -> InstrId -> Bool
$cmax :: InstrId -> InstrId -> InstrId
max :: InstrId -> InstrId -> InstrId
$cmin :: InstrId -> InstrId -> InstrId
min :: InstrId -> InstrId -> InstrId
Ord, (forall x. InstrId -> Rep InstrId x)
-> (forall x. Rep InstrId x -> InstrId) -> Generic InstrId
forall x. Rep InstrId x -> InstrId
forall x. InstrId -> Rep InstrId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InstrId -> Rep InstrId x
from :: forall x. InstrId -> Rep InstrId x
$cto :: forall x. Rep InstrId x -> InstrId
to :: forall x. Rep InstrId x -> InstrId
Generic)

-- | Constructs an instrument id with the integer.
intInstrId :: Int -> InstrId
intInstrId :: Int -> InstrId
intInstrId Int
n = Maybe Int -> Int -> InstrId
InstrId Maybe Int
forall a. Maybe a
Nothing Int
n

-- | Constructs an instrument id with fractional part.
ratioInstrId :: Int -> Int -> InstrId
ratioInstrId :: Int -> Int -> InstrId
ratioInstrId Int
beforeDot Int
afterDot = Maybe Int -> Int -> InstrId
InstrId (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
afterDot) Int
beforeDot

-- | Constructs an instrument id with the string label.
stringInstrId :: Text -> InstrId
stringInstrId :: Text -> InstrId
stringInstrId = Text -> InstrId
InstrLabel

-- | The inner representation of csound expressions.
type E = Fix RatedExp

data RatedExp a = RatedExp
    { forall a. RatedExp a -> ByteString
ratedExpHash      :: !ByteString
       -- ^ expression hash for fast comparison
    , forall a. RatedExp a -> Maybe Rate
ratedExpRate      :: !(Maybe Rate)
        -- ^ Rate (can be undefined or Nothing,
        -- it means that rate should be deduced automatically from the context)
    , forall a. RatedExp a -> Maybe Int
ratedExpDepends   :: !(Maybe LineNum)
        -- ^ Dependency (it is used for expressions with side effects,
        -- value contains the privious statement)
    , forall a. RatedExp a -> Exp a
ratedExpExp       :: !(Exp a)
        -- ^ Main expression
    } deriving (Int -> RatedExp a -> ShowS
[RatedExp a] -> ShowS
RatedExp a -> String
(Int -> RatedExp a -> ShowS)
-> (RatedExp a -> String)
-> ([RatedExp a] -> ShowS)
-> Show (RatedExp a)
forall a. Show a => Int -> RatedExp a -> ShowS
forall a. Show a => [RatedExp a] -> ShowS
forall a. Show a => RatedExp a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> RatedExp a -> ShowS
showsPrec :: Int -> RatedExp a -> ShowS
$cshow :: forall a. Show a => RatedExp a -> String
show :: RatedExp a -> String
$cshowList :: forall a. Show a => [RatedExp a] -> ShowS
showList :: [RatedExp a] -> ShowS
Show, (forall a b. (a -> b) -> RatedExp a -> RatedExp b)
-> (forall a b. a -> RatedExp b -> RatedExp a) -> Functor RatedExp
forall a b. a -> RatedExp b -> RatedExp a
forall a b. (a -> b) -> RatedExp a -> RatedExp b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RatedExp a -> RatedExp b
fmap :: forall a b. (a -> b) -> RatedExp a -> RatedExp b
$c<$ :: forall a b. a -> RatedExp b -> RatedExp a
<$ :: forall a b. a -> RatedExp b -> RatedExp a
Functor, (forall m. Monoid m => RatedExp m -> m)
-> (forall m a. Monoid m => (a -> m) -> RatedExp a -> m)
-> (forall m a. Monoid m => (a -> m) -> RatedExp a -> m)
-> (forall a b. (a -> b -> b) -> b -> RatedExp a -> b)
-> (forall a b. (a -> b -> b) -> b -> RatedExp a -> b)
-> (forall b a. (b -> a -> b) -> b -> RatedExp a -> b)
-> (forall b a. (b -> a -> b) -> b -> RatedExp a -> b)
-> (forall a. (a -> a -> a) -> RatedExp a -> a)
-> (forall a. (a -> a -> a) -> RatedExp a -> a)
-> (forall a. RatedExp a -> [a])
-> (forall a. RatedExp a -> Bool)
-> (forall a. RatedExp a -> Int)
-> (forall a. Eq a => a -> RatedExp a -> Bool)
-> (forall a. Ord a => RatedExp a -> a)
-> (forall a. Ord a => RatedExp a -> a)
-> (forall a. Num a => RatedExp a -> a)
-> (forall a. Num a => RatedExp a -> a)
-> Foldable RatedExp
forall a. Eq a => a -> RatedExp a -> Bool
forall a. Num a => RatedExp a -> a
forall a. Ord a => RatedExp a -> a
forall m. Monoid m => RatedExp m -> m
forall a. RatedExp a -> Bool
forall a. RatedExp a -> Int
forall a. RatedExp a -> [a]
forall a. (a -> a -> a) -> RatedExp a -> a
forall m a. Monoid m => (a -> m) -> RatedExp a -> m
forall b a. (b -> a -> b) -> b -> RatedExp a -> b
forall a b. (a -> b -> b) -> b -> RatedExp a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => RatedExp m -> m
fold :: forall m. Monoid m => RatedExp m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> RatedExp a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> RatedExp a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> RatedExp a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> RatedExp a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> RatedExp a -> b
foldr :: forall a b. (a -> b -> b) -> b -> RatedExp a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> RatedExp a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> RatedExp a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> RatedExp a -> b
foldl :: forall b a. (b -> a -> b) -> b -> RatedExp a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> RatedExp a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> RatedExp a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> RatedExp a -> a
foldr1 :: forall a. (a -> a -> a) -> RatedExp a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> RatedExp a -> a
foldl1 :: forall a. (a -> a -> a) -> RatedExp a -> a
$ctoList :: forall a. RatedExp a -> [a]
toList :: forall a. RatedExp a -> [a]
$cnull :: forall a. RatedExp a -> Bool
null :: forall a. RatedExp a -> Bool
$clength :: forall a. RatedExp a -> Int
length :: forall a. RatedExp a -> Int
$celem :: forall a. Eq a => a -> RatedExp a -> Bool
elem :: forall a. Eq a => a -> RatedExp a -> Bool
$cmaximum :: forall a. Ord a => RatedExp a -> a
maximum :: forall a. Ord a => RatedExp a -> a
$cminimum :: forall a. Ord a => RatedExp a -> a
minimum :: forall a. Ord a => RatedExp a -> a
$csum :: forall a. Num a => RatedExp a -> a
sum :: forall a. Num a => RatedExp a -> a
$cproduct :: forall a. Num a => RatedExp a -> a
product :: forall a. Num a => RatedExp a -> a
Foldable, Functor RatedExp
Foldable RatedExp
(Functor RatedExp, Foldable RatedExp) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> RatedExp a -> f (RatedExp b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    RatedExp (f a) -> f (RatedExp a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> RatedExp a -> m (RatedExp b))
-> (forall (m :: * -> *) a.
    Monad m =>
    RatedExp (m a) -> m (RatedExp a))
-> Traversable RatedExp
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => RatedExp (m a) -> m (RatedExp a)
forall (f :: * -> *) a.
Applicative f =>
RatedExp (f a) -> f (RatedExp a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RatedExp a -> m (RatedExp b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RatedExp a -> f (RatedExp b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RatedExp a -> f (RatedExp b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RatedExp a -> f (RatedExp b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
RatedExp (f a) -> f (RatedExp a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
RatedExp (f a) -> f (RatedExp a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RatedExp a -> m (RatedExp b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RatedExp a -> m (RatedExp b)
$csequence :: forall (m :: * -> *) a. Monad m => RatedExp (m a) -> m (RatedExp a)
sequence :: forall (m :: * -> *) a. Monad m => RatedExp (m a) -> m (RatedExp a)
Traversable, (forall x. RatedExp a -> Rep (RatedExp a) x)
-> (forall x. Rep (RatedExp a) x -> RatedExp a)
-> Generic (RatedExp a)
forall x. Rep (RatedExp a) x -> RatedExp a
forall x. RatedExp a -> Rep (RatedExp a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RatedExp a) x -> RatedExp a
forall a x. RatedExp a -> Rep (RatedExp a) x
$cfrom :: forall a x. RatedExp a -> Rep (RatedExp a) x
from :: forall x. RatedExp a -> Rep (RatedExp a) x
$cto :: forall a x. Rep (RatedExp a) x -> RatedExp a
to :: forall x. Rep (RatedExp a) x -> RatedExp a
Generic, (forall a. RatedExp a -> Rep1 RatedExp a)
-> (forall a. Rep1 RatedExp a -> RatedExp a) -> Generic1 RatedExp
forall a. Rep1 RatedExp a -> RatedExp a
forall a. RatedExp a -> Rep1 RatedExp a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall a. RatedExp a -> Rep1 RatedExp a
from1 :: forall a. RatedExp a -> Rep1 RatedExp a
$cto1 :: forall a. Rep1 RatedExp a -> RatedExp a
to1 :: forall a. Rep1 RatedExp a -> RatedExp a
Generic1)

instance Eq (RatedExp a) where
  == :: RatedExp a -> RatedExp a -> Bool
(==) RatedExp a
a RatedExp a
b = RatedExp a -> ByteString
forall a. RatedExp a -> ByteString
ratedExpHash RatedExp a
a ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== RatedExp a -> ByteString
forall a. RatedExp a -> ByteString
ratedExpHash RatedExp a
b

instance Ord (RatedExp a) where
  compare :: RatedExp a -> RatedExp a -> Ordering
compare RatedExp a
a RatedExp a
b = RatedExp a -> ByteString
forall a. RatedExp a -> ByteString
ratedExpHash RatedExp a
a ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` RatedExp a -> ByteString
forall a. RatedExp a -> ByteString
ratedExpHash RatedExp a
b

ratedExp :: Maybe Rate -> Exp E -> E
ratedExp :: Maybe Rate -> Exp E -> E
ratedExp Maybe Rate
r Exp E
expr = RatedExp E -> E
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (RatedExp E -> E) -> RatedExp E -> E
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Rate -> Maybe Int -> Exp E -> RatedExp E
forall a.
ByteString -> Maybe Rate -> Maybe Int -> Exp a -> RatedExp a
RatedExp ByteString
h Maybe Rate
r Maybe Int
forall a. Maybe a
Nothing Exp E
expr
  where
    h :: ByteString
h = ByteString -> ByteString
Crypto.hash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ MainExp (PrimOr ByteString) -> ByteString
forall a. Serialize a => a -> ByteString
Cereal.encode (MainExp (PrimOr ByteString) -> ByteString)
-> MainExp (PrimOr ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (PrimOr E -> PrimOr ByteString)
-> Exp E -> MainExp (PrimOr ByteString)
forall a b. (a -> b) -> MainExp a -> MainExp b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((E -> ByteString) -> PrimOr E -> PrimOr ByteString
forall a b. (a -> b) -> PrimOr a -> PrimOr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap E -> ByteString
hashE) Exp E
expr

noRate :: Exp E -> E
noRate :: Exp E -> E
noRate = Maybe Rate -> Exp E -> E
ratedExp Maybe Rate
forall a. Maybe a
Nothing

withRate :: Rate -> Exp E -> E
withRate :: Rate -> Exp E -> E
withRate Rate
r = Maybe Rate -> Exp E -> E
ratedExp (Rate -> Maybe Rate
forall a. a -> Maybe a
Just Rate
r)

hashE :: E -> ByteString
hashE :: E -> ByteString
hashE (Fix RatedExp E
expr) = RatedExp E -> ByteString
forall a. RatedExp a -> ByteString
ratedExpHash RatedExp E
expr

-- | Call it on every change in underlying expression
rehashE :: E -> E
rehashE :: E -> E
rehashE (Fix RatedExp E
expr) = RatedExp E -> E
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (RatedExp E -> E) -> RatedExp E -> E
forall a b. (a -> b) -> a -> b
$
  RatedExp E
expr
    { ratedExpHash = Crypto.hash $ Cereal.encode $ fmap hashE expr
    }

-- rate coversion

setRate :: Rate -> E -> E
setRate :: Rate -> E -> E
setRate Rate
r E
a =
  case RatedExp E -> Exp E
forall a. RatedExp a -> Exp a
ratedExpExp (RatedExp E -> Exp E) -> RatedExp E -> Exp E
forall a b. (a -> b) -> a -> b
$ E -> RatedExp E
forall (f :: * -> *). Fix f -> f (Fix f)
unFix E
a of
    -- for Tfm we add rate to ratedExpRate hint
    Tfm Info
_ [PrimOr E]
_    -> RatedExp E -> E
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (RatedExp E -> E) -> RatedExp E -> E
forall a b. (a -> b) -> a -> b
$ (E -> RatedExp E
forall (f :: * -> *). Fix f -> f (Fix f)
unFix E
a) { ratedExpRate = Just r }
    -- conversion set's the rate for constants
    -- ExpPrim _  -> a
    ExpPrim Prim
_  -> RatedExp E -> E
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (RatedExp E -> E) -> RatedExp E -> E
forall a b. (a -> b) -> a -> b
$ (E -> RatedExp E
forall (f :: * -> *). Fix f -> f (Fix f)
unFix E
a) { ratedExpRate = Just r }
    -- don't convert rate twice
    ConvertRate Rate
_ Maybe Rate
b PrimOr E
arg -> Rate -> Exp E -> E
withRate Rate
r (Exp E -> E) -> Exp E -> E
forall a b. (a -> b) -> a -> b
$ Rate -> Maybe Rate -> PrimOr E -> Exp E
forall a. Rate -> Maybe Rate -> a -> MainExp a
ConvertRate Rate
r Maybe Rate
b PrimOr E
arg
    -- for booleans pass conversion over boolean operators
    ExpBool BoolExp (PrimOr E)
boolArg -> Exp E -> E
noRate (Exp E -> E) -> Exp E -> E
forall a b. (a -> b) -> a -> b
$ BoolExp (PrimOr E) -> Exp E
forall a. BoolExp a -> MainExp a
ExpBool (BoolExp (PrimOr E) -> Exp E) -> BoolExp (PrimOr E) -> Exp E
forall a b. (a -> b) -> a -> b
$ (PrimOr E -> PrimOr E) -> BoolExp (PrimOr E) -> BoolExp (PrimOr E)
forall a b. (a -> b) -> PreInline CondOp a -> PreInline CondOp b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((E -> E) -> PrimOr E -> PrimOr E
forall a b. (a -> b) -> PrimOr a -> PrimOr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rate -> E -> E
setRate Rate
r)) BoolExp (PrimOr E)
boolArg
    -- for other cases we insert rate conversion
    Exp E
_          -> Rate -> Exp E -> E
withRate Rate
r (Exp E -> E) -> Exp E -> E
forall a b. (a -> b) -> a -> b
$ Rate -> Maybe Rate -> PrimOr E -> Exp E
forall a. Rate -> Maybe Rate -> a -> MainExp a
ConvertRate Rate
r Maybe Rate
forall a. Maybe a
Nothing (Either Prim E -> PrimOr E
forall a. Either Prim a -> PrimOr a
PrimOr (Either Prim E -> PrimOr E) -> Either Prim E -> PrimOr E
forall a b. (a -> b) -> a -> b
$ E -> Either Prim E
forall a b. b -> Either a b
Right E
a)

-- | It's a primitive value or something else. It's used for inlining
-- of the constants (primitive values).
newtype PrimOr a = PrimOr { forall a. PrimOr a -> Either Prim a
unPrimOr :: Either Prim a }
    deriving (Int -> PrimOr a -> ShowS
[PrimOr a] -> ShowS
PrimOr a -> String
(Int -> PrimOr a -> ShowS)
-> (PrimOr a -> String) -> ([PrimOr a] -> ShowS) -> Show (PrimOr a)
forall a. Show a => Int -> PrimOr a -> ShowS
forall a. Show a => [PrimOr a] -> ShowS
forall a. Show a => PrimOr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> PrimOr a -> ShowS
showsPrec :: Int -> PrimOr a -> ShowS
$cshow :: forall a. Show a => PrimOr a -> String
show :: PrimOr a -> String
$cshowList :: forall a. Show a => [PrimOr a] -> ShowS
showList :: [PrimOr a] -> ShowS
Show, PrimOr a -> PrimOr a -> Bool
(PrimOr a -> PrimOr a -> Bool)
-> (PrimOr a -> PrimOr a -> Bool) -> Eq (PrimOr a)
forall a. Eq a => PrimOr a -> PrimOr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => PrimOr a -> PrimOr a -> Bool
== :: PrimOr a -> PrimOr a -> Bool
$c/= :: forall a. Eq a => PrimOr a -> PrimOr a -> Bool
/= :: PrimOr a -> PrimOr a -> Bool
Eq, Eq (PrimOr a)
Eq (PrimOr a) =>
(PrimOr a -> PrimOr a -> Ordering)
-> (PrimOr a -> PrimOr a -> Bool)
-> (PrimOr a -> PrimOr a -> Bool)
-> (PrimOr a -> PrimOr a -> Bool)
-> (PrimOr a -> PrimOr a -> Bool)
-> (PrimOr a -> PrimOr a -> PrimOr a)
-> (PrimOr a -> PrimOr a -> PrimOr a)
-> Ord (PrimOr a)
PrimOr a -> PrimOr a -> Bool
PrimOr a -> PrimOr a -> Ordering
PrimOr a -> PrimOr a -> PrimOr a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (PrimOr a)
forall a. Ord a => PrimOr a -> PrimOr a -> Bool
forall a. Ord a => PrimOr a -> PrimOr a -> Ordering
forall a. Ord a => PrimOr a -> PrimOr a -> PrimOr a
$ccompare :: forall a. Ord a => PrimOr a -> PrimOr a -> Ordering
compare :: PrimOr a -> PrimOr a -> Ordering
$c< :: forall a. Ord a => PrimOr a -> PrimOr a -> Bool
< :: PrimOr a -> PrimOr a -> Bool
$c<= :: forall a. Ord a => PrimOr a -> PrimOr a -> Bool
<= :: PrimOr a -> PrimOr a -> Bool
$c> :: forall a. Ord a => PrimOr a -> PrimOr a -> Bool
> :: PrimOr a -> PrimOr a -> Bool
$c>= :: forall a. Ord a => PrimOr a -> PrimOr a -> Bool
>= :: PrimOr a -> PrimOr a -> Bool
$cmax :: forall a. Ord a => PrimOr a -> PrimOr a -> PrimOr a
max :: PrimOr a -> PrimOr a -> PrimOr a
$cmin :: forall a. Ord a => PrimOr a -> PrimOr a -> PrimOr a
min :: PrimOr a -> PrimOr a -> PrimOr a
Ord, (forall a b. (a -> b) -> PrimOr a -> PrimOr b)
-> (forall a b. a -> PrimOr b -> PrimOr a) -> Functor PrimOr
forall a b. a -> PrimOr b -> PrimOr a
forall a b. (a -> b) -> PrimOr a -> PrimOr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PrimOr a -> PrimOr b
fmap :: forall a b. (a -> b) -> PrimOr a -> PrimOr b
$c<$ :: forall a b. a -> PrimOr b -> PrimOr a
<$ :: forall a b. a -> PrimOr b -> PrimOr a
Functor, (forall x. PrimOr a -> Rep (PrimOr a) x)
-> (forall x. Rep (PrimOr a) x -> PrimOr a) -> Generic (PrimOr a)
forall x. Rep (PrimOr a) x -> PrimOr a
forall x. PrimOr a -> Rep (PrimOr a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PrimOr a) x -> PrimOr a
forall a x. PrimOr a -> Rep (PrimOr a) x
$cfrom :: forall a x. PrimOr a -> Rep (PrimOr a) x
from :: forall x. PrimOr a -> Rep (PrimOr a) x
$cto :: forall a x. Rep (PrimOr a) x -> PrimOr a
to :: forall x. Rep (PrimOr a) x -> PrimOr a
Generic, (forall a. PrimOr a -> Rep1 PrimOr a)
-> (forall a. Rep1 PrimOr a -> PrimOr a) -> Generic1 PrimOr
forall a. Rep1 PrimOr a -> PrimOr a
forall a. PrimOr a -> Rep1 PrimOr a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall a. PrimOr a -> Rep1 PrimOr a
from1 :: forall a. PrimOr a -> Rep1 PrimOr a
$cto1 :: forall a. Rep1 PrimOr a -> PrimOr a
to1 :: forall a. Rep1 PrimOr a -> PrimOr a
Generic1)

instance Cereal.Serialize a => Cereal.Serialize (PrimOr a)

-- | Constructs PrimOr values from the expressions. It does inlining in
-- case of primitive values.
toPrimOr :: E -> PrimOr E
toPrimOr :: E -> PrimOr E
toPrimOr E
a = Either Prim E -> PrimOr E
forall a. Either Prim a -> PrimOr a
PrimOr (Either Prim E -> PrimOr E) -> Either Prim E -> PrimOr E
forall a b. (a -> b) -> a -> b
$ case RatedExp E -> Exp E
forall a. RatedExp a -> Exp a
ratedExpExp (RatedExp E -> Exp E) -> RatedExp E -> Exp E
forall a b. (a -> b) -> a -> b
$ E -> RatedExp E
forall (f :: * -> *). Fix f -> f (Fix f)
unFix E
a of
    ExpPrim (PString Int
_) -> E -> Either Prim E
forall a b. b -> Either a b
Right E
a
    ExpPrim Prim
p  -> Prim -> Either Prim E
forall a b. a -> Either a b
Left Prim
p
    ReadVar Var
v | Bool
noDeps -> Prim -> Either Prim E
forall a b. a -> Either a b
Left (Rate -> Var -> Prim
PrimVar (Var -> Rate
varRate Var
v) Var
v)
    Exp E
_         -> E -> Either Prim E
forall a b. b -> Either a b
Right E
a
    where
        noDeps :: Bool
noDeps = Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ RatedExp E -> Maybe Int
forall a. RatedExp a -> Maybe Int
ratedExpDepends (RatedExp E -> Maybe Int) -> RatedExp E -> Maybe Int
forall a b. (a -> b) -> a -> b
$ E -> RatedExp E
forall (f :: * -> *). Fix f -> f (Fix f)
unFix E
a

-- | Constructs PrimOr values from the expressions. It does inlining in
-- case of primitive values.
toPrimOrTfm :: Rate -> E -> PrimOr E
toPrimOrTfm :: Rate -> E -> PrimOr E
toPrimOrTfm Rate
r E
a = Either Prim E -> PrimOr E
forall a. Either Prim a -> PrimOr a
PrimOr (Either Prim E -> PrimOr E) -> Either Prim E -> PrimOr E
forall a b. (a -> b) -> a -> b
$ case RatedExp E -> Exp E
forall a. RatedExp a -> Exp a
ratedExpExp (RatedExp E -> Exp E) -> RatedExp E -> Exp E
forall a b. (a -> b) -> a -> b
$ E -> RatedExp E
forall (f :: * -> *). Fix f -> f (Fix f)
unFix E
a of
    ExpPrim (PString Int
_) -> E -> Either Prim E
forall a b. b -> Either a b
Right E
a
    ExpPrim Prim
p | (Rate
r Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Ir Bool -> Bool -> Bool
|| Rate
r Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Sr) -> Prim -> Either Prim E
forall a b. a -> Either a b
Left Prim
p
    ReadVar Var
v | Bool
noDeps -> Prim -> Either Prim E
forall a b. a -> Either a b
Left (Rate -> Var -> Prim
PrimVar (Var -> Rate
varRate Var
v) Var
v)
    Exp E
_         -> E -> Either Prim E
forall a b. b -> Either a b
Right E
a
    where
        noDeps :: Bool
noDeps = Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ RatedExp E -> Maybe Int
forall a. RatedExp a -> Maybe Int
ratedExpDepends (RatedExp E -> Maybe Int) -> RatedExp E -> Maybe Int
forall a b. (a -> b) -> a -> b
$ E -> RatedExp E
forall (f :: * -> *). Fix f -> f (Fix f)
unFix E
a


-- Expressions with inlining.
type Exp a = MainExp (PrimOr a)

newtype CodeBlock a = CodeBlock a
  deriving (Int -> CodeBlock a -> ShowS
[CodeBlock a] -> ShowS
CodeBlock a -> String
(Int -> CodeBlock a -> ShowS)
-> (CodeBlock a -> String)
-> ([CodeBlock a] -> ShowS)
-> Show (CodeBlock a)
forall a. Show a => Int -> CodeBlock a -> ShowS
forall a. Show a => [CodeBlock a] -> ShowS
forall a. Show a => CodeBlock a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> CodeBlock a -> ShowS
showsPrec :: Int -> CodeBlock a -> ShowS
$cshow :: forall a. Show a => CodeBlock a -> String
show :: CodeBlock a -> String
$cshowList :: forall a. Show a => [CodeBlock a] -> ShowS
showList :: [CodeBlock a] -> ShowS
Show, CodeBlock a -> CodeBlock a -> Bool
(CodeBlock a -> CodeBlock a -> Bool)
-> (CodeBlock a -> CodeBlock a -> Bool) -> Eq (CodeBlock a)
forall a. Eq a => CodeBlock a -> CodeBlock a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => CodeBlock a -> CodeBlock a -> Bool
== :: CodeBlock a -> CodeBlock a -> Bool
$c/= :: forall a. Eq a => CodeBlock a -> CodeBlock a -> Bool
/= :: CodeBlock a -> CodeBlock a -> Bool
Eq, Eq (CodeBlock a)
Eq (CodeBlock a) =>
(CodeBlock a -> CodeBlock a -> Ordering)
-> (CodeBlock a -> CodeBlock a -> Bool)
-> (CodeBlock a -> CodeBlock a -> Bool)
-> (CodeBlock a -> CodeBlock a -> Bool)
-> (CodeBlock a -> CodeBlock a -> Bool)
-> (CodeBlock a -> CodeBlock a -> CodeBlock a)
-> (CodeBlock a -> CodeBlock a -> CodeBlock a)
-> Ord (CodeBlock a)
CodeBlock a -> CodeBlock a -> Bool
CodeBlock a -> CodeBlock a -> Ordering
CodeBlock a -> CodeBlock a -> CodeBlock a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (CodeBlock a)
forall a. Ord a => CodeBlock a -> CodeBlock a -> Bool
forall a. Ord a => CodeBlock a -> CodeBlock a -> Ordering
forall a. Ord a => CodeBlock a -> CodeBlock a -> CodeBlock a
$ccompare :: forall a. Ord a => CodeBlock a -> CodeBlock a -> Ordering
compare :: CodeBlock a -> CodeBlock a -> Ordering
$c< :: forall a. Ord a => CodeBlock a -> CodeBlock a -> Bool
< :: CodeBlock a -> CodeBlock a -> Bool
$c<= :: forall a. Ord a => CodeBlock a -> CodeBlock a -> Bool
<= :: CodeBlock a -> CodeBlock a -> Bool
$c> :: forall a. Ord a => CodeBlock a -> CodeBlock a -> Bool
> :: CodeBlock a -> CodeBlock a -> Bool
$c>= :: forall a. Ord a => CodeBlock a -> CodeBlock a -> Bool
>= :: CodeBlock a -> CodeBlock a -> Bool
$cmax :: forall a. Ord a => CodeBlock a -> CodeBlock a -> CodeBlock a
max :: CodeBlock a -> CodeBlock a -> CodeBlock a
$cmin :: forall a. Ord a => CodeBlock a -> CodeBlock a -> CodeBlock a
min :: CodeBlock a -> CodeBlock a -> CodeBlock a
Ord, (forall a b. (a -> b) -> CodeBlock a -> CodeBlock b)
-> (forall a b. a -> CodeBlock b -> CodeBlock a)
-> Functor CodeBlock
forall a b. a -> CodeBlock b -> CodeBlock a
forall a b. (a -> b) -> CodeBlock a -> CodeBlock b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CodeBlock a -> CodeBlock b
fmap :: forall a b. (a -> b) -> CodeBlock a -> CodeBlock b
$c<$ :: forall a b. a -> CodeBlock b -> CodeBlock a
<$ :: forall a b. a -> CodeBlock b -> CodeBlock a
Functor, (forall m. Monoid m => CodeBlock m -> m)
-> (forall m a. Monoid m => (a -> m) -> CodeBlock a -> m)
-> (forall m a. Monoid m => (a -> m) -> CodeBlock a -> m)
-> (forall a b. (a -> b -> b) -> b -> CodeBlock a -> b)
-> (forall a b. (a -> b -> b) -> b -> CodeBlock a -> b)
-> (forall b a. (b -> a -> b) -> b -> CodeBlock a -> b)
-> (forall b a. (b -> a -> b) -> b -> CodeBlock a -> b)
-> (forall a. (a -> a -> a) -> CodeBlock a -> a)
-> (forall a. (a -> a -> a) -> CodeBlock a -> a)
-> (forall a. CodeBlock a -> [a])
-> (forall a. CodeBlock a -> Bool)
-> (forall a. CodeBlock a -> Int)
-> (forall a. Eq a => a -> CodeBlock a -> Bool)
-> (forall a. Ord a => CodeBlock a -> a)
-> (forall a. Ord a => CodeBlock a -> a)
-> (forall a. Num a => CodeBlock a -> a)
-> (forall a. Num a => CodeBlock a -> a)
-> Foldable CodeBlock
forall a. Eq a => a -> CodeBlock a -> Bool
forall a. Num a => CodeBlock a -> a
forall a. Ord a => CodeBlock a -> a
forall m. Monoid m => CodeBlock m -> m
forall a. CodeBlock a -> Bool
forall a. CodeBlock a -> Int
forall a. CodeBlock a -> [a]
forall a. (a -> a -> a) -> CodeBlock a -> a
forall m a. Monoid m => (a -> m) -> CodeBlock a -> m
forall b a. (b -> a -> b) -> b -> CodeBlock a -> b
forall a b. (a -> b -> b) -> b -> CodeBlock a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => CodeBlock m -> m
fold :: forall m. Monoid m => CodeBlock m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CodeBlock a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> CodeBlock a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CodeBlock a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> CodeBlock a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> CodeBlock a -> b
foldr :: forall a b. (a -> b -> b) -> b -> CodeBlock a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CodeBlock a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> CodeBlock a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CodeBlock a -> b
foldl :: forall b a. (b -> a -> b) -> b -> CodeBlock a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CodeBlock a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> CodeBlock a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> CodeBlock a -> a
foldr1 :: forall a. (a -> a -> a) -> CodeBlock a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CodeBlock a -> a
foldl1 :: forall a. (a -> a -> a) -> CodeBlock a -> a
$ctoList :: forall a. CodeBlock a -> [a]
toList :: forall a. CodeBlock a -> [a]
$cnull :: forall a. CodeBlock a -> Bool
null :: forall a. CodeBlock a -> Bool
$clength :: forall a. CodeBlock a -> Int
length :: forall a. CodeBlock a -> Int
$celem :: forall a. Eq a => a -> CodeBlock a -> Bool
elem :: forall a. Eq a => a -> CodeBlock a -> Bool
$cmaximum :: forall a. Ord a => CodeBlock a -> a
maximum :: forall a. Ord a => CodeBlock a -> a
$cminimum :: forall a. Ord a => CodeBlock a -> a
minimum :: forall a. Ord a => CodeBlock a -> a
$csum :: forall a. Num a => CodeBlock a -> a
sum :: forall a. Num a => CodeBlock a -> a
$cproduct :: forall a. Num a => CodeBlock a -> a
product :: forall a. Num a => CodeBlock a -> a
Foldable, Functor CodeBlock
Foldable CodeBlock
(Functor CodeBlock, Foldable CodeBlock) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> CodeBlock a -> f (CodeBlock b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    CodeBlock (f a) -> f (CodeBlock a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> CodeBlock a -> m (CodeBlock b))
-> (forall (m :: * -> *) a.
    Monad m =>
    CodeBlock (m a) -> m (CodeBlock a))
-> Traversable CodeBlock
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
CodeBlock (m a) -> m (CodeBlock a)
forall (f :: * -> *) a.
Applicative f =>
CodeBlock (f a) -> f (CodeBlock a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CodeBlock a -> m (CodeBlock b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CodeBlock a -> f (CodeBlock b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CodeBlock a -> f (CodeBlock b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CodeBlock a -> f (CodeBlock b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
CodeBlock (f a) -> f (CodeBlock a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
CodeBlock (f a) -> f (CodeBlock a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CodeBlock a -> m (CodeBlock b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CodeBlock a -> m (CodeBlock b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
CodeBlock (m a) -> m (CodeBlock a)
sequence :: forall (m :: * -> *) a.
Monad m =>
CodeBlock (m a) -> m (CodeBlock a)
Traversable, (forall x. CodeBlock a -> Rep (CodeBlock a) x)
-> (forall x. Rep (CodeBlock a) x -> CodeBlock a)
-> Generic (CodeBlock a)
forall x. Rep (CodeBlock a) x -> CodeBlock a
forall x. CodeBlock a -> Rep (CodeBlock a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CodeBlock a) x -> CodeBlock a
forall a x. CodeBlock a -> Rep (CodeBlock a) x
$cfrom :: forall a x. CodeBlock a -> Rep (CodeBlock a) x
from :: forall x. CodeBlock a -> Rep (CodeBlock a) x
$cto :: forall a x. Rep (CodeBlock a) x -> CodeBlock a
to :: forall x. Rep (CodeBlock a) x -> CodeBlock a
Generic, (forall a. CodeBlock a -> Rep1 CodeBlock a)
-> (forall a. Rep1 CodeBlock a -> CodeBlock a)
-> Generic1 CodeBlock
forall a. Rep1 CodeBlock a -> CodeBlock a
forall a. CodeBlock a -> Rep1 CodeBlock a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall a. CodeBlock a -> Rep1 CodeBlock a
from1 :: forall a. CodeBlock a -> Rep1 CodeBlock a
$cto1 :: forall a. Rep1 CodeBlock a -> CodeBlock a
to1 :: forall a. Rep1 CodeBlock a -> CodeBlock a
Generic1)

-- Csound expressions
data MainExp a
    = EmptyExp
    -- | Primitives
    | ExpPrim !Prim
    -- | Application of the opcode: we have opcode information (Info) and the arguments [a]
    | Tfm Info ![a]
    -- | Rate conversion
    | ConvertRate !Rate !(Maybe Rate) !a
    -- | Selects a cell from the tuple, here argument is always a tuple (result of opcode that returns several outputs)
    | Select !Rate !Int !a
    -- | if-then-else
    | If !IfRate !(CondInfo a) !a !a
    -- | Boolean expressions (rendered in infix notation in the Csound)
    | ExpBool !(BoolExp a)
    -- | Numerical expressions (rendered in infix notation in the Csound)
    | ExpNum !(NumExp a)
    -- | Reading/writing a named variable
    | InitVar !Var !a
    | ReadVar !Var
    | WriteVar !Var !a
    -- | Arrays
    | InitArr !Var !(ArrSize a)
    | ReadArr !Var !(ArrIndex a)
    | WriteArr !Var !(ArrIndex a) !a
    | WriteInitArr !Var !(ArrIndex a) !a
    | TfmArr !IsArrInit !Var !Info ![a]
    -- | inits 1-dimensional read only array (uses fillaray)
    -- args: rateOfTheOutput processingRate initValues
    | InitPureArr !Rate !IfRate ![a]
    -- | Reads read only array with index
    -- args: rateOfTheOutput processingRate array index
    | ReadPureArr !Rate !IfRate !a !a
    -- | Imperative If-then-else
    | IfBlock !IfRate !(CondInfo a) (CodeBlock a)
    | IfElseBlock !IfRate !(CondInfo a) (CodeBlock a) (CodeBlock a)
    | IfBegin !IfRate !(CondInfo a)
    | ElseBegin
    | IfEnd
    -- | looping constructions
    | UntilBlock !IfRate !(CondInfo a) (CodeBlock a)
    | UntilBegin !IfRate !(CondInfo a)
    | UntilEnd
    | WhileBlock !IfRate !(CondInfo a) (CodeBlock a)
    | WhileBegin !IfRate !(CondInfo a)
    | WhileRefBlock !Var !(CodeBlock a)
    | WhileRefBegin !Var
    | WhileEnd
    -- | Verbatim stmt
    | Verbatim !Text
    -- | Dependency tracking
    | Starts
    | Seq a a
    | Ends a
    -- | read macros arguments
    | InitMacrosInt !Text !Int
    | InitMacrosDouble !Text !Double
    | InitMacrosString !Text !Text
    | ReadMacrosInt !Text
    | ReadMacrosDouble !Text
    | ReadMacrosString !Text
    deriving (Int -> MainExp a -> ShowS
[MainExp a] -> ShowS
MainExp a -> String
(Int -> MainExp a -> ShowS)
-> (MainExp a -> String)
-> ([MainExp a] -> ShowS)
-> Show (MainExp a)
forall a. Show a => Int -> MainExp a -> ShowS
forall a. Show a => [MainExp a] -> ShowS
forall a. Show a => MainExp a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> MainExp a -> ShowS
showsPrec :: Int -> MainExp a -> ShowS
$cshow :: forall a. Show a => MainExp a -> String
show :: MainExp a -> String
$cshowList :: forall a. Show a => [MainExp a] -> ShowS
showList :: [MainExp a] -> ShowS
Show, MainExp a -> MainExp a -> Bool
(MainExp a -> MainExp a -> Bool)
-> (MainExp a -> MainExp a -> Bool) -> Eq (MainExp a)
forall a. Eq a => MainExp a -> MainExp a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => MainExp a -> MainExp a -> Bool
== :: MainExp a -> MainExp a -> Bool
$c/= :: forall a. Eq a => MainExp a -> MainExp a -> Bool
/= :: MainExp a -> MainExp a -> Bool
Eq, Eq (MainExp a)
Eq (MainExp a) =>
(MainExp a -> MainExp a -> Ordering)
-> (MainExp a -> MainExp a -> Bool)
-> (MainExp a -> MainExp a -> Bool)
-> (MainExp a -> MainExp a -> Bool)
-> (MainExp a -> MainExp a -> Bool)
-> (MainExp a -> MainExp a -> MainExp a)
-> (MainExp a -> MainExp a -> MainExp a)
-> Ord (MainExp a)
MainExp a -> MainExp a -> Bool
MainExp a -> MainExp a -> Ordering
MainExp a -> MainExp a -> MainExp a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (MainExp a)
forall a. Ord a => MainExp a -> MainExp a -> Bool
forall a. Ord a => MainExp a -> MainExp a -> Ordering
forall a. Ord a => MainExp a -> MainExp a -> MainExp a
$ccompare :: forall a. Ord a => MainExp a -> MainExp a -> Ordering
compare :: MainExp a -> MainExp a -> Ordering
$c< :: forall a. Ord a => MainExp a -> MainExp a -> Bool
< :: MainExp a -> MainExp a -> Bool
$c<= :: forall a. Ord a => MainExp a -> MainExp a -> Bool
<= :: MainExp a -> MainExp a -> Bool
$c> :: forall a. Ord a => MainExp a -> MainExp a -> Bool
> :: MainExp a -> MainExp a -> Bool
$c>= :: forall a. Ord a => MainExp a -> MainExp a -> Bool
>= :: MainExp a -> MainExp a -> Bool
$cmax :: forall a. Ord a => MainExp a -> MainExp a -> MainExp a
max :: MainExp a -> MainExp a -> MainExp a
$cmin :: forall a. Ord a => MainExp a -> MainExp a -> MainExp a
min :: MainExp a -> MainExp a -> MainExp a
Ord, (forall a b. (a -> b) -> MainExp a -> MainExp b)
-> (forall a b. a -> MainExp b -> MainExp a) -> Functor MainExp
forall a b. a -> MainExp b -> MainExp a
forall a b. (a -> b) -> MainExp a -> MainExp b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> MainExp a -> MainExp b
fmap :: forall a b. (a -> b) -> MainExp a -> MainExp b
$c<$ :: forall a b. a -> MainExp b -> MainExp a
<$ :: forall a b. a -> MainExp b -> MainExp a
Functor, (forall m. Monoid m => MainExp m -> m)
-> (forall m a. Monoid m => (a -> m) -> MainExp a -> m)
-> (forall m a. Monoid m => (a -> m) -> MainExp a -> m)
-> (forall a b. (a -> b -> b) -> b -> MainExp a -> b)
-> (forall a b. (a -> b -> b) -> b -> MainExp a -> b)
-> (forall b a. (b -> a -> b) -> b -> MainExp a -> b)
-> (forall b a. (b -> a -> b) -> b -> MainExp a -> b)
-> (forall a. (a -> a -> a) -> MainExp a -> a)
-> (forall a. (a -> a -> a) -> MainExp a -> a)
-> (forall a. MainExp a -> [a])
-> (forall a. MainExp a -> Bool)
-> (forall a. MainExp a -> Int)
-> (forall a. Eq a => a -> MainExp a -> Bool)
-> (forall a. Ord a => MainExp a -> a)
-> (forall a. Ord a => MainExp a -> a)
-> (forall a. Num a => MainExp a -> a)
-> (forall a. Num a => MainExp a -> a)
-> Foldable MainExp
forall a. Eq a => a -> MainExp a -> Bool
forall a. Num a => MainExp a -> a
forall a. Ord a => MainExp a -> a
forall m. Monoid m => MainExp m -> m
forall a. MainExp a -> Bool
forall a. MainExp a -> Int
forall a. MainExp a -> [a]
forall a. (a -> a -> a) -> MainExp a -> a
forall m a. Monoid m => (a -> m) -> MainExp a -> m
forall b a. (b -> a -> b) -> b -> MainExp a -> b
forall a b. (a -> b -> b) -> b -> MainExp a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => MainExp m -> m
fold :: forall m. Monoid m => MainExp m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MainExp a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MainExp a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MainExp a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> MainExp a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> MainExp a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MainExp a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MainExp a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MainExp a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MainExp a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MainExp a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MainExp a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> MainExp a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> MainExp a -> a
foldr1 :: forall a. (a -> a -> a) -> MainExp a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MainExp a -> a
foldl1 :: forall a. (a -> a -> a) -> MainExp a -> a
$ctoList :: forall a. MainExp a -> [a]
toList :: forall a. MainExp a -> [a]
$cnull :: forall a. MainExp a -> Bool
null :: forall a. MainExp a -> Bool
$clength :: forall a. MainExp a -> Int
length :: forall a. MainExp a -> Int
$celem :: forall a. Eq a => a -> MainExp a -> Bool
elem :: forall a. Eq a => a -> MainExp a -> Bool
$cmaximum :: forall a. Ord a => MainExp a -> a
maximum :: forall a. Ord a => MainExp a -> a
$cminimum :: forall a. Ord a => MainExp a -> a
minimum :: forall a. Ord a => MainExp a -> a
$csum :: forall a. Num a => MainExp a -> a
sum :: forall a. Num a => MainExp a -> a
$cproduct :: forall a. Num a => MainExp a -> a
product :: forall a. Num a => MainExp a -> a
Foldable, Functor MainExp
Foldable MainExp
(Functor MainExp, Foldable MainExp) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> MainExp a -> f (MainExp b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    MainExp (f a) -> f (MainExp a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MainExp a -> m (MainExp b))
-> (forall (m :: * -> *) a.
    Monad m =>
    MainExp (m a) -> m (MainExp a))
-> Traversable MainExp
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => MainExp (m a) -> m (MainExp a)
forall (f :: * -> *) a.
Applicative f =>
MainExp (f a) -> f (MainExp a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MainExp a -> m (MainExp b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MainExp a -> f (MainExp b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MainExp a -> f (MainExp b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MainExp a -> f (MainExp b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
MainExp (f a) -> f (MainExp a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
MainExp (f a) -> f (MainExp a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MainExp a -> m (MainExp b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MainExp a -> m (MainExp b)
$csequence :: forall (m :: * -> *) a. Monad m => MainExp (m a) -> m (MainExp a)
sequence :: forall (m :: * -> *) a. Monad m => MainExp (m a) -> m (MainExp a)
Traversable, (forall x. MainExp a -> Rep (MainExp a) x)
-> (forall x. Rep (MainExp a) x -> MainExp a)
-> Generic (MainExp a)
forall x. Rep (MainExp a) x -> MainExp a
forall x. MainExp a -> Rep (MainExp a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (MainExp a) x -> MainExp a
forall a x. MainExp a -> Rep (MainExp a) x
$cfrom :: forall a x. MainExp a -> Rep (MainExp a) x
from :: forall x. MainExp a -> Rep (MainExp a) x
$cto :: forall a x. Rep (MainExp a) x -> MainExp a
to :: forall x. Rep (MainExp a) x -> MainExp a
Generic, (forall a. MainExp a -> Rep1 MainExp a)
-> (forall a. Rep1 MainExp a -> MainExp a) -> Generic1 MainExp
forall a. Rep1 MainExp a -> MainExp a
forall a. MainExp a -> Rep1 MainExp a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall a. MainExp a -> Rep1 MainExp a
from1 :: forall a. MainExp a -> Rep1 MainExp a
$cto1 :: forall a. Rep1 MainExp a -> MainExp a
to1 :: forall a. Rep1 MainExp a -> MainExp a
Generic1)

-- | Rate of if-then-else conditional.
-- It can run at Ir or Kr
data IfRate = IfIr | IfKr
  deriving (Int -> IfRate -> ShowS
[IfRate] -> ShowS
IfRate -> String
(Int -> IfRate -> ShowS)
-> (IfRate -> String) -> ([IfRate] -> ShowS) -> Show IfRate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IfRate -> ShowS
showsPrec :: Int -> IfRate -> ShowS
$cshow :: IfRate -> String
show :: IfRate -> String
$cshowList :: [IfRate] -> ShowS
showList :: [IfRate] -> ShowS
Show, IfRate -> IfRate -> Bool
(IfRate -> IfRate -> Bool)
-> (IfRate -> IfRate -> Bool) -> Eq IfRate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfRate -> IfRate -> Bool
== :: IfRate -> IfRate -> Bool
$c/= :: IfRate -> IfRate -> Bool
/= :: IfRate -> IfRate -> Bool
Eq, Eq IfRate
Eq IfRate =>
(IfRate -> IfRate -> Ordering)
-> (IfRate -> IfRate -> Bool)
-> (IfRate -> IfRate -> Bool)
-> (IfRate -> IfRate -> Bool)
-> (IfRate -> IfRate -> Bool)
-> (IfRate -> IfRate -> IfRate)
-> (IfRate -> IfRate -> IfRate)
-> Ord IfRate
IfRate -> IfRate -> Bool
IfRate -> IfRate -> Ordering
IfRate -> IfRate -> IfRate
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IfRate -> IfRate -> Ordering
compare :: IfRate -> IfRate -> Ordering
$c< :: IfRate -> IfRate -> Bool
< :: IfRate -> IfRate -> Bool
$c<= :: IfRate -> IfRate -> Bool
<= :: IfRate -> IfRate -> Bool
$c> :: IfRate -> IfRate -> Bool
> :: IfRate -> IfRate -> Bool
$c>= :: IfRate -> IfRate -> Bool
>= :: IfRate -> IfRate -> Bool
$cmax :: IfRate -> IfRate -> IfRate
max :: IfRate -> IfRate -> IfRate
$cmin :: IfRate -> IfRate -> IfRate
min :: IfRate -> IfRate -> IfRate
Ord, (forall x. IfRate -> Rep IfRate x)
-> (forall x. Rep IfRate x -> IfRate) -> Generic IfRate
forall x. Rep IfRate x -> IfRate
forall x. IfRate -> Rep IfRate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IfRate -> Rep IfRate x
from :: forall x. IfRate -> Rep IfRate x
$cto :: forall x. Rep IfRate x -> IfRate
to :: forall x. Rep IfRate x -> IfRate
Generic)

fromIfRate :: IfRate -> Rate
fromIfRate :: IfRate -> Rate
fromIfRate = \case
  IfRate
IfKr -> Rate
Kr
  IfRate
IfIr -> Rate
Ir

-- | Can be infinite so fe just ignore the value
instance Cereal.Serialize Signature where
  put :: Putter Signature
put = \Signature
_a -> () -> PutM ()
forall a. a -> PutM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  get :: Get Signature
get = Get Signature
forall a. HasCallStack => a
undefined

instance Cereal.Serialize a => Cereal.Serialize (RatedExp a)
instance Cereal.Serialize Prim
instance Cereal.Serialize Rate
instance Cereal.Serialize IfRate
instance Cereal.Serialize Info
instance Cereal.Serialize OpcFixity
instance Cereal.Serialize InstrId
instance Cereal.Serialize CondOp
instance Cereal.Serialize NumOp
instance Cereal.Serialize Var
instance Cereal.Serialize VarType
instance Cereal.Serialize a => Cereal.Serialize (CodeBlock a)
instance Cereal.Serialize a => Cereal.Serialize (MainExp a)
instance (Cereal.Serialize a, Cereal.Serialize b) => Cereal.Serialize (Inline a b)
instance (Cereal.Serialize a, Cereal.Serialize b) => Cereal.Serialize (PreInline a b)
instance (Cereal.Serialize a) => Cereal.Serialize (InlineExp a)

type IsArrInit = Bool

-- | Array sizes by demensions
type ArrSize a = [a]

-- | Array multi index
type ArrIndex a = [a]

-- Named variable
data Var
    = Var
        { Var -> VarType
varType :: !VarType    -- global / local
        , Var -> Rate
varRate :: !Rate
        , Var -> Text
varName :: !Name }
    | VarVerbatim
        { varRate :: !Rate
        , varName :: !Name
        } deriving (Int -> Var -> ShowS
[Var] -> ShowS
Var -> String
(Int -> Var -> ShowS)
-> (Var -> String) -> ([Var] -> ShowS) -> Show Var
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Var -> ShowS
showsPrec :: Int -> Var -> ShowS
$cshow :: Var -> String
show :: Var -> String
$cshowList :: [Var] -> ShowS
showList :: [Var] -> ShowS
Show, Var -> Var -> Bool
(Var -> Var -> Bool) -> (Var -> Var -> Bool) -> Eq Var
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Var -> Var -> Bool
== :: Var -> Var -> Bool
$c/= :: Var -> Var -> Bool
/= :: Var -> Var -> Bool
Eq, Eq Var
Eq Var =>
(Var -> Var -> Ordering)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Var)
-> (Var -> Var -> Var)
-> Ord Var
Var -> Var -> Bool
Var -> Var -> Ordering
Var -> Var -> Var
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Var -> Var -> Ordering
compare :: Var -> Var -> Ordering
$c< :: Var -> Var -> Bool
< :: Var -> Var -> Bool
$c<= :: Var -> Var -> Bool
<= :: Var -> Var -> Bool
$c> :: Var -> Var -> Bool
> :: Var -> Var -> Bool
$c>= :: Var -> Var -> Bool
>= :: Var -> Var -> Bool
$cmax :: Var -> Var -> Var
max :: Var -> Var -> Var
$cmin :: Var -> Var -> Var
min :: Var -> Var -> Var
Ord, (forall x. Var -> Rep Var x)
-> (forall x. Rep Var x -> Var) -> Generic Var
forall x. Rep Var x -> Var
forall x. Var -> Rep Var x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Var -> Rep Var x
from :: forall x. Var -> Rep Var x
$cto :: forall x. Rep Var x -> Var
to :: forall x. Rep Var x -> Var
Generic)

-- Variables can be global (then we have to prefix them with `g` in the rendering) or local.
data VarType = LocalVar | GlobalVar
    deriving (Int -> VarType -> ShowS
[VarType] -> ShowS
VarType -> String
(Int -> VarType -> ShowS)
-> (VarType -> String) -> ([VarType] -> ShowS) -> Show VarType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarType -> ShowS
showsPrec :: Int -> VarType -> ShowS
$cshow :: VarType -> String
show :: VarType -> String
$cshowList :: [VarType] -> ShowS
showList :: [VarType] -> ShowS
Show, VarType -> VarType -> Bool
(VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool) -> Eq VarType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarType -> VarType -> Bool
== :: VarType -> VarType -> Bool
$c/= :: VarType -> VarType -> Bool
/= :: VarType -> VarType -> Bool
Eq, Eq VarType
Eq VarType =>
(VarType -> VarType -> Ordering)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> VarType)
-> (VarType -> VarType -> VarType)
-> Ord VarType
VarType -> VarType -> Bool
VarType -> VarType -> Ordering
VarType -> VarType -> VarType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: VarType -> VarType -> Ordering
compare :: VarType -> VarType -> Ordering
$c< :: VarType -> VarType -> Bool
< :: VarType -> VarType -> Bool
$c<= :: VarType -> VarType -> Bool
<= :: VarType -> VarType -> Bool
$c> :: VarType -> VarType -> Bool
> :: VarType -> VarType -> Bool
$c>= :: VarType -> VarType -> Bool
>= :: VarType -> VarType -> Bool
$cmax :: VarType -> VarType -> VarType
max :: VarType -> VarType -> VarType
$cmin :: VarType -> VarType -> VarType
min :: VarType -> VarType -> VarType
Ord, (forall x. VarType -> Rep VarType x)
-> (forall x. Rep VarType x -> VarType) -> Generic VarType
forall x. Rep VarType x -> VarType
forall x. VarType -> Rep VarType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VarType -> Rep VarType x
from :: forall x. VarType -> Rep VarType x
$cto :: forall x. Rep VarType x -> VarType
to :: forall x. Rep VarType x -> VarType
Generic)

-- Opcode information.
data Info = Info
    -- Opcode name
    { Info -> Text
infoName          :: !Name
    -- Opcode type signature
    , Info -> Signature
infoSignature     :: !Signature
    -- Opcode can be infix or prefix
    , Info -> OpcFixity
infoOpcFixity     :: !OpcFixity
    } deriving (Int -> Info -> ShowS
[Info] -> ShowS
Info -> String
(Int -> Info -> ShowS)
-> (Info -> String) -> ([Info] -> ShowS) -> Show Info
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Info -> ShowS
showsPrec :: Int -> Info -> ShowS
$cshow :: Info -> String
show :: Info -> String
$cshowList :: [Info] -> ShowS
showList :: [Info] -> ShowS
Show, Info -> Info -> Bool
(Info -> Info -> Bool) -> (Info -> Info -> Bool) -> Eq Info
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Info -> Info -> Bool
== :: Info -> Info -> Bool
$c/= :: Info -> Info -> Bool
/= :: Info -> Info -> Bool
Eq, Eq Info
Eq Info =>
(Info -> Info -> Ordering)
-> (Info -> Info -> Bool)
-> (Info -> Info -> Bool)
-> (Info -> Info -> Bool)
-> (Info -> Info -> Bool)
-> (Info -> Info -> Info)
-> (Info -> Info -> Info)
-> Ord Info
Info -> Info -> Bool
Info -> Info -> Ordering
Info -> Info -> Info
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Info -> Info -> Ordering
compare :: Info -> Info -> Ordering
$c< :: Info -> Info -> Bool
< :: Info -> Info -> Bool
$c<= :: Info -> Info -> Bool
<= :: Info -> Info -> Bool
$c> :: Info -> Info -> Bool
> :: Info -> Info -> Bool
$c>= :: Info -> Info -> Bool
>= :: Info -> Info -> Bool
$cmax :: Info -> Info -> Info
max :: Info -> Info -> Info
$cmin :: Info -> Info -> Info
min :: Info -> Info -> Info
Ord, (forall x. Info -> Rep Info x)
-> (forall x. Rep Info x -> Info) -> Generic Info
forall x. Rep Info x -> Info
forall x. Info -> Rep Info x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Info -> Rep Info x
from :: forall x. Info -> Rep Info x
$cto :: forall x. Rep Info x -> Info
to :: forall x. Rep Info x -> Info
Generic)

isPrefix, isInfix :: Info -> Bool

isPrefix :: Info -> Bool
isPrefix = (OpcFixity
Prefix OpcFixity -> OpcFixity -> Bool
forall a. Eq a => a -> a -> Bool
==) (OpcFixity -> Bool) -> (Info -> OpcFixity) -> Info -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info -> OpcFixity
infoOpcFixity
isInfix :: Info -> Bool
isInfix  = (OpcFixity
Infix  OpcFixity -> OpcFixity -> Bool
forall a. Eq a => a -> a -> Bool
==) (OpcFixity -> Bool) -> (Info -> OpcFixity) -> Info -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info -> OpcFixity
infoOpcFixity

-- Opcode fixity
data OpcFixity = Prefix | Infix | Opcode
    deriving (Int -> OpcFixity -> ShowS
[OpcFixity] -> ShowS
OpcFixity -> String
(Int -> OpcFixity -> ShowS)
-> (OpcFixity -> String)
-> ([OpcFixity] -> ShowS)
-> Show OpcFixity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpcFixity -> ShowS
showsPrec :: Int -> OpcFixity -> ShowS
$cshow :: OpcFixity -> String
show :: OpcFixity -> String
$cshowList :: [OpcFixity] -> ShowS
showList :: [OpcFixity] -> ShowS
Show, OpcFixity -> OpcFixity -> Bool
(OpcFixity -> OpcFixity -> Bool)
-> (OpcFixity -> OpcFixity -> Bool) -> Eq OpcFixity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpcFixity -> OpcFixity -> Bool
== :: OpcFixity -> OpcFixity -> Bool
$c/= :: OpcFixity -> OpcFixity -> Bool
/= :: OpcFixity -> OpcFixity -> Bool
Eq, Eq OpcFixity
Eq OpcFixity =>
(OpcFixity -> OpcFixity -> Ordering)
-> (OpcFixity -> OpcFixity -> Bool)
-> (OpcFixity -> OpcFixity -> Bool)
-> (OpcFixity -> OpcFixity -> Bool)
-> (OpcFixity -> OpcFixity -> Bool)
-> (OpcFixity -> OpcFixity -> OpcFixity)
-> (OpcFixity -> OpcFixity -> OpcFixity)
-> Ord OpcFixity
OpcFixity -> OpcFixity -> Bool
OpcFixity -> OpcFixity -> Ordering
OpcFixity -> OpcFixity -> OpcFixity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OpcFixity -> OpcFixity -> Ordering
compare :: OpcFixity -> OpcFixity -> Ordering
$c< :: OpcFixity -> OpcFixity -> Bool
< :: OpcFixity -> OpcFixity -> Bool
$c<= :: OpcFixity -> OpcFixity -> Bool
<= :: OpcFixity -> OpcFixity -> Bool
$c> :: OpcFixity -> OpcFixity -> Bool
> :: OpcFixity -> OpcFixity -> Bool
$c>= :: OpcFixity -> OpcFixity -> Bool
>= :: OpcFixity -> OpcFixity -> Bool
$cmax :: OpcFixity -> OpcFixity -> OpcFixity
max :: OpcFixity -> OpcFixity -> OpcFixity
$cmin :: OpcFixity -> OpcFixity -> OpcFixity
min :: OpcFixity -> OpcFixity -> OpcFixity
Ord, (forall x. OpcFixity -> Rep OpcFixity x)
-> (forall x. Rep OpcFixity x -> OpcFixity) -> Generic OpcFixity
forall x. Rep OpcFixity x -> OpcFixity
forall x. OpcFixity -> Rep OpcFixity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OpcFixity -> Rep OpcFixity x
from :: forall x. OpcFixity -> Rep OpcFixity x
$cto :: forall x. Rep OpcFixity x -> OpcFixity
to :: forall x. Rep OpcFixity x -> OpcFixity
Generic)

-- | The Csound rates.
data Rate   -- rate:
    ----------------------------
    = Xr    -- audio or control (and I use it for opcodes that produce no output, ie procedures)
    | Ar    -- audio
    | Kr    -- control
    | Ir    -- init (constants)
    | Sr    -- strings
    | Fr    -- spectrum (for pvs opcodes)
    | Wr    -- special spectrum
    | Tvar  -- I don't understand what it is (fix me) used with Fr
    | ArArr -- array rates
    | KrArr
    | IrArr
    | SrArr
    deriving (Int -> Rate -> ShowS
[Rate] -> ShowS
Rate -> String
(Int -> Rate -> ShowS)
-> (Rate -> String) -> ([Rate] -> ShowS) -> Show Rate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rate -> ShowS
showsPrec :: Int -> Rate -> ShowS
$cshow :: Rate -> String
show :: Rate -> String
$cshowList :: [Rate] -> ShowS
showList :: [Rate] -> ShowS
Show, Rate -> Rate -> Bool
(Rate -> Rate -> Bool) -> (Rate -> Rate -> Bool) -> Eq Rate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rate -> Rate -> Bool
== :: Rate -> Rate -> Bool
$c/= :: Rate -> Rate -> Bool
/= :: Rate -> Rate -> Bool
Eq, Eq Rate
Eq Rate =>
(Rate -> Rate -> Ordering)
-> (Rate -> Rate -> Bool)
-> (Rate -> Rate -> Bool)
-> (Rate -> Rate -> Bool)
-> (Rate -> Rate -> Bool)
-> (Rate -> Rate -> Rate)
-> (Rate -> Rate -> Rate)
-> Ord Rate
Rate -> Rate -> Bool
Rate -> Rate -> Ordering
Rate -> Rate -> Rate
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Rate -> Rate -> Ordering
compare :: Rate -> Rate -> Ordering
$c< :: Rate -> Rate -> Bool
< :: Rate -> Rate -> Bool
$c<= :: Rate -> Rate -> Bool
<= :: Rate -> Rate -> Bool
$c> :: Rate -> Rate -> Bool
> :: Rate -> Rate -> Bool
$c>= :: Rate -> Rate -> Bool
>= :: Rate -> Rate -> Bool
$cmax :: Rate -> Rate -> Rate
max :: Rate -> Rate -> Rate
$cmin :: Rate -> Rate -> Rate
min :: Rate -> Rate -> Rate
Ord, Int -> Rate
Rate -> Int
Rate -> [Rate]
Rate -> Rate
Rate -> Rate -> [Rate]
Rate -> Rate -> Rate -> [Rate]
(Rate -> Rate)
-> (Rate -> Rate)
-> (Int -> Rate)
-> (Rate -> Int)
-> (Rate -> [Rate])
-> (Rate -> Rate -> [Rate])
-> (Rate -> Rate -> [Rate])
-> (Rate -> Rate -> Rate -> [Rate])
-> Enum Rate
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Rate -> Rate
succ :: Rate -> Rate
$cpred :: Rate -> Rate
pred :: Rate -> Rate
$ctoEnum :: Int -> Rate
toEnum :: Int -> Rate
$cfromEnum :: Rate -> Int
fromEnum :: Rate -> Int
$cenumFrom :: Rate -> [Rate]
enumFrom :: Rate -> [Rate]
$cenumFromThen :: Rate -> Rate -> [Rate]
enumFromThen :: Rate -> Rate -> [Rate]
$cenumFromTo :: Rate -> Rate -> [Rate]
enumFromTo :: Rate -> Rate -> [Rate]
$cenumFromThenTo :: Rate -> Rate -> Rate -> [Rate]
enumFromThenTo :: Rate -> Rate -> Rate -> [Rate]
Enum, Rate
Rate -> Rate -> Bounded Rate
forall a. a -> a -> Bounded a
$cminBound :: Rate
minBound :: Rate
$cmaxBound :: Rate
maxBound :: Rate
Bounded, (forall x. Rate -> Rep Rate x)
-> (forall x. Rep Rate x -> Rate) -> Generic Rate
forall x. Rep Rate x -> Rate
forall x. Rate -> Rep Rate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Rate -> Rep Rate x
from :: forall x. Rate -> Rep Rate x
$cto :: forall x. Rep Rate x -> Rate
to :: forall x. Rep Rate x -> Rate
Generic)

toArrRate :: Rate -> Rate
toArrRate :: Rate -> Rate
toArrRate = \case
  Rate
Ar -> Rate
ArArr
  Rate
Kr -> Rate
KrArr
  Rate
Ir -> Rate
IrArr
  Rate
Sr -> Rate
SrArr
  Rate
other -> Rate
other

removeArrRate :: Rate -> Rate
removeArrRate :: Rate -> Rate
removeArrRate = \case
  Rate
ArArr -> Rate
Ar
  Rate
KrArr -> Rate
Kr
  Rate
IrArr -> Rate
Ir
  Rate
SrArr -> Rate
Sr
  Rate
other -> Rate
other

-- Opcode type signature. Opcodes can produce single output (SingleRate) or multiple outputs (MultiRate).
-- In Csound opcodes are often have several signatures. That is one opcode name can produce signals of the
-- different rate (it depends on the type of the outputs). Here we assume (to make things easier) that
-- opcodes that MultiRate-opcodes can produce only the arguments of the same type.
data Signature
    -- For SingleRate-opcodes type signature is the Map from output rate to the rate of the arguments.
    -- With it we can deduce the type of the argument from the type of the output.
    = SingleRate !(Map Rate [Rate])
    -- For MultiRate-opcodes Map degenerates to the singleton. We have only one link.
    -- It contains rates for outputs and inputs.
    | MultiRate
        { Signature -> [Rate]
outMultiRate :: ![Rate]
        , Signature -> [Rate]
inMultiRate  :: ![Rate] }
    deriving (Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signature -> ShowS
showsPrec :: Int -> Signature -> ShowS
$cshow :: Signature -> String
show :: Signature -> String
$cshowList :: [Signature] -> ShowS
showList :: [Signature] -> ShowS
Show, Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
/= :: Signature -> Signature -> Bool
Eq, Eq Signature
Eq Signature =>
(Signature -> Signature -> Ordering)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Signature)
-> (Signature -> Signature -> Signature)
-> Ord Signature
Signature -> Signature -> Bool
Signature -> Signature -> Ordering
Signature -> Signature -> Signature
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Signature -> Signature -> Ordering
compare :: Signature -> Signature -> Ordering
$c< :: Signature -> Signature -> Bool
< :: Signature -> Signature -> Bool
$c<= :: Signature -> Signature -> Bool
<= :: Signature -> Signature -> Bool
$c> :: Signature -> Signature -> Bool
> :: Signature -> Signature -> Bool
$c>= :: Signature -> Signature -> Bool
>= :: Signature -> Signature -> Bool
$cmax :: Signature -> Signature -> Signature
max :: Signature -> Signature -> Signature
$cmin :: Signature -> Signature -> Signature
min :: Signature -> Signature -> Signature
Ord, (forall x. Signature -> Rep Signature x)
-> (forall x. Rep Signature x -> Signature) -> Generic Signature
forall x. Rep Signature x -> Signature
forall x. Signature -> Rep Signature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Signature -> Rep Signature x
from :: forall x. Signature -> Rep Signature x
$cto :: forall x. Rep Signature x -> Signature
to :: forall x. Rep Signature x -> Signature
Generic)

-- Primitive values
data Prim
    -- instrument p-arguments
    = P !Int
    | PString !Int       -- >> p-string (read p-string notes at the bottom of the file):
    | PrimInt !Int
    | PrimDouble !Double
    | PrimString !Text
    | PrimInstrId !InstrId
    | PrimVar
        { Prim -> Rate
primVarTargetRate :: !Rate
        , Prim -> Var
primVar           :: !Var }
    deriving (Int -> Prim -> ShowS
[Prim] -> ShowS
Prim -> String
(Int -> Prim -> ShowS)
-> (Prim -> String) -> ([Prim] -> ShowS) -> Show Prim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Prim -> ShowS
showsPrec :: Int -> Prim -> ShowS
$cshow :: Prim -> String
show :: Prim -> String
$cshowList :: [Prim] -> ShowS
showList :: [Prim] -> ShowS
Show, Prim -> Prim -> Bool
(Prim -> Prim -> Bool) -> (Prim -> Prim -> Bool) -> Eq Prim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Prim -> Prim -> Bool
== :: Prim -> Prim -> Bool
$c/= :: Prim -> Prim -> Bool
/= :: Prim -> Prim -> Bool
Eq, Eq Prim
Eq Prim =>
(Prim -> Prim -> Ordering)
-> (Prim -> Prim -> Bool)
-> (Prim -> Prim -> Bool)
-> (Prim -> Prim -> Bool)
-> (Prim -> Prim -> Bool)
-> (Prim -> Prim -> Prim)
-> (Prim -> Prim -> Prim)
-> Ord Prim
Prim -> Prim -> Bool
Prim -> Prim -> Ordering
Prim -> Prim -> Prim
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Prim -> Prim -> Ordering
compare :: Prim -> Prim -> Ordering
$c< :: Prim -> Prim -> Bool
< :: Prim -> Prim -> Bool
$c<= :: Prim -> Prim -> Bool
<= :: Prim -> Prim -> Bool
$c> :: Prim -> Prim -> Bool
> :: Prim -> Prim -> Bool
$c>= :: Prim -> Prim -> Bool
>= :: Prim -> Prim -> Bool
$cmax :: Prim -> Prim -> Prim
max :: Prim -> Prim -> Prim
$cmin :: Prim -> Prim -> Prim
min :: Prim -> Prim -> Prim
Ord, (forall x. Prim -> Rep Prim x)
-> (forall x. Rep Prim x -> Prim) -> Generic Prim
forall x. Rep Prim x -> Prim
forall x. Prim -> Rep Prim x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Prim -> Rep Prim x
from :: forall x. Prim -> Rep Prim x
$cto :: forall x. Rep Prim x -> Prim
to :: forall x. Rep Prim x -> Prim
Generic)

-- Gen routine.
data Gen = Gen
    { Gen -> Int
genSize    :: !Int
    , Gen -> GenId
genId      :: !GenId
    , Gen -> [Double]
genArgs    :: ![Double]
    , Gen -> Maybe Text
genFile    :: !(Maybe Text)
    } deriving (Int -> Gen -> ShowS
[Gen] -> ShowS
Gen -> String
(Int -> Gen -> ShowS)
-> (Gen -> String) -> ([Gen] -> ShowS) -> Show Gen
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Gen -> ShowS
showsPrec :: Int -> Gen -> ShowS
$cshow :: Gen -> String
show :: Gen -> String
$cshowList :: [Gen] -> ShowS
showList :: [Gen] -> ShowS
Show, Gen -> Gen -> Bool
(Gen -> Gen -> Bool) -> (Gen -> Gen -> Bool) -> Eq Gen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Gen -> Gen -> Bool
== :: Gen -> Gen -> Bool
$c/= :: Gen -> Gen -> Bool
/= :: Gen -> Gen -> Bool
Eq, Eq Gen
Eq Gen =>
(Gen -> Gen -> Ordering)
-> (Gen -> Gen -> Bool)
-> (Gen -> Gen -> Bool)
-> (Gen -> Gen -> Bool)
-> (Gen -> Gen -> Bool)
-> (Gen -> Gen -> Gen)
-> (Gen -> Gen -> Gen)
-> Ord Gen
Gen -> Gen -> Bool
Gen -> Gen -> Ordering
Gen -> Gen -> Gen
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Gen -> Gen -> Ordering
compare :: Gen -> Gen -> Ordering
$c< :: Gen -> Gen -> Bool
< :: Gen -> Gen -> Bool
$c<= :: Gen -> Gen -> Bool
<= :: Gen -> Gen -> Bool
$c> :: Gen -> Gen -> Bool
> :: Gen -> Gen -> Bool
$c>= :: Gen -> Gen -> Bool
>= :: Gen -> Gen -> Bool
$cmax :: Gen -> Gen -> Gen
max :: Gen -> Gen -> Gen
$cmin :: Gen -> Gen -> Gen
min :: Gen -> Gen -> Gen
Ord, (forall x. Gen -> Rep Gen x)
-> (forall x. Rep Gen x -> Gen) -> Generic Gen
forall x. Rep Gen x -> Gen
forall x. Gen -> Rep Gen x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Gen -> Rep Gen x
from :: forall x. Gen -> Rep Gen x
$cto :: forall x. Rep Gen x -> Gen
to :: forall x. Rep Gen x -> Gen
Generic)

data GenId = IntGenId !Int | StringGenId !Text
    deriving (Int -> GenId -> ShowS
[GenId] -> ShowS
GenId -> String
(Int -> GenId -> ShowS)
-> (GenId -> String) -> ([GenId] -> ShowS) -> Show GenId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenId -> ShowS
showsPrec :: Int -> GenId -> ShowS
$cshow :: GenId -> String
show :: GenId -> String
$cshowList :: [GenId] -> ShowS
showList :: [GenId] -> ShowS
Show, GenId -> GenId -> Bool
(GenId -> GenId -> Bool) -> (GenId -> GenId -> Bool) -> Eq GenId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenId -> GenId -> Bool
== :: GenId -> GenId -> Bool
$c/= :: GenId -> GenId -> Bool
/= :: GenId -> GenId -> Bool
Eq, Eq GenId
Eq GenId =>
(GenId -> GenId -> Ordering)
-> (GenId -> GenId -> Bool)
-> (GenId -> GenId -> Bool)
-> (GenId -> GenId -> Bool)
-> (GenId -> GenId -> Bool)
-> (GenId -> GenId -> GenId)
-> (GenId -> GenId -> GenId)
-> Ord GenId
GenId -> GenId -> Bool
GenId -> GenId -> Ordering
GenId -> GenId -> GenId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GenId -> GenId -> Ordering
compare :: GenId -> GenId -> Ordering
$c< :: GenId -> GenId -> Bool
< :: GenId -> GenId -> Bool
$c<= :: GenId -> GenId -> Bool
<= :: GenId -> GenId -> Bool
$c> :: GenId -> GenId -> Bool
> :: GenId -> GenId -> Bool
$c>= :: GenId -> GenId -> Bool
>= :: GenId -> GenId -> Bool
$cmax :: GenId -> GenId -> GenId
max :: GenId -> GenId -> GenId
$cmin :: GenId -> GenId -> GenId
min :: GenId -> GenId -> GenId
Ord, (forall x. GenId -> Rep GenId x)
-> (forall x. Rep GenId x -> GenId) -> Generic GenId
forall x. Rep GenId x -> GenId
forall x. GenId -> Rep GenId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenId -> Rep GenId x
from :: forall x. GenId -> Rep GenId x
$cto :: forall x. Rep GenId x -> GenId
to :: forall x. Rep GenId x -> GenId
Generic)

-- Csound note
type Note = [Prim]

------------------------------------------------------------
-- types for arithmetic and boolean expressions

data Inline op arg = Inline
    { forall op arg. Inline op arg -> InlineExp op
inlineExp :: !(InlineExp op)
    , forall op arg. Inline op arg -> IntMap arg
inlineEnv :: !(IM.IntMap arg)
    } deriving (Int -> Inline op arg -> ShowS
[Inline op arg] -> ShowS
Inline op arg -> String
(Int -> Inline op arg -> ShowS)
-> (Inline op arg -> String)
-> ([Inline op arg] -> ShowS)
-> Show (Inline op arg)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall op arg. (Show op, Show arg) => Int -> Inline op arg -> ShowS
forall op arg. (Show op, Show arg) => [Inline op arg] -> ShowS
forall op arg. (Show op, Show arg) => Inline op arg -> String
$cshowsPrec :: forall op arg. (Show op, Show arg) => Int -> Inline op arg -> ShowS
showsPrec :: Int -> Inline op arg -> ShowS
$cshow :: forall op arg. (Show op, Show arg) => Inline op arg -> String
show :: Inline op arg -> String
$cshowList :: forall op arg. (Show op, Show arg) => [Inline op arg] -> ShowS
showList :: [Inline op arg] -> ShowS
Show, Inline op arg -> Inline op arg -> Bool
(Inline op arg -> Inline op arg -> Bool)
-> (Inline op arg -> Inline op arg -> Bool) -> Eq (Inline op arg)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall op arg.
(Eq op, Eq arg) =>
Inline op arg -> Inline op arg -> Bool
$c== :: forall op arg.
(Eq op, Eq arg) =>
Inline op arg -> Inline op arg -> Bool
== :: Inline op arg -> Inline op arg -> Bool
$c/= :: forall op arg.
(Eq op, Eq arg) =>
Inline op arg -> Inline op arg -> Bool
/= :: Inline op arg -> Inline op arg -> Bool
Eq, Eq (Inline op arg)
Eq (Inline op arg) =>
(Inline op arg -> Inline op arg -> Ordering)
-> (Inline op arg -> Inline op arg -> Bool)
-> (Inline op arg -> Inline op arg -> Bool)
-> (Inline op arg -> Inline op arg -> Bool)
-> (Inline op arg -> Inline op arg -> Bool)
-> (Inline op arg -> Inline op arg -> Inline op arg)
-> (Inline op arg -> Inline op arg -> Inline op arg)
-> Ord (Inline op arg)
Inline op arg -> Inline op arg -> Bool
Inline op arg -> Inline op arg -> Ordering
Inline op arg -> Inline op arg -> Inline op arg
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall op arg. (Ord op, Ord arg) => Eq (Inline op arg)
forall op arg.
(Ord op, Ord arg) =>
Inline op arg -> Inline op arg -> Bool
forall op arg.
(Ord op, Ord arg) =>
Inline op arg -> Inline op arg -> Ordering
forall op arg.
(Ord op, Ord arg) =>
Inline op arg -> Inline op arg -> Inline op arg
$ccompare :: forall op arg.
(Ord op, Ord arg) =>
Inline op arg -> Inline op arg -> Ordering
compare :: Inline op arg -> Inline op arg -> Ordering
$c< :: forall op arg.
(Ord op, Ord arg) =>
Inline op arg -> Inline op arg -> Bool
< :: Inline op arg -> Inline op arg -> Bool
$c<= :: forall op arg.
(Ord op, Ord arg) =>
Inline op arg -> Inline op arg -> Bool
<= :: Inline op arg -> Inline op arg -> Bool
$c> :: forall op arg.
(Ord op, Ord arg) =>
Inline op arg -> Inline op arg -> Bool
> :: Inline op arg -> Inline op arg -> Bool
$c>= :: forall op arg.
(Ord op, Ord arg) =>
Inline op arg -> Inline op arg -> Bool
>= :: Inline op arg -> Inline op arg -> Bool
$cmax :: forall op arg.
(Ord op, Ord arg) =>
Inline op arg -> Inline op arg -> Inline op arg
max :: Inline op arg -> Inline op arg -> Inline op arg
$cmin :: forall op arg.
(Ord op, Ord arg) =>
Inline op arg -> Inline op arg -> Inline op arg
min :: Inline op arg -> Inline op arg -> Inline op arg
Ord, (forall a b. (a -> b) -> Inline op a -> Inline op b)
-> (forall a b. a -> Inline op b -> Inline op a)
-> Functor (Inline op)
forall a b. a -> Inline op b -> Inline op a
forall a b. (a -> b) -> Inline op a -> Inline op b
forall op a b. a -> Inline op b -> Inline op a
forall op a b. (a -> b) -> Inline op a -> Inline op b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall op a b. (a -> b) -> Inline op a -> Inline op b
fmap :: forall a b. (a -> b) -> Inline op a -> Inline op b
$c<$ :: forall op a b. a -> Inline op b -> Inline op a
<$ :: forall a b. a -> Inline op b -> Inline op a
Functor, (forall m. Monoid m => Inline op m -> m)
-> (forall m a. Monoid m => (a -> m) -> Inline op a -> m)
-> (forall m a. Monoid m => (a -> m) -> Inline op a -> m)
-> (forall a b. (a -> b -> b) -> b -> Inline op a -> b)
-> (forall a b. (a -> b -> b) -> b -> Inline op a -> b)
-> (forall b a. (b -> a -> b) -> b -> Inline op a -> b)
-> (forall b a. (b -> a -> b) -> b -> Inline op a -> b)
-> (forall a. (a -> a -> a) -> Inline op a -> a)
-> (forall a. (a -> a -> a) -> Inline op a -> a)
-> (forall a. Inline op a -> [a])
-> (forall a. Inline op a -> Bool)
-> (forall a. Inline op a -> Int)
-> (forall a. Eq a => a -> Inline op a -> Bool)
-> (forall a. Ord a => Inline op a -> a)
-> (forall a. Ord a => Inline op a -> a)
-> (forall a. Num a => Inline op a -> a)
-> (forall a. Num a => Inline op a -> a)
-> Foldable (Inline op)
forall a. Eq a => a -> Inline op a -> Bool
forall a. Num a => Inline op a -> a
forall a. Ord a => Inline op a -> a
forall m. Monoid m => Inline op m -> m
forall a. Inline op a -> Bool
forall a. Inline op a -> Int
forall a. Inline op a -> [a]
forall a. (a -> a -> a) -> Inline op a -> a
forall op a. Eq a => a -> Inline op a -> Bool
forall op a. Num a => Inline op a -> a
forall op a. Ord a => Inline op a -> a
forall m a. Monoid m => (a -> m) -> Inline op a -> m
forall op m. Monoid m => Inline op m -> m
forall op a. Inline op a -> Bool
forall op a. Inline op a -> Int
forall op a. Inline op a -> [a]
forall b a. (b -> a -> b) -> b -> Inline op a -> b
forall a b. (a -> b -> b) -> b -> Inline op a -> b
forall op a. (a -> a -> a) -> Inline op a -> a
forall op m a. Monoid m => (a -> m) -> Inline op a -> m
forall op b a. (b -> a -> b) -> b -> Inline op a -> b
forall op a b. (a -> b -> b) -> b -> Inline op a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall op m. Monoid m => Inline op m -> m
fold :: forall m. Monoid m => Inline op m -> m
$cfoldMap :: forall op m a. Monoid m => (a -> m) -> Inline op a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Inline op a -> m
$cfoldMap' :: forall op m a. Monoid m => (a -> m) -> Inline op a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Inline op a -> m
$cfoldr :: forall op a b. (a -> b -> b) -> b -> Inline op a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Inline op a -> b
$cfoldr' :: forall op a b. (a -> b -> b) -> b -> Inline op a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Inline op a -> b
$cfoldl :: forall op b a. (b -> a -> b) -> b -> Inline op a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Inline op a -> b
$cfoldl' :: forall op b a. (b -> a -> b) -> b -> Inline op a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Inline op a -> b
$cfoldr1 :: forall op a. (a -> a -> a) -> Inline op a -> a
foldr1 :: forall a. (a -> a -> a) -> Inline op a -> a
$cfoldl1 :: forall op a. (a -> a -> a) -> Inline op a -> a
foldl1 :: forall a. (a -> a -> a) -> Inline op a -> a
$ctoList :: forall op a. Inline op a -> [a]
toList :: forall a. Inline op a -> [a]
$cnull :: forall op a. Inline op a -> Bool
null :: forall a. Inline op a -> Bool
$clength :: forall op a. Inline op a -> Int
length :: forall a. Inline op a -> Int
$celem :: forall op a. Eq a => a -> Inline op a -> Bool
elem :: forall a. Eq a => a -> Inline op a -> Bool
$cmaximum :: forall op a. Ord a => Inline op a -> a
maximum :: forall a. Ord a => Inline op a -> a
$cminimum :: forall op a. Ord a => Inline op a -> a
minimum :: forall a. Ord a => Inline op a -> a
$csum :: forall op a. Num a => Inline op a -> a
sum :: forall a. Num a => Inline op a -> a
$cproduct :: forall op a. Num a => Inline op a -> a
product :: forall a. Num a => Inline op a -> a
Foldable, Functor (Inline op)
Foldable (Inline op)
(Functor (Inline op), Foldable (Inline op)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Inline op a -> f (Inline op b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Inline op (f a) -> f (Inline op a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Inline op a -> m (Inline op b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Inline op (m a) -> m (Inline op a))
-> Traversable (Inline op)
forall op. Functor (Inline op)
forall op. Foldable (Inline op)
forall op (m :: * -> *) a.
Monad m =>
Inline op (m a) -> m (Inline op a)
forall op (f :: * -> *) a.
Applicative f =>
Inline op (f a) -> f (Inline op a)
forall op (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Inline op a -> m (Inline op b)
forall op (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Inline op a -> f (Inline op b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Inline op (m a) -> m (Inline op a)
forall (f :: * -> *) a.
Applicative f =>
Inline op (f a) -> f (Inline op a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Inline op a -> m (Inline op b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Inline op a -> f (Inline op b)
$ctraverse :: forall op (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Inline op a -> f (Inline op b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Inline op a -> f (Inline op b)
$csequenceA :: forall op (f :: * -> *) a.
Applicative f =>
Inline op (f a) -> f (Inline op a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Inline op (f a) -> f (Inline op a)
$cmapM :: forall op (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Inline op a -> m (Inline op b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Inline op a -> m (Inline op b)
$csequence :: forall op (m :: * -> *) a.
Monad m =>
Inline op (m a) -> m (Inline op a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Inline op (m a) -> m (Inline op a)
Traversable, (forall a. Inline op a -> Rep1 (Inline op) a)
-> (forall a. Rep1 (Inline op) a -> Inline op a)
-> Generic1 (Inline op)
forall a. Rep1 (Inline op) a -> Inline op a
forall a. Inline op a -> Rep1 (Inline op) a
forall op a. Rep1 (Inline op) a -> Inline op a
forall op a. Inline op a -> Rep1 (Inline op) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall op a. Inline op a -> Rep1 (Inline op) a
from1 :: forall a. Inline op a -> Rep1 (Inline op) a
$cto1 :: forall op a. Rep1 (Inline op) a -> Inline op a
to1 :: forall a. Rep1 (Inline op) a -> Inline op a
Generic1, (forall x. Inline op arg -> Rep (Inline op arg) x)
-> (forall x. Rep (Inline op arg) x -> Inline op arg)
-> Generic (Inline op arg)
forall x. Rep (Inline op arg) x -> Inline op arg
forall x. Inline op arg -> Rep (Inline op arg) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall op arg x. Rep (Inline op arg) x -> Inline op arg
forall op arg x. Inline op arg -> Rep (Inline op arg) x
$cfrom :: forall op arg x. Inline op arg -> Rep (Inline op arg) x
from :: forall x. Inline op arg -> Rep (Inline op arg) x
$cto :: forall op arg x. Rep (Inline op arg) x -> Inline op arg
to :: forall x. Rep (Inline op arg) x -> Inline op arg
Generic)

-- Inlined expression.
data InlineExp op
    = InlinePrim !Int
    | InlineExp !op ![InlineExp op]
    deriving (Int -> InlineExp op -> ShowS
[InlineExp op] -> ShowS
InlineExp op -> String
(Int -> InlineExp op -> ShowS)
-> (InlineExp op -> String)
-> ([InlineExp op] -> ShowS)
-> Show (InlineExp op)
forall op. Show op => Int -> InlineExp op -> ShowS
forall op. Show op => [InlineExp op] -> ShowS
forall op. Show op => InlineExp op -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall op. Show op => Int -> InlineExp op -> ShowS
showsPrec :: Int -> InlineExp op -> ShowS
$cshow :: forall op. Show op => InlineExp op -> String
show :: InlineExp op -> String
$cshowList :: forall op. Show op => [InlineExp op] -> ShowS
showList :: [InlineExp op] -> ShowS
Show, InlineExp op -> InlineExp op -> Bool
(InlineExp op -> InlineExp op -> Bool)
-> (InlineExp op -> InlineExp op -> Bool) -> Eq (InlineExp op)
forall op. Eq op => InlineExp op -> InlineExp op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall op. Eq op => InlineExp op -> InlineExp op -> Bool
== :: InlineExp op -> InlineExp op -> Bool
$c/= :: forall op. Eq op => InlineExp op -> InlineExp op -> Bool
/= :: InlineExp op -> InlineExp op -> Bool
Eq, Eq (InlineExp op)
Eq (InlineExp op) =>
(InlineExp op -> InlineExp op -> Ordering)
-> (InlineExp op -> InlineExp op -> Bool)
-> (InlineExp op -> InlineExp op -> Bool)
-> (InlineExp op -> InlineExp op -> Bool)
-> (InlineExp op -> InlineExp op -> Bool)
-> (InlineExp op -> InlineExp op -> InlineExp op)
-> (InlineExp op -> InlineExp op -> InlineExp op)
-> Ord (InlineExp op)
InlineExp op -> InlineExp op -> Bool
InlineExp op -> InlineExp op -> Ordering
InlineExp op -> InlineExp op -> InlineExp op
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall op. Ord op => Eq (InlineExp op)
forall op. Ord op => InlineExp op -> InlineExp op -> Bool
forall op. Ord op => InlineExp op -> InlineExp op -> Ordering
forall op. Ord op => InlineExp op -> InlineExp op -> InlineExp op
$ccompare :: forall op. Ord op => InlineExp op -> InlineExp op -> Ordering
compare :: InlineExp op -> InlineExp op -> Ordering
$c< :: forall op. Ord op => InlineExp op -> InlineExp op -> Bool
< :: InlineExp op -> InlineExp op -> Bool
$c<= :: forall op. Ord op => InlineExp op -> InlineExp op -> Bool
<= :: InlineExp op -> InlineExp op -> Bool
$c> :: forall op. Ord op => InlineExp op -> InlineExp op -> Bool
> :: InlineExp op -> InlineExp op -> Bool
$c>= :: forall op. Ord op => InlineExp op -> InlineExp op -> Bool
>= :: InlineExp op -> InlineExp op -> Bool
$cmax :: forall op. Ord op => InlineExp op -> InlineExp op -> InlineExp op
max :: InlineExp op -> InlineExp op -> InlineExp op
$cmin :: forall op. Ord op => InlineExp op -> InlineExp op -> InlineExp op
min :: InlineExp op -> InlineExp op -> InlineExp op
Ord, (forall x. InlineExp op -> Rep (InlineExp op) x)
-> (forall x. Rep (InlineExp op) x -> InlineExp op)
-> Generic (InlineExp op)
forall x. Rep (InlineExp op) x -> InlineExp op
forall x. InlineExp op -> Rep (InlineExp op) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall op x. Rep (InlineExp op) x -> InlineExp op
forall op x. InlineExp op -> Rep (InlineExp op) x
$cfrom :: forall op x. InlineExp op -> Rep (InlineExp op) x
from :: forall x. InlineExp op -> Rep (InlineExp op) x
$cto :: forall op x. Rep (InlineExp op) x -> InlineExp op
to :: forall x. Rep (InlineExp op) x -> InlineExp op
Generic)

-- Expression as a tree (to be inlined)
data PreInline a b = PreInline !a ![b]
    deriving (Int -> PreInline a b -> ShowS
[PreInline a b] -> ShowS
PreInline a b -> String
(Int -> PreInline a b -> ShowS)
-> (PreInline a b -> String)
-> ([PreInline a b] -> ShowS)
-> Show (PreInline a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> PreInline a b -> ShowS
forall a b. (Show a, Show b) => [PreInline a b] -> ShowS
forall a b. (Show a, Show b) => PreInline a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> PreInline a b -> ShowS
showsPrec :: Int -> PreInline a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => PreInline a b -> String
show :: PreInline a b -> String
$cshowList :: forall a b. (Show a, Show b) => [PreInline a b] -> ShowS
showList :: [PreInline a b] -> ShowS
Show, PreInline a b -> PreInline a b -> Bool
(PreInline a b -> PreInline a b -> Bool)
-> (PreInline a b -> PreInline a b -> Bool) -> Eq (PreInline a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => PreInline a b -> PreInline a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => PreInline a b -> PreInline a b -> Bool
== :: PreInline a b -> PreInline a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => PreInline a b -> PreInline a b -> Bool
/= :: PreInline a b -> PreInline a b -> Bool
Eq, Eq (PreInline a b)
Eq (PreInline a b) =>
(PreInline a b -> PreInline a b -> Ordering)
-> (PreInline a b -> PreInline a b -> Bool)
-> (PreInline a b -> PreInline a b -> Bool)
-> (PreInline a b -> PreInline a b -> Bool)
-> (PreInline a b -> PreInline a b -> Bool)
-> (PreInline a b -> PreInline a b -> PreInline a b)
-> (PreInline a b -> PreInline a b -> PreInline a b)
-> Ord (PreInline a b)
PreInline a b -> PreInline a b -> Bool
PreInline a b -> PreInline a b -> Ordering
PreInline a b -> PreInline a b -> PreInline a b
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord a, Ord b) => Eq (PreInline a b)
forall a b.
(Ord a, Ord b) =>
PreInline a b -> PreInline a b -> Bool
forall a b.
(Ord a, Ord b) =>
PreInline a b -> PreInline a b -> Ordering
forall a b.
(Ord a, Ord b) =>
PreInline a b -> PreInline a b -> PreInline a b
$ccompare :: forall a b.
(Ord a, Ord b) =>
PreInline a b -> PreInline a b -> Ordering
compare :: PreInline a b -> PreInline a b -> Ordering
$c< :: forall a b.
(Ord a, Ord b) =>
PreInline a b -> PreInline a b -> Bool
< :: PreInline a b -> PreInline a b -> Bool
$c<= :: forall a b.
(Ord a, Ord b) =>
PreInline a b -> PreInline a b -> Bool
<= :: PreInline a b -> PreInline a b -> Bool
$c> :: forall a b.
(Ord a, Ord b) =>
PreInline a b -> PreInline a b -> Bool
> :: PreInline a b -> PreInline a b -> Bool
$c>= :: forall a b.
(Ord a, Ord b) =>
PreInline a b -> PreInline a b -> Bool
>= :: PreInline a b -> PreInline a b -> Bool
$cmax :: forall a b.
(Ord a, Ord b) =>
PreInline a b -> PreInline a b -> PreInline a b
max :: PreInline a b -> PreInline a b -> PreInline a b
$cmin :: forall a b.
(Ord a, Ord b) =>
PreInline a b -> PreInline a b -> PreInline a b
min :: PreInline a b -> PreInline a b -> PreInline a b
Ord, (forall a b. (a -> b) -> PreInline a a -> PreInline a b)
-> (forall a b. a -> PreInline a b -> PreInline a a)
-> Functor (PreInline a)
forall a b. a -> PreInline a b -> PreInline a a
forall a b. (a -> b) -> PreInline a a -> PreInline a b
forall a a b. a -> PreInline a b -> PreInline a a
forall a a b. (a -> b) -> PreInline a a -> PreInline a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b. (a -> b) -> PreInline a a -> PreInline a b
fmap :: forall a b. (a -> b) -> PreInline a a -> PreInline a b
$c<$ :: forall a a b. a -> PreInline a b -> PreInline a a
<$ :: forall a b. a -> PreInline a b -> PreInline a a
Functor, (forall m. Monoid m => PreInline a m -> m)
-> (forall m a. Monoid m => (a -> m) -> PreInline a a -> m)
-> (forall m a. Monoid m => (a -> m) -> PreInline a a -> m)
-> (forall a b. (a -> b -> b) -> b -> PreInline a a -> b)
-> (forall a b. (a -> b -> b) -> b -> PreInline a a -> b)
-> (forall b a. (b -> a -> b) -> b -> PreInline a a -> b)
-> (forall b a. (b -> a -> b) -> b -> PreInline a a -> b)
-> (forall a. (a -> a -> a) -> PreInline a a -> a)
-> (forall a. (a -> a -> a) -> PreInline a a -> a)
-> (forall a. PreInline a a -> [a])
-> (forall a. PreInline a a -> Bool)
-> (forall a. PreInline a a -> Int)
-> (forall a. Eq a => a -> PreInline a a -> Bool)
-> (forall a. Ord a => PreInline a a -> a)
-> (forall a. Ord a => PreInline a a -> a)
-> (forall a. Num a => PreInline a a -> a)
-> (forall a. Num a => PreInline a a -> a)
-> Foldable (PreInline a)
forall a. Eq a => a -> PreInline a a -> Bool
forall a. Num a => PreInline a a -> a
forall a. Ord a => PreInline a a -> a
forall m. Monoid m => PreInline a m -> m
forall a. PreInline a a -> Bool
forall a. PreInline a a -> Int
forall a. PreInline a a -> [a]
forall a. (a -> a -> a) -> PreInline a a -> a
forall a a. Eq a => a -> PreInline a a -> Bool
forall a a. Num a => PreInline a a -> a
forall a a. Ord a => PreInline a a -> a
forall m a. Monoid m => (a -> m) -> PreInline a a -> m
forall a m. Monoid m => PreInline a m -> m
forall a a. PreInline a a -> Bool
forall a a. PreInline a a -> Int
forall a a. PreInline a a -> [a]
forall b a. (b -> a -> b) -> b -> PreInline a a -> b
forall a b. (a -> b -> b) -> b -> PreInline a a -> b
forall a a. (a -> a -> a) -> PreInline a a -> a
forall a m a. Monoid m => (a -> m) -> PreInline a a -> m
forall a b a. (b -> a -> b) -> b -> PreInline a a -> b
forall a a b. (a -> b -> b) -> b -> PreInline a a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall a m. Monoid m => PreInline a m -> m
fold :: forall m. Monoid m => PreInline a m -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> PreInline a a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> PreInline a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> PreInline a a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> PreInline a a -> m
$cfoldr :: forall a a b. (a -> b -> b) -> b -> PreInline a a -> b
foldr :: forall a b. (a -> b -> b) -> b -> PreInline a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> PreInline a a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> PreInline a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> PreInline a a -> b
foldl :: forall b a. (b -> a -> b) -> b -> PreInline a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> PreInline a a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> PreInline a a -> b
$cfoldr1 :: forall a a. (a -> a -> a) -> PreInline a a -> a
foldr1 :: forall a. (a -> a -> a) -> PreInline a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> PreInline a a -> a
foldl1 :: forall a. (a -> a -> a) -> PreInline a a -> a
$ctoList :: forall a a. PreInline a a -> [a]
toList :: forall a. PreInline a a -> [a]
$cnull :: forall a a. PreInline a a -> Bool
null :: forall a. PreInline a a -> Bool
$clength :: forall a a. PreInline a a -> Int
length :: forall a. PreInline a a -> Int
$celem :: forall a a. Eq a => a -> PreInline a a -> Bool
elem :: forall a. Eq a => a -> PreInline a a -> Bool
$cmaximum :: forall a a. Ord a => PreInline a a -> a
maximum :: forall a. Ord a => PreInline a a -> a
$cminimum :: forall a a. Ord a => PreInline a a -> a
minimum :: forall a. Ord a => PreInline a a -> a
$csum :: forall a a. Num a => PreInline a a -> a
sum :: forall a. Num a => PreInline a a -> a
$cproduct :: forall a a. Num a => PreInline a a -> a
product :: forall a. Num a => PreInline a a -> a
Foldable, Functor (PreInline a)
Foldable (PreInline a)
(Functor (PreInline a), Foldable (PreInline a)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> PreInline a a -> f (PreInline a b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    PreInline a (f a) -> f (PreInline a a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> PreInline a a -> m (PreInline a b))
-> (forall (m :: * -> *) a.
    Monad m =>
    PreInline a (m a) -> m (PreInline a a))
-> Traversable (PreInline a)
forall a. Functor (PreInline a)
forall a. Foldable (PreInline a)
forall a (m :: * -> *) a.
Monad m =>
PreInline a (m a) -> m (PreInline a a)
forall a (f :: * -> *) a.
Applicative f =>
PreInline a (f a) -> f (PreInline a a)
forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PreInline a a -> m (PreInline a b)
forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PreInline a a -> f (PreInline a b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
PreInline a (m a) -> m (PreInline a a)
forall (f :: * -> *) a.
Applicative f =>
PreInline a (f a) -> f (PreInline a a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PreInline a a -> m (PreInline a b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PreInline a a -> f (PreInline a b)
$ctraverse :: forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PreInline a a -> f (PreInline a b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PreInline a a -> f (PreInline a b)
$csequenceA :: forall a (f :: * -> *) a.
Applicative f =>
PreInline a (f a) -> f (PreInline a a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
PreInline a (f a) -> f (PreInline a a)
$cmapM :: forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PreInline a a -> m (PreInline a b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PreInline a a -> m (PreInline a b)
$csequence :: forall a (m :: * -> *) a.
Monad m =>
PreInline a (m a) -> m (PreInline a a)
sequence :: forall (m :: * -> *) a.
Monad m =>
PreInline a (m a) -> m (PreInline a a)
Traversable, (forall x. PreInline a b -> Rep (PreInline a b) x)
-> (forall x. Rep (PreInline a b) x -> PreInline a b)
-> Generic (PreInline a b)
forall x. Rep (PreInline a b) x -> PreInline a b
forall x. PreInline a b -> Rep (PreInline a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (PreInline a b) x -> PreInline a b
forall a b x. PreInline a b -> Rep (PreInline a b) x
$cfrom :: forall a b x. PreInline a b -> Rep (PreInline a b) x
from :: forall x. PreInline a b -> Rep (PreInline a b) x
$cto :: forall a b x. Rep (PreInline a b) x -> PreInline a b
to :: forall x. Rep (PreInline a b) x -> PreInline a b
Generic, (forall a. PreInline a a -> Rep1 (PreInline a) a)
-> (forall a. Rep1 (PreInline a) a -> PreInline a a)
-> Generic1 (PreInline a)
forall a. Rep1 (PreInline a) a -> PreInline a a
forall a. PreInline a a -> Rep1 (PreInline a) a
forall a a. Rep1 (PreInline a) a -> PreInline a a
forall a a. PreInline a a -> Rep1 (PreInline a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall a a. PreInline a a -> Rep1 (PreInline a) a
from1 :: forall a. PreInline a a -> Rep1 (PreInline a) a
$cto1 :: forall a a. Rep1 (PreInline a) a -> PreInline a a
to1 :: forall a. Rep1 (PreInline a) a -> PreInline a a
Generic1)

-- booleans

type BoolExp a = PreInline CondOp a
type CondInfo a = Inline CondOp a

-- Conditional operators
data CondOp
    = TrueOp | FalseOp | And | Or
    | Equals | NotEquals | Less | Greater | LessEquals | GreaterEquals
    deriving (Int -> CondOp -> ShowS
[CondOp] -> ShowS
CondOp -> String
(Int -> CondOp -> ShowS)
-> (CondOp -> String) -> ([CondOp] -> ShowS) -> Show CondOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CondOp -> ShowS
showsPrec :: Int -> CondOp -> ShowS
$cshow :: CondOp -> String
show :: CondOp -> String
$cshowList :: [CondOp] -> ShowS
showList :: [CondOp] -> ShowS
Show, CondOp -> CondOp -> Bool
(CondOp -> CondOp -> Bool)
-> (CondOp -> CondOp -> Bool) -> Eq CondOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CondOp -> CondOp -> Bool
== :: CondOp -> CondOp -> Bool
$c/= :: CondOp -> CondOp -> Bool
/= :: CondOp -> CondOp -> Bool
Eq, Eq CondOp
Eq CondOp =>
(CondOp -> CondOp -> Ordering)
-> (CondOp -> CondOp -> Bool)
-> (CondOp -> CondOp -> Bool)
-> (CondOp -> CondOp -> Bool)
-> (CondOp -> CondOp -> Bool)
-> (CondOp -> CondOp -> CondOp)
-> (CondOp -> CondOp -> CondOp)
-> Ord CondOp
CondOp -> CondOp -> Bool
CondOp -> CondOp -> Ordering
CondOp -> CondOp -> CondOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CondOp -> CondOp -> Ordering
compare :: CondOp -> CondOp -> Ordering
$c< :: CondOp -> CondOp -> Bool
< :: CondOp -> CondOp -> Bool
$c<= :: CondOp -> CondOp -> Bool
<= :: CondOp -> CondOp -> Bool
$c> :: CondOp -> CondOp -> Bool
> :: CondOp -> CondOp -> Bool
$c>= :: CondOp -> CondOp -> Bool
>= :: CondOp -> CondOp -> Bool
$cmax :: CondOp -> CondOp -> CondOp
max :: CondOp -> CondOp -> CondOp
$cmin :: CondOp -> CondOp -> CondOp
min :: CondOp -> CondOp -> CondOp
Ord, (forall x. CondOp -> Rep CondOp x)
-> (forall x. Rep CondOp x -> CondOp) -> Generic CondOp
forall x. Rep CondOp x -> CondOp
forall x. CondOp -> Rep CondOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CondOp -> Rep CondOp x
from :: forall x. CondOp -> Rep CondOp x
$cto :: forall x. Rep CondOp x -> CondOp
to :: forall x. Rep CondOp x -> CondOp
Generic)

isTrue, isFalse :: CondInfo a -> Bool

isTrue :: forall a. CondInfo a -> Bool
isTrue  = CondOp -> CondInfo a -> Bool
forall a. CondOp -> CondInfo a -> Bool
isCondOp CondOp
TrueOp
isFalse :: forall a. CondInfo a -> Bool
isFalse = CondOp -> CondInfo a -> Bool
forall a. CondOp -> CondInfo a -> Bool
isCondOp CondOp
FalseOp

isCondOp :: CondOp -> CondInfo a -> Bool
isCondOp :: forall a. CondOp -> CondInfo a -> Bool
isCondOp CondOp
op = Bool -> (CondOp -> Bool) -> Maybe CondOp -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (CondOp
op CondOp -> CondOp -> Bool
forall a. Eq a => a -> a -> Bool
== ) (Maybe CondOp -> Bool)
-> (CondInfo a -> Maybe CondOp) -> CondInfo a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondInfo a -> Maybe CondOp
forall a. CondInfo a -> Maybe CondOp
getCondInfoOp

getCondInfoOp :: CondInfo a -> Maybe CondOp
getCondInfoOp :: forall a. CondInfo a -> Maybe CondOp
getCondInfoOp CondInfo a
x = case CondInfo a -> InlineExp CondOp
forall op arg. Inline op arg -> InlineExp op
inlineExp CondInfo a
x of
    InlineExp CondOp
op [InlineExp CondOp]
_ -> CondOp -> Maybe CondOp
forall a. a -> Maybe a
Just CondOp
op
    InlineExp CondOp
_ -> Maybe CondOp
forall a. Maybe a
Nothing

-- Numeric expressions (or Csound infix operators)

type NumExp a = PreInline NumOp a

data NumOp = Add | Sub | Neg | Mul | Div | Pow | Mod
    deriving (Int -> NumOp -> ShowS
[NumOp] -> ShowS
NumOp -> String
(Int -> NumOp -> ShowS)
-> (NumOp -> String) -> ([NumOp] -> ShowS) -> Show NumOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NumOp -> ShowS
showsPrec :: Int -> NumOp -> ShowS
$cshow :: NumOp -> String
show :: NumOp -> String
$cshowList :: [NumOp] -> ShowS
showList :: [NumOp] -> ShowS
Show, NumOp -> NumOp -> Bool
(NumOp -> NumOp -> Bool) -> (NumOp -> NumOp -> Bool) -> Eq NumOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumOp -> NumOp -> Bool
== :: NumOp -> NumOp -> Bool
$c/= :: NumOp -> NumOp -> Bool
/= :: NumOp -> NumOp -> Bool
Eq, Eq NumOp
Eq NumOp =>
(NumOp -> NumOp -> Ordering)
-> (NumOp -> NumOp -> Bool)
-> (NumOp -> NumOp -> Bool)
-> (NumOp -> NumOp -> Bool)
-> (NumOp -> NumOp -> Bool)
-> (NumOp -> NumOp -> NumOp)
-> (NumOp -> NumOp -> NumOp)
-> Ord NumOp
NumOp -> NumOp -> Bool
NumOp -> NumOp -> Ordering
NumOp -> NumOp -> NumOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NumOp -> NumOp -> Ordering
compare :: NumOp -> NumOp -> Ordering
$c< :: NumOp -> NumOp -> Bool
< :: NumOp -> NumOp -> Bool
$c<= :: NumOp -> NumOp -> Bool
<= :: NumOp -> NumOp -> Bool
$c> :: NumOp -> NumOp -> Bool
> :: NumOp -> NumOp -> Bool
$c>= :: NumOp -> NumOp -> Bool
>= :: NumOp -> NumOp -> Bool
$cmax :: NumOp -> NumOp -> NumOp
max :: NumOp -> NumOp -> NumOp
$cmin :: NumOp -> NumOp -> NumOp
min :: NumOp -> NumOp -> NumOp
Ord, (forall x. NumOp -> Rep NumOp x)
-> (forall x. Rep NumOp x -> NumOp) -> Generic NumOp
forall x. Rep NumOp x -> NumOp
forall x. NumOp -> Rep NumOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NumOp -> Rep NumOp x
from :: forall x. NumOp -> Rep NumOp x
$cto :: forall x. Rep NumOp x -> NumOp
to :: forall x. Rep NumOp x -> NumOp
Generic)

-------------------------------------------------------
-- instances for cse that ghc was not able to derive for me

instance Foldable PrimOr where foldMap :: forall m a. Monoid m => (a -> m) -> PrimOr a -> m
foldMap = (a -> m) -> PrimOr a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Traversable PrimOr where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PrimOr a -> f (PrimOr b)
traverse a -> f b
f PrimOr a
x = case PrimOr a -> Either Prim a
forall a. PrimOr a -> Either Prim a
unPrimOr PrimOr a
x of
        Left  Prim
p -> PrimOr b -> f (PrimOr b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimOr b -> f (PrimOr b)) -> PrimOr b -> f (PrimOr b)
forall a b. (a -> b) -> a -> b
$ Either Prim b -> PrimOr b
forall a. Either Prim a -> PrimOr a
PrimOr (Either Prim b -> PrimOr b) -> Either Prim b -> PrimOr b
forall a b. (a -> b) -> a -> b
$ Prim -> Either Prim b
forall a b. a -> Either a b
Left Prim
p
        Right a
a -> Either Prim b -> PrimOr b
forall a. Either Prim a -> PrimOr a
PrimOr (Either Prim b -> PrimOr b)
-> (b -> Either Prim b) -> b -> PrimOr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either Prim b
forall a b. b -> Either a b
Right (b -> PrimOr b) -> f b -> f (PrimOr b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

----------------------------------------------------------

-- | Multiple output. Specify the number of outputs to get the result.
type MultiOut a = Int -> a

------------------------------------------------------
-- hashable instances

$(deriveEq1 ''PrimOr)
$(deriveEq1 ''PreInline)
$(deriveEq1 ''Inline)
$(deriveEq1 ''CodeBlock)
$(deriveEq1 ''MainExp)
$(deriveEq1 ''RatedExp)

$(deriveOrd1 ''PrimOr)
$(deriveOrd1 ''PreInline)
$(deriveOrd1 ''Inline)
$(deriveOrd1 ''CodeBlock)
$(deriveOrd1 ''MainExp)
$(deriveOrd1 ''RatedExp)

$(deriveShow1 ''PrimOr)
$(deriveShow1 ''PreInline)
$(deriveShow1 ''Inline)
$(deriveShow1 ''CodeBlock)
$(deriveShow1 ''MainExp)
$(deriveShow1 ''RatedExp)

deriving instance Generic1 IM.IntMap

isEmptyExp :: E -> Bool
isEmptyExp :: E -> Bool
isEmptyExp (Fix RatedExp E
re) = Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (RatedExp E -> Maybe Int
forall a. RatedExp a -> Maybe Int
ratedExpDepends RatedExp E
re) Bool -> Bool -> Bool
&&
  (case RatedExp E -> Exp E
forall a. RatedExp a -> Exp a
ratedExpExp RatedExp E
re of
    Exp E
EmptyExp -> Bool
True
    Exp E
_ -> Bool
False
  )

--------------------------------------------------------------
-- comments
--
-- p-string
--
--    separate p-param for strings (we need it to read strings from global table)
--    Csound doesn't permits us to use more than four string params so we need to
--    keep strings in the global table and use `strget` to read them