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