X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcHsType.lhs;h=08f4f7f718d8e4d9bb8a63cb07087413b77b372d;hb=e4417dcd4679da9c6b18c02ff667199c572bed89;hp=00bc2ede20e5575a95c4c2b982ca7c25db778b48;hpb=f9dd1aacd7a93d4175adad9e3e3e65670157b01c;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 00bc2ed..08f4f7f 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -53,6 +53,7 @@ import BasicTypes
 import SrcLoc
 import UniqSupply
 import Outputable
+import FastString
 
 import Control.Monad
 \end{code}
@@ -597,9 +598,9 @@ GADT constructor signatures
 
 \begin{code}
 tcLHsConResTy :: LHsType Name -> TcM (TyCon, [TcType])
-tcLHsConResTy res_ty
-  = addErrCtxt (gadtResCtxt res_ty) $
-    case get_largs res_ty [] of
+tcLHsConResTy (L span res_ty)
+  = setSrcSpan span $
+    case get_args res_ty [] of
 	   (HsTyVar tc_name, args) 
 	      -> do { args' <- mapM dsHsType args
 		    ; thing <- tcLookup tc_name
@@ -612,15 +613,11 @@ tcLHsConResTy res_ty
 	-- because that causes a black hole, and for good reason.  Building
 	-- the type means expanding type synonyms, and we can't do that
 	-- inside the "knot".  So we have to work by steam.
-    get_largs (L _ ty) args = get_args ty args
-    get_args (HsAppTy fun arg) 		  args = get_largs fun (arg:args)
-    get_args (HsParTy ty)      		  args = get_largs ty  args
+    get_args (HsAppTy (L _ fun) arg) 	  args = get_args fun (arg:args)
+    get_args (HsParTy (L _ ty)) 	  args = get_args ty  args
     get_args (HsOpTy ty1 (L span tc) ty2) args = (HsTyVar tc, ty1:ty2:args)
     get_args ty  	     		  args = (ty, args)
 
-gadtResCtxt ty
-  = hang (ptext SLIT("In the result type of a data constructor:"))
-       2 (ppr ty)
 badGadtDecl ty
   = hang (ptext SLIT("Malformed constructor result type:"))
        2 (ppr ty)