never executed always true always false
    1 {-# LANGUAGE TypeApplications #-}
    2 {-# LANGUAGE DeriveFunctor       #-}
    3 {-# LANGUAGE FlexibleContexts    #-}
    4 {-# LANGUAGE RankNTypes          #-}
    5 {-# LANGUAGE ScopedTypeVariables #-}
    6 {-# LANGUAGE TypeFamilies        #-}
    7 {-# LANGUAGE ViewPatterns        #-}
    8 {-# LANGUAGE DisambiguateRecordFields #-}
    9 
   10 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
   11 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
   12 
   13 {-
   14 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   15 
   16 Renaming of patterns
   17 
   18 Basically dependency analysis.
   19 
   20 Handles @Match@, @GRHSs@, @HsExpr@, and @Qualifier@ datatypes.  In
   21 general, all of these functions return a renamed thing, and a set of
   22 free variables.
   23 -}
   24 module GHC.Rename.Pat (-- main entry points
   25               rnPat, rnPats, rnBindPat, rnPatAndThen,
   26 
   27               NameMaker, applyNameMaker,     -- a utility for making names:
   28               localRecNameMaker, topRecNameMaker,  --   sometimes we want to make local names,
   29                                              --   sometimes we want to make top (qualified) names.
   30               isTopRecNameMaker,
   31 
   32               rnHsRecFields, HsRecFieldContext(..),
   33               rnHsRecUpdFields,
   34 
   35               -- CpsRn monad
   36               CpsRn, liftCps, liftCpsWithCont,
   37 
   38               -- Literals
   39               rnLit, rnOverLit,
   40              ) where
   41 
   42 -- ENH: thin imports to only what is necessary for patterns
   43 
   44 import GHC.Prelude
   45 
   46 import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr )
   47 import {-# SOURCE #-} GHC.Rename.Splice ( rnSplicePat )
   48 
   49 import GHC.Hs
   50 import GHC.Tc.Errors.Types
   51 import GHC.Tc.Utils.Monad
   52 import GHC.Tc.Utils.Zonk   ( hsOverLitName )
   53 import GHC.Rename.Env
   54 import GHC.Rename.Fixity
   55 import GHC.Rename.Utils    ( HsDocContext(..), newLocalBndrRn, bindLocalNames
   56                            , warnUnusedMatches, newLocalBndrRn
   57                            , checkUnusedRecordWildcard
   58                            , checkDupNames, checkDupAndShadowedNames
   59                            , wrapGenSpan, genHsApps, genLHsVar, genHsIntegralLit )
   60 import GHC.Rename.HsType
   61 import GHC.Builtin.Names
   62 import GHC.Types.Avail ( greNameMangledName )
   63 import GHC.Types.Error
   64 import GHC.Types.Name
   65 import GHC.Types.Name.Set
   66 import GHC.Types.Name.Reader
   67 import GHC.Types.Basic
   68 import GHC.Types.SourceText
   69 import GHC.Utils.Misc
   70 import GHC.Data.List.SetOps( removeDups )
   71 import GHC.Utils.Outputable
   72 import GHC.Utils.Panic.Plain
   73 import GHC.Types.SrcLoc
   74 import GHC.Types.Literal   ( inCharRange )
   75 import GHC.Builtin.Types   ( nilDataCon )
   76 import GHC.Core.DataCon
   77 import GHC.Driver.Session ( getDynFlags, xopt_DuplicateRecordFields )
   78 import qualified GHC.LanguageExtensions as LangExt
   79 
   80 import Control.Monad       ( when, ap, guard, forM, unless )
   81 import qualified Data.List.NonEmpty as NE
   82 import Data.Maybe
   83 import Data.Ratio
   84 import GHC.Types.FieldLabel (DuplicateRecordFields(..))
   85 
   86 {-
   87 *********************************************************
   88 *                                                      *
   89         The CpsRn Monad
   90 *                                                      *
   91 *********************************************************
   92 
   93 Note [CpsRn monad]
   94 ~~~~~~~~~~~~~~~~~~
   95 The CpsRn monad uses continuation-passing style to support this
   96 style of programming:
   97 
   98         do { ...
   99            ; ns <- bindNames rs
  100            ; ...blah... }
  101 
  102    where rs::[RdrName], ns::[Name]
  103 
  104 The idea is that '...blah...'
  105   a) sees the bindings of ns
  106   b) returns the free variables it mentions
  107      so that bindNames can report unused ones
  108 
  109 In particular,
  110     mapM rnPatAndThen [p1, p2, p3]
  111 has a *left-to-right* scoping: it makes the binders in
  112 p1 scope over p2,p3.
  113 -}
  114 
  115 newtype CpsRn b = CpsRn { unCpsRn :: forall r. (b -> RnM (r, FreeVars))
  116                                             -> RnM (r, FreeVars) }
  117         deriving (Functor)
  118         -- See Note [CpsRn monad]
  119 
  120 instance Applicative CpsRn where
  121     pure x = CpsRn (\k -> k x)
  122     (<*>) = ap
  123 
  124 instance Monad CpsRn where
  125   (CpsRn m) >>= mk = CpsRn (\k -> m (\v -> unCpsRn (mk v) k))
  126 
  127 runCps :: CpsRn a -> RnM (a, FreeVars)
  128 runCps (CpsRn m) = m (\r -> return (r, emptyFVs))
  129 
  130 liftCps :: RnM a -> CpsRn a
  131 liftCps rn_thing = CpsRn (\k -> rn_thing >>= k)
  132 
  133 liftCpsFV :: RnM (a, FreeVars) -> CpsRn a
  134 liftCpsFV rn_thing = CpsRn (\k -> do { (v,fvs1) <- rn_thing
  135                                      ; (r,fvs2) <- k v
  136                                      ; return (r, fvs1 `plusFV` fvs2) })
  137 
  138 liftCpsWithCont :: (forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars)) -> CpsRn b
  139 liftCpsWithCont = CpsRn
  140 
  141 wrapSrcSpanCps :: (a -> CpsRn b) -> LocatedA a -> CpsRn (LocatedA b)
  142 -- Set the location, and also wrap it around the value returned
  143 wrapSrcSpanCps fn (L loc a)
  144   = CpsRn (\k -> setSrcSpanA loc $
  145                  unCpsRn (fn a) $ \v ->
  146                  k (L loc v))
  147 
  148 lookupConCps :: LocatedN RdrName -> CpsRn (LocatedN Name)
  149 lookupConCps con_rdr
  150   = CpsRn (\k -> do { con_name <- lookupLocatedOccRnConstr con_rdr
  151                     ; (r, fvs) <- k con_name
  152                     ; return (r, addOneFV fvs (unLoc con_name)) })
  153     -- We add the constructor name to the free vars
  154     -- See Note [Patterns are uses]
  155 
  156 {-
  157 Note [Patterns are uses]
  158 ~~~~~~~~~~~~~~~~~~~~~~~~
  159 Consider
  160   module Foo( f, g ) where
  161   data T = T1 | T2
  162 
  163   f T1 = True
  164   f T2 = False
  165 
  166   g _ = T1
  167 
  168 Arguably we should report T2 as unused, even though it appears in a
  169 pattern, because it never occurs in a constructed position.
  170 See #7336.
  171 However, implementing this in the face of pattern synonyms would be
  172 less straightforward, since given two pattern synonyms
  173 
  174   pattern P1 <- P2
  175   pattern P2 <- ()
  176 
  177 we need to observe the dependency between P1 and P2 so that type
  178 checking can be done in the correct order (just like for value
  179 bindings). Dependencies between bindings is analyzed in the renamer,
  180 where we don't know yet whether P2 is a constructor or a pattern
  181 synonym. So for now, we do report conid occurrences in patterns as
  182 uses.
  183 
  184 *********************************************************
  185 *                                                      *
  186         Name makers
  187 *                                                      *
  188 *********************************************************
  189 
  190 Externally abstract type of name makers,
  191 which is how you go from a RdrName to a Name
  192 -}
  193 
  194 data NameMaker
  195   = LamMk       -- Lambdas
  196       Bool      -- True <=> report unused bindings
  197                 --   (even if True, the warning only comes out
  198                 --    if -Wunused-matches is on)
  199 
  200   | LetMk       -- Let bindings, incl top level
  201                 -- Do *not* check for unused bindings
  202       TopLevelFlag
  203       MiniFixityEnv
  204 
  205 topRecNameMaker :: MiniFixityEnv -> NameMaker
  206 topRecNameMaker fix_env = LetMk TopLevel fix_env
  207 
  208 isTopRecNameMaker :: NameMaker -> Bool
  209 isTopRecNameMaker (LetMk TopLevel _) = True
  210 isTopRecNameMaker _ = False
  211 
  212 localRecNameMaker :: MiniFixityEnv -> NameMaker
  213 localRecNameMaker fix_env = LetMk NotTopLevel fix_env
  214 
  215 matchNameMaker :: HsMatchContext a -> NameMaker
  216 matchNameMaker ctxt = LamMk report_unused
  217   where
  218     -- Do not report unused names in interactive contexts
  219     -- i.e. when you type 'x <- e' at the GHCi prompt
  220     report_unused = case ctxt of
  221                       StmtCtxt (HsDoStmt GhciStmtCtxt) -> False
  222                       -- also, don't warn in pattern quotes, as there
  223                       -- is no RHS where the variables can be used!
  224                       ThPatQuote            -> False
  225                       _                     -> True
  226 
  227 newPatLName :: NameMaker -> LocatedN RdrName -> CpsRn (LocatedN Name)
  228 newPatLName name_maker rdr_name@(L loc _)
  229   = do { name <- newPatName name_maker rdr_name
  230        ; return (L loc name) }
  231 
  232 newPatName :: NameMaker -> LocatedN RdrName -> CpsRn Name
  233 newPatName (LamMk report_unused) rdr_name
  234   = CpsRn (\ thing_inside ->
  235         do { name <- newLocalBndrRn rdr_name
  236            ; (res, fvs) <- bindLocalNames [name] (thing_inside name)
  237            ; when report_unused $ warnUnusedMatches [name] fvs
  238            ; return (res, name `delFV` fvs) })
  239 
  240 newPatName (LetMk is_top fix_env) rdr_name
  241   = CpsRn (\ thing_inside ->
  242         do { name <- case is_top of
  243                        NotTopLevel -> newLocalBndrRn rdr_name
  244                        TopLevel    -> newTopSrcBinder rdr_name
  245            ; bindLocalNames [name] $
  246                  -- Do *not* use bindLocalNameFV here;
  247                  --   see Note [View pattern usage]
  248                  -- For the TopLevel case
  249                  --   see Note [bindLocalNames for an External name]
  250              addLocalFixities fix_env [name] $
  251              thing_inside name })
  252 
  253 {- Note [bindLocalNames for an External name]
  254 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  255 In the TopLevel case, the use of bindLocalNames here is somewhat
  256 suspicious because it binds a top-level External name in the
  257 LocalRdrEnv.  c.f. Note [LocalRdrEnv] in GHC.Types.Name.Reader.
  258 
  259 However, this only happens when renaming the LHS (only) of a top-level
  260 pattern binding.  Even though this only the LHS, we need to bring the
  261 binder into scope in the pattern itself in case the binder is used in
  262 subsequent view patterns.  A bit bizarre, something like
  263   (x, Just y <- f x) = e
  264 
  265 Anyway, bindLocalNames does work, and the binding only exists for the
  266 duration of the pattern; then the top-level name is added to the
  267 global env before going on to the RHSes (see GHC.Rename.Module).
  268 
  269 Note [View pattern usage]
  270 ~~~~~~~~~~~~~~~~~~~~~~~~~
  271 Consider
  272   let (r, (r -> x)) = x in ...
  273 Here the pattern binds 'r', and then uses it *only* in the view pattern.
  274 We want to "see" this use, and in let-bindings we collect all uses and
  275 report unused variables at the binding level. So we must use bindLocalNames
  276 here, *not* bindLocalNameFV.  #3943.
  277 
  278 
  279 Note [Don't report shadowing for pattern synonyms]
  280 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  281 There is one special context where a pattern doesn't introduce any new binders -
  282 pattern synonym declarations. Therefore we don't check to see if pattern
  283 variables shadow existing identifiers as they are never bound to anything
  284 and have no scope.
  285 
  286 Without this check, there would be quite a cryptic warning that the `x`
  287 in the RHS of the pattern synonym declaration shadowed the top level `x`.
  288 
  289 ```
  290 x :: ()
  291 x = ()
  292 
  293 pattern P x = Just x
  294 ```
  295 
  296 See #12615 for some more examples.
  297 
  298 Note [Handling overloaded and rebindable patterns]
  299 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  300 Overloaded paterns and rebindable patterns are desugared in the renamer
  301 using the HsPatExpansion mechanism detailed in:
  302 Note [Rebindable syntax and HsExpansion]
  303 The approach is similar to that of expressions, which is further detailed
  304 in Note [Handling overloaded and rebindable constructs] in GHC.Rename.Expr.
  305 
  306 Here are the patterns that are currently desugared in this way:
  307 
  308 * ListPat (list patterns [p1,p2,p3])
  309   When (and only when) OverloadedLists is on, desugar to a view pattern:
  310     [p1, p2, p3]
  311   ==>
  312     toList -> [p1, p2, p3]
  313               ^^^^^^^^^^^^ built-in (non-overloaded) list pattern
  314   NB: the type checker and desugarer still see ListPat,
  315       but to them it always means the built-in list pattern.
  316   See Note [Desugaring overloaded list patterns] below for more details.
  317 
  318 We expect to add to this list as we deal with more patterns via the expansion
  319 mechanism.
  320 
  321 Note [Desugaring overloaded list patterns]
  322 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  323 If OverloadedLists is enabled, we desugar a list pattern to a view pattern:
  324 
  325   [p1, p2, p3]
  326 ==>
  327   toList -> [p1, p2, p3]
  328 
  329 This happens directly in the renamer, using the HsPatExpansion mechanism
  330 detailed in Note [Rebindable syntax and HsExpansion].
  331 
  332 Note that we emit a special view pattern: we additionally keep track of an
  333 inverse to the pattern.
  334 See Note [Invertible view patterns] in GHC.Tc.TyCl.PatSyn for details.
  335 
  336 == Wrinkle ==
  337 
  338 This is all fine, except in one very specific case:
  339   - when RebindableSyntax is off,
  340   - and the type being matched on is already a list type.
  341 
  342 In this case, it is undesirable to desugar an overloaded list pattern into
  343 a view pattern. To illustrate, consider the following program:
  344 
  345 > {-# LANGUAGE OverloadedLists #-}
  346 >
  347 > f []    = True
  348 > f (_:_) = False
  349 
  350 Without any special logic, the pattern `[]` is desugared to `(toList -> [])`,
  351 whereas `(_:_)` remains a constructor pattern. This implies that the argument
  352 of `f` is necessarily a list (even though `OverloadedLists` is enabled).
  353 After desugaring the overloaded list pattern `[]`, and type-checking, we obtain:
  354 
  355 > f :: [a] -> Bool
  356 > f (toList -> []) = True
  357 > f (_:_)          = False
  358 
  359 The pattern match checker then warns that the pattern `[]` is not covered,
  360 as it isn't able to look through view patterns.
  361 We can see that this is silly: as we are matching on a list, `toList` doesn't
  362 actually do anything. So we ignore it, and desugar the pattern to an explicit
  363 list pattern, instead of a view pattern.
  364 
  365 Note however that this is not necessarily sound, because it is possible to have
  366 a list `l` such that `toList l` is not the same as `l`.
  367 This can happen with an overlapping instance, such as the following:
  368 
  369 instance {-# OVERLAPPING #-} IsList [Int] where
  370   type Item [Int] = Int
  371   toList = reverse
  372   fromList = reverse
  373 
  374 We make the assumption that no such instance exists, in order to avoid worsening
  375 pattern-match warnings (see #14547).
  376 
  377 *********************************************************
  378 *                                                      *
  379         External entry points
  380 *                                                      *
  381 *********************************************************
  382 
  383 There are various entry points to renaming patterns, depending on
  384  (1) whether the names created should be top-level names or local names
  385  (2) whether the scope of the names is entirely given in a continuation
  386      (e.g., in a case or lambda, but not in a let or at the top-level,
  387       because of the way mutually recursive bindings are handled)
  388  (3) whether the a type signature in the pattern can bind
  389         lexically-scoped type variables (for unpacking existential
  390         type vars in data constructors)
  391  (4) whether we do duplicate and unused variable checking
  392  (5) whether there are fixity declarations associated with the names
  393      bound by the patterns that need to be brought into scope with them.
  394 
  395  Rather than burdening the clients of this module with all of these choices,
  396  we export the three points in this design space that we actually need:
  397 -}
  398 
  399 -- ----------- Entry point 1: rnPats -------------------
  400 -- Binds local names; the scope of the bindings is entirely in the thing_inside
  401 --   * allows type sigs to bind type vars
  402 --   * local namemaker
  403 --   * unused and duplicate checking
  404 --   * no fixities
  405 rnPats :: HsMatchContext GhcRn -- for error messages
  406        -> [LPat GhcPs]
  407        -> ([LPat GhcRn] -> RnM (a, FreeVars))
  408        -> RnM (a, FreeVars)
  409 rnPats ctxt pats thing_inside
  410   = do  { envs_before <- getRdrEnvs
  411 
  412           -- (1) rename the patterns, bringing into scope all of the term variables
  413           -- (2) then do the thing inside.
  414         ; unCpsRn (rnLPatsAndThen (matchNameMaker ctxt) pats) $ \ pats' -> do
  415         { -- Check for duplicated and shadowed names
  416           -- Must do this *after* renaming the patterns
  417           -- See Note [Collect binders only after renaming] in GHC.Hs.Utils
  418           -- Because we don't bind the vars all at once, we can't
  419           --    check incrementally for duplicates;
  420           -- Nor can we check incrementally for shadowing, else we'll
  421           --    complain *twice* about duplicates e.g. f (x,x) = ...
  422           --
  423           -- See note [Don't report shadowing for pattern synonyms]
  424         ; let bndrs = collectPatsBinders CollNoDictBinders pats'
  425         ; addErrCtxt doc_pat $
  426           if isPatSynCtxt ctxt
  427              then checkDupNames bndrs
  428              else checkDupAndShadowedNames envs_before bndrs
  429         ; thing_inside pats' } }
  430   where
  431     doc_pat = text "In" <+> pprMatchContext ctxt
  432 
  433 rnPat :: HsMatchContext GhcRn -- for error messages
  434       -> LPat GhcPs
  435       -> (LPat GhcRn -> RnM (a, FreeVars))
  436       -> RnM (a, FreeVars)     -- Variables bound by pattern do not
  437                                -- appear in the result FreeVars
  438 rnPat ctxt pat thing_inside
  439   = rnPats ctxt [pat] (\pats' -> let [pat'] = pats' in thing_inside pat')
  440 
  441 applyNameMaker :: NameMaker -> LocatedN RdrName -> RnM (LocatedN Name)
  442 applyNameMaker mk rdr = do { (n, _fvs) <- runCps (newPatLName mk rdr)
  443                            ; return n }
  444 
  445 -- ----------- Entry point 2: rnBindPat -------------------
  446 -- Binds local names; in a recursive scope that involves other bound vars
  447 --      e.g let { (x, Just y) = e1; ... } in ...
  448 --   * does NOT allows type sig to bind type vars
  449 --   * local namemaker
  450 --   * no unused and duplicate checking
  451 --   * fixities might be coming in
  452 rnBindPat :: NameMaker
  453           -> LPat GhcPs
  454           -> RnM (LPat GhcRn, FreeVars)
  455    -- Returned FreeVars are the free variables of the pattern,
  456    -- of course excluding variables bound by this pattern
  457 
  458 rnBindPat name_maker pat = runCps (rnLPatAndThen name_maker pat)
  459 
  460 {-
  461 *********************************************************
  462 *                                                      *
  463         The main event
  464 *                                                      *
  465 *********************************************************
  466 -}
  467 
  468 -- ----------- Entry point 3: rnLPatAndThen -------------------
  469 -- General version: parametrized by how you make new names
  470 
  471 rnLPatsAndThen :: NameMaker -> [LPat GhcPs] -> CpsRn [LPat GhcRn]
  472 rnLPatsAndThen mk = mapM (rnLPatAndThen mk)
  473   -- Despite the map, the monad ensures that each pattern binds
  474   -- variables that may be mentioned in subsequent patterns in the list
  475 
  476 --------------------
  477 -- The workhorse
  478 rnLPatAndThen :: NameMaker -> LPat GhcPs -> CpsRn (LPat GhcRn)
  479 rnLPatAndThen nm lpat = wrapSrcSpanCps (rnPatAndThen nm) lpat
  480 
  481 rnPatAndThen :: NameMaker -> Pat GhcPs -> CpsRn (Pat GhcRn)
  482 rnPatAndThen _  (WildPat _)   = return (WildPat noExtField)
  483 rnPatAndThen mk (ParPat x lpar pat rpar) =
  484   do { pat' <- rnLPatAndThen mk pat
  485      ; return (ParPat x lpar pat' rpar) }
  486 rnPatAndThen mk (LazyPat _ pat) = do { pat' <- rnLPatAndThen mk pat
  487                                      ; return (LazyPat noExtField pat') }
  488 rnPatAndThen mk (BangPat _ pat) = do { pat' <- rnLPatAndThen mk pat
  489                                      ; return (BangPat noExtField pat') }
  490 rnPatAndThen mk (VarPat x (L l rdr))
  491     = do { loc <- liftCps getSrcSpanM
  492          ; name <- newPatName mk (L (noAnnSrcSpan loc) rdr)
  493          ; return (VarPat x (L l name)) }
  494      -- we need to bind pattern variables for view pattern expressions
  495      -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)
  496 
  497 rnPatAndThen mk (SigPat _ pat sig)
  498   -- When renaming a pattern type signature (e.g. f (a :: T) = ...), it is
  499   -- important to rename its type signature _before_ renaming the rest of the
  500   -- pattern, so that type variables are first bound by the _outermost_ pattern
  501   -- type signature they occur in. This keeps the type checker happy when
  502   -- pattern type signatures happen to be nested (#7827)
  503   --
  504   -- f ((Just (x :: a) :: Maybe a)
  505   -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~^       `a' is first bound here
  506   -- ~~~~~~~~~~~~~~~^                   the same `a' then used here
  507   = do { sig' <- rnHsPatSigTypeAndThen sig
  508        ; pat' <- rnLPatAndThen mk pat
  509        ; return (SigPat noExtField pat' sig' ) }
  510   where
  511     rnHsPatSigTypeAndThen :: HsPatSigType GhcPs -> CpsRn (HsPatSigType GhcRn)
  512     rnHsPatSigTypeAndThen sig = liftCpsWithCont (rnHsPatSigType AlwaysBind PatCtx sig)
  513 
  514 rnPatAndThen mk (LitPat x lit)
  515   | HsString src s <- lit
  516   = do { ovlStr <- liftCps (xoptM LangExt.OverloadedStrings)
  517        ; if ovlStr
  518          then rnPatAndThen mk
  519                            (mkNPat (noLocA (mkHsIsString src s))
  520                                       Nothing noAnn)
  521          else normal_lit }
  522   | otherwise = normal_lit
  523   where
  524     normal_lit = do { liftCps (rnLit lit); return (LitPat x (convertLit lit)) }
  525 
  526 rnPatAndThen _ (NPat x (L l lit) mb_neg _eq)
  527   = do { (lit', mb_neg') <- liftCpsFV $ rnOverLit lit
  528        ; mb_neg' -- See Note [Negative zero]
  529            <- let negative = do { (neg, fvs) <- lookupSyntax negateName
  530                                 ; return (Just neg, fvs) }
  531                   positive = return (Nothing, emptyFVs)
  532               in liftCpsFV $ case (mb_neg , mb_neg') of
  533                                   (Nothing, Just _ ) -> negative
  534                                   (Just _ , Nothing) -> negative
  535                                   (Nothing, Nothing) -> positive
  536                                   (Just _ , Just _ ) -> positive
  537        ; eq' <- liftCpsFV $ lookupSyntax eqName
  538        ; return (NPat x (L l lit') mb_neg' eq') }
  539 
  540 rnPatAndThen mk (NPlusKPat _ rdr (L l lit) _ _ _ )
  541   = do { new_name <- newPatName mk (l2n rdr)
  542        ; (lit', _) <- liftCpsFV $ rnOverLit lit -- See Note [Negative zero]
  543                                                 -- We skip negateName as
  544                                                 -- negative zero doesn't make
  545                                                 -- sense in n + k patterns
  546        ; minus <- liftCpsFV $ lookupSyntax minusName
  547        ; ge    <- liftCpsFV $ lookupSyntax geName
  548        ; return (NPlusKPat noExtField (L (noAnnSrcSpan $ nameSrcSpan new_name) new_name)
  549                                       (L l lit') lit' ge minus) }
  550                 -- The Report says that n+k patterns must be in Integral
  551 
  552 rnPatAndThen mk (AsPat _ rdr pat)
  553   = do { new_name <- newPatLName mk rdr
  554        ; pat' <- rnLPatAndThen mk pat
  555        ; return (AsPat noExtField new_name pat') }
  556 
  557 rnPatAndThen mk p@(ViewPat _ expr pat)
  558   = do { liftCps $ do { vp_flag <- xoptM LangExt.ViewPatterns
  559                       ; checkErr vp_flag (TcRnIllegalViewPattern p) }
  560          -- Because of the way we're arranging the recursive calls,
  561          -- this will be in the right context
  562        ; expr' <- liftCpsFV $ rnLExpr expr
  563        ; pat' <- rnLPatAndThen mk pat
  564        -- Note: at this point the PreTcType in ty can only be a placeHolder
  565        -- ; return (ViewPat expr' pat' ty) }
  566 
  567        -- Note: we can't cook up an inverse for an arbitrary view pattern,
  568        -- so we pass 'Nothing'.
  569        ; return (ViewPat Nothing expr' pat') }
  570 
  571 rnPatAndThen mk (ConPat _ con args)
  572    -- rnConPatAndThen takes care of reconstructing the pattern
  573    -- The pattern for the empty list needs to be replaced by an empty explicit list pattern when overloaded lists is turned on.
  574   = case unLoc con == nameRdrName (dataConName nilDataCon) of
  575       True    -> do { ol_flag <- liftCps $ xoptM LangExt.OverloadedLists
  576                     ; if ol_flag then rnPatAndThen mk (ListPat noAnn [])
  577                                  else rnConPatAndThen mk con args}
  578       False   -> rnConPatAndThen mk con args
  579 
  580 rnPatAndThen mk (ListPat _ pats)
  581   = do { opt_OverloadedLists  <- liftCps $ xoptM LangExt.OverloadedLists
  582        ; pats' <- rnLPatsAndThen mk pats
  583        ; if not opt_OverloadedLists
  584          then return (ListPat noExtField pats')
  585          else
  586     -- If OverloadedLists is enabled, desugar to a view pattern.
  587     -- See Note [Desugaring overloaded list patterns]
  588     do { (to_list_name,_)     <- liftCps $ lookupSyntaxName toListName
  589        -- Use 'fromList' as proof of invertibility of the view pattern.
  590        -- See Note [Invertible view patterns] in GHC.Tc.TyCl.PatSyn
  591        ; (from_list_n_name,_) <- liftCps $ lookupSyntaxName fromListNName
  592        ; let
  593            lit_n   = mkIntegralLit (length pats)
  594            hs_lit  = genHsIntegralLit lit_n
  595            inverse = genHsApps from_list_n_name [hs_lit]
  596            rn_list_pat  = ListPat noExtField pats'
  597            exp_expr     = genLHsVar to_list_name
  598            exp_list_pat = ViewPat (Just inverse) exp_expr (wrapGenSpan rn_list_pat)
  599        ; return $ mkExpandedPat rn_list_pat exp_list_pat }}
  600 
  601 rnPatAndThen mk (TuplePat _ pats boxed)
  602   = do { pats' <- rnLPatsAndThen mk pats
  603        ; return (TuplePat noExtField pats' boxed) }
  604 
  605 rnPatAndThen mk (SumPat _ pat alt arity)
  606   = do { pat <- rnLPatAndThen mk pat
  607        ; return (SumPat noExtField pat alt arity)
  608        }
  609 
  610 -- If a splice has been run already, just rename the result.
  611 rnPatAndThen mk (SplicePat x (HsSpliced x2 mfs (HsSplicedPat pat)))
  612   = SplicePat x . HsSpliced x2 mfs . HsSplicedPat <$> rnPatAndThen mk pat
  613 
  614 rnPatAndThen mk (SplicePat _ splice)
  615   = do { eith <- liftCpsFV $ rnSplicePat splice
  616        ; case eith of   -- See Note [rnSplicePat] in GHC.Rename.Splice
  617            Left  not_yet_renamed -> rnPatAndThen mk not_yet_renamed
  618            Right already_renamed -> return already_renamed }
  619 
  620 --------------------
  621 rnConPatAndThen :: NameMaker
  622                 -> LocatedN RdrName    -- the constructor
  623                 -> HsConPatDetails GhcPs
  624                 -> CpsRn (Pat GhcRn)
  625 
  626 rnConPatAndThen mk con (PrefixCon tyargs pats)
  627   = do  { con' <- lookupConCps con
  628         ; liftCps check_lang_exts
  629         ; tyargs' <- forM tyargs $ \t ->
  630             liftCpsWithCont $ rnHsPatSigTypeBindingVars HsTypeCtx t
  631         ; pats' <- rnLPatsAndThen mk pats
  632         ; return $ ConPat
  633             { pat_con_ext = noExtField
  634             , pat_con = con'
  635             , pat_args = PrefixCon tyargs' pats'
  636             }
  637         }
  638   where
  639     check_lang_exts :: RnM ()
  640     check_lang_exts = do
  641       scoped_tyvars <- xoptM LangExt.ScopedTypeVariables
  642       type_app      <- xoptM LangExt.TypeApplications
  643       unless (scoped_tyvars && type_app) $
  644         case listToMaybe tyargs of
  645           Nothing    -> pure ()
  646           Just tyarg -> addErr $ TcRnUnknownMessage $ mkPlainError noHints $
  647             hang (text "Illegal visible type application in a pattern:"
  648                     <+> quotes (char '@' <> ppr tyarg))
  649                2 (text "Both ScopedTypeVariables and TypeApplications are"
  650                     <+> text "required to use this feature")
  651 
  652 rnConPatAndThen mk con (InfixCon pat1 pat2)
  653   = do  { con' <- lookupConCps con
  654         ; pat1' <- rnLPatAndThen mk pat1
  655         ; pat2' <- rnLPatAndThen mk pat2
  656         ; fixity <- liftCps $ lookupFixityRn (unLoc con')
  657         ; liftCps $ mkConOpPatRn con' fixity pat1' pat2' }
  658 
  659 rnConPatAndThen mk con (RecCon rpats)
  660   = do  { con' <- lookupConCps con
  661         ; rpats' <- rnHsRecPatsAndThen mk con' rpats
  662         ; return $ ConPat
  663             { pat_con_ext = noExtField
  664             , pat_con = con'
  665             , pat_args = RecCon rpats'
  666             }
  667         }
  668 
  669 checkUnusedRecordWildcardCps :: SrcSpan -> Maybe [Name] -> CpsRn ()
  670 checkUnusedRecordWildcardCps loc dotdot_names =
  671   CpsRn (\thing -> do
  672                     (r, fvs) <- thing ()
  673                     checkUnusedRecordWildcard loc fvs dotdot_names
  674                     return (r, fvs) )
  675 --------------------
  676 rnHsRecPatsAndThen :: NameMaker
  677                    -> LocatedN Name      -- Constructor
  678                    -> HsRecFields GhcPs (LPat GhcPs)
  679                    -> CpsRn (HsRecFields GhcRn (LPat GhcRn))
  680 rnHsRecPatsAndThen mk (L _ con)
  681      hs_rec_fields@(HsRecFields { rec_dotdot = dd })
  682   = do { flds <- liftCpsFV $ rnHsRecFields (HsRecFieldPat con) mkVarPat
  683                                             hs_rec_fields
  684        ; flds' <- mapM rn_field (flds `zip` [1..])
  685        ; check_unused_wildcard (implicit_binders flds' <$> dd)
  686        ; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }) }
  687   where
  688     mkVarPat l n = VarPat noExtField (L (noAnnSrcSpan l) n)
  689     rn_field (L l fld, n') =
  690       do { arg' <- rnLPatAndThen (nested_mk dd mk n') (hfbRHS fld)
  691          ; return (L l (fld { hfbRHS = arg' })) }
  692 
  693     loc = maybe noSrcSpan getLoc dd
  694 
  695     -- Get the arguments of the implicit binders
  696     implicit_binders fs (unLoc -> n) = collectPatsBinders CollNoDictBinders implicit_pats
  697       where
  698         implicit_pats = map (hfbRHS . unLoc) (drop n fs)
  699 
  700     -- Don't warn for let P{..} = ... in ...
  701     check_unused_wildcard = case mk of
  702                               LetMk{} -> const (return ())
  703                               LamMk{} -> checkUnusedRecordWildcardCps loc
  704 
  705         -- Suppress unused-match reporting for fields introduced by ".."
  706     nested_mk Nothing  mk                    _  = mk
  707     nested_mk (Just _) mk@(LetMk {})         _  = mk
  708     nested_mk (Just (unLoc -> n)) (LamMk report_unused) n'
  709       = LamMk (report_unused && (n' <= n))
  710 
  711 
  712 {- *********************************************************************
  713 *                                                                      *
  714               Generating code for HsPatExpanded
  715       See Note [Handling overloaded and rebindable constructs]
  716 *                                                                      *
  717 ********************************************************************* -}
  718 
  719 -- | Build a 'HsPatExpansion' out of an extension constructor,
  720 --   and the two components of the expansion: original and
  721 --   desugared patterns
  722 mkExpandedPat
  723   :: Pat GhcRn -- ^ source pattern
  724   -> Pat GhcRn -- ^ expanded pattern
  725   -> Pat GhcRn -- ^ suitably wrapped 'HsPatExpansion'
  726 mkExpandedPat a b = XPat (HsPatExpanded a b)
  727 
  728 {-
  729 ************************************************************************
  730 *                                                                      *
  731         Record fields
  732 *                                                                      *
  733 ************************************************************************
  734 -}
  735 
  736 data HsRecFieldContext
  737   = HsRecFieldCon Name
  738   | HsRecFieldPat Name
  739   | HsRecFieldUpd
  740 
  741 rnHsRecFields
  742     :: forall arg.
  743        HsRecFieldContext
  744     -> (SrcSpan -> RdrName -> arg)
  745          -- When punning, use this to build a new field
  746     -> HsRecFields GhcPs (LocatedA arg)
  747     -> RnM ([LHsRecField GhcRn (LocatedA arg)], FreeVars)
  748 
  749 -- This surprisingly complicated pass
  750 --   a) looks up the field name (possibly using disambiguation)
  751 --   b) fills in puns and dot-dot stuff
  752 -- When we've finished, we've renamed the LHS, but not the RHS,
  753 -- of each x=e binding
  754 --
  755 -- This is used for record construction and pattern-matching, but not updates.
  756 
  757 rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
  758   = do { pun_ok      <- xoptM LangExt.NamedFieldPuns
  759        ; disambig_ok <- xoptM LangExt.DisambiguateRecordFields
  760        ; let parent = guard disambig_ok >> mb_con
  761        ; flds1  <- mapM (rn_fld pun_ok parent) flds
  762        ; mapM_ (addErr . dupFieldErr ctxt) dup_flds
  763        ; dotdot_flds <- rn_dotdot dotdot mb_con flds1
  764        ; let all_flds | null dotdot_flds = flds1
  765                       | otherwise        = flds1 ++ dotdot_flds
  766        ; return (all_flds, mkFVs (getFieldIds all_flds)) }
  767   where
  768     mb_con = case ctxt of
  769                 HsRecFieldCon con  -> Just con
  770                 HsRecFieldPat con  -> Just con
  771                 _ {- update -}     -> Nothing
  772 
  773     rn_fld :: Bool -> Maybe Name -> LHsRecField GhcPs (LocatedA arg)
  774            -> RnM (LHsRecField GhcRn (LocatedA arg))
  775     rn_fld pun_ok parent (L l
  776                            (HsFieldBind
  777                               { hfbLHS =
  778                                   (L loc (FieldOcc _ (L ll lbl)))
  779                               , hfbRHS = arg
  780                               , hfbPun      = pun }))
  781       = do { sel <- setSrcSpanA loc $ lookupRecFieldOcc parent lbl
  782            ; arg' <- if pun
  783                      then do { checkErr pun_ok (TcRnIllegalFieldPunning (L (locA loc) lbl))
  784                                -- Discard any module qualifier (#11662)
  785                              ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)
  786                              ; return (L (l2l loc) (mk_arg (locA loc) arg_rdr)) }
  787                      else return arg
  788            ; return (L l (HsFieldBind
  789                              { hfbAnn = noAnn
  790                              , hfbLHS = (L loc (FieldOcc sel (L ll lbl)))
  791                              , hfbRHS = arg'
  792                              , hfbPun      = pun })) }
  793 
  794 
  795     rn_dotdot :: Maybe (Located Int)      -- See Note [DotDot fields] in GHC.Hs.Pat
  796               -> Maybe Name -- The constructor (Nothing for an
  797                                 --    out of scope constructor)
  798               -> [LHsRecField GhcRn (LocatedA arg)] -- Explicit fields
  799               -> RnM ([LHsRecField GhcRn (LocatedA arg)])   -- Field Labels we need to fill in
  800     rn_dotdot (Just (L loc n)) (Just con) flds -- ".." on record construction / pat match
  801       | not (isUnboundName con) -- This test is because if the constructor
  802                                 -- isn't in scope the constructor lookup will add
  803                                 -- an error but still return an unbound name. We
  804                                 -- don't want that to screw up the dot-dot fill-in stuff.
  805       = assert (flds `lengthIs` n) $
  806         do { dd_flag <- xoptM LangExt.RecordWildCards
  807            ; checkErr dd_flag (needFlagDotDot ctxt)
  808            ; (rdr_env, lcl_env) <- getRdrEnvs
  809            ; con_fields <- lookupConstructorFields con
  810            ; when (null con_fields) (addErr (TcRnIllegalWildcardsInConstructor con))
  811            ; let present_flds = mkOccSet $ map rdrNameOcc (getFieldLbls flds)
  812 
  813                    -- For constructor uses (but not patterns)
  814                    -- the arg should be in scope locally;
  815                    -- i.e. not top level or imported
  816                    -- Eg.  data R = R { x,y :: Int }
  817                    --      f x = R { .. }   -- Should expand to R {x=x}, not R{x=x,y=y}
  818                  arg_in_scope lbl = mkRdrUnqual lbl `elemLocalRdrEnv` lcl_env
  819 
  820                  (dot_dot_fields, dot_dot_gres)
  821                         = unzip [ (fl, gre)
  822                                 | fl <- con_fields
  823                                 , let lbl = mkVarOccFS (flLabel fl)
  824                                 , not (lbl `elemOccSet` present_flds)
  825                                 , Just gre <- [lookupGRE_FieldLabel rdr_env fl]
  826                                               -- Check selector is in scope
  827                                 , case ctxt of
  828                                     HsRecFieldCon {} -> arg_in_scope lbl
  829                                     _other           -> True ]
  830 
  831            ; addUsedGREs dot_dot_gres
  832            ; let locn = noAnnSrcSpan loc
  833            ; return [ L (noAnnSrcSpan loc) (HsFieldBind
  834                         { hfbAnn = noAnn
  835                         , hfbLHS
  836                            = L (noAnnSrcSpan loc) (FieldOcc sel (L (noAnnSrcSpan loc) arg_rdr))
  837                         , hfbRHS = L locn (mk_arg loc arg_rdr)
  838                         , hfbPun      = False })
  839                     | fl <- dot_dot_fields
  840                     , let sel     = flSelector fl
  841                     , let arg_rdr = mkVarUnqual (flLabel fl) ] }
  842 
  843     rn_dotdot _dotdot _mb_con _flds
  844       = return []
  845       -- _dotdot = Nothing => No ".." at all
  846       -- _mb_con = Nothing => Record update
  847       -- _mb_con = Just unbound => Out of scope data constructor
  848 
  849     dup_flds :: [NE.NonEmpty RdrName]
  850         -- Each list represents a RdrName that occurred more than once
  851         -- (the list contains all occurrences)
  852         -- Each list in dup_fields is non-empty
  853     (_, dup_flds) = removeDups compare (getFieldLbls flds)
  854 
  855 
  856 -- NB: Consider this:
  857 --      module Foo where { data R = R { fld :: Int } }
  858 --      module Odd where { import Foo; fld x = x { fld = 3 } }
  859 -- Arguably this should work, because the reference to 'fld' is
  860 -- unambiguous because there is only one field id 'fld' in scope.
  861 -- But currently it's rejected.
  862 
  863 rnHsRecUpdFields
  864     :: [LHsRecUpdField GhcPs]
  865     -> RnM ([LHsRecUpdField GhcRn], FreeVars)
  866 rnHsRecUpdFields flds
  867   = do { pun_ok        <- xoptM LangExt.NamedFieldPuns
  868        ; dup_fields_ok <- xopt_DuplicateRecordFields <$> getDynFlags
  869        ; (flds1, fvss) <- mapAndUnzipM (rn_fld pun_ok dup_fields_ok) flds
  870        ; mapM_ (addErr . dupFieldErr HsRecFieldUpd) dup_flds
  871 
  872        -- Check for an empty record update  e {}
  873        -- NB: don't complain about e { .. }, because rn_dotdot has done that already
  874        ; when (null flds) $ addErr TcRnEmptyRecordUpdate
  875 
  876        ; return (flds1, plusFVs fvss) }
  877   where
  878     rn_fld :: Bool -> DuplicateRecordFields -> LHsRecUpdField GhcPs
  879            -> RnM (LHsRecUpdField GhcRn, FreeVars)
  880     rn_fld pun_ok dup_fields_ok (L l (HsFieldBind { hfbLHS = L loc f
  881                                                   , hfbRHS = arg
  882                                                   , hfbPun      = pun }))
  883       = do { let lbl = rdrNameAmbiguousFieldOcc f
  884            ; mb_sel <- setSrcSpanA loc $
  885                       -- Defer renaming of overloaded fields to the typechecker
  886                       -- See Note [Disambiguating record fields] in GHC.Tc.Gen.Head
  887                       lookupRecFieldOcc_update dup_fields_ok lbl
  888            ; arg' <- if pun
  889                      then do { checkErr pun_ok (TcRnIllegalFieldPunning (L (locA loc) lbl))
  890                                -- Discard any module qualifier (#11662)
  891                              ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)
  892                              ; return (L (l2l loc) (HsVar noExtField
  893                                               (L (l2l loc) arg_rdr))) }
  894                      else return arg
  895            ; (arg'', fvs) <- rnLExpr arg'
  896 
  897            ; let (lbl', fvs') = case mb_sel of
  898                    UnambiguousGre gname -> let sel_name = greNameMangledName gname
  899                                            in (Unambiguous sel_name (L (l2l loc) lbl), fvs `addOneFV` sel_name)
  900                    AmbiguousFields       -> (Ambiguous   noExtField (L (l2l loc) lbl), fvs)
  901 
  902            ; return (L l (HsFieldBind { hfbAnn = noAnn
  903                                       , hfbLHS = L loc lbl'
  904                                       , hfbRHS = arg''
  905                                       , hfbPun = pun }), fvs') }
  906 
  907     dup_flds :: [NE.NonEmpty RdrName]
  908         -- Each list represents a RdrName that occurred more than once
  909         -- (the list contains all occurrences)
  910         -- Each list in dup_fields is non-empty
  911     (_, dup_flds) = removeDups compare (getFieldUpdLbls flds)
  912 
  913 
  914 
  915 getFieldIds :: [LHsRecField GhcRn arg] -> [Name]
  916 getFieldIds flds = map (hsRecFieldSel . unLoc) flds
  917 
  918 getFieldLbls :: forall p arg . UnXRec p => [LHsRecField p arg] -> [RdrName]
  919 getFieldLbls flds
  920   = map (unXRec @p . foLabel . unXRec @p . hfbLHS . unXRec @p) flds
  921 
  922 getFieldUpdLbls :: [LHsRecUpdField GhcPs] -> [RdrName]
  923 getFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . unLoc . hfbLHS . unLoc) flds
  924 
  925 needFlagDotDot :: HsRecFieldContext -> TcRnMessage
  926 needFlagDotDot = TcRnIllegalWildcardsInRecord . toRecordFieldPart
  927 
  928 dupFieldErr :: HsRecFieldContext -> NE.NonEmpty RdrName -> TcRnMessage
  929 dupFieldErr ctxt = TcRnDuplicateFieldName (toRecordFieldPart ctxt)
  930 
  931 toRecordFieldPart :: HsRecFieldContext -> RecordFieldPart
  932 toRecordFieldPart (HsRecFieldCon n)  = RecordFieldConstructor n
  933 toRecordFieldPart (HsRecFieldPat n)  = RecordFieldPattern     n
  934 toRecordFieldPart (HsRecFieldUpd {}) = RecordFieldUpdate
  935 
  936 {-
  937 ************************************************************************
  938 *                                                                      *
  939 \subsubsection{Literals}
  940 *                                                                      *
  941 ************************************************************************
  942 
  943 When literals occur we have to make sure
  944 that the types and classes they involve
  945 are made available.
  946 -}
  947 
  948 rnLit :: HsLit p -> RnM ()
  949 rnLit (HsChar _ c) = checkErr (inCharRange c) (TcRnCharLiteralOutOfRange c)
  950 rnLit _ = return ()
  951 
  952 -- | Turn a Fractional-looking literal which happens to be an integer into an
  953 -- Integer-looking literal.
  954 -- We only convert numbers where the exponent is between 0 and 100 to avoid
  955 -- converting huge numbers and incurring long compilation times. See #15646.
  956 generalizeOverLitVal :: OverLitVal -> OverLitVal
  957 generalizeOverLitVal (HsFractional fl@(FL {fl_text=src,fl_neg=neg,fl_exp=e}))
  958     | e >= -100 && e <= 100
  959     , let val = rationalFromFractionalLit fl
  960     , denominator val == 1 = HsIntegral (IL {il_text=src,il_neg=neg,il_value=numerator val})
  961 generalizeOverLitVal lit = lit
  962 
  963 isNegativeZeroOverLit :: HsOverLit t -> Bool
  964 isNegativeZeroOverLit lit
  965  = case ol_val lit of
  966         HsIntegral i    -> 0 == il_value i && il_neg i
  967         -- For HsFractional, the value of fl is n * (b ^^ e) so it is sufficient
  968         -- to check if n = 0. b is equal to either 2 or 10. We don't call
  969         -- rationalFromFractionalLit here as it is expensive when e is big.
  970         HsFractional fl -> 0 == fl_signi fl && fl_neg fl
  971         _               -> False
  972 
  973 {-
  974 Note [Negative zero]
  975 ~~~~~~~~~~~~~~~~~~~~~~~~~
  976 There were problems with negative zero in conjunction with Negative Literals
  977 extension. Numeric literal value is contained in Integer and Rational types
  978 inside IntegralLit and FractionalLit. These types cannot represent negative
  979 zero value. So we had to add explicit field 'neg' which would hold information
  980 about literal sign. Here in rnOverLit we use it to detect negative zeroes and
  981 in this case return not only literal itself but also negateName so that users
  982 can apply it explicitly. In this case it stays negative zero.  #13211
  983 -}
  984 
  985 rnOverLit :: HsOverLit t ->
  986              RnM ((HsOverLit GhcRn, Maybe (HsExpr GhcRn)), FreeVars)
  987 rnOverLit origLit
  988   = do  { opt_NumDecimals <- xoptM LangExt.NumDecimals
  989         ; let { lit@(OverLit {ol_val=val})
  990             | opt_NumDecimals = origLit {ol_val = generalizeOverLitVal (ol_val origLit)}
  991             | otherwise       = origLit
  992           }
  993         ; let std_name = hsOverLitName val
  994         ; (from_thing_name, fvs1) <- lookupSyntaxName std_name
  995         ; let rebindable = from_thing_name /= std_name
  996               lit' = lit { ol_ext = OverLitRn { ol_rebindable = rebindable
  997                                               , ol_from_fun = noLocA from_thing_name } }
  998         ; if isNegativeZeroOverLit lit'
  999           then do { (negate_name, fvs2) <- lookupSyntaxExpr negateName
 1000                   ; return ((lit' { ol_val = negateOverLitVal val }, Just negate_name)
 1001                                   , fvs1 `plusFV` fvs2) }
 1002           else return ((lit', Nothing), fvs1) }