diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2013-10-04 18:50:08 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2013-10-04 18:50:08 +0100 |
commit | 174577912de7a21b8fe01881a28f5aafce02b92e (patch) | |
tree | dc68a17bedff46cda2b46b43fa4029c642afe415 /compiler/parser | |
parent | 8d829544304f98b441d366e793f3eac69e39801f (diff) | |
download | haskell-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')
-rw-r--r-- | compiler/parser/RdrHsSyn.lhs | 20 |
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 |