ngws
/
mad
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Implement DependencyRunner for MapComp

This commit is contained in:
Niels G. W. Serup 2024-09-27 21:13:16 +02:00
parent 53e9598d22
commit d3b32398b5
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
1 changed files with 15 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
byg/src/DependencyRunner.hs
View File

@ -1,5 +1,7 @@
module DependencyRunner module DependencyRunner
( runDeps ( DepRunM
, runDeps
, runDepRunM
) where ) where
import Types (Value(..), Valuable(..)) import Types (Value(..), Valuable(..))
@ -9,7 +11,7 @@ import Evaluation.FunctionIO
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as M import qualified Data.Map as M
import Control.Monad.State (MonadState, MonadIO, StateT, runState, put, get, modify, liftIO) import Control.Monad.State (MonadState, MonadIO, StateT, evalStateT, get, modify, liftIO)
newtype DepRunM a = DepRunM { unDepRunM :: StateT (Map Int Value) IO a } newtype DepRunM a = DepRunM { unDepRunM :: StateT (Map Int Value) IO a }
deriving (Functor, Applicative, Monad, MonadIO, MonadState (Map Int Value)) deriving (Functor, Applicative, Monad, MonadIO, MonadState (Map Int Value))
@ -17,6 +19,9 @@ newtype DepRunM a = DepRunM { unDepRunM :: StateT (Map Int Value) IO a }
runDeps :: [Dependency] -> DepRunM () runDeps :: [Dependency] -> DepRunM ()
runDeps = mapM_ runDep runDeps = mapM_ runDep
runDepRunM :: DepRunM a -> IO a
runDepRunM m = evalStateT (unDepRunM m) M.empty
runDep :: Dependency -> DepRunM () runDep :: Dependency -> DepRunM ()
runDep (Dependency a action b) = do runDep (Dependency a action b) = do
input <- getTokenValue a input <- getTokenValue a
@ -91,4 +96,11 @@ runAction action input = case action of
_ -> _ ->
error "unexpected" error "unexpected"
MapComp subDeps innerInput innerOutput -> MapComp subDeps innerInput innerOutput ->
undefined case input of
List vs ->
(List <$>) $ flip mapM vs $ \v -> do
putTokenValue innerInput v
runDeps subDeps
getTokenValue innerOutput
_ ->
error "unexpected"