Connect SetListElem to outer output list

This commit is contained in:
Niels G. W. Serup 2024-09-21 19:47:50 +02:00
parent 8c7e311338
commit 4884136dad
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
1 changed files with 18 additions and 14 deletions

View File

@ -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
put top'
genDependency (Dependency input (MapComp res))
where m :: ComputationM ()
m = do
let (res, top') = evalComputationM' top $ do
inp <- getListElem input
outp <- f inp
setListElem outp
setListElem outp target
put top'
pure (Dependency input (MapComp res) target)