X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnTypes.lhs;h=bfd02896647e346568d6088cdd4a42513519eb62;hb=04feba252e40d16101b92948cd1e13c7bc1f3062;hp=82c1a5de4cb7156db1a0a8d4a97bf1bd27515872;hpb=40888e1d6141c919254f93545ae0d795e20ae4bf;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnTypes.lhs b/ghc/compiler/rename/RnTypes.lhs index 82c1a5d..bfd0289 100644 --- a/ghc/compiler/rename/RnTypes.lhs +++ b/ghc/compiler/rename/RnTypes.lhs @@ -4,14 +4,24 @@ \section[RnSource]{Main pass of renamer} \begin{code} -module RnTypes ( rnHsType, rnLHsType, rnLHsTypes, rnContext, - rnHsSigType, rnHsTypeFVs, - rnLPat, rnPat, rnPatsAndThen, -- Here because it's not part - rnLit, rnOverLit, -- of any mutual recursion - precParseErr, sectionPrecErr, dupFieldErr, patSigErr, checkTupSize +module RnTypes ( + -- Type related stuff + rnHsType, rnLHsType, rnLHsTypes, rnContext, + rnHsSigType, rnHsTypeFVs, + + -- Patterns and literals + rnLPat, rnPat, rnPatsAndThen, -- Here because it's not part + rnLit, rnOverLit, -- of any mutual recursion + + -- Precence related stuff + mkOpAppRn, mkNegAppRn, mkOpFormRn, + checkPrecMatch, checkSectionPrec, + + -- Error messages + dupFieldErr, patSigErr, checkTupSize ) where -import CmdLineOpts ( DynFlag(Opt_WarnUnusedMatches, Opt_GlasgowExts) ) +import DynFlags ( DynFlag(Opt_WarnUnusedMatches, Opt_GlasgowExts) ) import HsSyn import RdrHsSyn ( extractHsRhoRdrTyVars ) @@ -20,25 +30,27 @@ import RnHsSyn ( extractHsTyNames, parrTyCon_name, tupleTyCon_name, ) import RnEnv ( lookupOccRn, lookupBndrRn, lookupSyntaxName, lookupLocatedOccRn, lookupLocatedBndrRn, - lookupLocatedGlobalOccRn, bindTyVarsRn, lookupFixityRn, + lookupLocatedGlobalOccRn, bindTyVarsRn, + lookupFixityRn, lookupTyFixityRn, mapFvRn, warnUnusedMatches, newIPNameRn, bindPatSigTyVarsFV, bindLocatedLocalsFV ) import TcRnMonad import RdrName ( RdrName, elemLocalRdrEnv ) -import PrelNames ( eqClassName, integralClassName, +import PrelNames ( eqClassName, integralClassName, geName, eqName, negateName, minusName, lengthPName, indexPName, plusIntegerName, fromIntegerName, timesIntegerName, ratioDataConName, fromRationalName ) +import TypeRep ( funTyCon ) import Constants ( mAX_TUPLE_SIZE ) import Name ( Name ) -import SrcLoc ( Located(..), unLoc ) +import SrcLoc ( SrcSpan, Located(..), unLoc, noLoc, combineLocs ) import NameSet import Literal ( inIntRange, inCharRange ) -import BasicTypes ( compareFixity ) +import BasicTypes ( compareFixity, funTyFixity, negateFixity, + Fixity(..), FixityDirection(..) ) import ListSetOps ( removeDups ) import Outputable -import Monad ( when ) #include "HsVersions.h" \end{code} @@ -87,7 +99,7 @@ rnHsType doc (HsForAllTy Implicit _ ctxt ty) -- class signatures: -- class C a where { op :: a -> a } forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env) . unLoc) mentioned - tyvar_bndrs = [ L loc (UserTyVar v) | (L loc v) <- forall_tyvars ] + tyvar_bndrs = userHsTyVarBndrs forall_tyvars in rnForAll doc Implicit tyvar_bndrs ctxt ty @@ -110,18 +122,25 @@ rnHsType doc (HsTyVar tyvar) returnM (HsTyVar tyvar') rnHsType doc (HsOpTy ty1 (L loc op) ty2) - = addSrcSpan loc ( + = setSrcSpan loc ( lookupOccRn op `thenM` \ op' -> - lookupTyFixityRn (L loc op') `thenM` \ fix -> + let + l_op' = L loc op' + in + lookupTyFixityRn l_op' `thenM` \ fix -> rnLHsType doc ty1 `thenM` \ ty1' -> rnLHsType doc ty2 `thenM` \ ty2' -> - mkHsOpTyRn (L loc op') fix ty1' ty2' + mkHsOpTyRn (\t1 t2 -> HsOpTy t1 l_op' t2) (ppr op') fix ty1' ty2' ) rnHsType doc (HsParTy ty) = rnLHsType doc ty `thenM` \ ty' -> returnM (HsParTy ty') +rnHsType doc (HsBangTy b ty) + = rnLHsType doc ty `thenM` \ ty' -> + returnM (HsBangTy b ty') + rnHsType doc (HsNumTy i) | i == 1 = returnM (HsNumTy i) | otherwise = addErr err_msg `thenM_` returnM (HsNumTy i) @@ -135,7 +154,9 @@ rnHsType doc (HsFunTy ty1 ty2) rnLHsType doc ty2 `thenM` \ ty2' -> -- Or as the result. This happens when reading Prelude.hi -- when we find return :: forall m. Monad m -> forall a. a -> m a - returnM (HsFunTy ty1' ty2') + + -- Check for fixity rearrangements + mkHsOpTyRn HsFunTy (ppr funTyCon) funTyFixity ty1' ty2' rnHsType doc (HsListTy ty) = rnLHsType doc ty `thenM` \ ty' -> @@ -161,7 +182,7 @@ rnHsType doc (HsAppTy ty1 ty2) returnM (HsAppTy ty1' ty2') rnHsType doc (HsPredTy pred) - = rnLPred doc pred `thenM` \ pred' -> + = rnPred doc pred `thenM` \ pred' -> returnM (HsPredTy pred') rnLHsTypes doc tys = mappM (rnLHsType doc) tys @@ -169,8 +190,8 @@ rnLHsTypes doc tys = mappM (rnLHsType doc) tys \begin{code} -rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName] -> LHsContext RdrName - -> LHsType RdrName -> RnM (HsType Name) +rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName] + -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name) rnForAll doc exp [] (L _ []) (L _ ty) = rnHsType doc ty -- One reason for this case is that a type like Int# @@ -191,12 +212,21 @@ rnForAll doc exp forall_tyvars ctxt ty \end{code} -%********************************************************* -%* * -\subsection{Fixities} -%* * -%********************************************************* +%************************************************************************ +%* * + Fixities and precedence parsing +%* * +%************************************************************************ + +@mkOpAppRn@ deals with operator fixities. The argument expressions +are assumed to be already correctly arranged. It needs the fixities +recorded in the OpApp nodes, because fixity info applies to the things +the programmer actually wrote, so you can't find it out from the Name. +Furthermore, the second argument is guaranteed not to be another +operator application. Why? Because the parser parses all +operator appications left-associatively, EXCEPT negation, which +we need to handle specially. Infix types are read in a *right-associative* way, so that a `op` b `op` c is always read in as @@ -204,39 +234,242 @@ is always read in as mkHsOpTyRn rearranges where necessary. The two arguments have already been renamed and rearranged. It's made rather tiresome -by the presence of -> +by the presence of ->, which is a separate syntactic construct. \begin{code} -lookupTyFixityRn (L loc n) - = doptM Opt_GlasgowExts `thenM` \ glaExts -> - when (not glaExts) - (addSrcSpan loc $ addWarn (infixTyConWarn n)) `thenM_` - lookupFixityRn n - +--------------- -- Building (ty1 `op1` (ty21 `op2` ty22)) -mkHsOpTyRn :: Located Name -> Fixity - -> LHsType Name -> LHsType Name +mkHsOpTyRn :: (LHsType Name -> LHsType Name -> HsType Name) + -> SDoc -> Fixity -> LHsType Name -> LHsType Name -> RnM (HsType Name) -mkHsOpTyRn op1 fix1 ty1 ty2@(L loc (HsOpTy ty21 op2 ty22)) - = lookupTyFixityRn op2 `thenM` \ fix2 -> +mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy ty21 op2 ty22)) + = do { fix2 <- lookupTyFixityRn op2 + ; mk_hs_op_ty mk1 pp_op1 fix1 ty1 + (\t1 t2 -> HsOpTy t1 op2 t2) + (ppr op2) fix2 ty21 ty22 loc2 } + +mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2@(L loc2 (HsFunTy ty21 ty22)) + = mk_hs_op_ty mk1 pp_op1 fix1 ty1 + HsFunTy (ppr funTyCon) funTyFixity ty21 ty22 loc2 + +mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2 -- Default case, no rearrangment + = return (mk1 ty1 ty2) + +--------------- +mk_hs_op_ty :: (LHsType Name -> LHsType Name -> HsType Name) + -> SDoc -> Fixity -> LHsType Name + -> (LHsType Name -> LHsType Name -> HsType Name) + -> SDoc -> Fixity -> LHsType Name -> LHsType Name -> SrcSpan + -> RnM (HsType Name) +mk_hs_op_ty mk1 pp_op1 fix1 ty1 + mk2 pp_op2 fix2 ty21 ty22 loc2 + | nofix_error = do { addErr (precParseErr (quotes pp_op1,fix1) + (quotes pp_op2,fix2)) + ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) } + | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) + | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22) + new_ty <- mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty21 + ; return (mk2 (noLoc new_ty) ty22) } + where + (nofix_error, associate_right) = compareFixity fix1 fix2 + + +--------------------------- +mkOpAppRn :: LHsExpr Name -- Left operand; already rearranged + -> LHsExpr Name -> Fixity -- Operator and fixity + -> LHsExpr Name -- Right operand (not an OpApp, but might + -- be a NegApp) + -> RnM (HsExpr Name) + +-- (e11 `op1` e12) `op2` e2 +mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2 + | nofix_error + = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_` + returnM (OpApp e1 op2 fix2 e2) + + | associate_right + = mkOpAppRn e12 op2 fix2 e2 `thenM` \ new_e -> + returnM (OpApp e11 op1 fix1 (L loc' new_e)) + where + loc'= combineLocs e12 e2 + (nofix_error, associate_right) = compareFixity fix1 fix2 + +--------------------------- +-- (- neg_arg) `op` e2 +mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2 + | nofix_error + = addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2)) `thenM_` + returnM (OpApp e1 op2 fix2 e2) + + | associate_right + = mkOpAppRn neg_arg op2 fix2 e2 `thenM` \ new_e -> + returnM (NegApp (L loc' new_e) neg_name) + where + loc' = combineLocs neg_arg e2 + (nofix_error, associate_right) = compareFixity negateFixity fix2 + +--------------------------- +-- e1 `op` - neg_arg +mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp neg_arg _)) -- NegApp can occur on the right + | not associate_right -- We *want* right association + = addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity)) `thenM_` + returnM (OpApp e1 op1 fix1 e2) + where + (_, associate_right) = compareFixity fix1 negateFixity + +--------------------------- +-- Default case +mkOpAppRn e1 op fix e2 -- Default case, no rearrangment + = ASSERT2( right_op_ok fix (unLoc e2), + ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2 + ) + returnM (OpApp e1 op fix e2) + +-- Parser left-associates everything, but +-- derived instances may have correctly-associated things to +-- in the right operarand. So we just check that the right operand is OK +right_op_ok fix1 (OpApp _ _ fix2 _) + = not error_please && associate_right + where + (error_please, associate_right) = compareFixity fix1 fix2 +right_op_ok fix1 other + = True + +-- Parser initially makes negation bind more tightly than any other operator +-- And "deriving" code should respect this (use HsPar if not) +mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id) +mkNegAppRn neg_arg neg_name + = ASSERT( not_op_app (unLoc neg_arg) ) + returnM (NegApp neg_arg neg_name) + +not_op_app (OpApp _ _ _ _) = False +not_op_app other = True + +--------------------------- +mkOpFormRn :: LHsCmdTop Name -- Left operand; already rearranged + -> LHsExpr Name -> Fixity -- Operator and fixity + -> LHsCmdTop Name -- Right operand (not an infix) + -> RnM (HsCmd Name) + +-- (e11 `op1` e12) `op2` e2 +mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _)) + op2 fix2 a2 + | nofix_error + = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_` + returnM (HsArrForm op2 (Just fix2) [a1, a2]) + + | associate_right + = mkOpFormRn a12 op2 fix2 a2 `thenM` \ new_c -> + returnM (HsArrForm op1 (Just fix1) + [a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])]) + -- TODO: locs are wrong + where + (nofix_error, associate_right) = compareFixity fix1 fix2 + +-- Default case +mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment + = returnM (HsArrForm op (Just fix) [arg1, arg2]) + + +-------------------------------------- +mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name + -> RnM (Pat Name) + +mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2 + = lookupFixityRn (unLoc op1) `thenM` \ fix1 -> let (nofix_error, associate_right) = compareFixity fix1 fix2 in if nofix_error then - addErr (precParseErr (quotes (ppr op1),fix1) - (quotes (ppr op2),fix2)) `thenM_` - returnM (HsOpTy ty1 op1 ty2) + addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_` + returnM (ConPatIn op2 (InfixCon p1 p2)) else - if not associate_right then - -- Rearrange to ((ty1 `op1` ty21) `op2` ty22) - mkHsOpTyRn op1 fix1 ty1 ty21 `thenM` \ new_ty -> - returnM (HsOpTy (L loc new_ty) op2 ty22) -- XXX loc is wrong + if associate_right then + mkConOpPatRn op2 fix2 p12 p2 `thenM` \ new_p -> + returnM (ConPatIn op1 (InfixCon p11 (L loc new_p))) -- XXX loc right? else - returnM (HsOpTy ty1 op1 ty2) + returnM (ConPatIn op2 (InfixCon p1 p2)) + +mkConOpPatRn op fix p1 p2 -- Default case, no rearrangment + = ASSERT( not_op_pat (unLoc p2) ) + returnM (ConPatIn op (InfixCon p1 p2)) + +not_op_pat (ConPatIn _ (InfixCon _ _)) = False +not_op_pat other = True + +-------------------------------------- +checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM () + -- True indicates an infix lhs + -- See comments with rnExpr (OpApp ...) about "deriving" + +checkPrecMatch False fn match + = returnM () +checkPrecMatch True op (MatchGroup ms _) + = mapM_ check ms + where + check (L _ (Match (p1:p2:_) _ _)) + = checkPrec op (unLoc p1) False `thenM_` + checkPrec op (unLoc p2) True + + check _ = panic "checkPrecMatch" + +checkPrec op (ConPatIn op1 (InfixCon _ _)) right + = lookupFixityRn op `thenM` \ op_fix@(Fixity op_prec op_dir) -> + lookupFixityRn (unLoc op1) `thenM` \ op1_fix@(Fixity op1_prec op1_dir) -> + let + inf_ok = op1_prec > op_prec || + (op1_prec == op_prec && + (op1_dir == InfixR && op_dir == InfixR && right || + op1_dir == InfixL && op_dir == InfixL && not right)) + + info = (ppr_op op, op_fix) + info1 = (ppr_op op1, op1_fix) + (infol, infor) = if right then (info, info1) else (info1, info) + in + checkErr inf_ok (precParseErr infol infor) + +checkPrec op pat right + = returnM () -mkHsOpTyRn op fix ty1 ty2 -- Default case, no rearrangment - = returnM (HsOpTy ty1 op ty2) +-- Check precedence of (arg op) or (op arg) respectively +-- If arg is itself an operator application, then either +-- (a) its precedence must be higher than that of op +-- (b) its precedency & associativity must be the same as that of op +checkSectionPrec :: FixityDirection -> HsExpr RdrName + -> LHsExpr Name -> LHsExpr Name -> RnM () +checkSectionPrec direction section op arg + = case unLoc arg of + OpApp _ op fix _ -> go_for_it (ppr_op op) fix + NegApp _ _ -> go_for_it pp_prefix_minus negateFixity + other -> returnM () + where + L _ (HsVar op_name) = op + go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc) + = lookupFixityRn op_name `thenM` \ op_fix@(Fixity op_prec _) -> + checkErr (op_prec < arg_prec + || op_prec == arg_prec && direction == assoc) + (sectionPrecErr (ppr_op op_name, op_fix) + (pp_arg_op, arg_fix) section) +\end{code} + +Precedence-related error messages + +\begin{code} +precParseErr op1 op2 + = hang (ptext SLIT("precedence parsing error")) + 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"), + ppr_opfix op2, + ptext SLIT("in the same infix expression")]) + +sectionPrecErr op arg_op section + = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"), + nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op), + nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))] + +pp_prefix_minus = ptext SLIT("prefix `-'") +ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name +ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity) \end{code} %********************************************************* @@ -275,7 +508,6 @@ rnPred doc (HsIParam n ty) \begin{code} rnPatsAndThen :: HsMatchContext Name - -> Bool -> [LPat RdrName] -> ([LPat Name] -> RnM (a, FreeVars)) -> RnM (a, FreeVars) @@ -287,7 +519,7 @@ rnPatsAndThen :: HsMatchContext Name -- matches together, so that we spot the repeated variable in -- f x x = 1 -rnPatsAndThen ctxt repUnused pats thing_inside +rnPatsAndThen ctxt pats thing_inside = bindPatSigTyVarsFV pat_sig_tys $ bindLocatedLocalsFV doc_pat bndrs $ \ new_bndrs -> rnLPats pats `thenM` \ (pats', pat_fvs) -> @@ -296,9 +528,7 @@ rnPatsAndThen ctxt repUnused pats thing_inside let unused_binders = filter (not . (`elemNameSet` res_fvs)) new_bndrs in - (if repUnused - then warnUnusedMatches unused_binders - else returnM ()) `thenM_` + warnUnusedMatches unused_binders `thenM_` returnM (res, res_fvs `plusFV` pat_fvs) where pat_sig_tys = collectSigTysFromPats pats @@ -339,23 +569,25 @@ rnPat (LitPat lit) = rnLit lit `thenM_` returnM (LitPat lit, emptyFVs) -rnPat (NPatIn lit mb_neg) +rnPat (NPat lit mb_neg eq _) = rnOverLit lit `thenM` \ (lit', fvs1) -> (case mb_neg of Nothing -> returnM (Nothing, emptyFVs) Just _ -> lookupSyntaxName negateName `thenM` \ (neg, fvs) -> returnM (Just neg, fvs) ) `thenM` \ (mb_neg', fvs2) -> - returnM (NPatIn lit' mb_neg', - fvs1 `plusFV` fvs2 `addOneFV` eqClassName) + lookupSyntaxName eqName `thenM` \ (eq', fvs3) -> + returnM (NPat lit' mb_neg' eq' placeHolderType, + fvs1 `plusFV` fvs2 `plusFV` fvs3 `addOneFV` eqClassName) -- Needed to find equality on pattern -rnPat (NPlusKPatIn name lit _) +rnPat (NPlusKPat name lit _ _) = rnOverLit lit `thenM` \ (lit', fvs1) -> lookupLocatedBndrRn name `thenM` \ name' -> lookupSyntaxName minusName `thenM` \ (minus, fvs2) -> - returnM (NPlusKPatIn name' lit' minus, - fvs1 `plusFV` fvs2 `addOneFV` integralClassName) + lookupSyntaxName geName `thenM` \ (ge, fvs3) -> + returnM (NPlusKPat name' lit' ge minus, + fvs1 `plusFV` fvs2 `plusFV` fvs3 `addOneFV` integralClassName) -- The Report says that n+k patterns must be in Integral rnPat (LazyPat pat) @@ -385,10 +617,11 @@ rnPat (PArrPat pats _) where implicit_fvs = mkFVs [lengthPName, indexPName] -rnPat (TuplePat pats boxed) +rnPat (TuplePat pats boxed _) = checkTupSize tup_size `thenM_` rnLPats pats `thenM` \ (patslist, fvs) -> - returnM (TuplePat patslist boxed, fvs `addOneFV` tycon_name) + returnM (TuplePat patslist boxed placeHolderType, + fvs `addOneFV` tycon_name) where tup_size = length pats tycon_name = tupleTyCon_name boxed tup_size @@ -437,33 +670,6 @@ rnRpats rpats rnLPat pat `thenM` \ (pat', fvs) -> returnM ((fieldname, pat'), fvs `addOneFV` unLoc fieldname) --- ----------------------------------------------------------------------------- --- mkConOpPatRn - -mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name - -> RnM (Pat Name) - -mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2 - = lookupFixityRn (unLoc op1) `thenM` \ fix1 -> - let - (nofix_error, associate_right) = compareFixity fix1 fix2 - in - if nofix_error then - addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_` - returnM (ConPatIn op2 (InfixCon p1 p2)) - else - if associate_right then - mkConOpPatRn op2 fix2 p12 p2 `thenM` \ new_p -> - returnM (ConPatIn op1 (InfixCon p11 (L loc new_p))) -- XXX loc right? - else - returnM (ConPatIn op2 (InfixCon p1 p2)) - -mkConOpPatRn op fix p1 p2 -- Default case, no rearrangment - = ASSERT( not_op_pat (unLoc p2) ) - returnM (ConPatIn op (InfixCon p1 p2)) - -not_op_pat (ConPatIn _ (InfixCon _ _)) = False -not_op_pat other = True \end{code} @@ -531,7 +737,7 @@ checkTupSize tup_size forAllWarn doc ty (L loc tyvar) = ifOptM Opt_WarnUnusedMatches $ - addSrcSpan loc $ + setSrcSpan loc $ addWarn (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar), nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))] $$ @@ -541,20 +747,6 @@ forAllWarn doc ty (L loc tyvar) bogusCharError c = ptext SLIT("character literal out of range: '\\") <> char c <> char '\'' -precParseErr op1 op2 - = hang (ptext SLIT("precedence parsing error")) - 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"), - ppr_opfix op2, - ptext SLIT("in the same infix expression")]) - -sectionPrecErr op arg_op section - = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"), - nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op), - nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))] - -infixTyConWarn op - = ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op) - patSigErr ty = (ptext SLIT("Illegal signature in pattern:") <+> ppr ty) $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it")) @@ -563,7 +755,4 @@ dupFieldErr str dup = hsep [ptext SLIT("duplicate field name"), quotes (ppr dup), ptext SLIT("in record"), text str] - -ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name -ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity) \end{code}