Remove dead code
[ghc.git] / compiler / rename / RnSplice.hs
index 36b1eda..5766080 100644 (file)
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module RnSplice (
         rnTopSpliceDecls,
@@ -18,7 +19,6 @@ import NameSet
 import HsSyn
 import RdrName
 import TcRnMonad
-import Kind
 
 import RnEnv
 import RnUtils          ( HsDocContext(..), newLocalBndrRn )
@@ -52,10 +52,11 @@ import {-# SOURCE #-} TcSplice
     , runMetaE
     , runMetaP
     , runMetaT
-    , runRemoteModFinalizers
     , tcTopSpliceExpr
     )
 
+import TcHsSyn
+
 import GHCi.RemoteTypes ( ForeignRef )
 import qualified Language.Haskell.TH as TH (Q)
 
@@ -103,7 +104,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 +112,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 flg rdr_name)
   = do { name <- lookupOccRn rdr_name
        ; this_mod <- getModule
 
@@ -137,17 +138,18 @@ rn_bracket outer_stage br@(VarBr flg rdr_name)
                                              (quotedNameStageErr br) }
                         }
                     }
-       ; return (VarBr flg name, unitFV name) }
+       ; return (VarBr flg name, unitFV name) }
 
-rn_bracket _ (ExpBr e) = do { (e', fvs) <- rnLExpr e
-                            ; return (ExpBr e', fvs) }
+rn_bracket _ (ExpBr e) = do { (e', fvs) <- rnLExpr e
+                            ; return (ExpBr 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 t) = do { (t', fvs) <- rnLHsType TypBrCtx t
+                              ; return (TypBr x t', fvs) }
 
-rn_bracket _ (DecBrL decls)
+rn_bracket _ (DecBrL decls)
   = do { group <- groupDecls decls
        ; gbl_env  <- getGblEnv
        ; let new_gbl_env = gbl_env { tcg_dus = emptyDUs }
@@ -159,7 +161,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 group', duUses (tcg_dus tcg_env)) }
   where
     groupDecls :: [LHsDecl GhcPs] -> RnM (HsGroup GhcPs)
     groupDecls decls
@@ -173,10 +175,12 @@ rn_bracket _ (DecBrL 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 _ (TExpBr e) = do { (e', fvs) <- rnLExpr e
-                             ; return (TExpBr e', fvs) }
+rn_bracket _ (XBracket {}) = panic "rn_bracket: unexpected XBracket"
 
 quotationCtxtDoc :: HsBracket GhcPs -> SDoc
 quotationCtxtDoc br_body
@@ -294,15 +298,18 @@ 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)
+                HsSplicedT {}             -> pprPanic "runRnSplice" (ppr splice)
+                XSplice {}                -> pprPanic "runRnSplice" (ppr splice)
 
              -- Typecheck the expression
        ; meta_exp_ty   <- tcMetaTy meta_ty_name
-       ; zonked_q_expr <- tcTopSpliceExpr Untyped $
-                          tcPolyExpr the_expr meta_exp_ty
+       ; zonked_q_expr <- zonkTopLExpr =<<
+                            tcTopSpliceExpr Untyped
+                              (tcPolyExpr the_expr meta_exp_ty)
 
              -- Run the expression
        ; mod_finalizers_ref <- newTcRef []
@@ -335,14 +342,18 @@ 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@(HsSplicedT {})
+  = pprPanic "makePending" (ppr splice)
+makePending _ splice@(XSplice {})
+  = pprPanic "makePending" (ppr splice)
 
 ------------------
 mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString
@@ -350,13 +361,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)))
+  = cL q_span $ HsApp noExt (cL q_span
+              $ HsApp noExt (cL q_span (HsVar noExt (cL 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 = cL q_span $! HsVar noExt $! (cL q_span quoter)
+    quoteExpr  = cL q_span $! HsLit noExt $! HsString NoSourceText quote
     quote_selector = case flavour of
                        UntypedExpSplice  -> quoteExpName
                        UntypedPatSplice  -> quotePatName
@@ -366,24 +377,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)
-  = do  { checkTH expr "Template Haskell typed splice"
-        ; loc  <- getSrcSpanM
-        ; n' <- newLocalBndrRn (L loc splice_name)
+rnSplice (HsTypedSplice x hasParen splice_name expr)
+  = do  { loc  <- getSrcSpanM
+        ; n' <- newLocalBndrRn (cL loc splice_name)
         ; (expr', fvs) <- rnLExpr expr
-        ; return (HsTypedSplice hasParen n' expr', fvs) }
+        ; return (HsTypedSplice hasParen n' expr', fvs) }
 
-rnSplice (HsUntypedSplice hasParen splice_name expr)
-  = do  { checkTH expr "Template Haskell untyped splice"
-        ; loc  <- getSrcSpanM
-        ; n' <- newLocalBndrRn (L loc splice_name)
+rnSplice (HsUntypedSplice x hasParen splice_name expr)
+  = do  { loc  <- getSrcSpanM
+        ; n' <- newLocalBndrRn (cL loc splice_name)
         ; (expr', fvs) <- rnLExpr expr
-        ; return (HsUntypedSplice hasParen n' expr', fvs) }
+        ; return (HsUntypedSplice hasParen n' expr', fvs) }
 
-rnSplice (HsQuasiQuote splice_name quoter q_loc quote)
-  = do  { checkTH quoter "Template Haskell quasi-quote"
-        ; loc  <- getSrcSpanM
-        ; splice_name' <- newLocalBndrRn (L loc splice_name)
+rnSplice (HsQuasiQuote x splice_name quoter q_loc quote)
+  = do  { loc  <- getSrcSpanM
+        ; splice_name' <- newLocalBndrRn (cL loc splice_name)
 
           -- Rename the quoter; akin to the HsVar case of rnExpr
         ; quoter' <- lookupOccRn quoter
@@ -391,9 +399,12 @@ 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@(HsSplicedT {}) = pprPanic "rnSplice" (ppr splice)
+rnSplice splice@(XSplice {})   = pprPanic "rnSplice" (ppr splice)
 
 ---------------------
 rnSpliceExpr :: HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars)
@@ -402,7 +413,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 +426,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 +434,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)
@@ -433,16 +444,16 @@ rnSpliceExpr splice
 {- Note [Running splices in the Renamer]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
-Splices used to be run in the typechecker, which led to (Trac #4364). Since the
+Splices used to be run in the typechecker, which led to (#4364). Since the
 renamer must decide which expressions depend on which others, and it cannot
 reliably do this for arbitrary splices, we used to conservatively say that
 splices depend on all other expressions in scope. Unfortunately, this led to
-the problem of cyclic type declarations seen in (Trac #4364). Instead, by
+the problem of cyclic type declarations seen in (#4364). Instead, by
 running splices in the renamer, we side-step the problem of determining
 dependencies: by the time the dependency analysis happens, any splices have
 already been run, and expression dependencies can be determined as usual.
 
-However, see (Trac #9813), for an example where we would like to run splices
+However, see (#9813), for an example where we would like to run splices
 *after* performing dependency analysis (that is, after renaming). It would be
 desirable to typecheck "non-splicy" expressions (those expressions that do not
 contain splices directly or via dependence on an expression that does) before
@@ -463,7 +474,7 @@ we wish to first determine dependencies and typecheck certain expressions,
 making them available to reify, but cannot accurately determine dependencies
 without running splices in the renamer!
 
-Indeed, the conclusion of (Trac #9813) was that it is not worth the complexity
+Indeed, the conclusion of (#9813) was that it is not worth the complexity
 to try and
  a) implement and maintain the code for renaming/typechecking non-splicy
     expressions before splicy expressions,
@@ -476,7 +487,7 @@ to try and
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 When splices run in the renamer, 'reify' does not have access to the local
-type environment (Trac #11832, [1]).
+type environment (#11832, [1]).
 
 For instance, in
 
@@ -511,7 +522,7 @@ global environment and exposes the current local environment to them [4, 5, 6].
 
 References:
 
-[1] https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/Reify
+[1] https://gitlab.haskell.org/ghc/ghc/wikis/template-haskell/reify
 [2] 'rnSpliceExpr'
 [3] 'TcSplice.qAddModFinalizer'
 [4] 'TcExpr.tcExpr' ('HsSpliceE' ('HsSpliced' ...))
@@ -521,13 +532,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 +548,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
@@ -593,18 +604,23 @@ rnSplicePat :: HsSplice GhcPs -> RnM ( Either (Pat GhcPs) (Pat GhcRn)
 rnSplicePat splice
   = rnSpliceGen run_pat_splice pend_pat_splice splice
   where
+    pend_pat_splice :: HsSplice GhcRn ->
+                       (PendingRnSplice, Either b (Pat GhcRn))
     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 :: HsSplice GhcRn ->
+                      RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
     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)  `onHasSrcSpan`
+                              pat
                     , emptyFVs
                     ) }
               -- Wrap the result of the quasi-quoter in parens so that we don't
@@ -612,13 +628,15 @@ rnSplicePat splice
 
 ----------------------
 rnSpliceDecl :: SpliceDecl GhcPs -> RnM (SpliceDecl GhcRn, FreeVars)
-rnSpliceDecl (SpliceDecl (L loc splice) flg)
+rnSpliceDecl (SpliceDecl _ (dL->L loc splice) flg)
   = rnSpliceGen run_decl_splice pend_decl_splice splice
   where
     pend_decl_splice rn_splice
-       = (makePending UntypedDeclSplice rn_splice, SpliceDecl (L loc rn_splice) flg)
+       = ( makePending UntypedDeclSplice rn_splice
+         , SpliceDecl noExt (cL loc rn_splice) flg)
 
     run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
+rnSpliceDecl (XSpliceDecl _) = panic "rnSpliceDecl"
 
 rnTopSpliceDecls :: HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars)
 -- Declaration splice at the very top level of the module
@@ -628,9 +646,16 @@ rnTopSpliceDecls splice
                                rnSplice splice
            -- As always, be sure to checkNoErrs above lest we end up with
            -- holes making it to typechecking, hence #12584.
+           --
+           -- Note that we cannot call checkNoErrs for the whole duration
+           -- of rnTopSpliceDecls. The reason is that checkNoErrs changes
+           -- the local environment to temporarily contain a new
+           -- reference to store errors, and add_mod_finalizers would
+           -- cause this reference to be stored after checkNoErrs finishes.
+           -- This is checked by test TH_finalizer.
          ; traceRn "rnTopSpliceDecls: untyped declaration splice" empty
-         ; (decls, mod_finalizers) <-
-              runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice
+         ; (decls, mod_finalizers) <- checkNoErrs $
+               runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice
          ; add_mod_finalizers_now mod_finalizers
          ; return (decls,fvs) }
    where
@@ -648,8 +673,9 @@ rnTopSpliceDecls splice
      add_mod_finalizers_now []             = return ()
      add_mod_finalizers_now mod_finalizers = do
        th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv
+       env <- getLclEnv
        updTcRef th_modfinalizers_var $ \fins ->
-         runRemoteModFinalizers (ThModFinalizers mod_finalizers) : fins
+         (env, ThModFinalizers mod_finalizers) : fins
 
 
 {-
@@ -687,6 +713,8 @@ spliceCtxt splice
              HsTypedSplice   {} -> text "typed splice:"
              HsQuasiQuote    {} -> text "quasi-quotation:"
              HsSpliced       {} -> text "spliced expression:"
+             HsSplicedT      {} -> text "spliced expression:"
+             XSplice         {} -> text "spliced expression:"
 
 -- | The splice data to be logged
 data SpliceInfo
@@ -710,8 +738,8 @@ traceSplice :: SpliceInfo -> TcM ()
 traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src
                         , spliceGenerated = gen, spliceIsDecl = is_decl })
   = do { loc <- case mb_src of
-                   Nothing        -> getSrcSpanM
-                   Just (L loc _) -> return loc
+                   Nothing           -> getSrcSpanM
+                   Just (dL->L loc _) -> return loc
        ; traceOptTcRn Opt_D_dump_splices (spliceDebugDoc loc)
 
        ; when is_decl $  -- Raw material for -dth-dec-file
@@ -825,7 +853,7 @@ ensures that 'f' stays as a top level binding.
 
 This must be done by the renamer, not the type checker (as of old),
 because the type checker doesn't typecheck the body of untyped
-brackets (Trac #8540).
+brackets (#8540).
 
 A thing can have a bind_lvl of outerLevel, but have an internal name:
    foo = [d| op = 3