Break dependency from HsSyn on the typechecker.wip/rae/remove-tc-dep

There are three reasons that HsSyn has depended
on the type-checker.

1. The AST contains HsWrappers in a variety of places -- notably,
   in expressions. HsWrappers are part of type-checker evidence,
   and they are declared in TcEvidence.

2. In a few places (notably, AbsBinds), the AST contains a TcEvBinds.
   TcEvBinds is also declared in TcEvidence.

3. Expressions can contain *delayed splices*. See Note [Running typed
   splices in the zonker] in Hs.Expr. A DelayedSplice structure needs
   a reference to a TcLclEnv, declared in TcRnTypes and rather
   intimately tied to the type-checker.

The third of these is the most pernicious, because it requires
a dependency on a central module within the type-checker. TcEvidence,
on the other hand, might conceivably be moved out from the type-checker.

This patch removes all three dependencies. The magic is all
in Note [Abstract data] in Hs.Extension. In order to support this
change, this patch also introduces some new constraints in Hs.Extension.
Specifically, we now have IsGhcPass, which allows functions to
do a runtiem (of GHC) check to see what phase we're in, in order
to do custom processing in one phase or another.

Somewhat separately, this patch also moves HsWrap and HsCmdWrap
into an extension field. CoPat should get the same treatment, but
is not included in this patch. And, of course, there are many other
places that constructors should be moved to extension fields (like
ConPatOut). This change is actually orthogonal to the
dependency-dropping, but it seemed convenient to do them all together.

This patch subsumes !1721 (sorry @chreekat).

1 files changed, 37 insertions, 56 deletions

diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 01c10b1ea1..074da0353a 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -16,6 +16,8 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module GHC.Hs.Binds where
 
