<div dir="ltr">Hi!<div><br></div><div>The issue is that "extract k = ..." is a binding of k which will be present in the generated code (and so will be available at runtime).  The anti-quote $(tsel k n) cannot depend on k, because it gets run at compiletime.</div><div><br></div><div>Seems to me like that error message could use some improvement.  Why not something more like "Stage error: `k' is bound in generated code but used in compiletime code"?  AFAIK there is no such thing as stage 3 or stage 0, so the numbering seems a bit arbitrary.</div><div><br></div><div>-Michael</div><div class="gmail_extra"><br><div class="gmail_quote">On Mon, Jan 25, 2016 at 2:58 AM, Dominik Bollmann <span dir="ltr"><<a href="mailto:dominikbollmann@gmail.com" target="_blank">dominikbollmann@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><br>
Hi all,<br>
<br>
I'm just getting my feet wet with template haskell, and I tried to write<br>
 a tmap function which maps a function over the ith component of an<br>
 n-tuple (which uses a slightly different approach than the given<br>
 version on the TH wiki):<br>
<br>
-- | Selects the ith component of an n-tuple<br>
tsel :: Int -> Int -> ExpQ -- n-tuple a -> a<br>
tsel i n = [| \t -> $(caseE [| t |] [alt]) |]<br>
  where alt  = match (tupP pats) body []<br>
        pats = map varP xs<br>
        xs   = [ mkName ("x" ++ show k) | k <- [1..n] ]<br>
        body = normalB . varE $ xs !! (i-1)<br>
<br>
-- | Maps a function over the ith component of an n-tuple<br>
tmap :: Int -> Int -> ExpQ -- :: (a -> b) -> n-tuple -> n-tuple<br>
tmap i n = do<br>
  f <- newName "f"<br>
  t <- newName "t"<br>
  lamE [varP f, varP t] $ [|<br>
     let prefix    = map extract [1..(i-1)]<br>
         new       = $f ($(tsel i n) $t)<br>
         suffix    = map extract [(i+1)..n]<br>
         extract k = $(tsel k n) t<br>
     in tupE $ prefix ++ [new] ++ suffix |]<br>
<br>
However, this code results in the following error:<br>
<br>
Sandbox.hs:26:29: Stage error: ‘k’ is bound at stage 2 but used at stage 1 …<br>
    In the splice: $(tsel k n)<br>
    In the Template Haskell quotation<br>
      [| let<br>
           prefix = map extract [1 .. (i - 1)]<br>
           new = $f ($(tsel i n) ($t))<br>
           suffix = map extract [(i + 1) .. n]<br>
           extract k = $(tsel k n) $t<br>
         in tupE $ prefix ++ [new] ++ suffix |]<br>
Compilation failed.<br>
<br>
Could anyone explain to me what stage 2 and stage 1 refer to, and<br>
further, what the logical flaw in the above snippet is? What exactly is<br>
wrong with line `extract k = $(tsel k n) $t' ?<br>
<br>
Thanks!<br>
<br>
Dominik.<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
</blockquote></div><br></div></div>