Add quasi-quotation, courtesy of Geoffrey Mainland

This patch adds quasi-quotation, as described in
  "Nice to be Quoted: Quasiquoting for Haskell"
	(Geoffrey Mainland, Haskell Workshop 2007)
Implemented by Geoffrey and polished by Simon.

Overview
~~~~~~~~
The syntax for quasiquotation is very similar to the existing
Template haskell syntax:
	[$q| stuff |]
where 'q' is the "quoter".  This syntax differs from the paper, by using
a '$' rather than ':', to avoid clashing with parallel array comprehensions.
 
The "quoter" is a value of type Language.Haskell.TH.Quote.QuasiQuoter, which
contains two functions for quoting expressions and patterns, respectively.
 
     quote = Language.Haskell.TH.Quote.QuasiQuoter quoteExp quotePat
 
     quoteExp :: String -> Language.Haskell.TH.ExpQ
     quotePat :: String -> Language.Haskell.TH.PatQ

TEXT is passed unmodified to the quoter. The context of the
quasiquotation statement determines which of the two quoters is
called: if the quasiquotation occurs in an expression context,
quoteExp is called, and if it occurs in a pattern context, quotePat
is called.

The result of running the quoter on its arguments is spliced into
the program using Template Haskell's existing mechanisms for
splicing in code. Note that although Template Haskell does not
support pattern brackets, with this patch binding occurrences of
variables in patterns are supported. Quoters must also obey the same
stage restrictions as Template Haskell; in particular, in this
example quote may not be defined in the module where it is used as a
quasiquoter, but must be imported from another module.

Points to notice
~~~~~~~~~~~~~~~~
* The whole thing is enabled with the flag -XQuasiQuotes

* There is an accompanying patch to the template-haskell library. This
  involves one interface change:
	currentModule :: Q String
  is replaced by
	location :: Q Loc
  where Loc is a data type defined in TH.Syntax thus:
      data Loc
        = Loc { loc_filename :: String
	      , loc_package  :: String
	      , loc_module   :: String
	      , loc_start    :: CharPos
	      , loc_end      :: CharPos }

      type CharPos = (Int, Int)	-- Line and character position
 
  So you get a lot more info from 'location' than from 'currentModule'.
  The location you get is the location of the splice.
  
  This works in Template Haskell too of course, and lets a TH program
  generate much better error messages.

* There's also a new module in the template-haskell package called 
  Language.Haskell.TH.Quote, which contains support code for the
  quasi-quoting feature.

* Quasi-quote splices are run *in the renamer* because they can build 
  *patterns* and hence the renamer needs to see the output of running the
  splice.  This involved a bit of rejigging in the renamer, especially
  concerning the reporting of duplicate or shadowed names.

  (In fact I found and removed a few calls to checkDupNames in RnSource 
  that are redundant, becuase top-level duplicate decls are handled in
  RnNames.)

1 files changed, 54 insertions, 13 deletions

diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs
index 8c75caa993..49f6f1db2d 100644
--- a/compiler/rename/RnPat.lhs
+++ b/compiler/rename/RnPat.lhs
@@ -30,6 +30,9 @@ module RnPat (-- main entry points
 	      -- Literals
 	      rnLit, rnOverLit,     
 
+	      -- Quasiquotation
+	      rnQuasiQuote,
+
              -- Pattern Error messages that are also used elsewhere
              checkTupSize, patSigErr
              ) where
@@ -37,6 +40,9 @@ module RnPat (-- main entry points
 -- ENH: thin imports to only what is necessary for patterns
 
 import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts)
+#ifdef GHCI
+import {-# SOURCE #-} TcSplice( runQuasiQuotePat )
+#endif 	/* GHCI */
 
 #include "HsVersions.h"
 
@@ -57,12 +63,15 @@ import PrelNames	( thFAKE, hasKey, assertIdKey, assertErrorName,
                         eqClassName, integralClassName, geName, eqName,
 		  	  negateName, minusName, lengthPName, indexPName,
 			  plusIntegerName, fromIntegerName, timesIntegerName,
-			  ratioDataConName, fromRationalName, fromStringName )
+			  ratioDataConName, fromRationalName, fromStringName, mkUnboundName )
 import Constants	( mAX_TUPLE_SIZE )
-import Name		( Name, nameOccName, nameIsLocalOrFrom, getOccName, nameSrcSpan )
+import Name		( Name, nameOccName, nameModule_maybe, getOccName, nameSrcSpan )
+import OccName		( occEnvElts )
 import NameSet
 import UniqFM
