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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
byg/src/ComputationM.hs
View File

@ -13,7 +13,7 @@ data TypedRun a b where
FunctionIO :: IsFunctionIO f a b => f -> TypedRun a b FunctionIO :: IsFunctionIO f a b => f -> TypedRun a b
Inject :: b -> TypedRun () b Inject :: b -> TypedRun () b
GetListElem :: TypedRun [b] b GetListElem :: TypedRun [b] b
SetListElem :: TypedRun a () SetListElem :: TypedRun a [a]
MapComp :: [DependencyUntyped] -> TypedRun [a] [b] MapComp :: [DependencyUntyped] -> TypedRun [a] [b]
deriving instance (Show a, Show b) => Show (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 :: ComputationM () -> [DependencyUntyped]
evalComputationM m = fst (evalComputationM' 0 m) evalComputationM m = fst (evalComputationM' 0 m)
genDependency :: (Show u, Show a) => (Token a -> Dependency u a) -> ComputationM a genDependency' :: (Show u, Show a) => (Token a -> ComputationM' (Dependency u a)) -> ComputationM a
genDependency g = do genDependency' f = do
top <- get top <- get
let top' = top + 1 let top' = top + 1
target = Token top' target = Token top'
put top' put top'
let result = g target result <- f target
tell [DependencyUntyped result (show result)] tell [DependencyUntyped result (show result)]
pure target 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 :: Show a => a -> ComputationM a
inject x = genDependency (Dependency NoToken (Inject x)) inject x = genDependency (Dependency NoToken (Inject x))
getListElem :: Show a => Token [a] -> ComputationM a getListElem :: Show a => Token [a] -> ComputationM a
getListElem outer = genDependency (Dependency outer GetListElem) getListElem outer = genDependency (Dependency outer GetListElem)
setListElem :: Show a => Token a -> ComputationM () setListElem :: Show a => Token a -> Token [a] -> ComputationM ()
setListElem a = genDependency (Dependency a SetListElem) 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 :: (Show a, Show b, IsFunction f a b) => f -> Token a -> ComputationM b
run f input = genDependency (Dependency input (Function f)) run f input = genDependency (Dependency input (Function f))
@ -79,13 +85,11 @@ saveFile = runIO SaveFile
runPandoc = runIO RunPandoc runPandoc = runIO RunPandoc
mapComputationM :: (Show a, Show b) => (Token a -> ComputationM b) -> Token [a] -> ComputationM [b] 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 top <- get
let (res, top') = evalComputationM' top m let (res, top') = evalComputationM' top $ do
put top'
genDependency (Dependency input (MapComp res))
where m :: ComputationM ()
m = do
inp <- getListElem input inp <- getListElem input
outp <- f inp outp <- f inp
setListElem outp setListElem outp target
put top'
pure (Dependency input (MapComp res) target)