diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs index 4a92f16..cb402d5 100644 --- a/byg/src/DependencyGenerator.hs +++ b/byg/src/DependencyGenerator.hs @@ -41,10 +41,10 @@ import Types.Values import Types.Value (Valuable(..)) import Types.Function (Function(..)) import Types.FunctionIO (FunctionIO(..)) -import Types.Dependency (Action(..), Dependency, makeDependency) +import Types.Dependency (Action(..), Dependency, makeDependency, makeUToken) import Control.Monad.State (MonadState, State, runState, put, get) -import Control.Monad.Writer (MonadWriter, WriterT, execWriterT, tell) +import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell) import Data.Text (Text) newtype DepGenM a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a } @@ -52,21 +52,26 @@ newtype DepGenM a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a } type DepGenM' a = DepGenM (Token a) -evalDepGenM' :: Int -> DepGenM () -> ([Dependency], Int) -evalDepGenM' top m = runState (execWriterT (unDepGenM m)) top +runDepGenM :: Int -> DepGenM a -> ((a, [Dependency]), Int) +runDepGenM top m = runState (runWriterT (unDepGenM m)) top evalDepGenM :: DepGenM () -> [Dependency] -evalDepGenM m = fst (evalDepGenM' 0 m) +evalDepGenM = snd . fst . runDepGenM 0 tellDep :: Dependency -> DepGenM () tellDep dep = tell [dep] -genDependencyM :: (Token a -> DepGenM Dependency) -> DepGenM' a -genDependencyM f = do +newToken :: DepGenM' a +newToken = do top <- get let top' = top + 1 target = Token top' put top' + pure target + +genDependencyM :: (Token a -> DepGenM Dependency) -> DepGenM' a +genDependencyM f = do + target <- newToken result <- f target tellDep result pure target @@ -77,13 +82,6 @@ genDependency f = genDependencyM (pure . f) inject :: Valuable a => a -> DepGenM' a inject x = genDependency (makeDependency NoToken (Inject (toValue x))) -getListElem :: Token [a] -> DepGenM' a -getListElem outer = genDependency (makeDependency outer GetListElem) - -setListElem :: Token a -> Token [a] -> DepGenM () -setListElem a outer = do - tellDep (makeDependency a SetListElem outer) - runFunction :: Function -> Token a -> DepGenM' b runFunction f input = genDependency (makeDependency input (Function f)) @@ -98,12 +96,12 @@ mapDepGenM f input = do input' <- toToken input genDependencyM $ \target -> do top <- get - let (res, top') = evalDepGenM' top $ do - inp <- getListElem input' + let (((innerInp, innerOutp), subDeps), top') = runDepGenM top $ do + inp <- newToken outp <- f inp - setListElem outp target + pure (inp, outp) put top' - pure (makeDependency input' (MapComp res) target) + pure (makeDependency input' (MapComp subDeps (makeUToken innerInp) (makeUToken innerOutp)) target) mapDepGenM_ :: TokenableTo [a] v => (Token a -> DepGenM ()) -> v -> DepGenM () mapDepGenM_ f input = do diff --git a/byg/src/DependencyRunner.hs b/byg/src/DependencyRunner.hs index 6b759f3..68e59aa 100644 --- a/byg/src/DependencyRunner.hs +++ b/byg/src/DependencyRunner.hs @@ -66,10 +66,6 @@ runAction action input = case action of pure $ List $ map fst $ filter (fromValue . snd) $ zip vs mask _ -> error "unexpected" - GetListElem -> - undefined - SetListElem -> - undefined UntupleFst -> case input of Tuple (v, _) -> @@ -94,5 +90,5 @@ runAction action input = case action of List <$> mapM (runAction UntupleSnd) vs _ -> error "unexpected" - MapComp subDeps -> + MapComp subDeps innerInput innerOutput -> undefined diff --git a/byg/src/Types/Dependency.hs b/byg/src/Types/Dependency.hs index f1c1e51..d7c527f 100644 --- a/byg/src/Types/Dependency.hs +++ b/byg/src/Types/Dependency.hs @@ -4,6 +4,7 @@ module Types.Dependency , UToken(..) , Dependency(..) , makeDependency + , makeUToken , formatDependencyTrees ) where @@ -21,13 +22,11 @@ data Action = Function Function | FunctionIO FunctionIO | Inject Value | FilterComp - | GetListElem - | SetListElem | UntupleFst | UntupleSnd | UnzipFst | UnzipSnd - | MapComp [Dependency] + | MapComp [Dependency] UToken UToken deriving (Show, Lift) data UToken = UToken Int @@ -83,8 +82,12 @@ formatDependencyTrees = T.concat . (formatDependencyTrees' "") [ "--" ] formatAction indentation = \case - MapComp subDeps -> - concat [ [ "MapComp:\n" ] + MapComp subDeps innerInput innerOutput -> + concat [ [ "MapComp(" ] + , formatUToken innerInput + , [ " -> " ] + , formatUToken innerOutput + , [ "):\n" ] , formatDependencyTrees' (T.append indentation "| ") subDeps ] action ->