diff options
Diffstat (limited to 'compiler/rename')
| -rw-r--r-- | compiler/rename/RnBinds.hs | 138 | ||||
| -rw-r--r-- | compiler/rename/RnExpr.hs | 29 | ||||
| -rw-r--r-- | compiler/rename/RnNames.hs | 2 | ||||
| -rw-r--r-- | compiler/rename/RnSource.hs | 14 |
4 files changed, 99 insertions, 84 deletions
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs index c54c734dce..4ce3a58539 100644 --- a/compiler/rename/RnBinds.hs +++ b/compiler/rename/RnBinds.hs @@ -32,7 +32,6 @@ import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts ) import HsSyn import TcRnMonad -import TcEvidence ( emptyTcEvBinds ) import RnTypes import RnPat import RnNames @@ -203,27 +202,31 @@ rnLocalBindsAndThen :: HsLocalBinds GhcPs -- This version (a) assumes that the binding vars are *not* already in scope -- (b) removes the binders from the free vars of the thing inside -- The parser doesn't produce ThenBinds -rnLocalBindsAndThen EmptyLocalBinds thing_inside = - thing_inside EmptyLocalBinds emptyNameSet +rnLocalBindsAndThen (EmptyLocalBinds x) thing_inside = + thing_inside (EmptyLocalBinds x) emptyNameSet -rnLocalBindsAndThen (HsValBinds val_binds) thing_inside +rnLocalBindsAndThen (HsValBinds x val_binds) thing_inside = rnLocalValBindsAndThen val_binds $ \ val_binds' -> - thing_inside (HsValBinds val_binds') + thing_inside (HsValBinds x val_binds') -rnLocalBindsAndThen (HsIPBinds binds) thing_inside = do +rnLocalBindsAndThen (HsIPBinds x binds) thing_inside = do (binds',fv_binds) <- rnIPBinds binds - (thing, fvs_thing) <- thing_inside (HsIPBinds binds') fv_binds + (thing, fvs_thing) <- thing_inside (HsIPBinds x binds') fv_binds return (thing, fvs_thing `plusFV` fv_binds) +rnLocalBindsAndThen (XHsLocalBindsLR _) _ = panic "rnLocalBindsAndThen" + rnIPBinds :: HsIPBinds GhcPs -> RnM (HsIPBinds GhcRn, FreeVars) -rnIPBinds (IPBinds ip_binds _no_dict_binds) = do +rnIPBinds (IPBinds _ ip_binds ) = do (ip_binds', fvs_s) <- mapAndUnzipM (wrapLocFstM rnIPBind) ip_binds - return (IPBinds ip_binds' emptyTcEvBinds, plusFVs fvs_s) + return (IPBinds noExt ip_binds', plusFVs fvs_s) +rnIPBinds (XHsIPBinds _) = panic "rnIPBinds" rnIPBind :: IPBind GhcPs -> RnM (IPBind GhcRn, FreeVars) -rnIPBind (IPBind ~(Left n) expr) = do +rnIPBind (IPBind _ ~(Left n) expr) = do (expr',fvExpr) <- rnLExpr expr - return (IPBind (Left n) expr', fvExpr) + return (IPBind noExt (Left n) expr', fvExpr) +rnIPBind (XCIPBind _) = panic "rnIPBind" {- ************************************************************************ @@ -338,8 +341,8 @@ rnLocalValBindsAndThen -> RnM (result, FreeVars) rnLocalValBindsAndThen binds@(ValBinds _ _ sigs) thing_inside = do { -- (A) Create the local fixity environment - new_fixities <- makeMiniFixityEnv [L loc sig - | L loc (FixSig sig) <- sigs] + new_fixities <- makeMiniFixityEnv [ L loc sig + | L loc (FixSig _ sig) <- sigs] -- (B) Rename the LHSes ; (bound_names, new_lhs) <- rnLocalValBindsLHS new_fixities binds @@ -405,27 +408,27 @@ rnBindLHS name_maker _ bind@(PatBind { pat_lhs = pat }) = do -- we don't actually use the FV processing of rnPatsAndThen here (pat',pat'_fvs) <- rnBindPat name_maker pat - return (bind { pat_lhs = pat', bind_fvs = pat'_fvs }) + return (bind { pat_lhs = pat', pat_ext = pat'_fvs }) -- We temporarily store the pat's FVs in bind_fvs; -- gets updated to the FVs of the whole bind -- when doing the RHS below rnBindLHS name_maker _ bind@(FunBind { fun_id = rdr_name }) = do { name <- applyNameMaker name_maker rdr_name - ; return (bind { fun_id = name - , bind_fvs = placeHolderNamesTc }) } + ; return (bind { fun_id = name + , fun_ext = noExt }) } -rnBindLHS name_maker _ (PatSynBind psb@PSB{ psb_id = rdrname }) +rnBindLHS name_maker _ (PatSynBind x psb@PSB{ psb_id = rdrname }) | isTopRecNameMaker name_maker = do { addLocM checkConName rdrname ; name <- lookupLocatedTopBndrRn rdrname -- Should be in scope already - ; return (PatSynBind psb{ psb_id = name }) } + ; return (PatSynBind x psb{ psb_ext = noExt, psb_id = name }) } | otherwise -- Pattern synonym, not at top level = do { addErr localPatternSynonymErr -- Complain, but make up a fake -- name so that we can carry on ; name <- applyNameMaker name_maker rdrname - ; return (PatSynBind psb{ psb_id = name }) } + ; return (PatSynBind x psb{ psb_ext = noExt, psb_id = name }) } where localPatternSynonymErr :: SDoc localPatternSynonymErr @@ -450,7 +453,7 @@ rnBind _ bind@(PatBind { pat_lhs = pat , pat_rhs = grhss -- pat fvs were stored in bind_fvs -- after processing the LHS - , bind_fvs = pat_fvs }) + , pat_ext = pat_fvs }) = do { mod <- getModule ; (grhss', rhs_fvs) <- rnGRHSs PatBindRhs rnLExpr grhss @@ -462,7 +465,7 @@ rnBind _ bind@(PatBind { pat_lhs = pat -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan bndrs = collectPatBinders pat bind' = bind { pat_rhs = grhss' - , pat_rhs_ty = placeHolderType, bind_fvs = fvs' } + , pat_ext = fvs' } ok_nobind_pat = -- See Note [Pattern bindings that bind no variables] @@ -501,13 +504,13 @@ rnBind sig_fn bind@(FunBind { fun_id = name ; fvs' `seq` -- See Note [Free-variable space leak] return (bind { fun_matches = matches' - , bind_fvs = fvs' }, + , fun_ext = fvs' }, [plain_name], rhs_fvs) } -rnBind sig_fn (PatSynBind bind) +rnBind sig_fn (PatSynBind x bind) = do { (bind', name, fvs) <- rnPatSynBind sig_fn bind - ; return (PatSynBind bind', name, fvs) } + ; return (PatSynBind x bind', name, fvs) } rnBind _ b = pprPanic "rnBind" (ppr b) @@ -591,11 +594,11 @@ mkSigTvFn sigs = \n -> lookupNameEnv env n `orElse` [] get_scoped_tvs :: LSig GhcRn -> Maybe ([Located Name], [Name]) -- Returns (binders, scoped tvs for those binders) - get_scoped_tvs (L _ (ClassOpSig _ names sig_ty)) + get_scoped_tvs (L _ (ClassOpSig _ _ names sig_ty)) = Just (names, hsScopedTvs sig_ty) - get_scoped_tvs (L _ (TypeSig names sig_ty)) + get_scoped_tvs (L _ (TypeSig _ names sig_ty)) = Just (names, hsWcScopedTvs sig_ty) - get_scoped_tvs (L _ (PatSynSig names sig_ty)) + get_scoped_tvs (L _ (PatSynSig _ names sig_ty)) = Just (names, hsScopedTvs sig_ty) get_scoped_tvs _ = Nothing @@ -610,9 +613,10 @@ makeMiniFixityEnv :: [LFixitySig GhcPs] -> RnM MiniFixityEnv makeMiniFixityEnv decls = foldlM add_one_sig emptyFsEnv decls where - add_one_sig env (L loc (FixitySig names fixity)) = + add_one_sig env (L loc (FixitySig _ names fixity)) = foldlM add_one env [ (loc,name_loc,name,fixity) | L name_loc name <- names ] + add_one_sig _ (L _ (XFixitySig _)) = panic "makeMiniFixityEnv" add_one env (loc, name_loc, name,fixity) = do { -- this fixity decl is a duplicate iff @@ -701,7 +705,8 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name -- As well as dependency analysis, we need these for the -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan - bind' = bind{ psb_args = details' + bind' = bind{ psb_ext = noExt + , psb_args = details' , psb_def = pat' , psb_dir = dir' , psb_fvs = fvs' } @@ -723,6 +728,8 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name = hang (text "Illegal pattern synonym declaration") 2 (text "Use -XPatternSynonyms to enable this extension") +rnPatSynBind _ (XPatSynBind _) = panic "rnPatSynBind" + {- Note [Renaming pattern synonym variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -876,9 +883,7 @@ rnMethodBindLHS _ cls (L loc bind@(FunBind { fun_id = name })) rest = setSrcSpan loc $ do do { sel_name <- wrapLocM (lookupInstDeclBndr cls (text "method")) name -- We use the selector name as the binder - ; let bind' = bind { fun_id = sel_name - , bind_fvs = placeHolderNamesTc } - + ; let bind' = bind { fun_id = sel_name, fun_ext = noExt } ; return (L loc bind' `consBag` rest ) } -- Report error for all other forms of bindings @@ -941,41 +946,41 @@ renameSigs ctxt sigs -- Doesn't seem worth much trouble to sort this. renameSig :: HsSigCtxt -> Sig GhcPs -> RnM (Sig GhcRn, FreeVars) -renameSig _ (IdSig x) - = return (IdSig x, emptyFVs) -- Actually this never occurs +renameSig _ (IdSig _ x) + = return (IdSig noExt x, emptyFVs) -- Actually this never occurs -renameSig ctxt sig@(TypeSig vs ty) +renameSig ctxt sig@(TypeSig _ vs ty) = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs ; let doc = TypeSigCtx (ppr_sig_bndrs vs) ; (new_ty, fvs) <- rnHsSigWcType doc ty - ; return (TypeSig new_vs new_ty, fvs) } + ; return (TypeSig noExt new_vs new_ty, fvs) } -renameSig ctxt sig@(ClassOpSig is_deflt vs ty) +renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty) = do { defaultSigs_on <- xoptM LangExt.DefaultSignatures ; when (is_deflt && not defaultSigs_on) $ addErr (defaultSigErr sig) ; new_v <- mapM (lookupSigOccRn ctxt sig) vs ; (new_ty, fvs) <- rnHsSigType ty_ctxt ty - ; return (ClassOpSig is_deflt new_v new_ty, fvs) } + ; return (ClassOpSig noExt is_deflt new_v new_ty, fvs) } where (v1:_) = vs ty_ctxt = GenericCtx (text "a class method signature for" <+> quotes (ppr v1)) -renameSig _ (SpecInstSig src ty) +renameSig _ (SpecInstSig _ src ty) = do { (new_ty, fvs) <- rnHsSigType SpecInstSigCtx ty - ; return (SpecInstSig src new_ty,fvs) } + ; return (SpecInstSig noExt src new_ty,fvs) } -- {-# SPECIALISE #-} pragmas can refer to imported Ids -- so, in the top-level case (when mb_names is Nothing) -- we use lookupOccRn. If there's both an imported and a local 'f' -- then the SPECIALISE pragma is ambiguous, unlike all other signatures -renameSig ctxt sig@(SpecSig v tys inl) +renameSig ctxt sig@(SpecSig _ v tys inl) = do { new_v <- case ctxt of TopSigCtxt {} -> lookupLocatedOccRn v _ -> lookupSigOccRn ctxt sig v ; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys - ; return (SpecSig new_v new_ty inl, fvs) } + ; return (SpecSig noExt new_v new_ty inl, fvs) } where ty_ctxt = GenericCtx (text "a SPECIALISE signature for" <+> quotes (ppr v)) @@ -983,33 +988,33 @@ renameSig ctxt sig@(SpecSig v tys inl) = do { (new_ty, fvs_ty) <- rnHsSigType ty_ctxt ty ; return ( new_ty:tys, fvs_ty `plusFV` fvs) } -renameSig ctxt sig@(InlineSig v s) +renameSig ctxt sig@(InlineSig _ v s) = do { new_v <- lookupSigOccRn ctxt sig v - ; return (InlineSig new_v s, emptyFVs) } + ; return (InlineSig noExt new_v s, emptyFVs) } -renameSig ctxt (FixSig fsig) +renameSig ctxt (FixSig _ fsig) = do { new_fsig <- rnSrcFixityDecl ctxt fsig - ; return (FixSig new_fsig, emptyFVs) } + ; return (FixSig noExt new_fsig, emptyFVs) } -renameSig ctxt sig@(MinimalSig s (L l bf)) +renameSig ctxt sig@(MinimalSig _ s (L l bf)) = do new_bf <- traverse (lookupSigOccRn ctxt sig) bf - return (MinimalSig s (L l new_bf), emptyFVs) + return (MinimalSig noExt s (L l new_bf), emptyFVs) -renameSig ctxt sig@(PatSynSig vs ty) +renameSig ctxt sig@(PatSynSig _ vs ty) = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs ; (ty', fvs) <- rnHsSigType ty_ctxt ty - ; return (PatSynSig new_vs ty', fvs) } + ; return (PatSynSig noExt new_vs ty', fvs) } where ty_ctxt = GenericCtx (text "a pattern synonym signature for" <+> ppr_sig_bndrs vs) -renameSig ctxt sig@(SCCFunSig st v s) +renameSig ctxt sig@(SCCFunSig _ st v s) = do { new_v <- lookupSigOccRn ctxt sig v - ; return (SCCFunSig st new_v s, emptyFVs) } + ; return (SCCFunSig noExt st new_v s, emptyFVs) } -- COMPLETE Sigs can refer to imported IDs which is why we use -- lookupLocatedOccRn rather than lookupSigOccRn -renameSig _ctxt sig@(CompleteMatchSig s (L l bf) mty) +renameSig _ctxt sig@(CompleteMatchSig _ s (L l bf) mty) = do new_bf <- traverse lookupLocatedOccRn bf new_mty <- traverse lookupLocatedOccRn mty @@ -1018,7 +1023,7 @@ renameSig _ctxt sig@(CompleteMatchSig s (L l bf) mty) -- Why 'any'? See Note [Orphan COMPLETE pragmas] addErrCtxt (text "In" <+> ppr sig) $ failWithTc orphanError - return (CompleteMatchSig s (L l new_bf) new_mty, emptyFVs) + return (CompleteMatchSig noExt s (L l new_bf) new_mty, emptyFVs) where orphanError :: SDoc orphanError = @@ -1026,6 +1031,8 @@ renameSig _ctxt sig@(CompleteMatchSig s (L l bf) mty) text "A COMPLETE pragma must mention at least one data constructor" $$ text "or pattern synonym defined in the same module." +renameSig _ (XSig _) = panic "renameSig" + {- Note [Orphan COMPLETE pragmas] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1092,6 +1099,8 @@ okHsSig ctxt (L _ sig) (CompleteMatchSig {}, TopSigCtxt {} ) -> True (CompleteMatchSig {}, _) -> False + (XSig _, _) -> panic "okHsSig" + ------------------- findDupSigs :: [LSig GhcPs] -> [NonEmpty (Located RdrName, Sig GhcPs)] -- Check for duplicates on RdrName version, @@ -1105,20 +1114,20 @@ findDupSigs :: [LSig GhcPs] -> [NonEmpty (Located RdrName, Sig GhcPs)] findDupSigs sigs = findDupsEq matching_sig (concatMap (expand_sig . unLoc) sigs) where - expand_sig sig@(FixSig (FixitySig ns _)) = zip ns (repeat sig) - expand_sig sig@(InlineSig n _) = [(n,sig)] - expand_sig sig@(TypeSig ns _) = [(n,sig) | n <- ns] - expand_sig sig@(ClassOpSig _ ns _) = [(n,sig) | n <- ns] - expand_sig sig@(PatSynSig ns _ ) = [(n,sig) | n <- ns] - expand_sig sig@(SCCFunSig _ n _) = [(n,sig)] + expand_sig sig@(FixSig _ (FixitySig _ ns _)) = zip ns (repeat sig) + expand_sig sig@(InlineSig _ n _) = [(n,sig)] + expand_sig sig@(TypeSig _ ns _) = [(n,sig) | n <- ns] + expand_sig sig@(ClassOpSig _ _ ns _) = [(n,sig) | n <- ns] + expand_sig sig@(PatSynSig _ ns _ ) = [(n,sig) | n <- ns] + expand_sig sig@(SCCFunSig _ _ n _) = [(n,sig)] expand_sig _ = [] matching_sig (L _ n1,sig1) (L _ n2,sig2) = n1 == n2 && mtch sig1 sig2 mtch (FixSig {}) (FixSig {}) = True mtch (InlineSig {}) (InlineSig {}) = True mtch (TypeSig {}) (TypeSig {}) = True - mtch (ClassOpSig d1 _ _) (ClassOpSig d2 _ _) = d1 == d2 - mtch (PatSynSig _ _) (PatSynSig _ _) = True + mtch (ClassOpSig _ d1 _ _) (ClassOpSig _ d2 _ _) = d1 == d2 + mtch (PatSynSig _ _ _) (PatSynSig _ _ _) = True mtch (SCCFunSig{}) (SCCFunSig{}) = True mtch _ _ = False @@ -1240,9 +1249,10 @@ rnSrcFixityDecl sig_ctxt = rn_decl -- for con-like things; hence returning a list -- If neither are in scope, report an error; otherwise -- return a fixity sig for each (slightly odd) - rn_decl (FixitySig fnames fixity) + rn_decl (FixitySig _ fnames fixity) = do names <- concatMapM lookup_one fnames - return (FixitySig names fixity) + return (FixitySig noExt names fixity) + rn_decl (XFixitySig _) = panic "rnSrcFixityDecl" lookup_one :: Located RdrName -> RnM [Located Name] lookup_one (L name_loc rdr_name) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index ec2b09f80d..4fe4102891 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -1099,10 +1099,10 @@ rnRecStmtsAndThen rnBody s cont collectRecStmtsFixities :: [LStmtLR GhcPs GhcPs body] -> [LFixitySig GhcPs] collectRecStmtsFixities l = foldr (\ s -> \acc -> case s of - (L _ (LetStmt (L _ (HsValBinds (ValBinds _ _ sigs))))) -> - foldr (\ sig -> \ acc -> case sig of - (L loc (FixSig s)) -> (L loc s) : acc - _ -> acc) acc sigs + (L _ (LetStmt (L _ (HsValBinds _ (ValBinds _ _ sigs))))) -> + foldr (\ sig -> \ acc -> case sig of + (L loc (FixSig _ s)) -> (L loc s) : acc + _ -> acc) acc sigs _ -> acc) [] l -- left-hand sides @@ -1127,12 +1127,12 @@ rn_rec_stmt_lhs fix_env (L loc (BindStmt pat body a b t)) return [(L loc (BindStmt pat' body a b t), fv_pat)] -rn_rec_stmt_lhs _ (L _ (LetStmt (L _ binds@(HsIPBinds _)))) +rn_rec_stmt_lhs _ (L _ (LetStmt (L _ binds@(HsIPBinds {})))) = failWith (badIpBinds (text "an mdo expression") binds) -rn_rec_stmt_lhs fix_env (L loc (LetStmt (L l(HsValBinds binds)))) +rn_rec_stmt_lhs fix_env (L loc (LetStmt (L l(HsValBinds x binds)))) = do (_bound_names, binds') <- rnLocalValBindsLHS fix_env binds - return [(L loc (LetStmt (L l (HsValBinds binds'))), + return [(L loc (LetStmt (L l (HsValBinds x binds'))), -- Warning: this is bogus; see function invariant emptyFVs )] @@ -1150,8 +1150,10 @@ rn_rec_stmt_lhs _ stmt@(L _ (TransStmt {})) -- Syntactically illegal in mdo rn_rec_stmt_lhs _ stmt@(L _ (ApplicativeStmt {})) -- Shouldn't appear yet = pprPanic "rn_rec_stmt" (ppr stmt) -rn_rec_stmt_lhs _ (L _ (LetStmt (L _ EmptyLocalBinds))) +rn_rec_stmt_lhs _ (L _ (LetStmt (L _ (EmptyLocalBinds _)))) = panic "rn_rec_stmt LetStmt EmptyLocalBinds" +rn_rec_stmt_lhs _ (L _ (LetStmt (L _ (XHsLocalBindsLR _)))) + = panic "rn_rec_stmt LetStmt XHsLocalBindsLR" rn_rec_stmts_lhs :: Outputable body => MiniFixityEnv -> [LStmt GhcPs body] @@ -1202,15 +1204,15 @@ rn_rec_stmt rnBody _ (L loc (BindStmt pat' body _ _ _), fv_pat) ; return [(bndrs, fvs, bndrs `intersectNameSet` fvs, L loc (BindStmt pat' body' bind_op fail_op placeHolder))] } -rn_rec_stmt _ _ (L _ (LetStmt (L _ binds@(HsIPBinds _))), _) +rn_rec_stmt _ _ (L _ (LetStmt (L _ binds@(HsIPBinds {}))), _) = failWith (badIpBinds (text "an mdo expression") binds) -rn_rec_stmt _ all_bndrs (L loc (LetStmt (L l (HsValBinds binds'))), _) +rn_rec_stmt _ all_bndrs (L loc (LetStmt (L l (HsValBinds x binds'))), _) = do { (binds', du_binds) <- rnLocalValBindsRHS (mkNameSet all_bndrs) binds' -- fixities and unused are handled above in rnRecStmtsAndThen ; let fvs = allUses du_binds ; return [(duDefs du_binds, fvs, emptyNameSet, - L loc (LetStmt (L l (HsValBinds binds'))))] } + L loc (LetStmt (L l (HsValBinds x binds'))))] } -- no RecStmt case because they get flattened above when doing the LHSes rn_rec_stmt _ _ stmt@(L _ (RecStmt {}), _) @@ -1222,7 +1224,10 @@ rn_rec_stmt _ _ stmt@(L _ (ParStmt {}), _) -- Syntactically illegal in mdo rn_rec_stmt _ _ stmt@(L _ (TransStmt {}), _) -- Syntactically illegal in mdo = pprPanic "rn_rec_stmt: TransStmt" (ppr stmt) -rn_rec_stmt _ _ (L _ (LetStmt (L _ EmptyLocalBinds)), _) +rn_rec_stmt _ _ (L _ (LetStmt (L _ (XHsLocalBindsLR _))), _) + = panic "rn_rec_stmt: LetStmt XHsLocalBindsLR" + +rn_rec_stmt _ _ (L _ (LetStmt (L _ (EmptyLocalBinds _))), _) = panic "rn_rec_stmt: LetStmt EmptyLocalBinds" rn_rec_stmt _ _ stmt@(L _ (ApplicativeStmt {}), _) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 0f6f3a1327..5458469c44 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -667,7 +667,7 @@ getLocalNonValBinders fixity_env -- In a hs-boot file, the value binders come from the -- *signatures*, and there should be no foreign binders hs_boot_sig_bndrs = [ L decl_loc (unLoc n) - | L decl_loc (TypeSig ns _) <- val_sigs, n <- ns] + | L decl_loc (TypeSig _ ns _) <- val_sigs, n <- ns] -- the SrcSpan attached to the input should be the span of the -- declaration, not just the name diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index 31caffee80..07dcff2a04 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -580,7 +580,7 @@ checkCanonicalInstances cls poly_ty mbinds = do isAliasMG :: MatchGroup GhcRn (LHsExpr GhcRn) -> Maybe Name isAliasMG MG {mg_alts = L _ [L _ (Match { m_pats = [], m_grhss = grhss })]} | GRHSs [L _ (GRHS [] body)] lbinds <- grhss - , L _ EmptyLocalBinds <- lbinds + , L _ (EmptyLocalBinds _) <- lbinds , L _ (HsVar _ (L _ rhsName)) <- body = Just rhsName isAliasMG _ = Nothing @@ -1571,7 +1571,7 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls, -- Check the signatures -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs). - ; let sig_rdr_names_w_locs = [op | L _ (ClassOpSig False ops _) <- sigs + ; let sig_rdr_names_w_locs = [op |L _ (ClassOpSig _ False ops _) <- sigs , op <- ops] ; checkDupRdrNames sig_rdr_names_w_locs -- Typechecker is responsible for checking that we only @@ -2011,8 +2011,8 @@ extendPatSynEnv val_decls local_fix_env thing = do { -> [(Name, [FieldLabel])] -> TcM [(Name, [FieldLabel])] new_ps' bind names - | L bind_loc (PatSynBind (PSB { psb_id = L _ n - , psb_args = RecCon as })) <- bind + | L bind_loc (PatSynBind _ (PSB { psb_id = L _ n + , psb_args = RecCon as })) <- bind = do bnd_name <- newTopSrcBinder (L bind_loc n) let rnames = map recordPatSynSelectorId as @@ -2021,7 +2021,7 @@ extendPatSynEnv val_decls local_fix_env thing = do { field_occs = map mkFieldOcc rnames flds <- mapM (newRecordSelector False [bnd_name]) field_occs return ((bnd_name, flds): names) - | L bind_loc (PatSynBind (PSB { psb_id = L _ n})) <- bind + | L bind_loc (PatSynBind _ (PSB { psb_id = L _ n})) <- bind = do bnd_name <- newTopSrcBinder (L bind_loc n) return ((bnd_name, []): names) @@ -2105,13 +2105,13 @@ add gp loc (SpliceD splice@(SpliceDecl _ flag)) ds -- Class declarations: pull out the fixity signatures to the top add gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs}) l (TyClD d) ds | isClassDecl d - = let fsigs = [ L l f | L l (FixSig f) <- tcdSigs d ] in + = let fsigs = [ L l f | L l (FixSig _ f) <- tcdSigs d ] in addl (gp { hs_tyclds = add_tycld (L l d) ts, hs_fixds = fsigs ++ fs}) ds | otherwise = addl (gp { hs_tyclds = add_tycld (L l d) ts }) ds -- Signatures: fixity sigs go a different place than all others -add gp@(HsGroup {hs_fixds = ts}) l (SigD (FixSig f)) ds +add gp@(HsGroup {hs_fixds = ts}) l (SigD (FixSig _ f)) ds = addl (gp {hs_fixds = L l f : ts}) ds add gp@(HsGroup {hs_valds = ts}) l (SigD d) ds = addl (gp {hs_valds = add_sig (L l d) ts}) ds |