関数引数のpermutation (2)

Template Haskell版。型の縛りがないので、素直に相対位置で([id:yts:20041210#p1]では型をあわせるために絶対位置で変数の置換を行っている)自分自身を呼び出して再帰できる。

permArgs :: Int -> ExpQ
permArgs n = [| \f -> map ($ f) $(pgen n) |]

pgen :: Int -> ExpQ
pgen 1 = [| [id] |]
pgen n = [| [r . (j .) | r <- scanl (flip (.)) id $(flips n), j <- $(pgen (n - 1))] |]
  where	
    flips 1 = [| [] |]
    flips n = [| flip:map (.) $(flips (n - 1)) |]

TH版:

*FunArgPermTH> map (\f -> f 1 2 3) $ $(permArgs 3) (,,)
[(1,2,3),(1,3,2),(2,1,3),(2,3,1),(3,1,2),(3,2,1)]

ちなみにNon-TH版:

*FunArgPerm> map (\f -> f 1 2 3) $ permArgs three (,,)
[(1,2,3),(1,3,2),(2,1,3),(2,3,1),(3,1,2),(3,2,1)]