summaryrefslogtreecommitdiff
path: root/compiler/parser/RdrHsSyn.lhs
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2013-10-04 18:50:08 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2013-10-04 18:50:08 +0100
commit174577912de7a21b8fe01881a28f5aafce02b92e (patch)
treedc68a17bedff46cda2b46b43fa4029c642afe415 /compiler/parser/RdrHsSyn.lhs
parent8d829544304f98b441d366e793f3eac69e39801f (diff)
downloadhaskell-174577912de7a21b8fe01881a28f5aafce02b92e.tar.gz
Simplify the plumbing for checkValidTyCl
Instead of walking over the source decls, and looking up the Name to find the TyCon or whatever, we just walk over the list of TyThings that have been brought into scope. This is much tidier. The only wrinkle is that, since we don't have the original declaration, we don't have its SrcSpan to put in the error message. I fixed this by making the SrcSpan for the TyCon itself be the span of the whole declaration. This actually makes sense anyway. There are bunch of error message wibbles in consequence.
Diffstat (limited to 'compiler/parser/RdrHsSyn.lhs')
-rw-r--r--compiler/parser/RdrHsSyn.lhs20
1 files changed, 14 insertions, 6 deletions
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 715af25d12..363d49fae0 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -120,7 +120,7 @@ mkClassDecl loc (L _ (mcxt, tycl_hdr)) fds where_cls
cxt = fromMaybe (noLoc []) mcxt
; (cls, tparams) <- checkTyClHdr tycl_hdr
; tyvars <- checkTyVars tycl_hdr tparams -- Only type vars allowed
- ; return (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, tcdTyVars = tyvars,
+ ; return (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = reLocate loc cls, tcdTyVars = tyvars,
tcdFDs = unLoc fds, tcdSigs = sigs, tcdMeths = binds,
tcdATs = ats, tcdATDefs = at_defs, tcdDocs = docs,
tcdFVs = placeHolderNames })) }
@@ -137,7 +137,7 @@ mkTyData loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv
= do { (tc, tparams) <- checkTyClHdr tycl_hdr
; tyvars <- checkTyVars tycl_hdr tparams
; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
- ; return (L loc (DataDecl { tcdLName = tc, tcdTyVars = tyvars,
+ ; return (L loc (DataDecl { tcdLName = reLocate loc tc, tcdTyVars = tyvars,
tcdDataDefn = defn,
tcdFVs = placeHolderNames })) }
@@ -166,7 +166,7 @@ mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
= do { checkDatatypeContext mcxt
; let cxt = fromMaybe (noLoc []) mcxt
; return (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
- , dd_ctxt = cxt
+ , dd_ctxt = cxt
, dd_cons = data_cons
, dd_kindSig = ksig
, dd_derivs = maybe_deriv }) }
@@ -178,8 +178,8 @@ mkTySynonym :: SrcSpan
mkTySynonym loc lhs rhs
= do { (tc, tparams) <- checkTyClHdr lhs
; tyvars <- checkTyVars lhs tparams
- ; return (L loc (SynDecl { tcdLName = tc, tcdTyVars = tyvars,
- tcdRhs = rhs, tcdFVs = placeHolderNames })) }
+ ; return (L loc (SynDecl { tcdLName = reLocate loc tc, tcdTyVars = tyvars
+ , tcdRhs = rhs, tcdFVs = placeHolderNames })) }
mkTyFamInstEqn :: LHsType RdrName
-> LHsType RdrName
@@ -205,7 +205,15 @@ mkFamDecl :: SrcSpan
mkFamDecl loc info lhs ksig
= do { (tc, tparams) <- checkTyClHdr lhs
; tyvars <- checkTyVars lhs tparams
- ; return (L loc (FamilyDecl info tc tyvars ksig)) }
+ ; return (L loc (FamilyDecl { fdInfo = info, fdLName = reLocate loc tc
+ , fdTyVars = tyvars, fdKindSig = ksig })) }
+
+reLocate :: SrcSpan -> Located a -> Located a
+-- For the main binder of a declaration, we make its SrcSpan to
+-- cover the whole declaration, rather than just the syntactic occurrence
+-- of the binder. This makes error messages refer to the declaration as
+-- a whole, rather than just the binding site
+reLocate loc (L _ x) = L loc x
mkTopSpliceDecl :: LHsExpr RdrName -> HsDecl RdrName
-- If the user wrote