diff --git a/byg/src/ComputationM.hs b/byg/src/ComputationM.hs index 25ee2cd..b566a8b 100644 --- a/byg/src/ComputationM.hs +++ b/byg/src/ComputationM.hs @@ -13,7 +13,7 @@ data TypedRun a b where FunctionIO :: IsFunctionIO f a b => f -> TypedRun a b Inject :: b -> TypedRun () b GetListElem :: TypedRun [b] b - SetListElem :: TypedRun a () + SetListElem :: TypedRun a [a] MapComp :: [DependencyUntyped] -> TypedRun [a] [b] deriving instance (Show a, Show b) => Show (TypedRun a b) @@ -44,24 +44,30 @@ evalComputationM' top m = runState (execWriterT (unComputationM m)) top evalComputationM :: ComputationM () -> [DependencyUntyped] evalComputationM m = fst (evalComputationM' 0 m) -genDependency :: (Show u, Show a) => (Token a -> Dependency u a) -> ComputationM a -genDependency g = do +genDependency' :: (Show u, Show a) => (Token a -> ComputationM' (Dependency u a)) -> ComputationM a +genDependency' f = do top <- get let top' = top + 1 target = Token top' put top' - let result = g target + result <- f target tell [DependencyUntyped result (show result)] pure target +genDependency :: (Show u, Show a) => (Token a -> Dependency u a) -> ComputationM a +genDependency g = genDependency' (\t -> pure $ g t) + inject :: Show a => a -> ComputationM a inject x = genDependency (Dependency NoToken (Inject x)) getListElem :: Show a => Token [a] -> ComputationM a getListElem outer = genDependency (Dependency outer GetListElem) -setListElem :: Show a => Token a -> ComputationM () -setListElem a = genDependency (Dependency a SetListElem) +setListElem :: Show a => Token a -> Token [a] -> ComputationM () +setListElem a outer = do + tell [DependencyUntyped d (show d)] + pure NoToken + where d = Dependency a SetListElem outer run :: (Show a, Show b, IsFunction f a b) => f -> Token a -> ComputationM b run f input = genDependency (Dependency input (Function f)) @@ -79,13 +85,11 @@ saveFile = runIO SaveFile runPandoc = runIO RunPandoc mapComputationM :: (Show a, Show b) => (Token a -> ComputationM b) -> Token [a] -> ComputationM [b] -mapComputationM f input = do +mapComputationM f input = genDependency' $ \target -> do top <- get - let (res, top') = evalComputationM' top m + let (res, top') = evalComputationM' top $ do + inp <- getListElem input + outp <- f inp + setListElem outp target put top' - genDependency (Dependency input (MapComp res)) - where m :: ComputationM () - m = do - inp <- getListElem input - outp <- f inp - setListElem outp + pure (Dependency input (MapComp res) target)