[commit: ghc] wip/pattern-synonyms: Add renamer support for explicitly-bidirectional pattern synonyms (a61a5e0)

[git at git.haskell.org]

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

On branch  : wip/pattern-synonyms
Link       : http://ghc.haskell.org/trac/ghc/changeset/a61a5e0034595038700bd42d648c1e67b0432bc1/ghc

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

commit a61a5e0034595038700bd42d648c1e67b0432bc1
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Mon Jul 7 19:25:29 2014 +0800

    Add renamer support for explicitly-bidirectional pattern synonyms


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

a61a5e0034595038700bd42d648c1e67b0432bc1
 compiler/rename/RnBinds.lhs | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index e65d317..b8887b0 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -523,7 +523,7 @@ rnBind _sig_fn bind@(PatSynBind { patsyn_id = L _ name
   = do	{ pattern_synonym_ok <- xoptM Opt_PatternSynonyms
         ; unless pattern_synonym_ok (addErr patternSynonymErr)
 
-        ; ((pat', details'), fvs) <- rnPat PatSyn pat $ \pat' -> do
+        ; ((pat', details'), fvs1) <- rnPat PatSyn pat $ \pat' -> do
          -- We check the 'RdrName's instead of the 'Name's
          -- so that the binding locations are reported
          -- from the left-hand side
@@ -539,12 +539,16 @@ rnBind _sig_fn bind@(PatSynBind { patsyn_id = L _ name
                       -- ; checkPrecMatch -- TODO
                       ; return (InfixPatSyn name1 name2, mkFVs (map unLoc [name1, name2])) }
         ; return ((pat', details'), fvs) }
-        ; dir' <- case dir of
-            Unidirectional -> return Unidirectional
-            ImplicitBidirectional -> return ImplicitBidirectional
+        ; (dir', fvs2) <- case dir of
+            Unidirectional -> return (Unidirectional, emptyFVs)
+            ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs)
+            ExplicitBidirectional mg ->
+                do { (mg', fvs) <- rnMatchGroup PatSyn rnLExpr mg
+                   ; return (ExplicitBidirectional mg', fvs) }
 
         ; mod <- getModule
-        ; let fvs' = filterNameSet (nameIsLocalOrFrom mod) fvs
+        ; let fvs = fvs1 `plusFV` fvs2
+              fvs' = filterNameSet (nameIsLocalOrFrom mod) fvs
 	        -- Keep locally-defined Names
 		-- As well as dependency analysis, we need these for the
 		-- MonoLocalBinds test in TcBinds.decideGeneralisationPlan