Introduce IsPass; refactor wrappers.

There are two main payloads of this patch:

1. This introduces IsPass, which allows e.g. printing
   code to ask what pass it is running in (Renamed vs
   Typechecked) and thus print extension fields. See
   Note [IsPass] in Hs.Extension

2. This moves the HsWrap constructor into an extension
   field, where it rightly belongs. This is done for
   HsExpr and HsCmd, but not for HsPat, which is left
   as an exercise for the reader.

There is also some refactoring around SyntaxExprs, but this
is really just incidental.

This patch subsumes !1721 (sorry @chreekat).

Along the way, there is a bit of refactoring in GHC.Hs.Extension,
including the removal of NameOrRdrName in favor of NoGhcTc.
This meant that we had no real need for GHC.Hs.PlaceHolder, so
I got rid of it.

Updates haddock submodule.

-------------------------
Metric Decrease:
    haddock.compiler
-------------------------

9 files changed, 54 insertions, 53 deletions

diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index 6f9fe36141..0092e991ef 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -633,10 +633,10 @@ addTickHsExpr (HsProc x pat cmdtop) =
         liftM2 (HsProc x)
                 (addTickLPat pat)
                 (liftL (addTickHsCmdTop) cmdtop)
-addTickHsExpr (HsWrap x w e) =
-        liftM2 (HsWrap x)
-                (return w)
-                (addTickHsExpr e)       -- Explicitly no tick on inside
+addTickHsExpr (XExpr (HsWrap w e)) =
+        liftM XExpr $
+        liftM (HsWrap w)
+              (addTickHsExpr e)        -- Explicitly no tick on inside
 
 -- Others should never happen in expression content.
 addTickHsExpr e  = pprPanic "addTickHsExpr" (ppr e)
@@ -834,9 +834,11 @@ addTickIPBind (XIPBind x) = return (XIPBind x)
 
 -- There is no location here, so we might need to use a context location??
 addTickSyntaxExpr :: SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
-addTickSyntaxExpr pos syn@(SyntaxExpr { syn_expr = x }) = do
+addTickSyntaxExpr pos syn@(SyntaxExprTc { syn_expr = x }) = do
         x' <- fmap unLoc (addTickLHsExpr (L pos x))
         return $ syn { syn_expr = x' }
+addTickSyntaxExpr _ NoSyntaxExprTc = return NoSyntaxExprTc
+
 -- we do not walk into patterns.
 addTickLPat :: LPat GhcTc -> TM (LPat GhcTc)
 addTickLPat pat = return pat
@@ -899,10 +901,9 @@ addTickHsCmd (HsCmdArrForm x e f fix cmdtop) =
                (return fix)
                (mapM (liftL (addTickHsCmdTop)) cmdtop)
 
-addTickHsCmd (HsCmdWrap x w cmd)
-  = liftM2 (HsCmdWrap x) (return w) (addTickHsCmd cmd)
-
-addTickHsCmd (XCmd nec) = noExtCon nec
+addTickHsCmd (XCmd (HsWrap w cmd)) =
+  liftM XCmd $
+  liftM (HsWrap w) (addTickHsCmd cmd)
 
 -- Others should never happen in a command context.
 --addTickHsCmd e  = pprPanic "addTickHsCmd" (ppr e)
diff --git a/compiler/deSugar/DsArrows.hs b/compiler/deSugar/DsArrows.hs
index bab9a60cad..8c1e161dc9 100644
--- a/compiler/deSugar/DsArrows.hs
+++ b/compiler/deSugar/DsArrows.hs
@@ -45,7 +45,6 @@ import CoreUtils
 import MkCore
 import DsBinds (dsHsWrapper)
 
-import Name
 import Id
 import ConLike
 import TysWiredIn
@@ -169,7 +168,7 @@ do_premap :: DsCmdEnv -> Type -> Type -> Type ->
 do_premap ids b_ty c_ty d_ty f g
    = do_compose ids b_ty c_ty d_ty (do_arr ids b_ty c_ty f) g
 
-mkFailExpr :: HsMatchContext Id -> Type -> DsM CoreExpr
+mkFailExpr :: HsMatchContext GhcRn -> Type -> DsM CoreExpr
 mkFailExpr ctxt ty
   = mkErrorAppDs pAT_ERROR_ID ty (matchContextErrString ctxt)
 
@@ -530,11 +529,11 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdIf _ mb_fun cond then_cmd else_cmd)
                        (buildEnvStack else_ids stack_id)
 
     core_if <- case mb_fun of
