Use fewer tuples internally

This commit is contained in:
Niels G. W. Serup 2024-10-05 19:44:28 +02:00
parent ae3ae4c5b0
commit a019cee656
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
4 changed files with 25 additions and 25 deletions

View File

@ -119,26 +119,26 @@ filterDepGenM :: (TokenableTo [Bool] v, TokenableTo [a] u) => v -> u -> DepGenM'
filterDepGenM mask input = do
mask' <- toToken mask
input' <- toToken input
genDependency (makeDependency (TupleToken (input', mask')) FilterComp)
genDependency (makeDependency (TupleToken input' mask') FilterComp)
zipDepGenM :: (TokenableTo [a] v, TokenableTo [b] u) => v -> u -> DepGenM' [(a, b)]
zipDepGenM a b = do
a' <- toToken a
b' <- toToken b
pure $ ZipToken (a', b')
pure $ ZipToken a' b'
untupleFstDepGenM :: TokenableTo (a, b) t => t -> DepGenM (Token a)
untupleFstDepGenM t = do
t' <- toToken t
case t' of
TupleToken (a, _) -> pure a
TupleToken a _ -> pure a
Token _ -> genDependency (makeDependency t' UntupleFst)
untupleSndDepGenM :: TokenableTo (a, b) t => t -> DepGenM (Token b)
untupleSndDepGenM t = do
t' <- toToken t
case t' of
TupleToken (_, b) -> pure b
TupleToken _ b -> pure b
Token _ -> genDependency (makeDependency t' UntupleSnd)
untupleDepGenM :: TokenableTo (a, b) t => t -> DepGenM (Token a, Token b)
@ -152,14 +152,14 @@ unzipFstDepGenM :: TokenableTo [(a, b)] t => t -> DepGenM (Token [a])
unzipFstDepGenM t = do
t' <- toToken t
case t' of
ZipToken (a, _) -> pure a
ZipToken a _ -> pure a
Token _ -> genDependency (makeDependency t' UnzipFst)
unzipSndDepGenM :: TokenableTo [(a, b)] t => t -> DepGenM (Token [b])
unzipSndDepGenM t = do
t' <- toToken t
case t' of
ZipToken (_, b) -> pure b
ZipToken _ b -> pure b
Token _ -> genDependency (makeDependency t' UnzipSnd)
unzipDepGenM :: TokenableTo [(a, b)] t => t -> DepGenM (Token [a], Token [b])
@ -182,7 +182,7 @@ appendStrings :: (TokenableTo String a, TokenableTo String b) => a -> b -> DepGe
appendStrings a b = do
a' <- toToken a
b' <- toToken b
runFunction AppendStrings $ TupleToken (a', b')
runFunction AppendStrings $ TupleToken a' b'
concatStrings :: TokenableTo [String] a => a -> DepGenM' String
concatStrings a = runFunction ConcatStrings =<< toToken a
@ -191,7 +191,7 @@ appendTexts :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM' Te
appendTexts a b = do
a' <- toToken a
b' <- toToken b
runFunction AppendTexts $ TupleToken (a', b')
runFunction AppendTexts $ TupleToken a' b'
concatTexts :: TokenableTo [Text] a => a -> DepGenM' Text
concatTexts a = runFunction ConcatTexts =<< toToken a
@ -200,7 +200,7 @@ joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGe
joinPaths a b = do
a' <- toToken a
b' <- toToken b
runFunction JoinPaths $ TupleToken (a', b')
runFunction JoinPaths $ TupleToken a' b'
fileComponents :: TokenableTo FilePath a => a -> DepGenM' (String, String)
fileComponents a = runFunction FileComponents =<< toToken a
@ -212,19 +212,19 @@ elemOf :: (TokenableTo String a, TokenableTo [String] b) => a -> b -> DepGenM' B
elemOf a b = do
a' <- toToken a
b' <- toToken b
runFunction ElemOf $ TupleToken (a', b')
runFunction ElemOf $ TupleToken a' b'
makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM' Template
makeTemplate a b = do
a' <- toToken a
b' <- toToken b
runFunction MakeTemplate $ TupleToken (a', b')
runFunction MakeTemplate $ TupleToken a' b'
applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM' Text
applyTemplate a b = do
a' <- toToken a
b' <- toToken b
runFunction ApplyTemplate $ TupleToken (a', b')
runFunction ApplyTemplate $ TupleToken a' b'
toText :: TokenableTo String a => a -> DepGenM' Text
toText a = runFunction ToText =<< toToken a
@ -242,19 +242,19 @@ convertImage :: (TokenableTo (FilePath, FilePath) a, TokenableTo ImageConversion
convertImage a b = do
a' <- toToken a
b' <- toToken b
runFunctionIO' ConvertImage $ TupleToken (a', b')
runFunctionIO' ConvertImage $ TupleToken a' b'
saveFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM ()
saveFile a b = do
a' <- toToken a
b' <- toToken b
runFunctionIO' SaveFile $ TupleToken (a', b')
runFunctionIO' SaveFile $ TupleToken a' b'
copyFile :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM ()
copyFile a b = do
a' <- toToken a
b' <- toToken b
runFunctionIO' CopyFile $ TupleToken (a', b')
runFunctionIO' CopyFile $ TupleToken a' b'
copyFile' :: Token (FilePath, FilePath) -> DepGenM ()
copyFile' = runFunctionIO' CopyFile

View File

@ -38,11 +38,11 @@ getTokenValue = \case
UToken i -> do
m <- get
pure (m M.! i)
UTupleToken (a, b) -> do
UTupleToken a b -> do
va <- getTokenValue a
vb <- getTokenValue b
pure $ Tuple (va, vb)
UZipToken (a, b) -> do
UZipToken a b -> do
va <- getTokenValue a
vb <- getTokenValue b
case (va, vb) of

View File

@ -30,8 +30,8 @@ data Action = Function Function
deriving (Show, Lift)
data UToken = UToken Int
| UTupleToken (UToken, UToken)
| UZipToken (UToken, UToken)
| UTupleToken UToken UToken
| UZipToken UToken UToken
| UNoToken
deriving (Show, Lift)
@ -44,8 +44,8 @@ makeDependency a action b = Dependency (makeUToken a) action (makeUToken b)
makeUToken :: Token a -> UToken
makeUToken = \case
Token i -> UToken i
TupleToken (a, b) -> UTupleToken (makeUToken a, makeUToken b)
ZipToken (a, b) -> UZipToken (makeUToken a, makeUToken b)
TupleToken a b -> UTupleToken (makeUToken a) (makeUToken b)
ZipToken a b -> UZipToken (makeUToken a) (makeUToken b)
NoToken -> UNoToken
formatDependencyTrees :: [Dependency] -> Text
@ -64,14 +64,14 @@ formatDependencyTrees = T.concat . (formatDependencyTrees' "")
formatUToken = \case
UToken i ->
[ T.pack (printf "%03d" i) ]
UTupleToken (a, b) ->
UTupleToken a b ->
concat [ [ "tup(" ]
, formatUToken a
, [ ", " ]
, formatUToken b
, [ ")" ]
]
UZipToken (a, b) ->
UZipToken a b ->
concat [ [ "zip(" ]
, formatUToken a
, [ ", " ]

View File

@ -7,8 +7,8 @@ import Language.Haskell.TH.Syntax (Lift)
data Token a where
Token :: Int -> Token a
TupleToken :: (Token a, Token b) -> Token (a, b)
ZipToken :: (Token [a], Token [b]) -> Token [(a, b)]
TupleToken :: Token a -> Token b -> Token (a, b)
ZipToken :: Token [a] -> Token [b] -> Token [(a, b)]
NoToken :: Token ()
deriving instance Show (Token a)