csound-expression-typed 0.2.7.1 → 0.2.8.0
raw patch · 18 files changed
+192/−174 lines, 18 filesdep ~csound-expression-dynamicPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: csound-expression-dynamic
API changes (from Hackage documentation)
- Csound.Typed.Types.Tuple: dirtyTuple :: forall a. Tuple a => GE (MultiOut [E]) -> SE a
+ Csound.Typed.GlobalState.Options: setDebugTrace :: Options
+ Csound.Typed.GlobalState.Options: setVerbatimFlags :: Text -> Options
+ Csound.Typed.GlobalState.SE: [newTmpVarNum] :: LocalHistory -> !Int
- Csound.Typed.Control.Ref: whileRef :: forall st. Tuple st => st -> (st -> SE BoolSig) -> (st -> SE st) -> SE ()
+ Csound.Typed.Control.Ref: whileRef :: forall st. Tuple st => st -> (st -> BoolSig) -> (st -> SE st) -> SE ()
- Csound.Typed.Control.Ref: whileRefD :: forall st. Tuple st => st -> (st -> SE BoolD) -> (st -> SE st) -> SE ()
+ Csound.Typed.Control.Ref: whileRefD :: forall st. Tuple st => st -> (st -> BoolD) -> (st -> SE st) -> SE ()
- Csound.Typed.GlobalState: Instrs :: Map ByteString InstrId -> Int -> [(InstrId, InstrBody)] -> Instrs
+ Csound.Typed.GlobalState: Instrs :: Map ExpHash InstrId -> Int -> [(InstrId, InstrBody)] -> Instrs
- Csound.Typed.GlobalState: [instrsCache] :: Instrs -> Map ByteString InstrId
+ Csound.Typed.GlobalState: [instrsCache] :: Instrs -> Map ExpHash InstrId
- Csound.Typed.GlobalState.Elements: Instrs :: Map ByteString InstrId -> Int -> [(InstrId, InstrBody)] -> Instrs
+ Csound.Typed.GlobalState.Elements: Instrs :: Map ExpHash InstrId -> Int -> [(InstrId, InstrBody)] -> Instrs
- Csound.Typed.GlobalState.Elements: [instrsCache] :: Instrs -> Map ByteString InstrId
+ Csound.Typed.GlobalState.Elements: [instrsCache] :: Instrs -> Map ExpHash InstrId
- Csound.Typed.GlobalState.SE: LocalHistory :: !E -> !Int -> !Int -> LocalHistory
+ Csound.Typed.GlobalState.SE: LocalHistory :: !E -> !Int -> !Int -> !Int -> LocalHistory
- Csound.Typed.Render: renderEff :: (Sigs a, Sigs b) => (a -> SE b) -> IO String
+ Csound.Typed.Render: renderEff :: (Sigs a, Sigs b) => (a -> SE b) -> IO Text
- Csound.Typed.Render: renderEffBy :: (Sigs a, Sigs b) => Options -> (a -> SE b) -> IO String
+ Csound.Typed.Render: renderEffBy :: (Sigs a, Sigs b) => Options -> (a -> SE b) -> IO Text
- Csound.Typed.Render: renderOut :: Sigs a => SE a -> IO String
+ Csound.Typed.Render: renderOut :: Sigs a => SE a -> IO Text
- Csound.Typed.Render: renderOutBy :: Sigs a => Options -> SE a -> IO String
+ Csound.Typed.Render: renderOutBy :: Sigs a => Options -> SE a -> IO Text
- Csound.Typed.Render: renderOutBy_ :: Options -> SE () -> IO String
+ Csound.Typed.Render: renderOutBy_ :: Options -> SE () -> IO Text
- Csound.Typed.Render: renderOut_ :: SE () -> IO String
+ Csound.Typed.Render: renderOut_ :: SE () -> IO Text
- Csound.Typed.Types.Tuple: arg :: Arg a => Int -> a
+ Csound.Typed.Types.Tuple: arg :: forall a. Arg a => Int -> a
Files
- csound-expression-typed.cabal +2/−2
- src/Csound/Typed/Control/Api.hs +2/−2
- src/Csound/Typed/Control/ArrayTraverse.hs +11/−14
- src/Csound/Typed/Control/Midi.hs +1/−2
- src/Csound/Typed/Control/Ref.hs +28/−27
- src/Csound/Typed/GlobalState/Elements.hs +16/−18
- src/Csound/Typed/GlobalState/GE.hs +3/−3
- src/Csound/Typed/GlobalState/Instr.hs +4/−4
- src/Csound/Typed/GlobalState/Opcodes.hs +21/−21
- src/Csound/Typed/GlobalState/Options.hs +13/−1
- src/Csound/Typed/Gui/Widget.hs +9/−9
- src/Csound/Typed/Plugins/AmbiRow.hs +2/−2
- src/Csound/Typed/Plugins/TapeEcho.hs +1/−1
- src/Csound/Typed/Render.hs +7/−6
- src/Csound/Typed/Types/Array.hs +24/−24
- src/Csound/Typed/Types/Prim.hs +13/−13
- src/Csound/Typed/Types/SigSpace.hs +0/−1
- src/Csound/Typed/Types/Tuple.hs +35/−24
csound-expression-typed.cabal view
@@ -1,5 +1,5 @@ Name: csound-expression-typed-Version: 0.2.7.1+Version: 0.2.8.0 Cabal-Version: 1.12 License: BSD3 License-file: LICENSE@@ -81,7 +81,7 @@ filepath, directory, wl-pprint-text >= 1.2.0,- csound-expression-dynamic >= 0.3.9.1,+ csound-expression-dynamic >= 0.4.0.0, temporal-media >= 0.6.3, hashable, text
src/Csound/Typed/Control/Api.hs view
@@ -57,9 +57,9 @@ args <- fromTuple (pch, vol, other) return $ do D.when1 D.IfIr (noteFlagExpr ==* 1) $ do- D.toBlock $ eventi (Event instrIdExpr 0 (-1) args)+ eventi (Event instrIdExpr 0 (-1) args) D.when1 D.IfIr (noteFlagExpr ==* 0) $ do- D.toBlock $ eventi (Event (negate instrIdExpr) 0 0 args)+ eventi (Event (negate instrIdExpr) 0 0 args) turnoff -- | Creates an instrument that can be triggered by name with Csound API.
src/Csound/Typed/Control/ArrayTraverse.hs view
@@ -15,8 +15,8 @@ ------------------------------------------------------------------------- -- Functional style traversals -whileRefBegin :: SigOrD a => Ref a -> SE ()-whileRefBegin (Ref vars) = fromDep_ $ D.whileRef $ head vars+whileRefBegin :: SigOrD a => Ref a -> SE () -> SE ()+whileRefBegin (Ref vars) = undefined -- TODO -- fromDep_ $ D.whileRef $ head vars -- | Traverses all elements of the array array and applies a procedure to each element. -- The procedure takes in a pair of index and the current value at the given index.@@ -47,15 +47,12 @@ val <- readArr array ix body (ix, val) (n, var, condVar) : rest -> do- whileRefBegin condVar-- recWhile vars rest-- modifyRef var (+ 1)- ix <- readRef var- writeRef condVar (ifB (ix `lessThan` getArrayLength n array) 1 0)+ whileRefBegin condVar $ do+ recWhile vars rest - fromDep_ D.whileEnd+ modifyRef var (+ 1)+ ix <- readRef var+ writeRef condVar (ifB (ix `lessThan` getArrayLength n array) 1 0) arity = tupleArity (Proxy :: Proxy ix) @@ -66,7 +63,7 @@ forRowArr :: (Tuple a) => Sig -> Arr Sig2 a -> ((Sig, a) -> SE ()) -> SE () forRowArr rowId array phi = whileRef 0 condition body where- condition ix = return $ ix `lessThan` lenarray array `withD` 2+ condition ix = ix `lessThan` lenarray array `withD` 2 body ix = do val <- readArr array (rowId, ix)@@ -78,7 +75,7 @@ forColumnArr :: (Tuple a) => Sig -> Arr Sig2 a -> ((Sig, a) -> SE ()) -> SE () forColumnArr colId array phi = whileRef 0 condition body where- condition ix = return $ ix `lessThan` lenarray array `withD` 1+ condition ix = ix `lessThan` lenarray array `withD` 1 body ix = do val <- readArr array (ix, colId)@@ -89,7 +86,7 @@ forRowArrD :: Tuple a => D -> Arr D2 a -> ((D, a) -> SE ()) -> SE () forRowArrD rowId array phi = whileRefD 0 condition body where- condition ix = return $ ix `lessThan` lenarray array `withD` 2+ condition ix = ix `lessThan` lenarray array `withD` 2 body ix = do val <- readArr array (rowId, ix)@@ -100,7 +97,7 @@ forColumnArrD :: Tuple a => D -> Arr D2 a -> ((D, a) -> SE ()) -> SE () forColumnArrD colId array phi = whileRefD 0 condition body where- condition ix = return $ ix `lessThan` lenarray array `withD` 1+ condition ix = ix `lessThan` lenarray array `withD` 1 body ix = do val <- readArr array (ix, colId)
src/Csound/Typed/Control/Midi.hs view
@@ -75,9 +75,8 @@ initMidiCtrl chno ctrlno val = geToSe $ saveMidiCtrl =<< (MidiCtrl <$> toGE chno <*> toGE ctrlno <*> toGE val) - ----------------------------------------------------------------- -- midi volume factor scaleMidiVolumeFactor :: Sigs a => a -> a-scaleMidiVolumeFactor = mapTuple (setRate Ir (C.midiVolumeFactor (pn 1)) * )+scaleMidiVolumeFactor = mapTuple (setRate Ir (C.midiVolumeFactor (pn Ir 1)) * )
src/Csound/Typed/Control/Ref.hs view
@@ -13,7 +13,7 @@ import Control.Monad import Control.Monad.Trans.Class-import Csound.Dynamic hiding (when1, newLocalVars, writeArr, readArr, whileRef)+import Csound.Dynamic hiding (when1, newLocalVars, writeArr, readArr, toCtrlRate) import Csound.Typed.Types.Prim import Csound.Typed.Types.Tuple@@ -32,14 +32,14 @@ writeRef :: Tuple a => Ref a -> a -> SE () writeRef (Ref vars) a = fromDep_ $ hideGEinDep $ do vals <- fromTuple a- return $ zipWithM_ writeVar vars vals+ return $ zipWithM_ (writeVar IfKr) vars vals -- (zipWithM_ writeVar vars) =<< lift (fromTuple a) --writeVar :: Var -> E -> Dep () --[Var] (GE [E]) readRef :: Tuple a => Ref a -> SE a-readRef (Ref vars) = SE $ fmap (toTuple . return) $ mapM readVar vars+readRef (Ref vars) = SE $ fmap (toTuple . return) $ mapM (readVar IfKr) vars -- | Allocates a new local (it is visible within the instrument) mutable value and initializes it with value. -- A reference can contain a tuple of variables.@@ -103,7 +103,7 @@ -- to mutable value but a pair of reader and writer functions. globalSensorsSE :: Tuple a => a -> SE (SE a, a -> SE ()) globalSensorsSE a = do- ref <- newRef a+ ref <- newGlobalRef a return $ (readRef ref, writeRef ref) -- | Allocates a new clearable global mutable value and initializes it with value.@@ -145,35 +145,36 @@ -- -- csound doc: <http://www.csounds.com/manual/html/ftgentmp.html> ftgentmp :: D -> D -> D -> D -> D -> [D] -> SE Tab-ftgentmp b1 b2 b3 b4 b5 b6 = fmap ( Tab . return) $ SE $ (depT =<<) $ lift $ f <$> unD b1 <*> unD b2 <*> unD b3 <*> unD b4 <*> unD b5 <*> mapM unD b6- where f a1 a2 a3 a4 a5 a6 = opcs "ftgentmp" [(Ir,(repeat Ir))] ([a1,a2,a3,a4,a5] ++ a6)+ftgentmp b1 b2 b3 b4 b5 b6 =+ fmap ( Tab . return) $+ SE $ join $ f <$> unD' b1 <*> unD' b2 <*> unD' b3 <*> unD' b4 <*> unD' b5 <*> mapM unD' b6+ where+ f a1 a2 a3 a4 a5 a6 = opcsDep "ftgentmp" [(Ir,(repeat Ir))] ([a1,a2,a3,a4,a5] ++ a6)+ unD' = lift . unD -------------------------------------------------------------------- -whileRef :: forall st . Tuple st => st -> (st -> SE BoolSig) -> (st -> SE st) -> SE ()+whileRef :: forall st . Tuple st => st -> (st -> BoolSig) -> (st -> SE st) -> SE () whileRef initVal c body = do refSt <- newCtrlRef initVal- refCond <- newRef =<< condSig =<< readRef refSt- whileRefBegin refCond- writeRef refSt =<< body =<< readRef refSt- writeRef refCond =<< condSig =<< readRef refSt- fromDep_ whileEnd- where- condSig :: st -> SE Sig- condSig = fmap (\b -> ifB b 1 0) . c-+ whileRefBy IfKr c refSt $ do+ writeRef refSt =<< body =<< readRef refSt -whileRefD :: forall st . Tuple st => st -> (st -> SE BoolD) -> (st -> SE st) -> SE ()+whileRefD :: forall st . Tuple st => st -> (st -> BoolD) -> (st -> SE st) -> SE () whileRefD initVal c body = do refSt <- newCtrlRef initVal- refCond <- newRef =<< condSig =<< readRef refSt- whileRefBegin refCond- writeRef refSt =<< body =<< readRef refSt- writeRef refCond =<< condSig =<< readRef refSt- fromDep_ whileEnd- where- condSig :: st -> SE D- condSig = fmap (\b -> ifB b 1 0) . c+ whileRefBy IfIr c refSt $ do+ writeRef refSt =<< body =<< readRef refSt -whileRefBegin :: SigOrD a => Ref a -> SE ()-whileRefBegin (Ref vars) = fromDep_ $ D.whileRef $ head vars+whileRefBy :: (Val bool, Tuple a) => IfRate -> (a -> bool) -> Ref a -> SE () -> SE ()+whileRefBy ifRate check (Ref vars) = ifBlockBy (D.whileBlock ifRate) (check $ toTuple $ pure $ fmap (D.inlineVar ifRate) vars)++-- | Constructs generic if-block statement with single then case+-- We can choose constructors for: if, while, until statements+ifBlockBy :: Val cond => (E -> DepT GE () -> DepT GE ()) -> cond -> SE () -> SE ()+ifBlockBy cons p body =+ fromDep_ $ do+ pE <- lift $ toGE p+ cons pE (unSE body)++
src/Csound/Typed/GlobalState/Elements.hs view
@@ -49,8 +49,6 @@ ) where import Data.List-import Data.ByteString (ByteString)- import Control.Monad.Trans.State.Strict import Control.Monad(zipWithM_) import Data.Default@@ -186,7 +184,7 @@ newSf = saveId sfVar :: Int -> E-sfVar n = readOnlyVar (VarVerbatim Ir $ sfEngineName n)+sfVar n = readOnlyVar IfIr (VarVerbatim Ir $ sfEngineName n) sfEngineName :: Int -> Text sfEngineName n = "gi_Sf_engine_" <> Text.pack (show n)@@ -221,7 +219,7 @@ bandLimitedIdToExpr :: BandLimitedId -> E bandLimitedIdToExpr x = case x of SimpleBandLimitedWave simpleId -> int simpleId- UserBandLimitedWave userId -> noRate $ ReadVar $ bandLimitedVar userId+ UserBandLimitedWave userId -> noRate $ ReadVar IfIr $ bandLimitedVar userId bandLimitedVar :: Show a => a -> Var bandLimitedVar userId = Var GlobalVar Ir ("BandLim" <> Text.pack (show userId))@@ -264,7 +262,7 @@ isEmptyBlMap m = (M.null $ simpleBandLimitedMap m) && (M.null $ idMapContent $ vcoInitMap m) render lastGenId gens vcos = do- writeVar freeVcoVar $ int (lastGenId + length gens + 100)+ writeVar IfIr freeVcoVar $ int (lastGenId + length gens + 100) mapM_ (renderGen lastGenId) gens mapM_ renderVco vcos @@ -277,20 +275,20 @@ freeVcoVar = Var GlobalVar Ir "free_vco" ftVar n = Var GlobalVar Ir $ "vco_table_" <> Text.pack (show n) - renderFtgen lastGenId (g, n) = writeVar (ftVar n) $ ftgen (int $ lastGenId + n) g+ renderFtgen lastGenId (g, n) = writeVar IfIr (ftVar n) $ ftgen (int $ lastGenId + n) g renderVcoGen ftId = do- ft <- readVar (ftVar ftId)- free <- readVar freeVcoVar- writeVar freeVcoVar $ vco2init [-ft, free, 1.05, -1, -1, ft]+ ft <- readVar IfIr (ftVar ftId)+ free <- readVar IfIr freeVcoVar+ writeVar IfIr freeVcoVar $ vco2init [-ft, free, 1.05, -1, -1, ft] - renderVcoVarAssignment n = writeVar (bandLimitedVar n) =<< (fmap negate $ readVar (ftVar n))+ renderVcoVarAssignment n = writeVar IfIr (bandLimitedVar n) =<< (fmap negate $ readVar IfIr (ftVar n)) renderVco :: Monad m => (BandLimited, BandLimitedId) -> DepT m () renderVco (_bandLimited, blId) = case blId of SimpleBandLimitedWave waveId -> do- free <- readVar freeVcoVar- writeVar freeVcoVar $ vco2init [int waveId, free]+ free <- readVar IfIr freeVcoVar+ writeVar IfIr freeVcoVar $ vco2init [int waveId, free] UserBandLimitedWave _ -> return () readBandLimited :: Maybe E -> BandLimitedId -> E -> E@@ -385,7 +383,7 @@ AllocArrVar var sizes -> initArr var sizes clearAlloc x = case x of- AllocVar _ var initProc -> writeVar var initProc+ AllocVar _ var initProc -> writeVar IfKr var initProc AllocArrVar _ _ -> return () isClearable x = case x of@@ -396,7 +394,7 @@ -- instrs data Instrs = Instrs- { instrsCache :: M.Map ByteString InstrId+ { instrsCache :: M.Map ExpHash InstrId , instrsNewId :: Int , instrsContent :: [(InstrId, InstrBody)] }@@ -439,15 +437,15 @@ getIn :: Monad m => Int -> DepT m [E] getIn arity | arity == 0 = return []- | otherwise = ($ arity ) $ mdepT $ mopcs "inch" (replicate arity Ar, replicate arity Kr) (fmap int [1 .. arity])+ | otherwise = mopcsDep arity "inch" (replicate arity Ar, replicate arity Kr) (fmap int [1 .. arity]) sendOut :: Monad m => Int -> [E] -> DepT m () sendOut arity sigs | arity == 0 = return () | otherwise = do vars <- newLocalVars (replicate arity Ar) (return $ replicate arity 0)- zipWithM_ writeVar vars sigs- vals <- mapM readVar vars+ zipWithM_ (writeVar IfKr) vars sigs+ vals <- mapM (readVar IfKr) vars depT_ $ opcsNoInlineArgs name [(Xr, replicate arity Ar)] vals where name@@ -463,7 +461,7 @@ sendGlobal :: Monad m => Int -> [E] -> State Globals ([E], DepT m ()) sendGlobal arityOuts sigs = do vars <- mapM (uncurry newClearableGlobalVar) $ replicate arityOuts (Ar, 0)- return (fmap readOnlyVar vars, zipWithM_ (appendVarBy (+)) vars sigs)+ return (fmap (readOnlyVar IfKr) vars, zipWithM_ (appendVarBy (+) IfKr) vars sigs) sendChn :: Monad m => Int -> Int -> [E] -> DepT m () sendChn arityIns arityOuts sigs = writeChn (chnRefFromParg (chnPargId arityIns) arityOuts) sigs
src/Csound/Typed/GlobalState/GE.hs view
@@ -510,11 +510,11 @@ let keys = flKeyIn isChange = changed keys ==* 1 when1 IfKr isChange $ do- toBlock $ whens IfKr (fmap (uncurry $ listenEvt keys) events) (toBlock doNothing)+ whens IfKr (fmap (uncurry $ listenEvt keys) events) doNothing where doNothing = return () - listenEvt keySig keyCode var = (keySig ==* int keyCode, toBlock $ writeVar var 1)+ listenEvt keySig keyCode var = (keySig ==* int keyCode, writeVar IfKr var 1) events = IM.toList keyMap @@ -535,7 +535,7 @@ -- osc port listen getOscPortHandle :: Int -> GE E-getOscPortHandle port = onOscPorts (fmap inlineVar $ getOscPortVar port)+getOscPortHandle port = onOscPorts (fmap (inlineVar IfIr) $ getOscPortVar port) where onOscPorts = onHistory (\h -> (oscListenPorts h, globals h)) (\(ports, gs) h -> h { oscListenPorts = ports, globals = gs })
src/Csound/Typed/GlobalState/Instr.hs view
@@ -88,10 +88,10 @@ saveMidiInstr midiType channel arity instr = do setDurationToInfinite vars <- onGlobals $ sequence $ replicate (arityOuts arity) (C.newClearableGlobalVar Ar 0)- let expr = (SE . zipWithM_ (appendVarBy (+)) vars) =<< instr+ let expr = (SE . zipWithM_ (appendVarBy (+) IfKr) vars) =<< instr instrId <- saveInstr expr saveMidi $ MidiAssign midiType channel instrId- return $ fmap readOnlyVar vars+ return $ fmap (readOnlyVar IfKr) vars saveMidiMap :: GE () saveMidiMap = do@@ -106,8 +106,8 @@ saveIns0 :: Int -> [Rate] -> SE [E] -> GE [E] saveIns0 arity rates as = do vars <- onGlobals $ zipWithM C.newPersistentGlobalVar rates (replicate arity 0)- saveUserInstr0 $ unSE $ (SE . zipWithM_ writeVar vars) =<< as- return $ fmap readOnlyVar vars+ saveUserInstr0 $ unSE $ (SE . zipWithM_ (writeVar IfIr) vars) =<< as+ return $ fmap (readOnlyVar IfIr) vars terminatorInstr :: GE (SE ()) terminatorInstr = do
src/Csound/Typed/GlobalState/Opcodes.hs view
@@ -53,7 +53,7 @@ , chnRefNames :: [E] } chnRefFromParg :: Int -> Int -> ChnRef-chnRefFromParg pargId arity = ChnRef (pn pargId) $ fmap (flip chnName (pn pargId)) [1 .. arity]+chnRefFromParg pargId arity = ChnRef (pn Ir pargId) $ fmap (flip chnName (pn Ir pargId)) [1 .. arity] chnRefAlloc :: Monad m => Int -> DepT m ChnRef chnRefAlloc arity = do@@ -89,26 +89,26 @@ servantUpdateChnAlive :: Monad m => Int -> DepT m () servantUpdateChnAlive pargId = do- let sName = chnAliveName (pn pargId)+ let sName = chnAliveName (pn Ir pargId) kAlive <- chngetK sName when1 IfKr (kAlive <* -10) $ do- toBlock turnoff+ turnoff chnsetK sName (kAlive - 1) getRetrigVal :: Int -> E-getRetrigVal pargId = pn $ pargId + 1+getRetrigVal pargId = pn Ir $ pargId + 1 servantUpdateChnRetrig :: Monad m => Int -> DepT m () servantUpdateChnRetrig pargId = do- let sName = chnRetrigName (pn pargId)- let retrigVal = pn $ pargId + 1+ let sName = chnRetrigName (pn Ir pargId)+ let retrigVal = pn Ir $ pargId + 1 kRetrig <- chngetK sName when1 IfKr (kRetrig /=* retrigVal) $ do- toBlock turnoff+ turnoff servantUpdateChnEvtLoop :: Monad m => Int -> DepT m () servantUpdateChnEvtLoop pargId = do- let sName = chnEvtLoopName (pn pargId)+ let sName = chnEvtLoopName (pn Ir pargId) kEvtLoop <- chngetK sName chnsetK sName (ifExp IfKr (kEvtLoop ==* 0) 1 0) turnoff@@ -134,18 +134,18 @@ chnmix :: Monad m => E -> E -> DepT m () chnmix asig name = do var <- newLocalVar Ar (return 0)- writeVar var asig- val <- readVar var+ writeVar IfKr var asig+ val <- readVar IfKr var depT_ $ opcsNoInlineArgs "chnmix" [(Xr, [Ar, Sr])] [val, name] chnset :: Monad m => E -> E -> DepT m () chnset name value = depT_ $ opcs "chnset" [(Xr, [Ar, Sr])] [value, name] chnget :: Monad m => E -> DepT m E-chnget name = depT $ opcs "chnget" [(Ar, [Sr])] [name]+chnget name = opcsDep "chnget" [(Ar, [Sr])] [name] chngetK :: Monad m => E -> DepT m E-chngetK name = depT $ opcs "chnget" [(Kr, [Sr])] [name]+chngetK name = opcsDep "chnget" [(Kr, [Sr])] [name] chnsetK :: Monad m => E -> E -> DepT m () chnsetK name val = depT_ $ opcsNoInlineArgs "chnset" [(Xr, [Kr, Sr])] [val, name]@@ -166,7 +166,7 @@ chnUpdateOpcodeName = "FreePort" freeChn :: Monad m => DepT m E-freeChn = depT $ opcs chnUpdateOpcodeName [(Ir, [])] []+freeChn = opcsDep chnUpdateOpcodeName [(Ir, [])] [] -- trigger @@ -235,7 +235,7 @@ autoOff dt a = do ihold when1 IfKr (trig a) $- toBlock turnoff+ turnoff return a where trig = (<* eps) . (env + ) . setRate Kr . flip follow dt . l2@@ -329,7 +329,7 @@ oscInit portExpr = opcs "OSCinit" [(Ir, [Ir])] [portExpr] oscListen :: Monad m => E -> E -> E -> [Var] -> DepT m E-oscListen oscHandle addr oscType vars = depT $ opcs "OSClisten" [(Kr, Ir:Ir:Ir:repeat Xr)] (oscHandle : addr : oscType : fmap inlineVar vars)+oscListen oscHandle addr oscType vars = opcsDep "OSClisten" [(Kr, Ir:Ir:Ir:repeat Xr)] (oscHandle : addr : oscType : fmap (inlineVar IfKr) vars) oscSend :: Monad m => [E] -> DepT m () oscSend args = depT_ $ opcs "OSCsend" [(Xr, Kr:Ir:Ir:Ir:Ir:repeat Xr)] args@@ -338,7 +338,7 @@ -- Channel chnGet :: Monad m => Rate -> E -> DepT m E-chnGet r chn = depT $ opcs "chnget" [(r, [Sr])] [chn]+chnGet r chn = opcsDep "chnget" [(r, [Sr])] [chn] chnSet :: Monad m => Rate -> E -> E -> DepT m () chnSet r val chn = depT_ $ opcs "chnset" [(Xr, [r, Sr])] [val, chn]@@ -353,26 +353,26 @@ -- times times :: Monad m => DepT m E-times = depT $ opcs "times" [(Ir, []), (Kr, [])] []+times = opcsDep "times" [(Ir, []), (Kr, [])] [] ----------------------------------------------------------- -- fluid engine fluidEngine :: Monad m => DepT m E-fluidEngine = depT $ opcs "fluidEngine" [(Ir, [])] []+fluidEngine = opcsDep "fluidEngine" [(Ir, [])] [] fluidLoad :: Monad m => String -> E -> DepT m E-fluidLoad sfName engine = depT $ opcs "fluidLoad" [(Ir, [Sr, Ir, Ir])] [str sfName, engine, 1]+fluidLoad sfName engine = opcsDep "fluidLoad" [(Ir, [Sr, Ir, Ir])] [str sfName, engine, 1] fluidProgramSelect :: Monad m => E -> E -> Int -> Int -> DepT m E-fluidProgramSelect engine sfInstr bank prog = depT $ opcs "fluidProgramSelect"+fluidProgramSelect engine sfInstr bank prog = opcsDep "fluidProgramSelect" [(Xr, replicate 5 Ir)] [engine, 1, sfInstr, int bank, int prog] ----------------------------------------------------------- -- soundfonts sfload :: Monad m => Text -> DepT m E-sfload fileName = depT $ opcs "sfload" [(Ir, [Sr])] [prim $ PrimString fileName]+sfload fileName = opcsDep "sfload" [(Ir, [Sr])] [prim $ PrimString fileName] sfplist :: Monad m => E -> DepT m () sfplist sf = depT_ $ opcs "sfplist" [(Xr, [Ir])] [sf]
src/Csound/Typed/GlobalState/Options.hs view
@@ -19,7 +19,9 @@ -- * Jacko Jacko(..), JackoConnect, renderJacko, -- * Debug trace- csdNeedTrace+ csdNeedTrace,+ setDebugTrace,+ setVerbatimFlags ) where import Control.Applicative@@ -32,6 +34,7 @@ import Data.Text qualified as Text import Csound.Dynamic hiding (csdFlags)+import Csound.Dynamic.Debug -- | Csound options. The default values are --@@ -258,3 +261,12 @@ csdNeedTrace :: Options -> Bool csdNeedTrace opt = fromMaybe False $ csdTrace opt++setDebugTrace :: Options+setDebugTrace =+ def { csdRender =+ Just $ RenderOptions {+ inferenceOptions = def { opcodeInferenceDebug = IsDebug True } } }++setVerbatimFlags :: Text -> Options+setVerbatimFlags flags = def { csdFlags = def { flagsVerbatim = Just flags } }
src/Csound/Typed/Gui/Widget.hs view
@@ -365,19 +365,19 @@ instrId <- geToSe $ saveInstr $ instr flag geToSe $ (saveAlwaysOnInstr =<< ) $ saveInstr $ instrCh flag flagChanged (g, _) <- singleOut Nothing (Button instrId)- val <- fmap fromGE $ fromDep $ readVar flagChanged+ val <- fmap fromGE $ fromDep $ readVar IfKr flagChanged return (g, sigToEvt val) where instr ref = SE $ do- val <- readVar ref+ val <- readVar IfKr ref whens IfKr- [ (val ==* 0, toBlock $ writeVar ref 1)- ] (toBlock $ writeVar ref 0)+ [ (val ==* 0, writeVar IfKr ref 1)+ ] (writeVar IfKr ref 0) turnoff instrCh ref refCh = SE $ do- val <- readVar ref- writeVar refCh (C.changed val)+ val <- readVar IfKr ref+ writeVar IfKr refCh (C.changed val) -- | A FLTK widget opcode that creates a toggle button. --@@ -464,15 +464,15 @@ -- | The stream of keyboard press/release events. keyIn :: KeyEvt -> Evt Unit keyIn evt = boolToEvt $ asig ==* 1- where asig = Sig $ fmap readOnlyVar $ listenKeyEvt evt+ where asig = Sig $ fmap (readOnlyVar IfKr) $ listenKeyEvt evt -- Outputs readD :: Var -> SE D-readD v = fmap (D . return) $ SE $ readVar v+readD v = fmap (D . return) $ SE $ readVar IfIr v readSig :: Var -> Sig-readSig v = Sig $ return $ readOnlyVar v+readSig v = Sig $ return $ readOnlyVar IfKr v refHandle :: GuiHandle -> SE D
src/Csound/Typed/Plugins/AmbiRow.hs view
@@ -12,11 +12,11 @@ ambiRow (Arr sFiles) kSpeed kIndex iFadeTime = toTuple $ fmap ($ 2) $ do addUdoPlugin E.ambiRowPlugin f sFiles <$> toGE kSpeed <*> toGE kIndex <*> toGE iFadeTime- where f sFiles' kSpeed' kIndex' iFadeTime' = mopcs "AmbiRow" ([Ar, Ar], [Sr, Kr, Kr, Ir]) [inlineVar $ head sFiles', kSpeed', kIndex', iFadeTime']+ where f sFiles' kSpeed' kIndex' iFadeTime' = mopcs "AmbiRow" ([Ar, Ar], [Sr, Kr, Kr, Ir]) [inlineVar IfKr $ head sFiles', kSpeed', kIndex', iFadeTime'] ambiRowMp3 :: Arr1 Str -> Sig -> Sig -> D -> Sig2 ambiRowMp3 (Arr sFiles) kSpeed kIndex iFadeTime = toTuple $ fmap ($ 2) $ do addUdoPlugin E.ambiRowMp3Plugin f sFiles <$> toGE kSpeed <*> toGE kIndex <*> toGE iFadeTime- where f sFiles' kSpeed' kIndex' iFadeTime' = mopcs "AmbiRowMp3" ([Ar, Ar], [Sr, Kr, Kr, Ir]) [inlineVar $ head sFiles', kSpeed', kIndex', iFadeTime']+ where f sFiles' kSpeed' kIndex' iFadeTime' = mopcs "AmbiRowMp3" ([Ar, Ar], [Sr, Kr, Kr, Ir]) [inlineVar IfKr $ head sFiles', kSpeed', kIndex', iFadeTime']
src/Csound/Typed/Plugins/TapeEcho.hs view
@@ -24,7 +24,7 @@ -- the higher the worser the quality of the tape. -- opcode tapeRead, a, akk tapeRead :: Sig -> Sig -> Sig -> SE Sig-tapeRead ain kdel kRandomSpread = fmap (Sig . return) $ SE $ (depT =<<) $ lift $ do+tapeRead ain kdel kRandomSpread = fmap (Sig . return) $ SE $ lift $ do addUdoPlugin E.tapeEchoPlugin f <$> toGE ain <*> toGE kdel <*> toGE kRandomSpread where f ain' kdel' krand' = opcs "tapeRead" [(Ar, [Ar, Kr, Kr])] [ain', kdel', krand']
src/Csound/Typed/Render.hs view
@@ -22,6 +22,7 @@ import System.Directory import System.FilePath import Text.Read (readMaybe)+import Data.Text (Text) import Text.PrettyPrint.Leijen.Text (displayTStrict, renderPretty) @@ -54,10 +55,10 @@ else do return () -renderOut_ :: SE () -> IO String+renderOut_ :: SE () -> IO Text renderOut_ = renderOutBy_ def -renderOutBy_ :: Options -> SE () -> IO String+renderOutBy_ :: Options -> SE () -> IO Text renderOutBy_ options sigs = do finalOptions <- fmap (maybe options (options `mappend` )) getUserOptions evalGE finalOptions $ fmap (renderCsd renderOpts) $ toCsd Nothing finalOptions (fmap (const unit) sigs)@@ -65,20 +66,20 @@ renderOpts = fromMaybe def $ csdRender options -renderOut :: Sigs a => SE a -> IO String+renderOut :: Sigs a => SE a -> IO Text renderOut = renderOutBy def -renderOutBy :: Sigs a => Options -> SE a -> IO String+renderOutBy :: Sigs a => Options -> SE a -> IO Text renderOutBy options sigs = do finalOptions <- fmap (maybe options (options `mappend` )) getUserOptions evalGE finalOptions $ fmap (renderCsd renderOpts) $ toCsd Nothing finalOptions sigs where renderOpts = fromMaybe def $ csdRender options -renderEff :: (Sigs a, Sigs b) => (a -> SE b) -> IO String+renderEff :: (Sigs a, Sigs b) => (a -> SE b) -> IO Text renderEff = renderEffBy def -renderEffBy :: (Sigs a, Sigs b) => Options -> (a -> SE b) -> IO String+renderEffBy :: (Sigs a, Sigs b) => Options -> (a -> SE b) -> IO Text renderEffBy options eff = do finalOptions <- fmap (maybe options (options `mappend` )) getUserOptions evalGE finalOptions $ fmap (renderCsd renderOpts) $ toCsd (Just (arityIns $ funArity eff)) finalOptions (eff =<< getIns)
src/Csound/Typed/Types/Array.hs view
@@ -34,7 +34,7 @@ import Data.Proxy import Data.Text (Text) -import Csound.Dynamic hiding (writeArr, writeInitArr, readArr, newLocalArrVar, newTmpArrVar, int)+import Csound.Dynamic hiding (writeArr, writeInitArr, readArr, newLocalArrVar, newTmpArrVar, int, toCtrlRate) import qualified Csound.Dynamic as D import Csound.Typed.Types.Prim@@ -181,7 +181,7 @@ return $ mapM (\v -> read' v ixsExp) vars where read' :: Var -> [E] -> Dep E- read' = D.readArr+ read' = D.readArr IfKr -- | Writes data to the array. writeArr :: (Tuple ix, Tuple a) => Arr ix a -> ix -> a -> SE ()@@ -191,7 +191,7 @@ return $ zipWithM_ (\var value -> write var ixsExp value) vars bsExp where write :: Var -> [E] -> E -> Dep ()- write = D.writeArr+ write = D.writeArr IfKr -- | Writes data to the array. writeInitArr :: (Tuple ix, Tuple a) => Arr ix a -> ix -> a -> SE ()@@ -201,7 +201,7 @@ return $ zipWithM_ (\var value -> write var ixsExp value) vars bsExp where write :: Var -> [E] -> E -> Dep ()- write = D.writeInitArr+ write = D.writeInitArr IfKr -- | Updates the value of the array with pure function. modifyArr :: (Tuple a, Tuple ix) => Arr ix a -> ix -> (a -> a) -> SE ()@@ -232,20 +232,20 @@ divArrayNew = binOp "/" lenarray :: SigOrD c => Arr a b -> c-lenarray (Arr vs) = fromGE $ return $ f (inlineVar $ head vs)+lenarray (Arr vs) = fromGE $ return $ f (inlineVar IfKr $ head vs) where f a = opcs "lenarray" [(Kr, [Xr, Ir]), (Ir, [Xr, Ir])] [a] -- | Copies table to array. copyf2array :: Arr Sig Sig -> Tab -> SE () copyf2array (Arr vs) t = SE $ hideGEinDep $ do tabExp <- toGE t- return $ depT_ $ opcs "copyf2array" [(Xr, [varRate $ head vs, Ir])] [inlineVar $ head vs, tabExp]+ return $ depT_ $ opcs "copyf2array" [(Xr, [varRate $ head vs, Ir])] [inlineVar IfKr $ head vs, tabExp] -- | Copies array to table. copya2ftab :: Arr Sig Sig -> Tab -> SE () copya2ftab (Arr vs) t = SE $ hideGEinDep $ do tabExp <- toGE t- return $ depT_ $ opcs "copya2ftab" [(Xr, [varRate $ head vs, Ir])] [inlineVar $ head vs, tabExp]+ return $ depT_ $ opcs "copya2ftab" [(Xr, [varRate $ head vs, Ir])] [inlineVar IfKr $ head vs, tabExp] -- | Mapps all values in the array with the function. --@@ -257,7 +257,7 @@ where go var strExp = do outVar <- unSE $ newTmpArrVar (varRate var)- opcsArr isArrayInit outVar "slicearray" idRate [inlineVar var, strExp]+ opcsArr isArrayInit outVar "slicearray" idRate [inlineVar IfKr var, strExp] return $ outVar idRate = fmap (\rate -> (rate, [rate, Ir, Ir])) [Ir, Kr, Ar]@@ -282,7 +282,7 @@ return $ zipWithM_ (\var (aExp, bExp) -> go var (aExp, bExp)) vs (zip aExps bExps) where go v (aExp, bExp) =- depT_ $ opcs "copyf2array" [(Xr, [varRate $ head vs, Ir])] [inlineVar v, aExp, bExp]+ depT_ $ opcs "copyf2array" [(Xr, [varRate $ head vs, Ir])] [inlineVar IfKr v, aExp, bExp] -- | Creates a copy of some part of the given array slicearrayNew :: Arr D a -> (D, D) -> SE (Arr D a)@@ -293,7 +293,7 @@ where go var (fromExpr, toExpr) = do outVar <- unSE $ newTmpArrVar (varRate var)- opcsArr isArrayInit outVar "slicearray" idRate [inlineVar var, fromExpr, toExpr]+ opcsArr isArrayInit outVar "slicearray" idRate [inlineVar IfKr var, fromExpr, toExpr] return $ outVar idRate = fmap (\rate -> (rate, [rate, Ir, Ir])) [Ir, Kr, Ar]@@ -424,7 +424,7 @@ where go x y = SE $ do outVar <- unSE $ newTmpArrVar (varRate x)- infOprArr isArrayInit outVar name (inlineVar x) (inlineVar y)+ infOprArr isArrayInit outVar name (inlineVar IfKr x) (inlineVar IfKr y) return outVar convert :: Text -> Arr a b -> SE (Arr a b)@@ -432,7 +432,7 @@ where go v = SE $ do outVar <- unSE $ newTmpArrVar (varRate v)- opcsArr isArrayInit outVar name idRate1 [inlineVar v]+ opcsArr isArrayInit outVar name idRate1 [inlineVar IfKr v] return outVar idRate1 = fmap (\r -> (r, [r])) [Kr, Ar, Ir, Sr, Fr]@@ -442,24 +442,24 @@ where go x y = SE $ do outVar <- unSE $ newTmpArrVar (varRate x)- opcsArr isArrayInit outVar name idRate2 [inlineVar x, inlineVar y]+ opcsArr isArrayInit outVar name idRate2 [inlineVar IfKr x, inlineVar IfKr y] return outVar idRate2 = fmap (\r -> (r, [r, r])) [Kr, Ar, Ir, Sr, Fr] extractArray :: (Tuple b) => Text -> Arr a b -> SE b-extractArray name (Arr vs) = SE $ fmap (toTuple . return) $ mapM (f . inlineVar) vs- where f a = depT $ opcs name [(Xr, [Xr])] [a]+extractArray name (Arr vs) = SE $ fmap (toTuple . return) $ mapM (f . inlineVar IfKr) vs+ where f a = opcsDep name [(Xr, [Xr])] [a] extract1 :: (Tuple b, Tuple c) => Rate -> Text -> Arr a b -> SE c-extract1 rate name (Arr vs) = SE $ fmap (toTuple . return) $ mapM (f . inlineVar) vs- where f a = depT $ opcs name [(rate, [Xr])] [a]+extract1 rate name (Arr vs) = SE $ fmap (toTuple . return) $ mapM (f . inlineVar IfKr) vs+ where f a = opcsDep name [(rate, [Xr])] [a] extractWith :: (Tuple b, Tuple c, Tuple d) => Text -> (Rate, [Rate]) -> Arr a b -> c -> SE d extractWith name rates (Arr vs) argument = SE $ fmap (toTuple . return) $ hideGEinDep $ do argExps <- fromTuple argument- return $ zipWithM (\var x -> f (inlineVar var) x) vs argExps- where f a b = depT $ opcs name [rates] [a, b]+ return $ zipWithM (\var x -> f (inlineVar IfKr var) x) vs argExps+ where f a b = opcsDep name [rates] [a, b] --------------------------------------------------- -- opcodes with copy@@ -470,7 +470,7 @@ strExp <- toGE s return $ zipWithM_ (\var outVar -> go var strExp outVar) vs outs where- go var strExp outVar = opcsArr noArrayInit outVar "slicearray" idRate [inlineVar var, strExp]+ go var strExp outVar = opcsArr noArrayInit outVar "slicearray" idRate [inlineVar IfKr var, strExp] idRate = fmap (\rate -> (rate, [rate, Ir, Ir])) [Ir, Kr, Ar] -- | Copies a part of array to another array.@@ -480,7 +480,7 @@ toExpr <- toGE to return $ zipWithM_ (\var outVar -> go var (fromExpr, toExpr) outVar) vs outs where- go var (fromExpr, toExpr) outVar = opcsArr noArrayInit outVar "slicearray" idRate [inlineVar var, fromExpr, toExpr]+ go var (fromExpr, toExpr) outVar = opcsArr noArrayInit outVar "slicearray" idRate [inlineVar IfKr var, fromExpr, toExpr] idRate = fmap (\rate -> (rate, [rate, Ir, Ir])) [Ir, Kr, Ar] -- | Multiplies two arrays and copies the result into third array.@@ -605,17 +605,17 @@ binOpCopy :: Text -> Arr a b -> Arr a b -> Arr a b -> SE () binOpCopy name (Arr xs) (Arr ys) (Arr outs) = mapM_ go $ zip3 xs ys outs where- go (x, y, outVar) = SE $ infOprArr noArrayInit outVar name (inlineVar x) (inlineVar y)+ go (x, y, outVar) = SE $ infOprArr noArrayInit outVar name (inlineVar IfKr x) (inlineVar IfKr y) convertCopy :: Text -> Arr a b -> Arr a b -> SE () convertCopy name (Arr vars) (Arr outs) = zipWithM_ go vars outs where- go v outVar = SE $ opcsArr noArrayInit outVar name idRate1 [inlineVar v]+ go v outVar = SE $ opcsArr noArrayInit outVar name idRate1 [inlineVar IfKr v] idRate1 = fmap (\r -> (r, [r])) [Kr, Ar, Ir, Sr, Fr] convert2Copy :: Text -> Arr a b -> Arr a b -> Arr a b -> SE () convert2Copy name (Arr xs) (Arr ys) (Arr outs) = mapM_ go $ zip3 xs ys outs where- go (x, y, outVar) = SE $ opcsArr noArrayInit outVar name idRate2 [inlineVar x, inlineVar y]+ go (x, y, outVar) = SE $ opcsArr noArrayInit outVar name idRate2 [inlineVar IfKr x, inlineVar IfKr y] idRate2 = fmap (\r -> (r, [r, r])) [Kr, Ar, Ir, Sr, Fr]
src/Csound/Typed/Types/Prim.hs view
@@ -324,27 +324,27 @@ -- | Querries a total duration of the note. It's equivallent to Csound's @p3@ field. idur :: D-idur = fromE $ pn 3+idur = fromE $ pn Ir 3 getSampleRate :: D-getSampleRate = fromE $ readOnlyVar (VarVerbatim Ir "sr")+getSampleRate = fromE $ readOnlyVar IfIr (VarVerbatim Ir "sr") getControlRate :: D-getControlRate = fromE $ readOnlyVar (VarVerbatim Ir "kr")+getControlRate = fromE $ readOnlyVar IfIr (VarVerbatim Ir "kr") getBlockSize :: D-getBlockSize = fromE $ readOnlyVar (VarVerbatim Ir "ksmps")+getBlockSize = fromE $ readOnlyVar IfIr (VarVerbatim Ir "ksmps") getZeroDbfs :: D-getZeroDbfs = fromE $ readOnlyVar (VarVerbatim Ir "0dbfs")+getZeroDbfs = fromE $ readOnlyVar IfIr (VarVerbatim Ir "0dbfs") -- | Gets the global BPM value. getBpm :: Sig-getBpm = fromE $ readOnlyVar bpmVar+getBpm = fromE $ readOnlyVar IfKr bpmVar -- | Sets the global BPM value. setBpm :: Sig -> SE ()-setBpm x = fromDep_ $ hideGEinDep $ fmap (writeVar bpmVar) (toGE x)+setBpm x = fromDep_ $ hideGEinDep $ fmap (writeVar IfKr bpmVar) (toGE x) ------------------------------------------------------------------------------- -- converters@@ -661,11 +661,11 @@ -- | Constructs generic if-block statement with single then case -- We can choose constructors for: if, while, until statements-ifBlockBy :: Val cond => (E -> DepT GE (CodeBlock E) -> DepT GE ()) -> cond -> SE () -> SE ()+ifBlockBy :: Val cond => (E -> DepT GE () -> DepT GE ()) -> cond -> SE () -> SE () ifBlockBy cons p body = fromDep_ $ do pE <- lift $ toGE p- cons pE (toBlock $ unSE body)+ cons pE (unSE body) -- | Invokes the given procedure if the boolean signal is true. when1 :: BoolSig -> SE () -> SE ()@@ -680,8 +680,8 @@ [] -> el _ -> fromDep_ $ join $ lift $ do checksE <- mapM (toGE . fst) bodies- let bodiesE = fmap (toBlock . unSE . snd) bodies- elE = toBlock $ unSE el+ let bodiesE = fmap (unSE . snd) bodies+ elE = unSE el pure $ D.whens IfKr (zip checksE bodiesE) elE -- | Invokes the given procedure if the boolean signal is true.@@ -697,8 +697,8 @@ [] -> el _ -> fromDep_ $ join $ lift $ do checksE <- mapM (toGE . fst) bodies- let bodiesE = fmap (toBlock . unSE . snd) bodies- elE = toBlock $ unSE el+ let bodiesE = fmap (unSE . snd) bodies+ elE = unSE el pure $ D.whens IfIr (zip checksE bodiesE) elE untilDo :: BoolSig -> SE () -> SE ()
src/Csound/Typed/Types/SigSpace.hs view
@@ -36,7 +36,6 @@ class SigSpace2 a => BindSig2 a where bindSig2 :: (Sig2 -> SE Sig2) -> a -> SE a - -- | Scaling the sound. mul :: SigSpace a => Sig -> a -> a mul k = mapSig (k * )
src/Csound/Typed/Types/Tuple.hs view
@@ -6,6 +6,7 @@ RankNTypes, ScopedTypeVariables, InstanceSigs,+ AllowAmbiguousTypes, CPP #-} module Csound.Typed.Types.Tuple( -- ** Tuple@@ -27,14 +28,13 @@ ifArg, guardedArg, caseArg, -- ** Constructors- pureTuple, dirtyTuple+ pureTuple ) where import Control.Arrow import Control.Applicative import Control.Monad-import Control.Monad.Trans.Class import Data.Default import Data.Boolean import Data.Proxy@@ -146,7 +146,7 @@ multiOuts :: forall a . Tuple a => E -> a multiOuts expr =- toTuple $ return $ mo (tupleArity (Proxy :: Proxy a)) expr+ toTuple $ return $ mo (tupleRates (Proxy :: Proxy a)) expr ar1 :: Sig -> Sig ar2 :: (Sig, Sig) -> (Sig, Sig)@@ -196,24 +196,42 @@ -- Arguments class (Tuple a) => Arg a where+ getArgRates :: [Rate] -instance Arg Unit-instance Arg D-instance Arg Str-instance Arg Tab-instance Arg TabList+instance Arg Unit where+ getArgRates = [] -instance (Arg a, Arg b) => Arg (a, b)-instance (Arg a, Arg b, Arg c) => Arg (a, b, c)-instance (Arg a, Arg b, Arg c, Arg d) => Arg (a, b, c, d)-instance (Arg a, Arg b, Arg c, Arg d, Arg e) => Arg (a, b, c, d, e)-instance (Arg a, Arg b, Arg c, Arg d, Arg e, Arg f) => Arg (a, b, c, d, e, f)-instance (Arg a, Arg b, Arg c, Arg d, Arg e, Arg f, Arg h) => Arg (a, b, c, d, e, f, h)-instance (Arg a, Arg b, Arg c, Arg d, Arg e, Arg f, Arg h, Arg g) => Arg (a, b, c, d, e, f, h, g)+instance Arg D where+ getArgRates = [Ir] -arg :: Arg a => Int -> a-arg n = toTuple $ return $ fmap pn [n ..]+instance Arg Str where+ getArgRates = [Sr] +instance Arg Tab where+ getArgRates = [Ir]++instance Arg TabList where+ getArgRates = [Ir]++instance (Arg a, Arg b) => Arg (a, b) where+ getArgRates = getArgRates @a <> getArgRates @b++instance (Arg a, Arg b, Arg c) => Arg (a, b, c) where+ getArgRates = getArgRates @a <> getArgRates @b <> getArgRates @c+instance (Arg a, Arg b, Arg c, Arg d) => Arg (a, b, c, d) where+ getArgRates = getArgRates @a <> getArgRates @b <> getArgRates @c <> getArgRates @d+instance (Arg a, Arg b, Arg c, Arg d, Arg e) => Arg (a, b, c, d, e) where+ getArgRates = getArgRates @a <> getArgRates @b <> getArgRates @c <> getArgRates @d <> getArgRates @e+instance (Arg a, Arg b, Arg c, Arg d, Arg e, Arg f) => Arg (a, b, c, d, e, f) where+ getArgRates = getArgRates @a <> getArgRates @b <> getArgRates @c <> getArgRates @d <> getArgRates @e <> getArgRates @f+instance (Arg a, Arg b, Arg c, Arg d, Arg e, Arg f, Arg h) => Arg (a, b, c, d, e, f, h) where+ getArgRates = getArgRates @a <> getArgRates @b <> getArgRates @c <> getArgRates @d <> getArgRates @e <> getArgRates @f <> getArgRates @h+instance (Arg a, Arg b, Arg c, Arg d, Arg e, Arg f, Arg h, Arg g) => Arg (a, b, c, d, e, f, h, g) where+ getArgRates = getArgRates @a <> getArgRates @b <> getArgRates @c <> getArgRates @d <> getArgRates @e <> getArgRates @f <> getArgRates @h <> getArgRates @g++arg :: forall a . Arg a => Int -> a+arg n = toTuple $ return $ zipWith pn (getArgRates @a) [n ..]+ toArg :: Arg a => a toArg = arg 4 @@ -296,10 +314,3 @@ pureTuple :: forall a . Tuple a => GE (MultiOut [E]) -> a pureTuple a = toTuple $ fmap ($ tupleArity (Proxy :: Proxy a)) a---dirtyTuple :: forall a . Tuple a => GE (MultiOut [E]) -> SE a-dirtyTuple a =- fmap (toTuple . return) $ SE- $ mapM depT =<< (lift $ fmap ($ (tupleArity (Proxy :: Proxy a))) a)-