<html xmlns:v="urn:schemas-microsoft-com:vml" xmlns:o="urn:schemas-microsoft-com:office:office" xmlns:w="urn:schemas-microsoft-com:office:word" xmlns:m="http://schemas.microsoft.com/office/2004/12/omml" xmlns="http://www.w3.org/TR/REC-html40">

<head>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=us-ascii">
<meta name=Generator content="Microsoft Word 12 (filtered medium)">
<style>
<!--
 /* Font Definitions */
 @font-face
        {font-family:Calibri;
        panose-1:2 15 5 2 2 2 4 3 2 4;}
@font-face
        {font-family:Tahoma;
        panose-1:2 11 6 4 3 5 4 4 2 4;}
 /* Style Definitions */
 p.MsoNormal, li.MsoNormal, div.MsoNormal
        {margin:0cm;
        margin-bottom:.0001pt;
        font-size:12.0pt;
        font-family:"Times New Roman","serif";}
a:link, span.MsoHyperlink
        {mso-style-priority:99;
        color:blue;
        text-decoration:underline;}
a:visited, span.MsoHyperlinkFollowed
        {mso-style-priority:99;
        color:purple;
        text-decoration:underline;}
span.EmailStyle17
        {mso-style-type:personal-reply;
        font-family:"Calibri","sans-serif";
        color:#1F497D;}
.MsoChpDefault
        {mso-style-type:export-only;}
@page Section1
        {size:612.0pt 792.0pt;
        margin:72.0pt 72.0pt 72.0pt 72.0pt;}
div.Section1
        {page:Section1;}
-->
</style>
<!--[if gte mso 9]><xml>
 <o:shapedefaults v:ext="edit" spidmax="1026" />
</xml><![endif]--><!--[if gte mso 9]><xml>
 <o:shapelayout v:ext="edit">
  <o:idmap v:ext="edit" data="1" />
 </o:shapelayout></xml><![endif]-->
</head>

<body lang=EN-GB link=blue vlink=purple>

<div class=Section1>

<p class=MsoNormal><span style='font-size:11.0pt;font-family:"Calibri","sans-serif";
color:#1F497D'>You already have splicing for top level decls. Splicing for
local decls is a whole different ball game because it brings new *<b>binders</b>*
into scope.&nbsp; For example<o:p></o:p></span></p>

<p class=MsoNormal><span style='font-size:11.0pt;font-family:"Calibri","sans-serif";
color:#1F497D'><o:p>&nbsp;</o:p></span></p>

<p class=MsoNormal><span style='font-size:11.0pt;font-family:"Calibri","sans-serif";
color:#1F497D'>f = ...g...<o:p></o:p></span></p>

<p class=MsoNormal><span style='font-size:11.0pt;font-family:"Calibri","sans-serif";
color:#1F497D'>g = let $(foo) in ...f...<o:p></o:p></span></p>

<p class=MsoNormal><span style='font-size:11.0pt;font-family:"Calibri","sans-serif";
color:#1F497D'><o:p>&nbsp;</o:p></span></p>

<p class=MsoNormal><span style='font-size:11.0pt;font-family:"Calibri","sans-serif";
color:#1F497D'>Is the &#8216;f&#8217; inside &#8216;g&#8217; the same &#8216;f&#8217; as the one bound at top
level?&nbsp; Not necessarily, because $(foo) might bind f.&nbsp; So I can&#8217;t even do
dependency analysis to figure out whether f and g are mutually recursive! &nbsp;&nbsp;It
gets harder if $(foo) mentions &#8216;f&#8217;; and if the definition of &#8216;f&#8217; has a
declaration splice too.<o:p></o:p></span></p>

<p class=MsoNormal><span style='font-size:11.0pt;font-family:"Calibri","sans-serif";
color:#1F497D'><o:p>&nbsp;</o:p></span></p>

<p class=MsoNormal><span style='font-size:11.0pt;font-family:"Calibri","sans-serif";
color:#1F497D'>So splicing local decls introduces a new raft of questions whose
answers are not obvious, and that might require some substantial structural
rearrangement of GHC. &nbsp;In particular to the &#8220;rename and then typecheck&#8221;
strategy. &nbsp;&nbsp;It&#8217;s very similar to reason that we don&#8217;t allow splices in
patterns.<o:p></o:p></span></p>

<p class=MsoNormal><span style='font-size:11.0pt;font-family:"Calibri","sans-serif";
color:#1F497D'><o:p>&nbsp;</o:p></span></p>

<p class=MsoNormal><span style='font-size:11.0pt;font-family:"Calibri","sans-serif";
color:#1F497D'>Bottom line: my nose tells me this is a swamp and I&#8217;m steering
clear of it for now.<o:p></o:p></span></p>

<p class=MsoNormal><span style='font-size:11.0pt;font-family:"Calibri","sans-serif";
color:#1F497D'><br>
Simon<o:p></o:p></span></p>

<p class=MsoNormal><span style='font-size:11.0pt;font-family:"Calibri","sans-serif";
color:#1F497D'><o:p>&nbsp;</o:p></span></p>

<div style='border:none;border-left:solid blue 1.5pt;padding:0cm 0cm 0cm 4.0pt'>

<div>

<div style='border:none;border-top:solid #B5C4DF 1.0pt;padding:3.0pt 0cm 0cm 0cm'>

<p class=MsoNormal><b><span lang=EN-US style='font-size:10.0pt;font-family:
"Tahoma","sans-serif"'>From:</span></b><span lang=EN-US style='font-size:10.0pt;
font-family:"Tahoma","sans-serif"'> Matt Morrow [mailto:moonpatio@gmail.com] <br>
<b>Sent:</b> 28 May 2009 00:08<br>
<b>To:</b> Simon Peyton-Jones<br>
<b>Cc:</b> Ross Mellgren; Haskell Cafe; GHC users<br>
<b>Subject:</b> Re: [Haskell-cafe] Template Haskell very wordy w/r/t Decs and
Types<o:p></o:p></span></p>

</div>

</div>

<p class=MsoNormal><o:p>&nbsp;</o:p></p>

<p class=MsoNormal style='margin-bottom:12.0pt'>Spectacular!<br>
<br>
How difficult would it be to implement splicing in decls? I'm interested in
having a go at it, and it seems like a perfect time since I can cheat off the
fresh diff. In particular I'd love to be able to do stuff like this (without
the current vicious hackery i'm using) (and granted, where i'm splicing is somewhat
willy-nilly, but some approximation of this):<br>
<br>
-----------------------------------------------------------------------------<br>
<br>
{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}<br>
module DecTest where<br>
import HsDec<br>
import Data.List<br>
import DecTestBoot<br>
import Language.Haskell.TH.Lib<br>
import Language.Haskell.TH.Syntax<br>
import Language.Haskell.Meta.Utils<br>
<br>
bootQ :: Q [Dec]<br>
bootQ = bootQFunct<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; primQStruct<br>
<br>
primQStruct = (''[]<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
,(conT ''[] `appT`)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
,[|[]|]<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
,[|null|]<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
,[|undefined|]<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
,[|union|]<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
,[|undefined|]<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
,[|undefined|])<br>
<br>
bootQFunct<br>
&nbsp; (primN&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; :: Name<br>
&nbsp; ,primQ&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; :: TypeQ<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
-&gt; TypeQ&nbsp; -- exists q. forall a. a -&gt; q a<br>
&nbsp; ,emptyQ&nbsp;&nbsp;&nbsp;&nbsp; :: ExpQ&nbsp;&nbsp; -- Q a<br>
&nbsp; ,isEmptyQ&nbsp;&nbsp; :: ExpQ&nbsp;&nbsp; -- q a -&gt; Bool<br>
&nbsp; ,insertQ&nbsp;&nbsp;&nbsp; :: ExpQ&nbsp;&nbsp; -- Int -&gt; a -&gt; q a
-&gt; q a<br>
&nbsp; ,mergeQ&nbsp;&nbsp;&nbsp;&nbsp; :: ExpQ&nbsp;&nbsp; -- q a -&gt; q a
-&gt; q a<br>
&nbsp; ,findMinQ&nbsp;&nbsp; :: ExpQ&nbsp;&nbsp; -- q a -&gt; Maybe (Int, a)<br>
&nbsp; ,deleteMinQ :: ExpQ)&nbsp; -- q a -&gt; q a<br>
<br>
&nbsp; = do&nbsp; n &lt;- newName &quot;a&quot;<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; let primT = varT primN<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; a = varT n<br>
<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [$dec|<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; data BootQ $(a)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; = Nil<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; | Node {-#
UNPACK #-} !Int $(a) ($(primT) (BootQ $(a)))<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
deriving(Eq,Ord)<br>
<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
empty&nbsp;&nbsp;&nbsp;&nbsp; :: BootQ $(a)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; isEmpty&nbsp;&nbsp; ::
BootQ $(a) -&gt; Bool<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; insert&nbsp;&nbsp;&nbsp;
:: Int -&gt; $(a) -&gt; BootQ $(a) -&gt; BootQ $(a)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
merge&nbsp;&nbsp;&nbsp;&nbsp; :: BootQ $(a) -&gt; BootQ $(a) -&gt; BootQ $(a)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; findMin&nbsp;&nbsp; ::
BootQ $(a) -&gt; Maybe (Int, $(a))<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; deleteMin :: BootQ $(a)
-&gt; BootQ $(a)<br>
<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; empty = Nil<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; isEmpty Nil = True<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; isEmpty&nbsp;&nbsp; _ =
False<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; findMin&nbsp; Nil =
Nothing<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; findMin (Node n x _) =
Just (n, x)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; insert n x q = merge
(Node n x $(emptyQ)) q<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; merge (Node n1 x1 q1)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
(Node n2 x2 q2)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; | n1 &lt;=
n2&nbsp; = Node n1 x1 ($(insertQ) n2 (Node n2 x2 q2) q1)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; | otherwise
= Node n2 x2 ($(insertQ) n1 (Node n1 x1 q1) q2)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; merge Nil q&nbsp; = q<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; merge q&nbsp; Nil = q<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; deleteMin&nbsp; Nil =
Nil<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; deleteMin (Node _ _ q)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; = case
$(findMinQ) q of<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
Nothing -&gt; Nil<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
Just (_, Node m y q1)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
-&gt; let q2 = $(deleteMinQ) q<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
in Node m y ($(mergeQ) q1 q2)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; |]<br>
<br>
<o:p></o:p></p>

<p class=MsoNormal><o:p>&nbsp;</o:p></p>

</div>

</div>

</body>

</html>