summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRichard Eisenberg <eir@cis.upenn.edu>2013-12-18 14:58:12 -0500
committerRichard Eisenberg <eir@cis.upenn.edu>2013-12-18 14:58:12 -0500
commit724690f86f9bf92e886a785141c9ef423ddae05e (patch)
treec7b64b7c853ab82e90ff63906e75b9cfd59159ce
parent82dfe08d43e5cb9617fbc056fd3359b514414413 (diff)
downloadhaskell-724690f86f9bf92e886a785141c9ef423ddae05e.tar.gz
Revert "Simplify the plumbing for checkValidTyCl"
This reverts commit 174577912de7a21b8fe01881a28f5aafce02b92e. This is part of the fix for #8607. Only reverting RdrHsSyn.lhs. Conflicts: compiler/parser/RdrHsSyn.lhs compiler/typecheck/TcTyClsDecls.lhs
-rw-r--r--compiler/parser/RdrHsSyn.lhs17
1 files changed, 5 insertions, 12 deletions
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 79e53b26ae..79d2d966ec 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -127,7 +127,7 @@ mkClassDecl loc (L _ (mcxt, tycl_hdr)) fds where_cls
; (cls, tparams) <- checkTyClHdr tycl_hdr
; tyvars <- checkTyVars (ptext (sLit "class")) whereDots
cls tparams -- Only type vars allowed
- ; return (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = reLocate loc cls, tcdTyVars = tyvars,
+ ; return (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, tcdTyVars = tyvars,
tcdFDs = unLoc fds, tcdSigs = sigs, tcdMeths = binds,
tcdATs = ats, tcdATDefs = at_defs, tcdDocs = docs,
tcdFVs = placeHolderNames })) }
@@ -144,7 +144,7 @@ mkTyData loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv
= do { (tc, tparams) <- checkTyClHdr tycl_hdr
; tyvars <- checkTyVars (ppr new_or_data) equalsDots tc tparams
; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
- ; return (L loc (DataDecl { tcdLName = reLocate loc tc, tcdTyVars = tyvars,
+ ; return (L loc (DataDecl { tcdLName = tc, tcdTyVars = tyvars,
tcdDataDefn = defn,
tcdFVs = placeHolderNames })) }
@@ -159,7 +159,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 }) }
@@ -171,7 +171,7 @@ mkTySynonym :: SrcSpan
mkTySynonym loc lhs rhs
= do { (tc, tparams) <- checkTyClHdr lhs
; tyvars <- checkTyVars (ptext (sLit "type")) equalsDots tc tparams
- ; return (L loc (SynDecl { tcdLName = reLocate loc tc, tcdTyVars = tyvars
+ ; return (L loc (SynDecl { tcdLName = tc, tcdTyVars = tyvars
, tcdRhs = rhs, tcdFVs = placeHolderNames })) }
mkTyFamInstEqn :: LHsType RdrName
@@ -213,7 +213,7 @@ mkFamDecl :: SrcSpan
mkFamDecl loc info lhs ksig
= do { (tc, tparams) <- checkTyClHdr lhs
; tyvars <- checkTyVars (ppr info) equals_or_where tc tparams
- ; return (L loc (FamDecl (FamilyDecl { fdInfo = info, fdLName = reLocate loc tc
+ ; return (L loc (FamDecl (FamilyDecl { fdInfo = info, fdLName = tc
, fdTyVars = tyvars, fdKindSig = ksig }))) }
where
equals_or_where = case info of
@@ -221,13 +221,6 @@ mkFamDecl loc info lhs ksig
OpenTypeFamily -> empty
ClosedTypeFamily {} -> whereDots
-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
-
mkSpliceDecl :: LHsExpr RdrName -> HsDecl RdrName
-- If the user wrote
-- [pads| ... ] then return a QuasiQuoteD