- implicit_fvs = mkFVs [lengthPName, indexPName]
-
-rnPat (TuplePat pats boxed _)
- = checkTupSize (length pats) `thenM_`
- rnLPats pats `thenM` \ (patslist, fvs) ->
- returnM (TuplePat patslist boxed placeHolderType, fvs)
-
-rnPat (TypePat name) =
- rnHsTypeFVs (text "In a type pattern") name `thenM` \ (name', fvs) ->
- returnM (TypePat name', fvs)
-
--- -----------------------------------------------------------------------------
--- rnConPat
-
-rnConPat :: Located RdrName -> HsConPatDetails RdrName -> RnM (Pat Name, FreeVars)
-rnConPat con (PrefixCon pats)
- = do { con' <- lookupLocatedOccRn con
- ; (pats', fvs) <- rnLPats pats
- ; return (ConPatIn con' (PrefixCon pats'), fvs `addOneFV` unLoc con') }
-
-rnConPat con (RecCon rpats)
- = do { con' <- lookupLocatedOccRn con
- ; (rpats', fvs) <- rnHsRecFields "pattern" (Just con') rnLPat VarPat rpats
- ; return (ConPatIn con' (RecCon rpats'), fvs `addOneFV` unLoc con') }
-
-rnConPat con (InfixCon pat1 pat2)
- = do { con' <- lookupLocatedOccRn con
- ; (pat1', fvs1) <- rnLPat pat1
- ; (pat2', fvs2) <- rnLPat pat2
- ; fixity <- lookupFixityRn (unLoc con')
- ; pat' <- mkConOpPatRn con' fixity pat1' pat2'
- ; return (pat', fvs1 `plusFV` fvs2 `addOneFV` unLoc con') }
-
--- -----------------------------------------------------------------------------
-rnHsRecFields :: String -- "pattern" or "construction" or "update"
- -> Maybe (Located Name)
- -> (Located a -> RnM (Located b, FreeVars))
- -> (RdrName -> a) -- How to fill in ".."
- -> HsRecFields RdrName (Located a)
- -> RnM (HsRecFields Name (Located b), FreeVars)
--- Haddock comments for record fields are renamed to Nothing here
-rnHsRecFields str mb_con rn_thing mk_rhs (HsRecFields fields dd)
- = do { mappM_ field_dup_err dup_fields
- ; pun_flag <- doptM Opt_RecordPuns
- ; (fields1, fvs1) <- mapFvRn (rn_rpat pun_flag) fields
- ; case dd of
- Nothing -> return (HsRecFields fields1 dd, fvs1)
- Just n -> ASSERT( n == length fields ) do
- { dd_flag <- doptM Opt_RecordWildCards
- ; checkErr dd_flag (needFlagDotDot str)
-
- ; let fld_names1 = map (unLoc . hsRecFieldId) fields1
- ; (fields2, fvs2) <- dot_dot_fields fld_names1 mb_con
-
- ; return (HsRecFields (fields1 ++ fields2) dd, fvs1 `plusFV` fvs2) } }
- where
- (_, dup_fields) = removeDups compare (map (unLoc . hsRecFieldId) fields)
-
- field_dup_err dups = addErr (dupFieldErr str (head dups))
-
- rn_rpat pun_ok (HsRecField field pat pun)
- = do { fieldname <- lookupRecordBndr mb_con field
- ; checkErr (not pun || pun_ok) (badPun field)
- ; (pat', fvs) <- rn_thing pat
- ; return (HsRecField fieldname pat' pun,
- fvs `addOneFV` unLoc fieldname) }
-
- dot_dot_fields fs Nothing = do { addErr (badDotDot str)
- ; return ([], emptyFVs) }
-
- -- Compute the extra fields to be filled in by the dot-dot notation
- dot_dot_fields fs (Just con)
- = do { con_fields <- lookupConstructorFields (unLoc con)
- ; let missing_fields = con_fields `minusList` fs
- ; loc <- getSrcSpanM -- Rather approximate
- ; (rhss, fvs_s) <- mapAndUnzipM rn_thing
- [ L loc (mk_rhs (mkRdrUnqual (getOccName f)))
- | f <- missing_fields ]
- ; let new_fs = [ HsRecField (L loc f) r False
- | (f, r) <- missing_fields `zip` rhss ]
- ; return (new_fs, plusFVs fvs_s) }
-
-needFlagDotDot str = vcat [ptext SLIT("Illegal `..' in record") <+> text str,
- ptext SLIT("Use -frecord-dot-dot to permit this")]
-
-badDotDot str = ptext SLIT("You cannot use `..' in record") <+> text str
-
-badPun fld = vcat [ptext SLIT("Illegal use of punning for field") <+> quotes (ppr fld),
- ptext SLIT("Use -frecord-puns to permit this")]
-\end{code}
-
-
-%************************************************************************
-%* *
-\subsubsection{Literals}
-%* *
-%************************************************************************
-
-When literals occur we have to make sure
-that the types and classes they involve
-are made available.
-
-\begin{code}
-rnLit :: HsLit -> RnM ()
-rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
-rnLit other = returnM ()
-
-rnOverLit (HsIntegral i _)
- = lookupSyntaxName fromIntegerName `thenM` \ (from_integer_name, fvs) ->
- if inIntRange i then
- returnM (HsIntegral i from_integer_name, fvs)
- else let
- extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
- -- Big integer literals are built, using + and *,
- -- out of small integers (DsUtils.mkIntegerLit)
- -- [NB: plusInteger, timesInteger aren't rebindable...
- -- they are used to construct the argument to fromInteger,
- -- which is the rebindable one.]
- in
- returnM (HsIntegral i from_integer_name, fvs `plusFV` extra_fvs)
-
-rnOverLit (HsFractional i _)
- = lookupSyntaxName fromRationalName `thenM` \ (from_rat_name, fvs) ->
- let
- extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
- -- We have to make sure that the Ratio type is imported with
- -- its constructor, because literals of type Ratio t are
- -- built with that constructor.
- -- The Rational type is needed too, but that will come in
- -- as part of the type for fromRational.
- -- The plus/times integer operations may be needed to construct the numerator
- -- and denominator (see DsUtils.mkIntegerLit)
- in
- returnM (HsFractional i from_rat_name, fvs `plusFV` extra_fvs)
-
-rnOverLit (HsIsString s _)
- = lookupSyntaxName fromStringName `thenM` \ (from_string_name, fvs) ->
- returnM (HsIsString s from_string_name, fvs)