packages feed

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 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)-