[commit: ghc] wip/pattern-synonyms: tcLookupPatSyn: look up the PatSyn record for a given Id (25c2eeb)

[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/25c2eebc4ad0c1dc4f4c371f39bd5336546ec094/ghc

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

commit 25c2eebc4ad0c1dc4f4c371f39bd5336546ec094
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Sun Jul 27 21:00:15 2014 +0200

    tcLookupPatSyn: look up the PatSyn record for a given Id


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

25c2eebc4ad0c1dc4f4c371f39bd5336546ec094
 compiler/typecheck/TcEnv.lhs | 14 +++++++++++---
 1 file changed, 11 insertions(+), 3 deletions(-)

diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index d9a4122..f4c7c10 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -18,8 +18,8 @@ module TcEnv(
         tcExtendGlobalEnv, tcExtendGlobalEnvImplicit, setGlobalTypeEnv,
         tcExtendGlobalValEnv,
         tcLookupLocatedGlobal, tcLookupGlobal, 
-        tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
-        tcLookupConLike,
+        tcLookupField, tcLookupTyCon, tcLookupClass,
+        tcLookupDataCon, tcLookupPatSyn, tcLookupConLike,
         tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
         tcLookupLocatedClass, tcLookupInstance, tcLookupAxiom,
         
@@ -73,7 +73,8 @@ import Var
 import VarSet
 import RdrName
 import InstEnv
-import DataCon
+import DataCon ( DataCon )
+import PatSyn  ( PatSyn )
 import ConLike
 import TyCon
 import CoAxiom
@@ -160,6 +161,13 @@ tcLookupDataCon name = do
         AConLike (RealDataCon con) -> return con
         _                          -> wrongThingErr "data constructor" (AGlobal thing) name
 
+tcLookupPatSyn :: Name -> TcM PatSyn
+tcLookupPatSyn name = do
+    thing <- tcLookupGlobal name
+    case thing of
+        AConLike (PatSynCon ps) -> return ps
+        _                       -> wrongThingErr "pattern synonym" (AGlobal thing) name
+
 tcLookupConLike :: Name -> TcM ConLike
 tcLookupConLike name = do
     thing <- tcLookupGlobal name