@@ -29,7 +31,7 @@ import {-# SOURCE #-} GHC.Hs.Pat  ( LPat )
 import GHC.Hs.Extension
 import GHC.Hs.Types
 import CoreSyn
-import TcEvidence
+import PprCore ()   -- Outputable (Tickish id)
 import Type
 import NameSet
 import BasicTypes
@@ -218,29 +220,29 @@ data HsBindLR idL idR
     -- For details on above see note [Api annotations] in ApiAnnotation
     FunBind {
 
-        fun_ext :: XFunBind idL idR, -- ^ After the renamer, this contains
-                                --  the locally-bound
-                                -- free variables of this defn.
-                                -- See Note [Bind free vars]
+        fun_ext :: XFunBind idL idR,
+
+          -- ^ After the renamer (but before the type-checker), this contains the
+          -- locally-bound free variables of this defn. See Note [Bind free vars]
+          --
+          -- After the type-checker, a coercion from the type of the MatchGroup
+          -- to the type of the Id.  Example:
+          --
+          -- @
+          --      f :: Int -> forall a. a -> a
+          --      f x y = y
+          -- @
+          --
+          -- Then the MatchGroup will have type (Int -> a' -> a')
+          -- (with a free type variable a').  The coercion will take
+          -- a CoreExpr of this type and convert it to a CoreExpr of
+          -- type         Int -> forall a'. a' -> a'
+          -- Notice that the coercion captures the free a'.
 
         fun_id :: Located (IdP idL), -- Note [fun_id in Match] in GHC.Hs.Expr
 
         fun_matches :: MatchGroup idR (LHsExpr idR),  -- ^ The payload
 
-        fun_co_fn :: HsWrapper, -- ^ Coercion from the type of the MatchGroup to the type of
-                                -- the Id.  Example:
-                                --
-                                -- @
-                                --      f :: Int -> forall a. a -> a
-                                --      f x y = y
-                                -- @
-                                --
-                                -- Then the MatchGroup will have type (Int -> a' -> a')
-                                -- (with a free type variable a').  The coercion will take
-                                -- a CoreExpr of this type and convert it to a CoreExpr of
-                                -- type         Int -> forall a'. a' -> a'
-                                -- Notice that the coercion captures the free a'.
-
         fun_tick :: [Tickish Id] -- ^ Ticks to put on the rhs, if any
     }
 
@@ -292,7 +294,7 @@ data HsBindLR idL idR
         -- | Evidence bindings
         -- Why a list? See TcInstDcls
         -- Note [Typechecking plan for instance declarations]
-        abs_ev_binds :: [TcEvBinds],
+        abs_ev_binds :: [XTcEvBinds],
 
         -- | Typechecked user bindings
         abs_binds    :: LHsBinds idL,
@@ -319,8 +321,8 @@ data NPatBindTc = NPatBindTc {
      } deriving Data
 
 type instance XFunBind    (GhcPass pL) GhcPs = NoExtField
-type instance XFunBind    (GhcPass pL) GhcRn = NameSet -- Free variables
-type instance XFunBind    (GhcPass pL) GhcTc = NameSet -- Free variables
+type instance XFunBind    (GhcPass pL) GhcRn = NameSet    -- Free variables
+type instance XFunBind    (GhcPass pL) GhcTc = XHsWrapper -- See comments on FunBind.fun_ext
 
 type instance XPatBind    GhcPs (GhcPass pR) = NoExtField
 type instance XPatBind    GhcRn (GhcPass pR) = NameSet -- Free variables
@@ -349,7 +351,7 @@ data ABExport p
   = ABE { abe_ext       :: XABE p
         , abe_poly      :: IdP p -- ^ Any INLINE pragma is attached to this Id
         , abe_mono      :: IdP p
-        , abe_wrap      :: HsWrapper    -- ^ See Note [ABExport wrapper]
+        , abe_wrap      :: XHsWrapper   -- ^ See Note [ABExport wrapper]
              -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly
         , abe_prags     :: TcSpecPrags  -- ^ SPECIALISE pragmas
         }
@@ -683,19 +685,6 @@ pprDeclList ds = pprDeeperList vcat ds
 emptyLocalBinds :: HsLocalBindsLR (GhcPass a) (GhcPass b)
 emptyLocalBinds = EmptyLocalBinds noExtField
 
--- AZ:These functions do not seem to be used at all?
-isEmptyLocalBindsTc :: HsLocalBindsLR (GhcPass a) GhcTc -> Bool
-isEmptyLocalBindsTc (HsValBinds _ ds)   = isEmptyValBinds ds
-isEmptyLocalBindsTc (HsIPBinds _ ds)    = isEmptyIPBindsTc ds
-isEmptyLocalBindsTc (EmptyLocalBinds _) = True
-isEmptyLocalBindsTc (XHsLocalBindsLR _) = True
-
-isEmptyLocalBindsPR :: HsLocalBindsLR (GhcPass a) (GhcPass b) -> Bool
-isEmptyLocalBindsPR (HsValBinds _ ds)   = isEmptyValBinds ds
-isEmptyLocalBindsPR (HsIPBinds _ ds)    = isEmptyIPBindsPR ds
-isEmptyLocalBindsPR (EmptyLocalBinds _) = True
-isEmptyLocalBindsPR (XHsLocalBindsLR _) = True
-
 eqEmptyLocalBinds :: HsLocalBindsLR a b -> Bool
 eqEmptyLocalBinds (EmptyLocalBinds _) = True
 eqEmptyLocalBinds _                   = False
@@ -730,7 +719,8 @@ instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
          => Outputable (HsBindLR idL idR) where
     ppr mbind = ppr_monobind mbind
 
-ppr_monobind :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
+ppr_monobind :: forall idL idR.
+                (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
              => HsBindLR (GhcPass idL) (GhcPass idR) -> SDoc
 
 ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })
@@ -738,14 +728,15 @@ ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })
 ppr_monobind (VarBind { var_id = var, var_rhs = rhs })
   = sep [pprBndr CasePatBind var, nest 2 $ equals <+> pprExpr (unLoc rhs)]
 ppr_monobind (FunBind { fun_id = fun,
-                        fun_co_fn = wrap,
                         fun_matches = matches,
-                        fun_tick = ticks })
+                        fun_tick = ticks,
+                        fun_ext = wrap })
   = pprTicks empty (if null ticks then empty
                     else text "-- ticks = " <> ppr ticks)
     $$  whenPprDebug (pprBndr LetBind (unLoc fun))
     $$  pprFunBind  matches