-       Just fun -> do { fun_apps <- dsSyntaxExpr fun
+       NoSyntaxExprTc  -> matchEnvStack env_ids stack_id $
+                          mkIfThenElse core_cond core_left core_right
+       _ -> do { fun_apps <- dsSyntaxExpr mb_fun
                                       [core_cond, core_left, core_right]
-                      ; matchEnvStack env_ids stack_id fun_apps }
-       Nothing  -> matchEnvStack env_ids stack_id $
-                   mkIfThenElse core_cond core_left core_right
+               ; matchEnvStack env_ids stack_id fun_apps }
 
     return (do_premap ids in_ty sum_ty res_ty
                 core_if
@@ -690,7 +689,7 @@ dsCmd _ local_vars _stack_ty _res_ty (HsCmdArrForm _ op _ _ args) env_ids = do
     return (mkApps (App core_op (Type env_ty)) core_args,
             unionDVarSets fv_sets)
 
-dsCmd ids local_vars stack_ty res_ty (HsCmdWrap _ wrap cmd) env_ids = do
+dsCmd ids local_vars stack_ty res_ty (XCmd (HsWrap wrap cmd)) env_ids = do
     (core_cmd, env_ids') <- dsCmd ids local_vars stack_ty res_ty cmd env_ids
     core_wrap <- dsHsWrapper wrap
     return (core_wrap core_cmd, env_ids')
@@ -1126,7 +1125,7 @@ dsCmdStmts _ _ _ [] _ = panic "dsCmdStmts []"
 -- Match a list of expressions against a list of patterns, left-to-right.
 
 matchSimplys :: [CoreExpr]              -- Scrutinees
-             -> HsMatchContext Name     -- Match kind
+             -> HsMatchContext GhcRn    -- Match kind
              -> [LPat GhcTc]            -- Patterns they should match
              -> CoreExpr                -- Return this if they all match
              -> CoreExpr                -- Return this if they don't
diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index ac3a41a8fb..d573efc0c3 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -147,7 +147,7 @@ dsHsBind dflags (VarBind { var_id = var
 
 dsHsBind dflags b@(FunBind { fun_id = L _ fun
                            , fun_matches = matches
-                           , fun_co_fn = co_fn
+                           , fun_ext = co_fn
                            , fun_tick = tick })
  = do   { (args, body) <- matchWrapper
                            (mkPrefixFunRhs (noLoc $ idName fun))
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index 0f1386d76d..d4754fe568 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -198,7 +198,7 @@ dsUnliftedBind (AbsBinds { abs_tvs = [], abs_ev_vars = []
 
 dsUnliftedBind (FunBind { fun_id = L l fun
                         , fun_matches = matches
-                        , fun_co_fn = co_fn
+                        , fun_ext = co_fn
                         , fun_tick = tick }) body
                -- Can't be a bang pattern (that looks like a PatBind)
                -- so must be simply unboxed
@@ -278,7 +278,7 @@ ds_expr _ (HsOverLit _ lit)
   = do { warnAboutOverflowedOverLit lit
        ; dsOverLit lit }
 
-ds_expr _ (HsWrap _ co_fn e)
+ds_expr _ (XExpr (HsWrap co_fn e))
   = do { e' <- ds_expr True e    -- This is the one place where we recurse to
                                  -- ds_expr (passing True), rather than dsExpr
        ; wrap' <- dsHsWrapper co_fn
@@ -429,13 +429,13 @@ ds_expr _ (HsDo _ GhciStmtCtxt  (L _ stmts)) = dsDo stmts
 ds_expr _ (HsDo _ MDoExpr       (L _ stmts)) = dsDo stmts
 ds_expr _ (HsDo _ MonadComp     (L _ stmts)) = dsMonadComp stmts
 
-ds_expr _ (HsIf _ mb_fun guard_expr then_expr else_expr)
+ds_expr _ (HsIf _ fun guard_expr then_expr else_expr)
   = do { pred <- dsLExpr guard_expr
        ; b1 <- dsLExpr then_expr
        ; b2 <- dsLExpr else_expr
-       ; case mb_fun of
-           Just fun -> dsSyntaxExpr fun [pred, b1, b2]
-           Nothing  -> return $ mkIfThenElse pred b1 b2 }
+       ; case fun of  -- See Note [Rebindable if] in Hs.Expr
+           (SyntaxExprTc {}) -> dsSyntaxExpr fun [pred, b1, b2]
+           NoSyntaxExprTc    -> return $ mkIfThenElse pred b1 b2 }
 
 ds_expr _ (HsMultiIf res_ty alts)
   | null alts
@@ -741,7 +741,6 @@ ds_expr _ (HsBinTick _ ixT ixF e) = do
 ds_expr _ (HsBracket     {})  = panic "dsExpr:HsBracket"
 ds_expr _ (HsDo          {})  = panic "dsExpr:HsDo"
 ds_expr _ (HsRecFld      {})  = panic "dsExpr:HsRecFld"
-ds_expr _ (XExpr nec)         = noExtCon nec
 
 ds_prag_expr :: HsPragE GhcTc -> LHsExpr GhcTc -> DsM CoreExpr
 ds_prag_expr (HsPragSCC _ _ cc) expr = do
@@ -766,9 +765,9 @@ ds_prag_expr (XHsPragE x) _ = noExtCon x
 
 ------------------------------
 dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
-dsSyntaxExpr (SyntaxExpr { syn_expr      = expr
-                         , syn_arg_wraps = arg_wraps
-                         , syn_res_wrap  = res_wrap })
+dsSyntaxExpr (SyntaxExprTc { syn_expr      = expr
+                           , syn_arg_wraps = arg_wraps
+                           , syn_res_wrap  = res_wrap })
              arg_exprs
   = do { fun            <- dsExpr expr
        ; core_arg_wraps <- mapM dsHsWrapper arg_wraps
@@ -778,6 +777,7 @@ dsSyntaxExpr (SyntaxExpr { syn_expr      = expr
                       (\_ -> core_res_wrap (mkApps fun wrapped_args)) }
   where
     mk_doc n = text "In the" <+> speakNth n <+> text "argument of" <+> quotes (ppr expr)
+dsSyntaxExpr NoSyntaxExprTc _ = panic "dsSyntaxExpr"
 
 findField :: [LHsRecField GhcTc arg] -> Name -> [arg]
 findField rbinds sel
diff --git a/compiler/deSugar/DsGRHSs.hs b/compiler/deSugar/DsGRHSs.hs
index fe60cb8001..a424bd9d7b 100644
--- a/compiler/deSugar/DsGRHSs.hs
+++ b/compiler/deSugar/DsGRHSs.hs
@@ -29,7 +29,6 @@ import GHC.HsToCore.PmCheck (needToRunPmCheck, addTyCsDs, addPatTmCs, addScrutTm
 import DsMonad
 import DsUtils
 import Type   ( Type )
-import Name
 import Util
 import SrcLoc
 import Outputable
@@ -55,7 +54,7 @@ dsGuarded grhss rhs_ty = do
 
 -- In contrast, @dsGRHSs@ produces a @MatchResult@.
 
-dsGRHSs :: HsMatchContext Name
+dsGRHSs :: HsMatchContext GhcRn
         -> GRHSs GhcTc (LHsExpr GhcTc)          -- Guarded RHSs
         -> Type                                 -- Type of RHS
         -> DsM MatchResult
@@ -68,7 +67,7 @@ dsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty
        ; return match_result2 }
 dsGRHSs _ (XGRHSs nec) _ = noExtCon nec
 
-dsGRHS :: HsMatchContext Name -> Type -> LGRHS GhcTc (LHsExpr GhcTc)
+dsGRHS :: HsMatchContext GhcRn -> Type -> LGRHS GhcTc (LHsExpr GhcTc)
        -> DsM MatchResult
 dsGRHS hs_ctx rhs_ty (L _ (GRHS _ guards rhs))
   = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs rhs_ty
@@ -83,7 +82,7 @@ dsGRHS _ _ (L _ (XGRHS nec)) = noExtCon nec
 -}
 
 matchGuards :: [GuardStmt GhcTc]     -- Guard
-            -> HsStmtContext Name    -- Context
+            -> HsStmtContext GhcRn   -- Context
             -> LHsExpr GhcTc         -- RHS
             -> Type                  -- Type of RHS of guard
             -> DsM MatchResult
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 9dcbc8faaa..5473682a40 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -1971,9 +1971,10 @@ repP (AsPat _ x p)      = do { x' <- lookupLBinder x; p1 <- repLP p
                              ; repPaspat x' p1 }
 repP (ParPat _ p)       = repLP p
 repP (ListPat Nothing ps)  = do { qs <- repLPs ps; repPlist qs }
-repP (ListPat (Just e) ps) = do { p <- repP (ListPat Nothing ps)
-                                ; e' <- repE (syn_expr e)
-                                ; repPview e' p}
+repP (ListPat (Just (SyntaxExprRn e)) ps) = do { p <- repP (ListPat Nothing ps)
+                                               ; e' <- repE e
+                                               ; repPview e' p}
+repP (ListPat _ ps) = pprPanic "repP missing SyntaxExprRn" (ppr ps)
 repP (TuplePat _ ps boxed)
   | isBoxed boxed       = do { qs <- repLPs ps; repPtup qs }
   | otherwise           = do { qs <- repLPs ps; repPunboxedTup qs }
diff --git a/compiler/deSugar/DsMonad.hs b/compiler/deSugar/DsMonad.hs
index 2af170be5f..998d46395d 100644
--- a/compiler/deSugar/DsMonad.hs
+++ b/compiler/deSugar/DsMonad.hs
@@ -97,7 +97,7 @@ import Data.IORef
 -}
 
 data DsMatchContext
-  = DsMatchContext (HsMatchContext Name) SrcSpan
+  = DsMatchContext (HsMatchContext GhcRn) SrcSpan
   deriving ()
 
 instance Outputable DsMatchContext where
diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs
index ac277893f6..d6ddfb894a 100644
--- a/compiler/deSugar/Match.hs
+++ b/compiler/deSugar/Match.hs
@@ -694,7 +694,7 @@ Call @match@ with all of this information!
 -}
 
 matchWrapper
-  :: HsMatchContext Name               -- ^ For shadowing warning messages
+  :: HsMatchContext GhcRn              -- ^ For shadowing warning messages
   -> Maybe (LHsExpr GhcTc)             -- ^ Scrutinee. (Just scrut) for a case expr
                                        --      case scrut of { p1 -> e1 ... }
                                        --   (and in this case the MatchGroup will
@@ -775,7 +775,7 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches
                      else id
 matchWrapper _ _ (XMatchGroup nec) = noExtCon nec
 
-matchEquations  :: HsMatchContext Name
+matchEquations  :: HsMatchContext GhcRn
                 -> [MatchId] -> [EquationInfo] -> Type
                 -> DsM CoreExpr
 matchEquations ctxt vars eqns_info rhs_ty
@@ -799,7 +799,7 @@ pattern. It returns an expression.
 -}
 
 matchSimply :: CoreExpr                 -- ^ Scrutinee
-            -> HsMatchContext Name      -- ^ Match kind
+            -> HsMatchContext GhcRn     -- ^ Match kind
             -> LPat GhcTc               -- ^ Pattern it should match
             -> CoreExpr                 -- ^ Return this if it matches
             -> CoreExpr                 -- ^ Return this if it doesn't
@@ -813,7 +813,7 @@ matchSimply scrut hs_ctx pat result_expr fail_expr = do
     match_result' <- matchSinglePat scrut hs_ctx pat rhs_ty match_result
     extractMatchResult match_result' fail_expr
 
-matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat GhcTc
+matchSinglePat :: CoreExpr -> HsMatchContext GhcRn -> LPat GhcTc
                -> Type -> MatchResult -> DsM MatchResult
 -- matchSinglePat ensures that the scrutinee is a variable
 -- and then calls matchSinglePatVar
@@ -832,7 +832,7 @@ matchSinglePat scrut hs_ctx pat ty match_result
        ; return (adjustMatchResult (bindNonRec var scrut) match_result') }
 
 matchSinglePatVar :: Id   -- See Note [Match Ids]
-                  -> HsMatchContext Name -> LPat GhcTc
+                  -> HsMatchContext GhcRn -> LPat GhcTc
                   -> Type -> MatchResult -> DsM MatchResult
 matchSinglePatVar var ctx pat ty match_result
   = ASSERT2( isInternalName (idName var), ppr var )
@@ -1014,7 +1014,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
     exp e (HsPar _ (L _ e'))   = exp e e'
     -- because the expressions do not necessarily have the same type,
     -- we have to compare the wrappers
-    exp (HsWrap _ h e) (HsWrap _ h' e') = wrap h h' && exp e e'
+    exp (XExpr (HsWrap h e)) (XExpr (HsWrap  h' e')) = wrap h h' && exp e e'
     exp (HsVar _ i) (HsVar _ i') =  i == i'
     exp (HsConLikeOut _ c) (HsConLikeOut _ c') = c == c'
     -- the instance for IPName derives using the id, so this works if the
@@ -1053,15 +1053,17 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
 
     ---------
     syn_exp :: SyntaxExpr GhcTc -> SyntaxExpr GhcTc -> Bool
-    syn_exp (SyntaxExpr { syn_expr      = expr1
-                        , syn_arg_wraps = arg_wraps1
-                        , syn_res_wrap  = res_wrap1 })
-            (SyntaxExpr { syn_expr      = expr2
-                        , syn_arg_wraps = arg_wraps2
-                        , syn_res_wrap  = res_wrap2 })
+    syn_exp (SyntaxExprTc { syn_expr      = expr1
+                          , syn_arg_wraps = arg_wraps1
+                          , syn_res_wrap  = res_wrap1 })
+            (SyntaxExprTc { syn_expr      = expr2
+                          , syn_arg_wraps = arg_wraps2
+                          , syn_res_wrap  = res_wrap2 })
       = exp expr1 expr2 &&
         and (zipWithEqual "viewLExprEq" wrap arg_wraps1 arg_wraps2) &&
         wrap res_wrap1 res_wrap2
+    syn_exp NoSyntaxExprTc NoSyntaxExprTc = True
+    syn_exp _              _              = False
 
     ---------
     tup_arg (L _ (Present _ e1)) (L _ (Present _ e2)) = lexp e1 e2
diff --git a/compiler/deSugar/Match.hs-boot b/compiler/deSugar/Match.hs-boot
index be5cd766ea..6d6cf989df 100644
--- a/compiler/deSugar/Match.hs-boot
+++ b/compiler/deSugar/Match.hs-boot
@@ -6,8 +6,7 @@ import TcType   ( Type )
 import DsMonad  ( DsM, EquationInfo, MatchResult )
 import CoreSyn  ( CoreExpr )
 import GHC.Hs   ( LPat, HsMatchContext, MatchGroup, LHsExpr )
-import Name     ( Name )
-import GHC.Hs.Extension ( GhcTc )
+import GHC.Hs.Extension ( GhcRn, GhcTc )
 
 match   :: [Id]
         -> Type
@@ -15,14 +14,14 @@ match   :: [Id]
         -> DsM MatchResult
 
 matchWrapper
-        :: HsMatchContext Name
+        :: HsMatchContext GhcRn
         -> Maybe (LHsExpr GhcTc)
         -> MatchGroup GhcTc (LHsExpr GhcTc)
         -> DsM ([Id], CoreExpr)
 
 matchSimply
         :: CoreExpr
-        -> HsMatchContext Name
+        -> HsMatchContext GhcRn
         -> LPat GhcTc
         -> CoreExpr
         -> CoreExpr
@@ -30,7 +29,7 @@ matchSimply
 
 matchSinglePatVar
         :: Id
-        -> HsMatchContext Name
+        -> HsMatchContext GhcRn
         -> LPat GhcTc
         -> Type
         -> MatchResult