diff options
Diffstat (limited to 'compiler/rename/RnSplice.hs')
| -rw-r--r-- | compiler/rename/RnSplice.hs | 101 |
1 files changed, 55 insertions, 46 deletions
diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index 36b1eda140..fc7240ef44 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -18,7 +18,6 @@ import NameSet import HsSyn import RdrName import TcRnMonad -import Kind import RnEnv import RnUtils ( HsDocContext(..), newLocalBndrRn ) @@ -103,7 +102,7 @@ rnBracket e br_body ; (body', fvs_e) <- setStage (Brack cur_stage RnPendingTyped) $ rn_bracket cur_stage br_body - ; return (HsBracket body', fvs_e) } + ; return (HsBracket noExt body', fvs_e) } False -> do { traceRn "Renaming untyped TH bracket" empty ; ps_var <- newMutVar [] @@ -111,11 +110,11 @@ rnBracket e br_body setStage (Brack cur_stage (RnPendingUntyped ps_var)) $ rn_bracket cur_stage br_body ; pendings <- readMutVar ps_var - ; return (HsRnBracketOut body' pendings, fvs_e) } + ; return (HsRnBracketOut noExt body' pendings, fvs_e) } } rn_bracket :: ThStage -> HsBracket GhcPs -> RnM (HsBracket GhcRn, FreeVars) -rn_bracket outer_stage br@(VarBr flg rdr_name) +rn_bracket outer_stage br@(VarBr x flg rdr_name) = do { name <- lookupOccRn rdr_name ; this_mod <- getModule @@ -137,17 +136,18 @@ rn_bracket outer_stage br@(VarBr flg rdr_name) (quotedNameStageErr br) } } } - ; return (VarBr flg name, unitFV name) } + ; return (VarBr x flg name, unitFV name) } -rn_bracket _ (ExpBr e) = do { (e', fvs) <- rnLExpr e - ; return (ExpBr e', fvs) } +rn_bracket _ (ExpBr x e) = do { (e', fvs) <- rnLExpr e + ; return (ExpBr x e', fvs) } -rn_bracket _ (PatBr p) = rnPat ThPatQuote p $ \ p' -> return (PatBr p', emptyFVs) +rn_bracket _ (PatBr x p) + = rnPat ThPatQuote p $ \ p' -> return (PatBr x p', emptyFVs) -rn_bracket _ (TypBr t) = do { (t', fvs) <- rnLHsType TypBrCtx t - ; return (TypBr t', fvs) } +rn_bracket _ (TypBr x t) = do { (t', fvs) <- rnLHsType TypBrCtx t + ; return (TypBr x t', fvs) } -rn_bracket _ (DecBrL decls) +rn_bracket _ (DecBrL x decls) = do { group <- groupDecls decls ; gbl_env <- getGblEnv ; let new_gbl_env = gbl_env { tcg_dus = emptyDUs } @@ -159,7 +159,7 @@ rn_bracket _ (DecBrL decls) -- Discard the tcg_env; it contains only extra info about fixity ; traceRn "rn_bracket dec" (ppr (tcg_dus tcg_env) $$ ppr (duUses (tcg_dus tcg_env))) - ; return (DecBrG group', duUses (tcg_dus tcg_env)) } + ; return (DecBrG x group', duUses (tcg_dus tcg_env)) } where groupDecls :: [LHsDecl GhcPs] -> RnM (HsGroup GhcPs) groupDecls decls @@ -173,10 +173,12 @@ rn_bracket _ (DecBrL decls) } }} -rn_bracket _ (DecBrG _) = panic "rn_bracket: unexpected DecBrG" +rn_bracket _ (DecBrG {}) = panic "rn_bracket: unexpected DecBrG" -rn_bracket _ (TExpBr e) = do { (e', fvs) <- rnLExpr e - ; return (TExpBr e', fvs) } +rn_bracket _ (TExpBr x e) = do { (e', fvs) <- rnLExpr e + ; return (TExpBr x e', fvs) } + +rn_bracket _ (XBracket {}) = panic "rn_bracket: unexpected XBracket" quotationCtxtDoc :: HsBracket GhcPs -> SDoc quotationCtxtDoc br_body @@ -294,10 +296,11 @@ runRnSplice flavour run_meta ppr_res splice = do { splice' <- getHooked runRnSpliceHook return >>= ($ splice) ; let the_expr = case splice' of - HsUntypedSplice _ _ e -> e - HsQuasiQuote _ q qs str -> mkQuasiQuoteExpr flavour q qs str - HsTypedSplice {} -> pprPanic "runRnSplice" (ppr splice) - HsSpliced {} -> pprPanic "runRnSplice" (ppr splice) + HsUntypedSplice _ _ _ e -> e + HsQuasiQuote _ _ q qs str -> mkQuasiQuoteExpr flavour q qs str + HsTypedSplice {} -> pprPanic "runRnSplice" (ppr splice) + HsSpliced {} -> pprPanic "runRnSplice" (ppr splice) + XSplice {} -> pprPanic "runRnSplice" (ppr splice) -- Typecheck the expression ; meta_exp_ty <- tcMetaTy meta_ty_name @@ -335,14 +338,16 @@ runRnSplice flavour run_meta ppr_res splice makePending :: UntypedSpliceFlavour -> HsSplice GhcRn -> PendingRnSplice -makePending flavour (HsUntypedSplice _ n e) +makePending flavour (HsUntypedSplice _ _ n e) = PendingRnSplice flavour n e -makePending flavour (HsQuasiQuote n quoter q_span quote) +makePending flavour (HsQuasiQuote _ n quoter q_span quote) = PendingRnSplice flavour n (mkQuasiQuoteExpr flavour quoter q_span quote) makePending _ splice@(HsTypedSplice {}) = pprPanic "makePending" (ppr splice) makePending _ splice@(HsSpliced {}) = pprPanic "makePending" (ppr splice) +makePending _ splice@(XSplice {}) + = pprPanic "makePending" (ppr splice) ------------------ mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString @@ -350,13 +355,13 @@ mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString -- Return the expression (quoter "...quote...") -- which is what we must run in a quasi-quote mkQuasiQuoteExpr flavour quoter q_span quote - = L q_span $ HsApp (L q_span $ - HsApp (L q_span (HsVar (L q_span quote_selector))) + = L q_span $ HsApp noExt (L q_span $ + HsApp noExt (L q_span (HsVar noExt (L q_span quote_selector))) quoterExpr) quoteExpr where - quoterExpr = L q_span $! HsVar $! (L q_span quoter) - quoteExpr = L q_span $! HsLit $! HsString NoSourceText quote + quoterExpr = L q_span $! HsVar noExt $! (L q_span quoter) + quoteExpr = L q_span $! HsLit noExt $! HsString NoSourceText quote quote_selector = case flavour of UntypedExpSplice -> quoteExpName UntypedPatSplice -> quotePatName @@ -366,21 +371,21 @@ mkQuasiQuoteExpr flavour quoter q_span quote --------------------- rnSplice :: HsSplice GhcPs -> RnM (HsSplice GhcRn, FreeVars) -- Not exported...used for all -rnSplice (HsTypedSplice hasParen splice_name expr) +rnSplice (HsTypedSplice x hasParen splice_name expr) = do { checkTH expr "Template Haskell typed splice" ; loc <- getSrcSpanM ; n' <- newLocalBndrRn (L loc splice_name) ; (expr', fvs) <- rnLExpr expr - ; return (HsTypedSplice hasParen n' expr', fvs) } + ; return (HsTypedSplice x hasParen n' expr', fvs) } -rnSplice (HsUntypedSplice hasParen splice_name expr) +rnSplice (HsUntypedSplice x hasParen splice_name expr) = do { checkTH expr "Template Haskell untyped splice" ; loc <- getSrcSpanM ; n' <- newLocalBndrRn (L loc splice_name) ; (expr', fvs) <- rnLExpr expr - ; return (HsUntypedSplice hasParen n' expr', fvs) } + ; return (HsUntypedSplice x hasParen n' expr', fvs) } -rnSplice (HsQuasiQuote splice_name quoter q_loc quote) +rnSplice (HsQuasiQuote x splice_name quoter q_loc quote) = do { checkTH quoter "Template Haskell quasi-quote" ; loc <- getSrcSpanM ; splice_name' <- newLocalBndrRn (L loc splice_name) @@ -391,9 +396,11 @@ rnSplice (HsQuasiQuote splice_name quoter q_loc quote) ; when (nameIsLocalOrFrom this_mod quoter') $ checkThLocalName quoter' - ; return (HsQuasiQuote splice_name' quoter' q_loc quote, unitFV quoter') } + ; return (HsQuasiQuote x splice_name' quoter' q_loc quote + , unitFV quoter') } rnSplice splice@(HsSpliced {}) = pprPanic "rnSplice" (ppr splice) +rnSplice splice@(XSplice {}) = pprPanic "rnSplice" (ppr splice) --------------------- rnSpliceExpr :: HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars) @@ -402,7 +409,7 @@ rnSpliceExpr splice where pend_expr_splice :: HsSplice GhcRn -> (PendingRnSplice, HsExpr GhcRn) pend_expr_splice rn_splice - = (makePending UntypedExpSplice rn_splice, HsSpliceE rn_splice) + = (makePending UntypedExpSplice rn_splice, HsSpliceE noExt rn_splice) run_expr_splice :: HsSplice GhcRn -> RnM (HsExpr GhcRn, FreeVars) run_expr_splice rn_splice @@ -415,7 +422,7 @@ rnSpliceExpr splice , isLocalGRE gre] lcl_names = mkNameSet (localRdrEnvElts lcl_rdr) - ; return (HsSpliceE rn_splice, lcl_names `plusFV` gbl_names) } + ; return (HsSpliceE noExt rn_splice, lcl_names `plusFV` gbl_names) } | otherwise -- Run it here, see Note [Running splices in the Renamer] = do { traceRn "rnSpliceExpr: untyped expression splice" empty @@ -423,8 +430,8 @@ rnSpliceExpr splice runRnSplice UntypedExpSplice runMetaE ppr rn_splice ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr) -- See Note [Delaying modFinalizers in untyped splices]. - ; return ( HsPar $ HsSpliceE - . HsSpliced (ThModFinalizers mod_finalizers) + ; return ( HsPar noExt $ HsSpliceE noExt + . HsSpliced noExt (ThModFinalizers mod_finalizers) . HsSplicedExpr <$> lexpr3 , fvs) @@ -521,13 +528,13 @@ References: -} ---------------------- -rnSpliceType :: HsSplice GhcPs -> PostTc GhcRn Kind - -> RnM (HsType GhcRn, FreeVars) -rnSpliceType splice k +rnSpliceType :: HsSplice GhcPs -> RnM (HsType GhcRn, FreeVars) +rnSpliceType splice = rnSpliceGen run_type_splice pend_type_splice splice where pend_type_splice rn_splice - = (makePending UntypedTypeSplice rn_splice, HsSpliceTy rn_splice k) + = ( makePending UntypedTypeSplice rn_splice + , HsSpliceTy noExt rn_splice) run_type_splice rn_splice = do { traceRn "rnSpliceType: untyped type splice" empty @@ -537,8 +544,8 @@ rnSpliceType splice k ; checkNoErrs $ rnLHsType doc hs_ty2 } -- checkNoErrs: see Note [Renamer errors] -- See Note [Delaying modFinalizers in untyped splices]. - ; return ( HsParTy $ flip HsSpliceTy k - . HsSpliced (ThModFinalizers mod_finalizers) + ; return ( HsParTy noExt $ HsSpliceTy noExt + . HsSpliced noExt (ThModFinalizers mod_finalizers) . HsSplicedTy <$> hs_ty3 , fvs @@ -594,17 +601,18 @@ rnSplicePat splice = rnSpliceGen run_pat_splice pend_pat_splice splice where pend_pat_splice rn_splice - = (makePending UntypedPatSplice rn_splice, Right (SplicePat rn_splice)) + = (makePending UntypedPatSplice rn_splice + , Right (SplicePat noExt rn_splice)) run_pat_splice rn_splice = do { traceRn "rnSplicePat: untyped pattern splice" empty ; (pat, mod_finalizers) <- runRnSplice UntypedPatSplice runMetaP ppr rn_splice -- See Note [Delaying modFinalizers in untyped splices]. - ; return ( Left $ ParPat $ SplicePat - . HsSpliced (ThModFinalizers mod_finalizers) - . HsSplicedPat <$> - pat + ; return ( Left $ ParPat noExt $ (SplicePat noExt) + . HsSpliced noExt (ThModFinalizers mod_finalizers) + . HsSplicedPat <$> + pat , emptyFVs ) } -- Wrap the result of the quasi-quoter in parens so that we don't @@ -687,6 +695,7 @@ spliceCtxt splice HsTypedSplice {} -> text "typed splice:" HsQuasiQuote {} -> text "quasi-quotation:" HsSpliced {} -> text "spliced expression:" + XSplice {} -> text "spliced expression:" -- | The splice data to be logged data SpliceInfo |