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

View File

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

View File

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

View File

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