Migrate *ListElem functionality into just MapComp

This commit is contained in:
Niels G. W. Serup 2024-09-27 20:58:18 +02:00
parent c53f804074
commit 53e9598d22
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
3 changed files with 25 additions and 28 deletions

View File

@ -41,10 +41,10 @@ import Types.Values
import Types.Value (Valuable(..)) import Types.Value (Valuable(..))
import Types.Function (Function(..)) import Types.Function (Function(..))
import Types.FunctionIO (FunctionIO(..)) 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.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) import Data.Text (Text)
newtype DepGenM a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a } 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) type DepGenM' a = DepGenM (Token a)
evalDepGenM' :: Int -> DepGenM () -> ([Dependency], Int) runDepGenM :: Int -> DepGenM a -> ((a, [Dependency]), Int)
evalDepGenM' top m = runState (execWriterT (unDepGenM m)) top runDepGenM top m = runState (runWriterT (unDepGenM m)) top
evalDepGenM :: DepGenM () -> [Dependency] evalDepGenM :: DepGenM () -> [Dependency]
evalDepGenM m = fst (evalDepGenM' 0 m) evalDepGenM = snd . fst . runDepGenM 0
tellDep :: Dependency -> DepGenM () tellDep :: Dependency -> DepGenM ()
tellDep dep = tell [dep] tellDep dep = tell [dep]
genDependencyM :: (Token a -> DepGenM Dependency) -> DepGenM' a newToken :: DepGenM' a
genDependencyM f = do newToken = do
top <- get top <- get
let top' = top + 1 let top' = top + 1
target = Token top' target = Token top'
put top' put top'
pure target
genDependencyM :: (Token a -> DepGenM Dependency) -> DepGenM' a
genDependencyM f = do
target <- newToken
result <- f target result <- f target
tellDep result tellDep result
pure target pure target
@ -77,13 +82,6 @@ genDependency f = genDependencyM (pure . f)
inject :: Valuable a => a -> DepGenM' a inject :: Valuable a => a -> DepGenM' a
inject x = genDependency (makeDependency NoToken (Inject (toValue x))) 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 :: Function -> Token a -> DepGenM' b
runFunction f input = genDependency (makeDependency input (Function f)) runFunction f input = genDependency (makeDependency input (Function f))
@ -98,12 +96,12 @@ mapDepGenM f input = do
input' <- toToken input input' <- toToken input
genDependencyM $ \target -> do genDependencyM $ \target -> do
top <- get top <- get
let (res, top') = evalDepGenM' top $ do let (((innerInp, innerOutp), subDeps), top') = runDepGenM top $ do
inp <- getListElem input' inp <- newToken
outp <- f inp outp <- f inp
setListElem outp target pure (inp, outp)
put top' 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_ :: TokenableTo [a] v => (Token a -> DepGenM ()) -> v -> DepGenM ()
mapDepGenM_ f input = do mapDepGenM_ f input = do

View File

@ -66,10 +66,6 @@ runAction action input = case action of
pure $ List $ map fst $ filter (fromValue . snd) $ zip vs mask pure $ List $ map fst $ filter (fromValue . snd) $ zip vs mask
_ -> _ ->
error "unexpected" error "unexpected"
GetListElem ->
undefined
SetListElem ->
undefined
UntupleFst -> UntupleFst ->
case input of case input of
Tuple (v, _) -> Tuple (v, _) ->
@ -94,5 +90,5 @@ runAction action input = case action of
List <$> mapM (runAction UntupleSnd) vs List <$> mapM (runAction UntupleSnd) vs
_ -> _ ->
error "unexpected" error "unexpected"
MapComp subDeps -> MapComp subDeps innerInput innerOutput ->
undefined undefined

View File

@ -4,6 +4,7 @@ module Types.Dependency
, UToken(..) , UToken(..)
, Dependency(..) , Dependency(..)
, makeDependency , makeDependency
, makeUToken
, formatDependencyTrees , formatDependencyTrees
) where ) where
@ -21,13 +22,11 @@ data Action = Function Function
| FunctionIO FunctionIO | FunctionIO FunctionIO
| Inject Value | Inject Value
| FilterComp | FilterComp
| GetListElem
| SetListElem
| UntupleFst | UntupleFst
| UntupleSnd | UntupleSnd
| UnzipFst | UnzipFst
| UnzipSnd | UnzipSnd
| MapComp [Dependency] | MapComp [Dependency] UToken UToken
deriving (Show, Lift) deriving (Show, Lift)
data UToken = UToken Int data UToken = UToken Int
@ -83,8 +82,12 @@ formatDependencyTrees = T.concat . (formatDependencyTrees' "")
[ "--" ] [ "--" ]
formatAction indentation = \case formatAction indentation = \case
MapComp subDeps -> MapComp subDeps innerInput innerOutput ->
concat [ [ "MapComp:\n" ] concat [ [ "MapComp(" ]
, formatUToken innerInput
, [ " -> " ]
, formatUToken innerOutput
, [ "):\n" ]
, formatDependencyTrees' (T.append indentation "| ") subDeps , formatDependencyTrees' (T.append indentation "| ") subDeps
] ]
action -> action ->