THでzip製作

論文にのってたので、Quoted-Monad使わない方向性で書いた。
ていうか、[| \x -> x |]とかで書いて、$つけるとか意味分からんので。
それとdoc読まないでいきなり書いてるから未だにさーぱり分からん。

module Th_ZipN3 where

import Language.Haskell.TH
import Language.Haskell.TH.Lib
import GHC.Base

{-
$(zipN 3) as bs cs
っぽく
-}

zipN n = [| let zp = $(do return (mkZip n (VarE $ mkName "zp"))) in zp |]

-- mkZip :: Int -> Exp -> Exp
mkZip n name = LamE pYs (CaseE (TupE eYs) [m1,m2])
    where
      (pXs, eXs)  = genPE "x"  n
      (pYs, eYs)  = genPE "y"  n
      (pXSs,eXSs) = genPE "xs" n
      pcons x xs  = InfixP x (mkName "GHC.Base.:") xs
      m1 = simpleMatch (TupP (zipWith pcons pXs pXSs)) (InfixE (Just(TupE eXs)) (ConE $ mkName "GHC.Base.:") (Just (apply' name eXSs)))
      m2 = simpleMatch (TupP (replicate n WildP)) (ConE (mkName "GHC.Base.[]"))

genPE :: String -> Int -> ([Pat],[Exp])
genPE s n = let ns = [ s++(show i) | i <- [1..n]]
            in (map (\x -> VarP $ mkName x) ns,map (\x -> VarE $ mkName x) ns)

apply' :: Exp -> [Exp] -> Exp
apply' fun (x:[]) = AppE fun x
apply' fun (x:xs) = apply' (AppE fun x) xs

でまぁこれが落ちると。後どうやって再帰させたもんだか分からんという感じで困って授業に行く気が完全に無く成った。

pprintするとこんな感じにはなってくれるんだけどもなぁ。

\y1 y2 y3 -> case (y1, y2, y3) of
                 (x1 GHC.Base.: xs1, x2 GHC.Base.: xs2, x3 GHC.Base.: xs3) -> (x1,
                                                                               x2,
                                                                               x3) GHC.Base.: zp xs1 xs2 xs3
                 (_, _, _) -> GHC.Base.[]

(do return zp) >>= putStrLn . pprint

動いた

module Th_ZipN4 where

import Language.Haskell.TH
import Language.Haskell.TH.Lib
import GHC.Base

zipN n = [| let zp = $(mkZip n $ var "zp") in zp |]

var str = varE $ mkName str
pvar str = varP $ mkName str

genPE :: String -> Int -> ([PatQ],[ExpQ]) 
genPE s n = let ns = [ s++(show i) | i <- [1..n]] 
            in (map pvar ns, map var ns)

mkZip n name = lamE pYs (caseE (tupE eYs) [m1,m2])
    where 
      (pXs, eXs) = genPE "x" n 
      (pYs, eYs) = genPE "y" n 
      (pXSs,eXSs) = genPE "xs" n

      pcons :: PatQ -> PatQ -> PatQ
      pcons x xs = infixP x (mkName "GHC.Base.:") xs

      simpleM p e = match p (normalB e) []
      b = [| $(tupE eXs) : $(appsE (name : eXSs)) |] 
      m1 = simpleM (tupP (zipWith pcons pXs pXSs)) b 
      m2 = simpleM (tupP (replicate n wildP)) (conE $ mkName "GHC.Base.[]")

importして、$(zipN なんか数字)やったら出来る。素晴らしい。

けど、これ今のTHに合う様に論文を書き直しただけで、個人的にはSyntax Suger使っていない方で書きたいんだけど、何故だか動いてくれない。
こんなのが出ている。

    GHC stage restriction: `n'
      is used in a top-level splice, and must be imported, not defined locally

慎重に調べる

ghciで

let myZipN n = [| let zp = $(do return $ mkZip n (VarE $ mkName "zp")) in zp |]

こんなんをやると通るんだけど、その次が問題で

*Th_ZipN3> $(myZipN 3)

<interactive>:1:2: Not in scope: `zp'

ぬへー。

一方、例えば

let zp = $(do return (mkZip 3 (VarE $ mkName "zp")))
$(do return (mkZip 3 (VarE $ mkName "zp")))

こんな事をすれば動く。

そういう事ならば、と別モジュールで

zipN2 n = do let zp = $(do return $ mkZip n (VarE $ mkName "zp"))
             $(do return $ mkZip n (VarE $ mkName "zp"))

とか取りあえず書いてみると、ここで

GHC stage restriction: `n'

が出て来る。