-import RdrName        ( RdrName, extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals, mkRdrUnqual, nameRdrName )
+import RdrName          ( RdrName, GlobalRdrElt(..), Provenance(..),
+                          extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals,
+                          mkRdrUnqual, nameRdrName, gre_name, globalRdrEnvElts, isLocalGRE )
 import LoadIface	( loadInterfaceForName )
 import UniqFM		( isNullUFM )
 import UniqSet		( emptyUniqSet )
@@ -161,21 +170,23 @@ rnPatsAndThen_LocalRightwards :: HsMatchContext Name -- for error messages
                               -> RnM (a, FreeVars)
 
 rnPatsAndThen_LocalRightwards ctxt pats thing_inside
-  = do	{ -- Check for duplicated and shadowed names 
-	  -- Because we don't bind the vars all at once, we can't
-	  -- 	check incrementally for duplicates; 
-	  -- Nor can we check incrementally for shadowing, else we'll
-	  -- 	complain *twice* about duplicates e.g. f (x,x) = ...
-	  let rdr_names_w_loc = collectLocatedPatsBinders pats
-	; checkDupNames  doc_pat rdr_names_w_loc
-      	; checkShadowing doc_pat rdr_names_w_loc
+  = do	{ envs_before <- getRdrEnvs
 
 	  -- (0) bring into scope all of the type variables bound by the patterns
 	  -- (1) rename the patterns, bringing into scope all of the term variables
 	  -- (2) then do the thing inside.
 	; bindPatSigTyVarsFV (collectSigTysFromPats pats) $ 
-	  rnLPatsAndThen matchNameMaker pats	$
-	  thing_inside }
+	  rnLPatsAndThen matchNameMaker pats	$ \ pats' ->
+            do { -- Check for duplicated and shadowed names 
+	         -- Because we don't bind the vars all at once, we can't
+	         -- 	check incrementally for duplicates; 
+	         -- Nor can we check incrementally for shadowing, else we'll
+	         -- 	complain *twice* about duplicates e.g. f (x,x) = ...
+            ; let names = collectPatsBinders pats'
+            ; checkDupNames doc_pat names
+	    ; checkShadowedNames doc_pat envs_before
+				 [(nameSrcSpan name, nameOccName name) | name <- names]
+            ; thing_inside pats' } }
   where
     doc_pat = ptext SLIT("In") <+> pprMatchContext ctxt
 
@@ -288,6 +299,16 @@ rnLPatAndThen var@(NM varf) (L loc p) cont =
 		                  lcont (ViewPat expr' pat' ty)
 	      ; return (res, fvs_res `plusFV` fv_expr) }
 
+#ifndef GHCI
+         pat@(QuasiQuotePat _) -> pprPanic "Can't do QuasiQuotePat without GHCi" (ppr p)
+#else
+         QuasiQuotePat qq -> do
+             (qq', _) <- rnQuasiQuote qq
+             pat' <- runQuasiQuotePat qq'
+             rnLPatAndThen var pat' $ \ (L _ pat'') ->
+                 lcont pat''
+#endif 	/* GHCI */
+
          ConPatIn con stuff -> 
              -- rnConPatAndThen takes care of reconstructing the pattern
              rnConPatAndThen var con stuff cont
@@ -543,6 +564,26 @@ rnOverLit (HsIsString s _ _)
 	returnM (HsIsString s from_string_name placeHolderType, fvs)
 \end{code}
 
+%************************************************************************
+%*									*
+\subsubsection{Quasiquotation}
+%*									*
+%************************************************************************
+
+See Note [Quasi-quote overview] in TcSplice.
+
+\begin{code}
+rnQuasiQuote :: HsQuasiQuote RdrName -> RnM (HsQuasiQuote Name, FreeVars)
+rnQuasiQuote (HsQuasiQuote n quoter quoteSpan quote)
+  = do	{ loc  <- getSrcSpanM
+   	; [n'] <- newLocalsRn [L loc n]
+   	; quoter' <-  (lookupOccRn quoter)
+		-- If 'quoter' is not in scope, proceed no further
+		-- Otherwise lookupOcc adds an error messsage and returns 
+		-- an "unubound name", which makes the subsequent attempt to
+		-- run the quote fail
+   	; return (HsQuasiQuote n' quoter' quoteSpan quote, unitFV quoter') }
+\end{code}
 
 %************************************************************************
 %*									*