X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnTypes.lhs;h=cb60b934d2907c1f387706be0f4886c74b63e237;hp=62b778d5f85b0eb1d95a467a4dfd55b5a6d1a804;hb=dafabe653da4e6cf5aea6b5281c8f77de8d0964a;hpb=1e436f2bb208a6c990743afaf17b7c2a93c31742 diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs index 62b778d..cb60b93 100644 --- a/compiler/rename/RnTypes.lhs +++ b/compiler/rename/RnTypes.lhs @@ -213,7 +213,7 @@ rnForAll doc _ [] (L _ []) (L _ ty) = rnHsType doc ty -- of kind *. rnForAll doc exp forall_tyvars ctxt ty - = bindTyVarsRn doc forall_tyvars $ \ new_tyvars -> do + = bindTyVarsRn forall_tyvars $ \ new_tyvars -> do new_ctxt <- rnContext doc ctxt new_ty <- rnLHsType doc ty return (HsForAllTy exp new_tyvars new_ctxt new_ty) @@ -459,18 +459,18 @@ not_op_pat (ConPatIn _ (InfixCon _ _)) = False not_op_pat _ = True -------------------------------------- -checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM () - -- True indicates an infix lhs - -- See comments with rnExpr (OpApp ...) about "deriving" +checkPrecMatch :: Name -> MatchGroup Name -> RnM () + -- Check precedence of a function binding written infix + -- eg a `op` b `C` c = ... + -- See comments with rnExpr (OpApp ...) about "deriving" -checkPrecMatch False _ _ - = return () -checkPrecMatch True op (MatchGroup ms _) +checkPrecMatch op (MatchGroup ms _) = mapM_ check ms where - check (L _ (Match (p1:p2:_) _ _)) - = do checkPrec op (unLoc p1) False - checkPrec op (unLoc p2) True + check (L _ (Match (L l1 p1 : L l2 p2 :_) _ _)) + = setSrcSpan (combineSrcSpans l1 l2) $ + do checkPrec op p1 False + checkPrec op p2 True check _ = return () -- This can happen. Consider