compiler/rename/RnTypes.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnSource]{Main pass of renamer}
   5
   6 \begin{code}
   7 module RnTypes (
   8         -- Type related stuff
   9         rnHsType, rnLHsType, rnLHsTypes, rnContext,
  10         rnHsSigType, rnHsTypeFVs, rnConDeclFields, rnLPred,
  11
  12         -- Precence related stuff
  13         mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
  14         checkPrecMatch, checkSectionPrec,
  15
  16         -- Splice related stuff
  17         rnSplice, checkTH
  18   ) where
  19
  20 import {-# SOURCE #-} RnExpr( rnLExpr )
  21 #ifdef GHCI
  22 import {-# SOURCE #-} TcSplice( runQuasiQuoteType )
  23 #endif  /* GHCI */
  24
  25 import DynFlags
  26 import HsSyn
  27 import RdrHsSyn         ( extractHsRhoRdrTyVars )
  28 import RnHsSyn          ( extractHsTyNames )
  29 import RnHsDoc          ( rnLHsDoc, rnMbLHsDoc )
  30 import RnEnv
  31 import TcRnMonad
  32 import RdrName
  33 import PrelNames
  34 import TysPrim          ( funTyConName )
  35 import Name
  36 import SrcLoc
  37 import NameSet
  38
  39 import BasicTypes       ( compareFixity, funTyFixity, negateFixity,
  40                           Fixity(..), FixityDirection(..) )
  41 import Outputable
  42 import FastString
  43 import Control.Monad    ( unless )
  44
  45 #include "HsVersions.h"
  46 \end{code}
  47
  48 These type renamers are in a separate module, rather than in (say) RnSource,
  49 to break several loop.
  50
  51 %*********************************************************
  52 %*                                                      *
  53 \subsection{Renaming types}
  54 %*                                                      *
  55 %*********************************************************
  56
  57 \begin{code}
  58 rnHsTypeFVs :: SDoc -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
  59 rnHsTypeFVs doc_str ty  = do
  60     ty' <- rnLHsType doc_str ty
  61     return (ty', extractHsTyNames ty')
  62
  63 rnHsSigType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
  64         -- rnHsSigType is used for source-language type signatures,
  65         -- which use *implicit* universal quantification.
  66 rnHsSigType doc_str ty
  67   = rnLHsType (text "In the type signature for" <+> doc_str) ty
  68 \end{code}
  69
  70 rnHsType is here because we call it from loadInstDecl, and I didn't
  71 want a gratuitous knot.
  72
  73 \begin{code}
  74 rnLHsType  :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
  75 rnLHsType doc = wrapLocM (rnHsType doc)
  76
  77 rnHsType :: SDoc -> HsType RdrName -> RnM (HsType Name)
  78
  79 rnHsType doc (HsForAllTy Implicit _ ctxt ty) = do
  80         -- Implicit quantifiction in source code (no kinds on tyvars)
  81         -- Given the signature  C => T  we universally quantify
  82         -- over FV(T) \ {in-scope-tyvars}
  83     name_env <- getLocalRdrEnv
  84     let
  85         mentioned = extractHsRhoRdrTyVars ctxt ty
  86
  87         -- Don't quantify over type variables that are in scope;
  88         -- when GlasgowExts is off, there usually won't be any, except for
  89         -- class signatures:
  90         --      class C a where { op :: a -> a }
  91         forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env) . unLoc) mentioned
  92         tyvar_bndrs   = userHsTyVarBndrs forall_tyvars
  93
  94     rnForAll doc Implicit tyvar_bndrs ctxt ty
  95
  96 rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau) = do
  97         -- Explicit quantification.
  98         -- Check that the forall'd tyvars are actually
  99         -- mentioned in the type, and produce a warning if not
 100     let
 101         mentioned          = map unLoc (extractHsRhoRdrTyVars ctxt tau)
 102         forall_tyvar_names = hsLTyVarLocNames forall_tyvars
 103
 104         -- Explicitly quantified but not mentioned in ctxt or tau
 105         warn_guys = filter ((`notElem` mentioned) . unLoc) forall_tyvar_names
 106
 107     mapM_ (forAllWarn doc tau) warn_guys
 108     rnForAll doc Explicit forall_tyvars ctxt tau
 109
 110 rnHsType _ (HsTyVar tyvar) = do
 111     tyvar' <- lookupOccRn tyvar
 112     return (HsTyVar tyvar')
 113
 114 -- If we see (forall a . ty), without foralls on, the forall will give
 115 -- a sensible error message, but we don't want to complain about the dot too
 116 -- Hence the jiggery pokery with ty1
 117 rnHsType doc ty@(HsOpTy ty1 (L loc op) ty2)
 118   = setSrcSpan loc $
 119     do  { ops_ok <- xoptM Opt_TypeOperators
 120         ; op' <- if ops_ok
 121                  then lookupOccRn op
 122                  else do { addErr (opTyErr op ty)
 123                          ; return (mkUnboundName op) }  -- Avoid double complaint
 124         ; let l_op' = L loc op'
 125         ; fix <- lookupTyFixityRn l_op'
 126         ; ty1' <- rnLHsType doc ty1
 127         ; ty2' <- rnLHsType doc ty2
 128         ; mkHsOpTyRn (\t1 t2 -> HsOpTy t1 l_op' t2) op' fix ty1' ty2' }
 129
 130 rnHsType doc (HsParTy ty) = do
 131     ty' <- rnLHsType doc ty
 132     return (HsParTy ty')
 133
 134 rnHsType doc (HsBangTy b ty)
 135   = do { ty' <- rnLHsType doc ty
 136        ; return (HsBangTy b ty') }
 137
 138 rnHsType doc (HsRecTy flds)
 139   = do { flds' <- rnConDeclFields doc flds
 140        ; return (HsRecTy flds') }
 141
 142 rnHsType doc (HsFunTy ty1 ty2) = do
 143     ty1' <- rnLHsType doc ty1
 144         -- Might find a for-all as the arg of a function type
 145     ty2' <- rnLHsType doc ty2
 146         -- Or as the result.  This happens when reading Prelude.hi
 147         -- when we find return :: forall m. Monad m -> forall a. a -> m a
 148
 149         -- Check for fixity rearrangements
 150     mkHsOpTyRn HsFunTy funTyConName funTyFixity ty1' ty2'
 151
 152 rnHsType doc (HsListTy ty) = do
 153     ty' <- rnLHsType doc ty
 154     return (HsListTy ty')
 155
 156 rnHsType doc (HsKindSig ty k)
 157   = do { kind_sigs_ok <- xoptM Opt_KindSignatures
 158        ; unless kind_sigs_ok (addErr (kindSigErr ty))
 159        ; ty' <- rnLHsType doc ty
 160        ; return (HsKindSig ty' k) }
 161
 162 rnHsType doc (HsPArrTy ty) = do
 163     ty' <- rnLHsType doc ty
 164     return (HsPArrTy ty')
 165
 166 -- Unboxed tuples are allowed to have poly-typed arguments.  These
 167 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
 168 rnHsType doc (HsTupleTy tup_con tys) = do
 169     tys' <- mapM (rnLHsType doc) tys
 170     return (HsTupleTy tup_con tys')
 171
 172 rnHsType doc (HsAppTy ty1 ty2) = do
 173     ty1' <- rnLHsType doc ty1
 174     ty2' <- rnLHsType doc ty2
 175     return (HsAppTy ty1' ty2')
 176
 177 rnHsType doc (HsPredTy pred) = do
 178     pred' <- rnPred doc pred
 179     return (HsPredTy pred')
 180
 181 rnHsType _ (HsSpliceTy sp _ k)
 182   = do { (sp', fvs) <- rnSplice sp      -- ToDo: deal with fvs
 183        ; return (HsSpliceTy sp' fvs k) }
 184
 185 rnHsType doc (HsDocTy ty haddock_doc) = do
 186     ty' <- rnLHsType doc ty
 187     haddock_doc' <- rnLHsDoc haddock_doc
 188     return (HsDocTy ty' haddock_doc')
 189
 190 #ifndef GHCI
 191 rnHsType _ ty@(HsQuasiQuoteTy _) = pprPanic "Can't do quasiquotation without GHCi" (ppr ty)
 192 #else
 193 rnHsType doc (HsQuasiQuoteTy qq) = do { ty <- runQuasiQuoteType qq
 194                                       ; rnHsType doc (unLoc ty) }
 195 #endif
 196 rnHsType _ (HsCoreTy ty) = return (HsCoreTy ty)
 197
 198 --------------
 199 rnLHsTypes :: SDoc -> [LHsType RdrName]
 200            -> IOEnv (Env TcGblEnv TcLclEnv) [LHsType Name]
 201 rnLHsTypes doc tys = mapM (rnLHsType doc) tys
 202 \end{code}
 203
 204
 205 \begin{code}
 206 rnForAll :: SDoc -> HsExplicitFlag -> [LHsTyVarBndr RdrName]
 207          -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
 208
 209 rnForAll doc _ [] (L _ []) (L _ ty) = rnHsType doc ty
 210         -- One reason for this case is that a type like Int#
 211         -- starts off as (HsForAllTy Nothing [] Int), in case
 212         -- there is some quantification.  Now that we have quantified
 213         -- and discovered there are no type variables, it's nicer to turn
 214         -- it into plain Int.  If it were Int# instead of Int, we'd actually
 215         -- get an error, because the body of a genuine for-all is
 216         -- of kind *.
 217
 218 rnForAll doc exp forall_tyvars ctxt ty
 219   = bindTyVarsRn forall_tyvars $ \ new_tyvars -> do
 220     new_ctxt <- rnContext doc ctxt
 221     new_ty <- rnLHsType doc ty
 222     return (HsForAllTy exp new_tyvars new_ctxt new_ty)
 223         -- Retain the same implicit/explicit flag as before
 224         -- so that we can later print it correctly
 225
 226 rnConDeclFields :: SDoc -> [ConDeclField RdrName] -> RnM [ConDeclField Name]
 227 rnConDeclFields doc fields = mapM (rnField doc) fields
 228
 229 rnField :: SDoc -> ConDeclField RdrName -> RnM (ConDeclField Name)
 230 rnField doc (ConDeclField name ty haddock_doc)
 231   = do { new_name <- lookupLocatedTopBndrRn name
 232        ; new_ty <- rnLHsType doc ty
 233        ; new_haddock_doc <- rnMbLHsDoc haddock_doc
 234        ; return (ConDeclField new_name new_ty new_haddock_doc) }
 235 \end{code}
 236
 237 %*********************************************************
 238 %*                                                      *
 239 \subsection{Contexts and predicates}
 240 %*                                                      *
 241 %*********************************************************
 242
 243 \begin{code}
 244 rnContext :: SDoc -> LHsContext RdrName -> RnM (LHsContext Name)
 245 rnContext doc = wrapLocM (rnContext' doc)
 246
 247 rnContext' :: SDoc -> HsContext RdrName -> RnM (HsContext Name)
 248 rnContext' doc ctxt = mapM (rnLPred doc) ctxt
 249
 250 rnLPred :: SDoc -> LHsPred RdrName -> RnM (LHsPred Name)
 251 rnLPred doc  = wrapLocM (rnPred doc)
 252
 253 rnPred :: SDoc -> HsPred RdrName
 254        -> IOEnv (Env TcGblEnv TcLclEnv) (HsPred Name)
 255 rnPred doc (HsClassP clas tys)
 256   = do { clas_name <- lookupOccRn clas
 257        ; tys' <- rnLHsTypes doc tys
 258        ; return (HsClassP clas_name tys')
 259        }
 260 rnPred doc (HsEqualP ty1 ty2)
 261   = do { ty1' <- rnLHsType doc ty1
 262        ; ty2' <- rnLHsType doc ty2
 263        ; return (HsEqualP ty1' ty2')
 264        }
 265 rnPred doc (HsIParam n ty)
 266   = do { name <- newIPNameRn n
 267        ; ty' <- rnLHsType doc ty
 268        ; return (HsIParam name ty')
 269        }
 270 \end{code}
 271
 272
 273 %************************************************************************
 274 %*                                                                      *
 275         Fixities and precedence parsing
 276 %*                                                                      *
 277 %************************************************************************
 278
 279 @mkOpAppRn@ deals with operator fixities.  The argument expressions
 280 are assumed to be already correctly arranged.  It needs the fixities
 281 recorded in the OpApp nodes, because fixity info applies to the things
 282 the programmer actually wrote, so you can't find it out from the Name.
 283
 284 Furthermore, the second argument is guaranteed not to be another
 285 operator application.  Why? Because the parser parses all
 286 operator appications left-associatively, EXCEPT negation, which
 287 we need to handle specially.
 288 Infix types are read in a *right-associative* way, so that
 289         a `op` b `op` c
 290 is always read in as
 291         a `op` (b `op` c)
 292
 293 mkHsOpTyRn rearranges where necessary.  The two arguments
 294 have already been renamed and rearranged.  It's made rather tiresome
 295 by the presence of ->, which is a separate syntactic construct.
 296
 297 \begin{code}
 298 ---------------
 299 -- Building (ty1 `op1` (ty21 `op2` ty22))
 300 mkHsOpTyRn :: (LHsType Name -> LHsType Name -> HsType Name)
 301            -> Name -> Fixity -> LHsType Name -> LHsType Name
 302            -> RnM (HsType Name)
 303
 304 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy ty21 op2 ty22))
 305   = do  { fix2 <- lookupTyFixityRn op2
 306         ; mk_hs_op_ty mk1 pp_op1 fix1 ty1
 307                       (\t1 t2 -> HsOpTy t1 op2 t2)
 308                       (unLoc op2) fix2 ty21 ty22 loc2 }
 309
 310 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsFunTy ty21 ty22))
 311   = mk_hs_op_ty mk1 pp_op1 fix1 ty1
 312                 HsFunTy funTyConName funTyFixity ty21 ty22 loc2
 313
 314 mkHsOpTyRn mk1 _ _ ty1 ty2              -- Default case, no rearrangment
 315   = return (mk1 ty1 ty2)
 316
 317 ---------------
 318 mk_hs_op_ty :: (LHsType Name -> LHsType Name -> HsType Name)
 319             -> Name -> Fixity -> LHsType Name
 320             -> (LHsType Name -> LHsType Name -> HsType Name)
 321             -> Name -> Fixity -> LHsType Name -> LHsType Name -> SrcSpan
 322             -> RnM (HsType Name)
 323 mk_hs_op_ty mk1 op1 fix1 ty1
 324             mk2 op2 fix2 ty21 ty22 loc2
 325   | nofix_error     = do { precParseErr (op1,fix1) (op2,fix2)
 326                          ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) }
 327   | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22)))
 328   | otherwise       = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
 329                            new_ty <- mkHsOpTyRn mk1 op1 fix1 ty1 ty21
 330                          ; return (mk2 (noLoc new_ty) ty22) }
 331   where
 332     (nofix_error, associate_right) = compareFixity fix1 fix2
 333
 334
 335 ---------------------------
 336 mkOpAppRn :: LHsExpr Name                       -- Left operand; already rearranged
 337           -> LHsExpr Name -> Fixity             -- Operator and fixity
 338           -> LHsExpr Name                       -- Right operand (not an OpApp, but might
 339                                                 -- be a NegApp)
 340           -> RnM (HsExpr Name)
 341
 342 -- (e11 `op1` e12) `op2` e2
 343 mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
 344   | nofix_error
 345   = do precParseErr (get_op op1,fix1) (get_op op2,fix2)
 346        return (OpApp e1 op2 fix2 e2)
 347
 348   | associate_right = do
 349     new_e <- mkOpAppRn e12 op2 fix2 e2
 350     return (OpApp e11 op1 fix1 (L loc' new_e))
 351   where
 352     loc'= combineLocs e12 e2
 353     (nofix_error, associate_right) = compareFixity fix1 fix2
 354
 355 ---------------------------
 356 --      (- neg_arg) `op` e2
 357 mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
 358   | nofix_error
 359   = do precParseErr (negateName,negateFixity) (get_op op2,fix2)
 360        return (OpApp e1 op2 fix2 e2)
 361
 362   | associate_right
 363   = do new_e <- mkOpAppRn neg_arg op2 fix2 e2
 364        return (NegApp (L loc' new_e) neg_name)
 365   where
 366     loc' = combineLocs neg_arg e2
 367     (nofix_error, associate_right) = compareFixity negateFixity fix2
 368
 369 ---------------------------
 370 --      e1 `op` - neg_arg
 371 mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp _ _))     -- NegApp can occur on the right
 372   | not associate_right                 -- We *want* right association
 373   = do precParseErr (get_op op1, fix1) (negateName, negateFixity)
 374        return (OpApp e1 op1 fix1 e2)
 375   where
 376     (_, associate_right) = compareFixity fix1 negateFixity
 377
 378 ---------------------------
 379 --      Default case
 380 mkOpAppRn e1 op fix e2                  -- Default case, no rearrangment
 381   = ASSERT2( right_op_ok fix (unLoc e2),
 382              ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
 383     )
 384     return (OpApp e1 op fix e2)
 385
 386 ----------------------------
 387 get_op :: LHsExpr Name -> Name
 388 get_op (L _ (HsVar n)) = n
 389 get_op other           = pprPanic "get_op" (ppr other)
 390
 391 -- Parser left-associates everything, but
 392 -- derived instances may have correctly-associated things to
 393 -- in the right operarand.  So we just check that the right operand is OK
 394 right_op_ok :: Fixity -> HsExpr Name -> Bool
 395 right_op_ok fix1 (OpApp _ _ fix2 _)
 396   = not error_please && associate_right
 397   where
 398     (error_please, associate_right) = compareFixity fix1 fix2
 399 right_op_ok _ _
 400   = True
 401
 402 -- Parser initially makes negation bind more tightly than any other operator
 403 -- And "deriving" code should respect this (use HsPar if not)
 404 mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
 405 mkNegAppRn neg_arg neg_name
 406   = ASSERT( not_op_app (unLoc neg_arg) )
 407     return (NegApp neg_arg neg_name)
 408
 409 not_op_app :: HsExpr id -> Bool
 410 not_op_app (OpApp _ _ _ _) = False
 411 not_op_app _               = True
 412
 413 ---------------------------
 414 mkOpFormRn :: LHsCmdTop Name            -- Left operand; already rearranged
 415           -> LHsExpr Name -> Fixity     -- Operator and fixity
 416           -> LHsCmdTop Name             -- Right operand (not an infix)
 417           -> RnM (HsCmd Name)
 418
 419 -- (e11 `op1` e12) `op2` e2
 420 mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _))
 421         op2 fix2 a2
 422   | nofix_error
 423   = do precParseErr (get_op op1,fix1) (get_op op2,fix2)
 424        return (HsArrForm op2 (Just fix2) [a1, a2])
 425
 426   | associate_right
 427   = do new_c <- mkOpFormRn a12 op2 fix2 a2
 428        return (HsArrForm op1 (Just fix1)
 429                   [a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])])
 430         -- TODO: locs are wrong
 431   where
 432     (nofix_error, associate_right) = compareFixity fix1 fix2
 433
 434 --      Default case
 435 mkOpFormRn arg1 op fix arg2                     -- Default case, no rearrangment
 436   = return (HsArrForm op (Just fix) [arg1, arg2])
 437
 438
 439 --------------------------------------
 440 mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name
 441              -> RnM (Pat Name)
 442
 443 mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
 444   = do  { fix1 <- lookupFixityRn (unLoc op1)
 445         ; let (nofix_error, associate_right) = compareFixity fix1 fix2
 446
 447         ; if nofix_error then do
 448                 { precParseErr (unLoc op1,fix1) (unLoc op2,fix2)
 449                 ; return (ConPatIn op2 (InfixCon p1 p2)) }
 450
 451           else if associate_right then do
 452                 { new_p <- mkConOpPatRn op2 fix2 p12 p2
 453                 ; return (ConPatIn op1 (InfixCon p11 (L loc new_p))) } -- XXX loc right?
 454           else return (ConPatIn op2 (InfixCon p1 p2)) }
 455
 456 mkConOpPatRn op _ p1 p2                         -- Default case, no rearrangment
 457   = ASSERT( not_op_pat (unLoc p2) )
 458     return (ConPatIn op (InfixCon p1 p2))
 459
 460 not_op_pat :: Pat Name -> Bool
 461 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
 462 not_op_pat _                           = True
 463
 464 --------------------------------------
 465 checkPrecMatch :: Name -> MatchGroup Name -> RnM ()
 466   -- Check precedence of a function binding written infix
 467   --   eg  a `op` b `C` c = ...
 468   -- See comments with rnExpr (OpApp ...) about "deriving"
 469
 470 checkPrecMatch op (MatchGroup ms _)
 471   = mapM_ check ms
 472   where
 473     check (L _ (Match (L l1 p1 : L l2 p2 :_) _ _))
 474       = setSrcSpan (combineSrcSpans l1 l2) $
 475         do checkPrec op p1 False
 476            checkPrec op p2 True
 477
 478     check _ = return ()
 479         -- This can happen.  Consider
 480         --      a `op` True = ...
 481         --      op          = ...
 482         -- The infix flag comes from the first binding of the group
 483         -- but the second eqn has no args (an error, but not discovered
 484         -- until the type checker).  So we don't want to crash on the
 485         -- second eqn.
 486
 487 checkPrec :: Name -> Pat Name -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
 488 checkPrec op (ConPatIn op1 (InfixCon _ _)) right = do
 489     op_fix@(Fixity op_prec  op_dir) <- lookupFixityRn op
 490     op1_fix@(Fixity op1_prec op1_dir) <- lookupFixityRn (unLoc op1)
 491     let
 492         inf_ok = op1_prec > op_prec ||
 493                  (op1_prec == op_prec &&
 494                   (op1_dir == InfixR && op_dir == InfixR && right ||
 495                    op1_dir == InfixL && op_dir == InfixL && not right))
 496
 497         info  = (op,        op_fix)
 498         info1 = (unLoc op1, op1_fix)
 499         (infol, infor) = if right then (info, info1) else (info1, info)
 500     unless inf_ok (precParseErr infol infor)
 501
 502 checkPrec _ _ _
 503   = return ()
 504
 505 -- Check precedence of (arg op) or (op arg) respectively
 506 -- If arg is itself an operator application, then either
 507 --   (a) its precedence must be higher than that of op
 508 --   (b) its precedency & associativity must be the same as that of op
 509 checkSectionPrec :: FixityDirection -> HsExpr RdrName
 510         -> LHsExpr Name -> LHsExpr Name -> RnM ()
 511 checkSectionPrec direction section op arg
 512   = case unLoc arg of
 513         OpApp _ op fix _ -> go_for_it (get_op op) fix
 514         NegApp _ _       -> go_for_it negateName  negateFixity
 515         _                -> return ()
 516   where
 517     op_name = get_op op
 518     go_for_it arg_op arg_fix@(Fixity arg_prec assoc) = do
 519           op_fix@(Fixity op_prec _) <- lookupFixityRn op_name
 520           unless (op_prec < arg_prec
 521                   || (op_prec == arg_prec && direction == assoc))
 522                  (sectionPrecErr (op_name, op_fix)
 523                                  (arg_op, arg_fix) section)
 524 \end{code}
 525
 526 Precedence-related error messages
 527
 528 \begin{code}
 529 precParseErr :: (Name, Fixity) -> (Name, Fixity) -> RnM ()
 530 precParseErr op1@(n1,_) op2@(n2,_)
 531   | isUnboundName n1 || isUnboundName n2
 532   = return ()     -- Avoid error cascade
 533   | otherwise
 534   = addErr $ hang (ptext (sLit "Precedence parsing error"))
 535       4 (hsep [ptext (sLit "cannot mix"), ppr_opfix op1, ptext (sLit "and"),
 536                ppr_opfix op2,
 537                ptext (sLit "in the same infix expression")])
 538
 539 sectionPrecErr :: (Name, Fixity) -> (Name, Fixity) -> HsExpr RdrName -> RnM ()
 540 sectionPrecErr op@(n1,_) arg_op@(n2,_) section
 541   | isUnboundName n1 || isUnboundName n2
 542   = return ()     -- Avoid error cascade
 543   | otherwise
 544   = addErr $ vcat [ptext (sLit "The operator") <+> ppr_opfix op <+> ptext (sLit "of a section"),
 545          nest 4 (sep [ptext (sLit "must have lower precedence than that of the operand,"),
 546                       nest 2 (ptext (sLit "namely") <+> ppr_opfix arg_op)]),
 547          nest 4 (ptext (sLit "in the section:") <+> quotes (ppr section))]
 548
 549 ppr_opfix :: (Name, Fixity) -> SDoc
 550 ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity)
 551    where
 552      pp_op | op == negateName = ptext (sLit "prefix `-'")
 553            | otherwise        = quotes (ppr op)
 554 \end{code}
 555
 556 %*********************************************************
 557 %*                                                      *
 558 \subsection{Errors}
 559 %*                                                      *
 560 %*********************************************************
 561
 562 \begin{code}
 563 forAllWarn :: SDoc -> LHsType RdrName -> Located RdrName
 564            -> TcRnIf TcGblEnv TcLclEnv ()
 565 forAllWarn doc ty (L loc tyvar)
 566   = ifDOptM Opt_WarnUnusedMatches       $
 567     addWarnAt loc (sep [ptext (sLit "The universally quantified type variable") <+> quotes (ppr tyvar),
 568                         nest 4 (ptext (sLit "does not appear in the type") <+> quotes (ppr ty))]
 569                    $$
 570                    doc)
 571
 572 opTyErr :: RdrName -> HsType RdrName -> SDoc
 573 opTyErr op ty@(HsOpTy ty1 _ _)
 574   = hang (ptext (sLit "Illegal operator") <+> quotes (ppr op) <+> ptext (sLit "in type") <+> quotes (ppr ty))
 575          2 extra
 576   where
 577     extra | op == dot_tv_RDR && forall_head ty1
 578           = perhapsForallMsg
 579           | otherwise
 580           = ptext (sLit "Use -XTypeOperators to allow operators in types")
 581
 582     forall_head (L _ (HsTyVar tv))   = tv == forall_tv_RDR
 583     forall_head (L _ (HsAppTy ty _)) = forall_head ty
 584     forall_head _other               = False
 585 opTyErr _ ty = pprPanic "opTyErr: Not an op" (ppr ty)
 586 \end{code}
 587
 588 %*********************************************************
 589 %*                                                      *
 590                 Splices
 591 %*                                                      *
 592 %*********************************************************
 593
 594 Note [Splices]
 595 ~~~~~~~~~~~~~~
 596 Consider
 597         f = ...
 598         h = ...$(thing "f")...
 599
 600 The splice can expand into literally anything, so when we do dependency
 601 analysis we must assume that it might mention 'f'.  So we simply treat
 602 all locally-defined names as mentioned by any splice.  This is terribly
 603 brutal, but I don't see what else to do.  For example, it'll mean
 604 that every locally-defined thing will appear to be used, so no unused-binding
 605 warnings.  But if we miss the dependency, then we might typecheck 'h' before 'f',
 606 and that will crash the type checker because 'f' isn't in scope.
 607
 608 Currently, I'm not treating a splice as also mentioning every import,
 609 which is a bit inconsistent -- but there are a lot of them.  We might
 610 thereby get some bogus unused-import warnings, but we won't crash the
 611 type checker.  Not very satisfactory really.
 612
 613 \begin{code}
 614 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
 615 rnSplice (HsSplice n expr)
 616   = do  { checkTH expr "splice"
 617         ; loc  <- getSrcSpanM
 618         ; n' <- newLocalBndrRn (L loc n)
 619         ; (expr', fvs) <- rnLExpr expr
 620
 621         -- Ugh!  See Note [Splices] above
 622         ; lcl_rdr <- getLocalRdrEnv
 623         ; gbl_rdr <- getGlobalRdrEnv
 624         ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
 625                                                     isLocalGRE gre]
 626               lcl_names = mkNameSet (occEnvElts lcl_rdr)
 627
 628         ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
 629
 630 checkTH :: Outputable a => a -> String -> RnM ()
 631 #ifdef GHCI
 632 checkTH _ _ = return () -- OK
 633 #else
 634 checkTH e what  -- Raise an error in a stage-1 compiler
 635   = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>
 636                   ptext (sLit "illegal in a stage-1 compiler"),
 637                   nest 2 (ppr e)])
 638 #endif
 639 \end{code}