我有点希望别人回应,但没关系。这是我很快做出的解决方案:
module Tuples (updateTuple) where
import Language.Haskell.TH
updateTuple :: Int -> [Int] -> Q Exp
updateTuple len ixs = do
ixfns <- mapM (newIxFunName . (+1)) ixs
ixvns <- mapM newIxVarName [1..len]
let baseVals = map VarE ixvns
modVals = foldr applyFun baseVals $ ixs `zip` ixfns
return . LamE [matchTuple ixfns, matchTuple ixvns] $ TupE modVals
where
matchTuple = TupP . map VarP
newIxFunName = newIndexedName "fun"
newIxVarName = newIndexedName "var"
newIndexedName prefix = newName . (prefix ++) . show
applyFun (ix, fn) = modifyElem ix $ AppE $ VarE fn
modifyElem :: Int -> (a -> a) -> [a] -> [a]
modifyElem 0 f (x:xs) = f x : xs
modifyElem n f (x:xs) = x : modifyElem (n - 1) f xs
modifyElem n _ [] = error $ "index " ++ show n ++ " out of bounds"
使用示例:
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Tuples
main :: IO ()
main = print $ $(updateTuple 5 [0, 2, 4])
(\ _ -> 'a', (*2), \ _ -> 42)
(1, 2, 3, 'b', 'c')
编译(显示生成的代码):
$ ghc -ddump-splices -fforce-recomp main.hs
[1 of 2] Compiling Tuples ( Tuples.hs, Tuples.o )
[2 of 2] Compiling Main ( main.hs, main.o )
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Loading package pretty-1.1.1.0 ... linking ... done.
Loading package array-0.4.0.0 ... linking ... done.
Loading package deepseq-1.3.0.0 ... linking ... done.
Loading package containers-0.4.2.1 ... linking ... done.
Loading package template-haskell ... linking ... done.
main.hs:6:18-40: Splicing expression
updateTuple 5 [0, 2, 4]
======>
\ (fun1_a1Cl, fun3_a1Cm, fun5_a1Cn)
(var1_a1Co, var2_a1Cp, var3_a1Cq, var4_a1Cr, var5_a1Cs)
-> (fun1_a1Cl var1_a1Co, var2_a1Cp, fun3_a1Cm var3_a1Cq,
var4_a1Cr, fun5_a1Cn var5_a1Cs)
Linking main ...
输出:
$ ./main
('a',2,6,'b',42)
编辑:使 lambda 中的函数使用与变量相同的索引,这样更有意义。