-- Literals
rnLit, rnOverLit,
+ -- Quasiquotation
+ rnQuasiQuote,
+
-- Pattern Error messages that are also used elsewhere
checkTupSize, patSigErr
) where
-- ENH: thin imports to only what is necessary for patterns
import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts)
+#ifdef GHCI
+import {-# SOURCE #-} TcSplice( runQuasiQuotePat )
+#endif /* GHCI */
#include "HsVersions.h"
eqClassName, integralClassName, geName, eqName,
negateName, minusName, lengthPName, indexPName,
plusIntegerName, fromIntegerName, timesIntegerName,
- ratioDataConName, fromRationalName, fromStringName )
+ ratioDataConName, fromRationalName, fromStringName, mkUnboundName )
import Constants ( mAX_TUPLE_SIZE )
-import Name ( Name, nameOccName, nameIsLocalOrFrom, getOccName, nameSrcSpan )
+import Name ( Name, nameOccName, nameModule_maybe, getOccName, nameSrcSpan )
+import OccName ( occEnvElts )
import NameSet
-import UniqFM
-import RdrName ( RdrName, extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals, mkRdrUnqual, nameRdrName )
+import LazyUniqFM
+import RdrName ( RdrName, GlobalRdrElt(..), Provenance(..),
+ extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals,
+ mkRdrUnqual, nameRdrName, gre_name, globalRdrEnvElts, isLocalGRE )
import LoadIface ( loadInterfaceForName )
-import UniqFM ( isNullUFM )
import UniqSet ( emptyUniqSet )
import List ( nub )
import Util ( isSingleton )
-> RnM (a, FreeVars)
rnPatsAndThen_LocalRightwards ctxt pats thing_inside
- = do { -- Check for duplicated and shadowed names
- -- Because we don't bind the vars all at once, we can't
- -- check incrementally for duplicates;
- -- Nor can we check incrementally for shadowing, else we'll
- -- complain *twice* about duplicates e.g. f (x,x) = ...
- let rdr_names_w_loc = collectLocatedPatsBinders pats
- ; checkDupNames doc_pat rdr_names_w_loc
- ; checkShadowing doc_pat rdr_names_w_loc
+ = do { envs_before <- getRdrEnvs
-- (0) bring into scope all of the type variables bound by the patterns
-- (1) rename the patterns, bringing into scope all of the term variables
-- (2) then do the thing inside.
; bindPatSigTyVarsFV (collectSigTysFromPats pats) $
- rnLPatsAndThen matchNameMaker pats $
- thing_inside }
+ rnLPatsAndThen matchNameMaker pats $ \ pats' ->
+ do { -- Check for duplicated and shadowed names
+ -- Because we don't bind the vars all at once, we can't
+ -- check incrementally for duplicates;
+ -- Nor can we check incrementally for shadowing, else we'll
+ -- complain *twice* about duplicates e.g. f (x,x) = ...
+ ; let names = collectPatsBinders pats'
+ ; checkDupNames doc_pat names
+ ; checkShadowedNames doc_pat envs_before
+ [(nameSrcSpan name, nameOccName name) | name <- names]
+ ; thing_inside pats' } }
where
doc_pat = ptext SLIT("In") <+> pprMatchContext ctxt
-- we need to bind pattern variables for view pattern expressions
-- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)
- SigPatIn pat ty ->
- doptM Opt_PatternSignatures `thenM` \ patsigs ->
+ SigPatIn pat ty -> do
+ patsigs <- doptM Opt_PatternSignatures
if patsigs
- then rnLPatAndThen var pat
+ then rnLPatAndThen var pat
(\ pat' -> do { (ty', fvs1) <- rnHsTypeFVs tvdoc ty
; (res, fvs2) <- lcont (SigPatIn pat' ty')
; return (res, fvs1 `plusFV` fvs2) })
- else addErr (patSigErr ty) `thenM_`
- rnLPatAndThen var pat cont
+ else do addErr (patSigErr ty)
+ rnLPatAndThen var pat cont
where
tvdoc = text "In a pattern type-signature"
lcont (ViewPat expr' pat' ty)
; return (res, fvs_res `plusFV` fv_expr) }
+#ifndef GHCI
+ pat@(QuasiQuotePat _) -> pprPanic "Can't do QuasiQuotePat without GHCi" (ppr p)
+#else
+ QuasiQuotePat qq -> do
+ (qq', _) <- rnQuasiQuote qq
+ pat' <- runQuasiQuotePat qq'
+ rnLPatAndThen var pat' $ \ (L _ pat'') ->
+ lcont pat''
+#endif /* GHCI */
+
ConPatIn con stuff ->
-- rnConPatAndThen takes care of reconstructing the pattern
rnConPatAndThen var con stuff cont
-- duplicate field reporting function
field_dup_err dup_group = addErr (dupFieldErr doingstr (head dup_group))
in
- mappM_ field_dup_err dup_fields
+ mapM_ field_dup_err dup_fields
-- helper to rename each field
rn_field pun_ok (HsRecField field inside pun) cont = do
checkErr dd_flag (needFlagDotDot doingstr)
let fld_names1 = map (unLoc . hsRecFieldId) fields1
case doDotDot choice of
- Nothing -> addErr (badDotDot doingstr) `thenM_`
- -- we return a junk value here so that error reporting goes on
- cont (HsRecFields fields1 dd)
+ Nothing -> do addErr (badDotDot doingstr)
+ -- we return a junk value here so that error reporting goes on
+ cont (HsRecFields fields1 dd)
Just (con, mk_field) ->
dot_dot_fields fld_names1 con mk_field $
\ fields2 ->
\begin{code}
rnLit :: HsLit -> RnM ()
rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
-rnLit other = returnM ()
+rnLit other = return ()
-rnOverLit (HsIntegral i _ _)
- = lookupSyntaxName fromIntegerName `thenM` \ (from_integer_name, fvs) ->
+rnOverLit (HsIntegral i _ _) = do
+ (from_integer_name, fvs) <- lookupSyntaxName fromIntegerName
if inIntRange i then
- returnM (HsIntegral i from_integer_name placeHolderType, fvs)
- else let
+ return (HsIntegral i from_integer_name placeHolderType, 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 placeHolderType, fvs `plusFV` extra_fvs)
+ in
+ return (HsIntegral i from_integer_name placeHolderType, fvs `plusFV` extra_fvs)
-rnOverLit (HsFractional i _ _)
- = lookupSyntaxName fromRationalName `thenM` \ (from_rat_name, fvs) ->
+rnOverLit (HsFractional i _ _) = do
+ (from_rat_name, fvs) <- lookupSyntaxName fromRationalName
let
extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
-- We have to make sure that the Ratio type is imported with
-- 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 placeHolderType, fvs `plusFV` extra_fvs)
+ return (HsFractional i from_rat_name placeHolderType, fvs `plusFV` extra_fvs)
-rnOverLit (HsIsString s _ _)
- = lookupSyntaxName fromStringName `thenM` \ (from_string_name, fvs) ->
- returnM (HsIsString s from_string_name placeHolderType, fvs)
+rnOverLit (HsIsString s _ _) = do
+ (from_string_name, fvs) <- lookupSyntaxName fromStringName
+ return (HsIsString s from_string_name placeHolderType, fvs)
\end{code}
+%************************************************************************
+%* *
+\subsubsection{Quasiquotation}
+%* *
+%************************************************************************
+
+See Note [Quasi-quote overview] in TcSplice.
+
+\begin{code}
+rnQuasiQuote :: HsQuasiQuote RdrName -> RnM (HsQuasiQuote Name, FreeVars)
+rnQuasiQuote (HsQuasiQuote n quoter quoteSpan quote)
+ = do { loc <- getSrcSpanM
+ ; [n'] <- newLocalsRn [L loc n]
+ ; quoter' <- (lookupOccRn quoter)
+ -- If 'quoter' is not in scope, proceed no further
+ -- Otherwise lookupOcc adds an error messsage and returns
+ -- an "unubound name", which makes the subsequent attempt to
+ -- run the quote fail
+ ; return (HsQuasiQuote n' quoter' quoteSpan quote, unitFV quoter') }
+\end{code}
%************************************************************************
%* *
checkTupSize :: Int -> RnM ()
checkTupSize tup_size
| tup_size <= mAX_TUPLE_SIZE
- = returnM ()
+ = return ()
| otherwise
= addErr (sep [ptext SLIT("A") <+> int tup_size <> ptext SLIT("-tuple is too large for GHC"),
nest 2 (parens (ptext SLIT("max size is") <+> int mAX_TUPLE_SIZE)),
projects / ghc-hetmet.git / blobdiff