-    $$  whenPprDebug (ppr wrap)
+    $$  whenPprDebug (pprIfTc @idR $ ppr wrap)
+
 ppr_monobind (PatSynBind _ psb) = ppr psb
 ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
                        , abs_exports = exports, abs_binds = val_binds
@@ -761,7 +752,7 @@ ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
       , text "Exported types:" <+>
           vcat [pprBndr LetBind (abe_poly ex) | ex <- exports]
       , text "Binds:" <+> pprLHsBinds val_binds
-      , text "Evidence:" <+> ppr ev_binds ]
+      , pprIfTc @idR (text "Evidence:" <+> ppr ev_binds) ]
     else
       pprLHsBinds val_binds
 ppr_monobind (XHsBindsLR x) = ppr x
@@ -770,7 +761,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ABExport p) where
   ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags })
     = vcat [ ppr gbl <+> text "<=" <+> ppr lcl
            , nest 2 (pprTcSpecPrags prags)
-           , nest 2 (text "wrap:" <+> ppr wrap)]
+           , pprIfTc @pass $ nest 2 (text "wrap:" <+> ppr wrap) ]
   ppr (XABExport x) = ppr x
 
 instance (idR ~ GhcPass pr,OutputableBndrId idL, OutputableBndrId idR,
@@ -825,20 +816,12 @@ data HsIPBinds id
 
 type instance XIPBinds       GhcPs = NoExtField
 type instance XIPBinds       GhcRn = NoExtField
-type instance XIPBinds       GhcTc = TcEvBinds -- binds uses of the
-                                               -- implicit parameters
+type instance XIPBinds       GhcTc = XTcEvBinds -- binds uses of the
+                                                -- implicit parameters
 
 
 type instance XXHsIPBinds    (GhcPass p) = NoExtCon
 
-isEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool
-isEmptyIPBindsPR (IPBinds _ is) = null is
-isEmptyIPBindsPR (XHsIPBinds _) = True
-
-isEmptyIPBindsTc :: HsIPBinds GhcTc -> Bool
-isEmptyIPBindsTc (IPBinds ds is) = null is && isEmptyTcEvBinds ds
-isEmptyIPBindsTc (XHsIPBinds _) = True
-
 -- | Located Implicit Parameter Binding
 type LIPBind id = Located (IPBind id)
 -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a
@@ -869,7 +852,7 @@ type instance XXIPBind    (GhcPass p) = NoExtCon
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (HsIPBinds p) where
   ppr (IPBinds ds bs) = pprDeeperList vcat (map ppr bs)
-                        $$ whenPprDebug (ppr ds)
+                        $$ whenPprDebug (pprIfTc @pass $ ppr ds)
   ppr (XHsIPBinds x) = ppr x
 
 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (IPBind p) where
@@ -1076,7 +1059,6 @@ data TcSpecPrags
   = IsDefaultMethod     -- ^ Super-specialised: a default method should
                         -- be macro-expanded at every call site
   | SpecPrags [LTcSpecPrag]
-  deriving Data
 
 -- | Located Type checker Specification Pragmas
 type LTcSpecPrag = Located TcSpecPrag
@@ -1085,11 +1067,10 @@ type LTcSpecPrag = Located TcSpecPrag
 data TcSpecPrag
   = SpecPrag
         Id
-        HsWrapper
+        XHsWrapper
         InlinePragma
   -- ^ The Id to be specialised, a wrapper that specialises the
   -- polymorphic function, and inlining spec for the specialised function
-  deriving Data
 
 noSpecPrags :: TcSpecPrags
 noSpecPrags = SpecPrags []