Use fewer tuples internally
This commit is contained in:
parent
ae3ae4c5b0
commit
a019cee656
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
, [ ", " ]
|
, [ ", " ]
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue