[commit: ghc] master: Fix #1476 by making splice patterns work. (2346de4)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/2346de44330a4309b840e26ddd1ded23f92c6f81/ghc

>---------------------------------------------------------------

commit 2346de44330a4309b840e26ddd1ded23f92c6f81
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Tue Nov 4 11:34:53 2014 -0500

    Fix #1476 by making splice patterns work.
    
    Unfortunately, splice patterns in brackets still do not work
    because we don't run splices in brackets. Without running a pattern
    splice, we can't know what variables it binds, so we're stuck.
    
    This is still a substantial improvement, and it may be the best
    we can do. Still must document new behavior.


>---------------------------------------------------------------

2346de44330a4309b840e26ddd1ded23f92c6f81
 compiler/rename/RnPat.lhs         | 10 ++++++----
 compiler/rename/RnSplice.lhs      | 38 +++++++++++++++++++++++++++++++-------
 compiler/rename/RnSplice.lhs-boot |  3 ++-
 testsuite/tests/th/all.T          |  2 +-
 4 files changed, 40 insertions(+), 13 deletions(-)

diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs
index 9d03805..370f6b4 100644
--- a/compiler/rename/RnPat.lhs
+++ b/compiler/rename/RnPat.lhs
@@ -440,10 +440,12 @@ rnPatAndThen mk (TuplePat pats boxed _)
        ; pats' <- rnLPatsAndThen mk pats
        ; return (TuplePat pats' boxed []) }
 
-rnPatAndThen _ (SplicePat splice)
-  = do { -- XXX How to deal with free variables?
-       ; (pat, _) <- liftCps $ rnSplicePat splice
-       ; return pat }
+rnPatAndThen mk (SplicePat splice)
+  = do { eith <- liftCpsFV $ rnSplicePat splice
+       ; case eith of   -- See Note [rnSplicePat] in RnSplice
+           Left not_yet_renamed -> rnPatAndThen mk not_yet_renamed
+           Right already_renamed -> return already_renamed } 
+    
 rnPatAndThen mk (QuasiQuotePat qq)
   = do { pat <- liftCps $ runQuasiQuotePat qq
          -- Wrap the result of the quasi-quoter in parens so that we don't
diff --git a/compiler/rename/RnSplice.lhs b/compiler/rename/RnSplice.lhs
index 59c8c62..8918e39 100644
--- a/compiler/rename/RnSplice.lhs
+++ b/compiler/rename/RnSplice.lhs
@@ -206,13 +206,40 @@ rnSpliceType splice k
                                   }
             ; return (unLoc hs_ty3, fvs) }
 
-----------------------
-rnSplicePat :: HsSplice RdrName -> RnM (Pat Name, FreeVars)
+\end{code}
+
+Note [rnSplicePat]
+~~~~~~~~~~~~~~~~~~
+Renaming a pattern splice is a bit tricky, because we need the variables
+bound in the pattern to be in scope in the RHS of the pattern. This scope
+management is effectively done by using continuation-passing style in
+RnPat, through the CpsRn monad. We don't wish to be in that monad here
+(it would create import cycles and generally conflict with renaming other
+splices), so we really want to return a (Pat RdrName) -- the result of
+running the splice -- which can then be further renamed in RnPat, in
+the CpsRn monad.
+
+The problem is that if we're renaming a splice within a bracket, we
+*don't* want to run the splice now. We really do just want to rename
+it to an HsSplice Name. Of course, then we can't know what variables
+are bound within the splice, so pattern splices within brackets aren't
+all that useful.
+
+In any case, when we're done in rnSplicePat, we'll either have a
+Pat RdrName (the result of running a top-level splice) or a Pat Name
+(the renamed nested splice). Thus, the awkward return type of
+rnSplicePat.
+
+\begin{code}
+
+-- | Rename a splice pattern. See Note [rnSplicePat]
+rnSplicePat :: HsSplice RdrName -> RnM ( Either (Pat RdrName) (Pat Name)
+                                       , FreeVars)
 rnSplicePat splice
   = rnSpliceGen False run_pat_splice pend_pat_splice splice
   where
     pend_pat_splice rn_splice@(HsSplice n e)
-      = (PendingRnPatSplice (PendSplice n e), SplicePat rn_splice)
+      = (PendingRnPatSplice (PendSplice n e), Right $ SplicePat rn_splice)
 
     run_pat_splice (HsSplice _ expr')
       = do { expr <- getHooked runRnSpliceHook return >>= ($ expr')
@@ -227,10 +254,7 @@ rnSplicePat splice
            ; pat <- runMetaP zonked_q_expr
            ; showSplice "pattern" expr (ppr pat)
 
-           ; (pat', fvs) <- checkNoErrs $
-                            rnPat ThPatSplice pat $ \pat' -> return (pat', emptyFVs)
-
-           ; return (unLoc pat', fvs) }
+           ; return (Left $ unLoc pat, emptyFVs) }
 
 ----------------------
 rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
diff --git a/compiler/rename/RnSplice.lhs-boot b/compiler/rename/RnSplice.lhs-boot
index 45a2a10..de6da77 100644
--- a/compiler/rename/RnSplice.lhs-boot
+++ b/compiler/rename/RnSplice.lhs-boot
@@ -11,6 +11,7 @@ import Kind
 
 rnSpliceType :: HsSplice RdrName   -> PostTc Name Kind
              -> RnM (HsType Name, FreeVars)
-rnSplicePat  :: HsSplice RdrName   -> RnM (Pat Name, FreeVars)
+rnSplicePat  :: HsSplice RdrName   -> RnM ( Either (Pat RdrName) (Pat Name)
+                                          , FreeVars )
 rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
 \end{code}
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 3f8ff16..366858e 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -344,5 +344,5 @@ test('T8100', normal, compile, ['-v0'])
 test('T9064', normal, compile, ['-v0'])
 test('T9209', normal, compile_fail, ['-v0'])
 test('T7484', normal, compile_fail, ['-v0'])
-test('T1476', expect_broken(1476), compile, ['-v0'])
+test('T1476', normal, compile, ['-v0'])
 test('T1476b', normal, compile_fail, ['-v0'])