Refactor the typechecker to use ExpTypes.

The idea here is described in [wiki:Typechecker]. Briefly,
this refactor keeps solid track of "synthesis" mode vs
"checking" in GHC's bidirectional type-checking algorithm.
When in synthesis mode, the expected type is just an IORef
to write to.

In addition, this patch does a significant reworking of
RebindableSyntax, allowing much more freedom in the types
of the rebindable operators. For example, we can now have
`negate :: Int -> Bool` and
`(>>=) :: m a -> (forall x. a x -> m b) -> m b`. The magic
is in tcSyntaxOp.

This addresses tickets #11397, #11452, and #11458.

Tests:
  typecheck/should_compile/{RebindHR,RebindNegate,T11397,T11458}
  th/T11452

7 files changed, 141 insertions, 56 deletions

diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 5b0b1a4125..213c4f5513 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -908,7 +908,7 @@ cvtStmt (NoBindS e)    = do { e' <- cvtl e; returnL $ mkBodyStmt e' }
 cvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnL $ mkBindStmt p' e' }
 cvtStmt (TH.LetS ds)   = do { ds' <- cvtLocalDecs (text "a let binding") ds
                             ; returnL $ LetStmt (noLoc ds') }
-cvtStmt (TH.ParS dss)  = do { dss' <- mapM cvt_one dss; returnL $ ParStmt dss' noSyntaxExpr noSyntaxExpr }
+cvtStmt (TH.ParS dss)  = do { dss' <- mapM cvt_one dss; returnL $ ParStmt dss' noExpr noSyntaxExpr placeHolderType }
                        where
                          cvt_one ds = do { ds' <- cvtStmts ds; return (ParStmtBlock ds' undefined noSyntaxExpr) }
 
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index 62b6a680e9..cfc373eeed 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -27,6 +27,7 @@ import HsBinds
 import TcEvidence
 import CoreSyn
 import Var
+import DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) )
 import Name
 import BasicTypes
 import ConLike
@@ -78,15 +79,54 @@ noPostTcTable = []
 -- E.g. @(>>=)@ is filled in before the renamer by the appropriate 'Name' for
 --      @(>>=)@, and then instantiated by the type checker with its type args
 --      etc
+--
+-- This should desugar to
+--
+-- > syn_res_wrap $ syn_expr (syn_arg_wraps[0] arg0)
+-- >                         (syn_arg_wraps[1] arg1) ...
+--
+-- where the actual arguments come from elsewhere in the AST.
+-- This could be defined using @PostRn@ and @PostTc@ and such, but it's
+-- harder to get it all to work out that way. ('noSyntaxExpr' is hard to
+-- write, for example.)
+data SyntaxExpr id = SyntaxExpr { syn_expr      :: HsExpr id
+                                , syn_arg_wraps :: [HsWrapper]
+                                , syn_res_wrap  :: HsWrapper }
+  deriving (Typeable)
+deriving instance (DataId id) => Data (SyntaxExpr id)
 
-type SyntaxExpr id = HsExpr id
+-- | This is used for rebindable-syntax pieces that are too polymorphic
+-- for tcSyntaxOp (trS_fmap and the mzip in ParStmt)
+noExpr :: HsExpr id
+noExpr = HsLit (HsString "" (fsLit "noExpr"))
 
 noSyntaxExpr :: SyntaxExpr id -- Before renaming, and sometimes after,
                               -- (if the syntax slot makes no sense)
-noSyntaxExpr = HsLit (HsString "" (fsLit "noSyntaxExpr"))
-
-
-type CmdSyntaxTable id = [(Name, SyntaxExpr id)]
+noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit (HsString "" (fsLit "noSyntaxExpr"))
+                          , syn_arg_wraps = []
+                          , syn_res_wrap  = WpHole }
+
+-- | Make a 'SyntaxExpr Name' (the "rn" is because this is used in the
+-- renamer), missing its HsWrappers.
+mkRnSyntaxExpr :: Name -> SyntaxExpr Name
+mkRnSyntaxExpr name = SyntaxExpr { syn_expr      = HsVar $ noLoc name
+                                 , syn_arg_wraps = []
+                                 , syn_res_wrap  = WpHole }
+  -- don't care about filling in syn_arg_wraps because we're clearly
+  -- not past the typechecker
+
+instance OutputableBndr id => Outputable (SyntaxExpr id) where
+  ppr (SyntaxExpr { syn_expr      = expr
+                  , syn_arg_wraps = arg_wraps
+                  , syn_res_wrap  = res_wrap })
+    = sdocWithDynFlags $ \ dflags ->
+      getPprStyle $ \s ->
+      if debugStyle s || gopt Opt_PrintExplicitCoercions dflags
+      then ppr expr <> braces (pprWithCommas (pprHsWrapper (text "<>")) arg_wraps)
+                    <> braces (pprHsWrapper (text "<>") res_wrap)
+      else ppr expr
+
+type CmdSyntaxTable id = [(Name, HsExpr id)]
 -- See Note [CmdSyntaxTable]
 
 {-
@@ -1368,6 +1408,9 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
              -- The fail operator is noSyntaxExpr
              -- if the pattern match can't fail
 
+             (PostTc idR Type)  -- result type of the function passed to bind;
+                                -- that is, S in (>>=) :: Q -> (R -> S) -> T
+
   -- | 'ApplicativeStmt' represents an applicative expression built with
   -- <$> and <*>.  It is generated by the renamer, and is desugared into the
   -- appropriate applicative expression by the desugarer, but it is intended
@@ -1396,9 +1439,10 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
 
   -- ParStmts only occur in a list/monad comprehension
   | ParStmt  [ParStmtBlock idL idR]
-             (SyntaxExpr idR)           -- Polymorphic `mzip` for monad comprehensions
+             (HsExpr idR)               -- Polymorphic `mzip` for monad comprehensions
              (SyntaxExpr idR)           -- The `>>=` operator
                                         -- See notes [Monad Comprehensions]
+             (PostTc idR Type)          -- S in (>>=) :: Q -> (R -> S) -> T
             -- After renaming, the ids are the binders
             -- bound by the stmts and used after themp
 
@@ -1416,8 +1460,11 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
       trS_ret :: SyntaxExpr idR,      -- The monomorphic 'return' function for
                                       -- the inner monad comprehensions
       trS_bind :: SyntaxExpr idR,     -- The '(>>=)' operator
-      trS_fmap :: SyntaxExpr idR      -- The polymorphic 'fmap' function for desugaring
+      trS_bind_arg_ty :: PostTc idR Type,  -- R in (>>=) :: Q -> (R -> S) -> T
+      trS_fmap :: HsExpr idR          -- The polymorphic 'fmap' function for desugaring
                                       -- Only for 'group' forms
+                                      -- Just a simple HsExpr, because it's
+                                      -- too polymorphic for tcSyntaxOp
     }                                 -- See Note [Monad Comprehensions]
 
   -- Recursive statement (see Note [How RecStmt works] below)
@@ -1442,6 +1489,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
      , recS_bind_fn :: SyntaxExpr idR -- The bind function
      , recS_ret_fn  :: SyntaxExpr idR -- The return function
      , recS_mfix_fn :: SyntaxExpr idR -- The mfix function
+     , recS_bind_ty :: PostTc idR Type  -- S in (>>=) :: Q -> (R -> S) -> T
 
         -- These fields are only valid after typechecking
      , recS_later_rets :: [PostTcExpr] -- (only used in the arrow version)
@@ -1482,7 +1530,7 @@ data ApplicativeArg idL idR
       (LHsExpr idL)
   | ApplicativeArgMany           -- do { stmts; return vars }
       [ExprLStmt idL]            -- stmts
-      (SyntaxExpr idL)           -- return (v1,..,vn), or just (v1,..,vn)
+      (HsExpr idL)               -- return (v1,..,vn), or just (v1,..,vn)
       (LPat idL)                 -- (v1,...,vn)
   deriving( Typeable )
 deriving instance (DataId idL, DataId idR) => Data (ApplicativeArg idL idR)
@@ -1638,10 +1686,10 @@ pprStmt (LastStmt expr ret_stripped _)
   = ifPprDebug (text "[last]") <+>
        (if ret_stripped then text "return" else empty) <+>
        ppr expr
-pprStmt (BindStmt pat expr _ _)   = hsep [ppr pat, larrow, ppr expr]
+pprStmt (BindStmt pat expr _ _ _) = hsep [ppr pat, larrow, ppr expr]
 pprStmt (LetStmt (L _ binds))     = hsep [text "let", pprBinds binds]
 pprStmt (BodyStmt expr _ _ _)     = ppr expr
-pprStmt (ParStmt stmtss _ _)      = sep (punctuate (text " | ") (map ppr stmtss))
+pprStmt (ParStmt stmtss _ _ _)    = sep (punctuate (text " | ") (map ppr stmtss))
 
 pprStmt (TransStmt { trS_stmts = stmts, trS_by = by, trS_using = using, trS_form = form })
   = sep $ punctuate comma (map ppr stmts ++ [pprTransStmt by using form])
@@ -1672,7 +1720,8 @@ pprStmt (ApplicativeStmt args mb_join _)
    flattenStmt stmt = [ppr stmt]
 
    flattenArg (_, ApplicativeArgOne pat expr) =
-     [ppr (BindStmt pat expr noSyntaxExpr noSyntaxExpr :: ExprStmt idL)]
+     [ppr (BindStmt pat expr noSyntaxExpr noSyntaxExpr (panic "pprStmt")
+             :: ExprStmt idL)]
    flattenArg (_, ApplicativeArgMany stmts _ _) =
      concatMap flattenStmt stmts
 
@@ -1685,7 +1734,8 @@ pprStmt (ApplicativeStmt args mb_join _)
           else text "join" <+> parens ap_expr
 
    pp_arg (_, ApplicativeArgOne pat expr) =
-     ppr (BindStmt pat expr noSyntaxExpr noSyntaxExpr :: ExprStmt idL)
+     ppr (BindStmt pat expr noSyntaxExpr noSyntaxExpr (panic "pprStmt")
+            :: ExprStmt idL)
    pp_arg (_, ApplicativeArgMany stmts return pat) =
      ppr pat <+>
      text "<-" <+>
diff --git a/compiler/hsSyn/HsExpr.hs-boot b/compiler/hsSyn/HsExpr.hs-boot
index bb5142f6ac..7eeddd481d 100644
--- a/compiler/hsSyn/HsExpr.hs-boot
+++ b/compiler/hsSyn/HsExpr.hs-boot
@@ -18,28 +18,31 @@ type role HsCmd nominal
 type role MatchGroup nominal representational
 type role GRHSs nominal representational
 type role HsSplice nominal
+type role SyntaxExpr nominal
 data HsExpr (i :: *)
 data HsCmd  (i :: *)
 data HsSplice (i :: *)
 data MatchGroup (a :: *) (body :: *)
 data GRHSs (a :: *) (body :: *)
+data SyntaxExpr (i :: *)
 
 instance Typeable HsSplice
 instance Typeable HsExpr
 instance Typeable MatchGroup
 instance Typeable GRHSs
+instance Typeable SyntaxExpr
 
 instance (DataId id) => Data (HsSplice id)
 instance (DataId id) => Data (HsExpr id)
 instance (DataId id) => Data (HsCmd id)
 instance (Data body,DataId id) => Data (MatchGroup id body)
 instance (Data body,DataId id) => Data (GRHSs id body)
+instance (DataId id) => Data (SyntaxExpr id)
 
 instance OutputableBndr id => Outputable (HsExpr id)
 instance OutputableBndr id => Outputable (HsCmd id)
 
 type LHsExpr a = Located (HsExpr a)
-type SyntaxExpr a = HsExpr a
 
 pprLExpr :: (OutputableBndr i) =>
         LHsExpr i -> SDoc
diff --git a/compiler/hsSyn/HsLit.hs b/compiler/hsSyn/HsLit.hs
index b929f86761..4686077d27 100644
--- a/compiler/hsSyn/HsLit.hs
+++ b/compiler/hsSyn/HsLit.hs
@@ -18,7 +18,7 @@ module HsLit where
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} HsExpr( SyntaxExpr, pprExpr )
+import {-# SOURCE #-} HsExpr( HsExpr, pprExpr )
 import BasicTypes ( FractionalLit(..),SourceText )
 import Type       ( Type )
 import Outputable
@@ -79,7 +79,7 @@ data HsOverLit id       -- An overloaded literal
   = OverLit {
         ol_val :: OverLitVal,
         ol_rebindable :: PostRn id Bool, -- Note [ol_rebindable]
-        ol_witness :: SyntaxExpr id,     -- Note [Overloaded literal witnesses]
+        ol_witness :: HsExpr id,     -- Note [Overloaded literal witnesses]
         ol_type :: PostTc id Type }
   deriving (Typeable)
 deriving instance (DataId id) => Data (HsOverLit id)
@@ -111,7 +111,7 @@ Equivalently it's True if
 
 Note [Overloaded literal witnesses]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-*Before* type checking, the SyntaxExpr in an HsOverLit is the
+*Before* type checking, the HsExpr in an HsOverLit is the
 name of the coercion function, 'fromInteger' or 'fromRational'.
 *After* type checking, it is a witness for the literal, such as
         (fromInteger 3) or lit_78
diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs
index 9bb91d21f8..e1ccd63203 100644
--- a/compiler/hsSyn/HsPat.hs
+++ b/compiler/hsSyn/HsPat.hs
@@ -190,14 +190,22 @@ data Pat id
                     (Maybe (SyntaxExpr id))     -- Just (Name of 'negate') for negative
                                                 -- patterns, Nothing otherwise
                     (SyntaxExpr id)             -- Equality checker, of type t->t->Bool
+                    (PostTc id Type)            -- Overall type of pattern. Might be
+                                                -- different than the literal's type
+                                                -- if (==) or negate changes the type
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVal' @'+'@
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | NPlusKPat       (Located id)        -- n+k pattern
                     (Located (HsOverLit id)) -- It'll always be an HsIntegral
-                    (SyntaxExpr id)     -- (>=) function, of type t->t->Bool
+                    (HsOverLit id)      -- See Note [NPlusK patterns] in TcPat
+                     -- NB: This could be (PostTc ...), but that induced a
+                     -- a new hs-boot file. Not worth it.
+
+                    (SyntaxExpr id)     -- (>=) function, of type t1->t2->Bool
                     (SyntaxExpr id)     -- Name of '-' (see RnEnv.lookupSyntaxName)
+                    (PostTc id Type)    -- Type of overall pattern
 
         ------------ Pattern type signatures ---------------
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
@@ -391,9 +399,9 @@ pprPat (AsPat name pat)       = hcat [pprPrefixOcc (unLoc name), char '@', pprPa
 pprPat (ViewPat expr pat _)   = hcat [pprLExpr expr, text " -> ", ppr pat]
 pprPat (ParPat pat)           = parens (ppr pat)
 pprPat (LitPat s)             = ppr s
-pprPat (NPat l Nothing  _)    = ppr l
-pprPat (NPat l (Just _) _)    = char '-' <> ppr l
-pprPat (NPlusKPat n k _ _)    = hcat [ppr n, char '+', ppr k]
+pprPat (NPat l Nothing  _ _)  = ppr l
+pprPat (NPat l (Just _) _ _)  = char '-' <> ppr l
+pprPat (NPlusKPat n k _ _ _ _)= hcat [ppr n, char '+', ppr k]
 pprPat (SplicePat splice)     = pprSplice splice
 pprPat (CoPat co pat _)       = pprHsWrapper (ppr pat) co
 pprPat (SigPatIn pat ty)      = ppr pat <+> dcolon <+> ppr ty
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index 43f3de6be3..abd7a4bdf3 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -16,6 +16,7 @@ which deal with the instantiated versions are located elsewhere:
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module HsUtils(
   -- Terms
@@ -27,7 +28,8 @@ module HsUtils(
   mkHsOpApp, mkHsDo, mkHsComp, mkHsWrapPat, mkHsWrapPatCo,
   mkLHsPar, mkHsCmdWrap, mkLHsCmdWrap, isLHsTypeExpr_maybe, isLHsTypeExpr,
 
-  nlHsTyApp, nlHsTyApps, nlHsVar, nlHsLit, nlHsApp, nlHsApps, nlHsIntLit, nlHsVarApps,
+  nlHsTyApp, nlHsTyApps, nlHsVar, nlHsLit, nlHsApp, nlHsApps, nlHsSyntaxApps,
+  nlHsIntLit, nlHsVarApps,
   nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList,
   mkLHsTupleExpr, mkLHsVarTuple, missingTupArg,
   toLHsSigWcType,
@@ -58,7 +60,8 @@ module HsUtils(
   getLHsInstDeclClass_maybe,
 
   -- Stmts
-  mkTransformStmt, mkTransformByStmt, mkBodyStmt, mkBindStmt, mkLastStmt,
+  mkTransformStmt, mkTransformByStmt, mkBodyStmt, mkBindStmt, mkTcBindStmt,
+  mkLastStmt,
   emptyTransStmt, mkGroupUsingStmt, mkGroupByUsingStmt,
   emptyRecStmt, emptyRecStmtName, emptyRecStmtId, mkRecStmt,
 
@@ -99,6 +102,7 @@ import RdrName
 import Var
 import TyCoRep
 import Type   ( filterOutInvisibleTypes )
+import TysWiredIn ( unitTy )
 import TcType
 import DataCon
 import Name
@@ -223,13 +227,16 @@ mkHsDo         :: HsStmtContext Name -> [ExprLStmt RdrName] -> HsExpr RdrName
 mkHsComp       :: HsStmtContext Name -> [ExprLStmt RdrName] -> LHsExpr RdrName
                -> HsExpr RdrName
 
-mkNPat      :: Located (HsOverLit id) -> Maybe (SyntaxExpr id) -> Pat id
-mkNPlusKPat :: Located id -> Located (HsOverLit id) -> Pat id
+mkNPat      :: Located (HsOverLit RdrName) -> Maybe (SyntaxExpr RdrName) -> Pat RdrName
+mkNPlusKPat :: Located RdrName -> Located (HsOverLit RdrName) -> Pat RdrName
 
 mkLastStmt :: Located (bodyR idR) -> StmtLR idL idR (Located (bodyR idR))
 mkBodyStmt :: Located (bodyR RdrName)
            -> StmtLR idL RdrName (Located (bodyR RdrName))
-mkBindStmt :: LPat idL -> Located (bodyR idR) -> StmtLR idL idR (Located (bodyR idR))
+mkBindStmt :: (PostTc idR Type ~ PlaceHolder)
+           => LPat idL -> Located (bodyR idR)
+           -> StmtLR idL idR (Located (bodyR idR))
+mkTcBindStmt :: LPat Id -> Located (bodyR Id) -> StmtLR Id Id (Located (bodyR Id))
 
 emptyRecStmt     :: StmtLR idL  RdrName bodyR
 emptyRecStmtName :: StmtLR Name Name    bodyR
@@ -237,9 +244,9 @@ emptyRecStmtId   :: StmtLR Id   Id      bodyR
 mkRecStmt    :: [LStmtLR idL RdrName bodyR] -> StmtLR idL RdrName bodyR
 
 
-mkHsIntegral src i  = OverLit (HsIntegral   src i) noRebindableInfo noSyntaxExpr
-mkHsFractional   f  = OverLit (HsFractional     f) noRebindableInfo noSyntaxExpr
-mkHsIsString src s  = OverLit (HsIsString   src s) noRebindableInfo noSyntaxExpr
+mkHsIntegral src i  = OverLit (HsIntegral   src i) noRebindableInfo noExpr
+mkHsFractional   f  = OverLit (HsFractional     f) noRebindableInfo noExpr
+mkHsIsString src s  = OverLit (HsIsString   src s) noRebindableInfo noExpr
 
 noRebindableInfo :: PlaceHolder
 noRebindableInfo = PlaceHolder -- Just another placeholder;
@@ -252,24 +259,29 @@ mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])
 mkHsIf :: LHsExpr id -> LHsExpr id -> LHsExpr id -> HsExpr id
 mkHsIf c a b = HsIf (Just noSyntaxExpr) c a b
 
-mkNPat lit neg     = NPat lit neg noSyntaxExpr
-mkNPlusKPat id lit = NPlusKPat id lit noSyntaxExpr noSyntaxExpr
+mkNPat lit neg     = NPat lit neg noSyntaxExpr placeHolderType
+mkNPlusKPat id lit = NPlusKPat id lit (unLoc lit) noSyntaxExpr noSyntaxExpr placeHolderType
 
-mkTransformStmt    :: [ExprLStmt idL] -> LHsExpr idR
+mkTransformStmt    :: (PostTc idR Type ~ PlaceHolder)
+                   => [ExprLStmt idL] -> LHsExpr idR
                    -> StmtLR idL idR (LHsExpr idL)
-mkTransformByStmt  :: [ExprLStmt idL] -> LHsExpr idR -> LHsExpr idR
+mkTransformByStmt  :: (PostTc idR Type ~ PlaceHolder)
+                   => [ExprLStmt idL] -> LHsExpr idR -> LHsExpr idR
                    -> StmtLR idL idR (LHsExpr idL)
-mkGroupUsingStmt   :: [ExprLStmt idL]                -> LHsExpr idR
+mkGroupUsingStmt   :: (PostTc idR Type ~ PlaceHolder)
+                   => [ExprLStmt idL]                -> LHsExpr idR
                    -> StmtLR idL idR (LHsExpr idL)
-mkGroupByUsingStmt :: [ExprLStmt idL] -> LHsExpr idR -> LHsExpr idR
+mkGroupByUsingStmt :: (PostTc idR Type ~ PlaceHolder)
+                   => [ExprLStmt idL] -> LHsExpr idR -> LHsExpr idR
                    -> StmtLR idL idR (LHsExpr idL)
 
-emptyTransStmt :: StmtLR idL idR (LHsExpr idR)
+emptyTransStmt :: (PostTc idR Type ~ PlaceHolder) => StmtLR idL idR (LHsExpr idR)
 emptyTransStmt = TransStmt { trS_form = panic "emptyTransStmt: form"
                            , trS_stmts = [], trS_bndrs = []
-                           , trS_by = Nothing, trS_using = noLoc noSyntaxExpr
+                           , trS_by = Nothing, trS_using = noLoc noExpr
                            , trS_ret = noSyntaxExpr, trS_bind = noSyntaxExpr
-                           , trS_fmap = noSyntaxExpr }
+                           , trS_bind_arg_ty = PlaceHolder
+                           , trS_fmap = noExpr }
 mkTransformStmt    ss u   = emptyTransStmt { trS_form = ThenForm,  trS_stmts = ss, trS_using = u }
 mkTransformByStmt  ss u b = emptyTransStmt { trS_form = ThenForm,  trS_stmts = ss, trS_using = u, trS_by = Just b }
 mkGroupUsingStmt   ss u   = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u }
@@ -277,8 +289,9 @@ mkGroupByUsingStmt ss b u = emptyTransStmt { trS_form = GroupForm, trS_stmts = s
 
 mkLastStmt body     = LastStmt body False noSyntaxExpr
 mkBodyStmt body     = BodyStmt body noSyntaxExpr noSyntaxExpr placeHolderType
-mkBindStmt pat body = BindStmt pat body noSyntaxExpr noSyntaxExpr
-
+mkBindStmt pat body = BindStmt pat body noSyntaxExpr noSyntaxExpr PlaceHolder
+mkTcBindStmt pat body = BindStmt pat body noSyntaxExpr noSyntaxExpr unitTy
+  -- don't use placeHolderTypeTc above, because that panics during zonking
 
 emptyRecStmt' :: forall idL idR body.
                        PostTc idR Type -> StmtLR idL idR body
@@ -288,12 +301,13 @@ emptyRecStmt' tyVal =
      , recS_rec_ids = []
      , recS_ret_fn = noSyntaxExpr
      , recS_mfix_fn = noSyntaxExpr
-     , recS_bind_fn = noSyntaxExpr, recS_later_rets = []
+     , recS_bind_fn = noSyntaxExpr, recS_bind_ty = tyVal
+     , recS_later_rets = []
      , recS_rec_rets = [], recS_ret_ty = tyVal }
 
 emptyRecStmt     = emptyRecStmt' placeHolderType
 emptyRecStmtName = emptyRecStmt' placeHolderType
-emptyRecStmtId   = emptyRecStmt' placeHolderTypeTc
+emptyRecStmtId   = emptyRecStmt' unitTy -- a panic might trigger during zonking
 mkRecStmt stmts  = emptyRecStmt { recS_stmts = stmts }
 
 -------------------------------
@@ -366,6 +380,18 @@ nlLitPat l = noLoc (LitPat l)
 nlHsApp :: LHsExpr id -> LHsExpr id -> LHsExpr id
 nlHsApp f x = noLoc (HsApp f x)
 
+nlHsSyntaxApps :: SyntaxExpr id -> [LHsExpr id] -> LHsExpr id
+nlHsSyntaxApps (SyntaxExpr { syn_expr      = fun
+                           , syn_arg_wraps = arg_wraps
+                           , syn_res_wrap  = res_wrap }) args
+  | [] <- arg_wraps   -- in the noSyntaxExpr case
+  = ASSERT( isIdHsWrapper res_wrap )
+    foldl nlHsApp (noLoc fun) args
+
+  | otherwise
+  = mkLHsWrap res_wrap (foldl nlHsApp (noLoc fun) (zipWithEqual "nlHsSyntaxApps"
+                                                     mkLHsWrap arg_wraps args))
+
 nlHsIntLit :: Integer -> LHsExpr id
 nlHsIntLit n = noLoc (HsLit (HsInt (show n) n))
 
@@ -797,11 +823,11 @@ collectLStmtBinders = collectStmtBinders . unLoc
 
 collectStmtBinders :: StmtLR idL idR body -> [idL]
   -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
-collectStmtBinders (BindStmt pat _ _ _)  = collectPatBinders pat
+collectStmtBinders (BindStmt pat _ _ _ _)= collectPatBinders pat
 collectStmtBinders (LetStmt (L _ binds)) = collectLocalBinders binds
 collectStmtBinders (BodyStmt {})         = []
 collectStmtBinders (LastStmt {})         = []
-collectStmtBinders (ParStmt xs _ _)   = collectLStmtsBinders
+collectStmtBinders (ParStmt xs _ _ _) = collectLStmtsBinders
                                       $ [s | ParStmtBlock ss _ _ <- xs, s <- ss]
 collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts
 collectStmtBinders (RecStmt { recS_stmts = ss })     = collectLStmtsBinders ss
@@ -836,8 +862,8 @@ collect_lpat (L _ pat) bndrs
     go (ConPatOut {pat_args=ps})  = foldr collect_lpat bndrs (hsConPatArgs ps)
         -- See Note [Dictionary binders in ConPatOut]
     go (LitPat _)                 = bndrs
-    go (NPat _ _ _)               = bndrs
-    go (NPlusKPat (L _ n) _ _ _)  = n : bndrs
+    go (NPat {})                  = bndrs
+    go (NPlusKPat (L _ n) _ _ _ _ _)= n : bndrs
 
     go (SigPatIn pat _)           = collect_lpat pat bndrs
     go (SigPatOut pat _)          = collect_lpat pat bndrs
@@ -1054,14 +1080,14 @@ lStmtsImplicits = hs_lstmts
     hs_lstmts = foldr (\stmt rest -> unionNameSet (hs_stmt (unLoc stmt)) rest) emptyNameSet
 
     hs_stmt :: StmtLR Name idR (Located (body idR)) -> NameSet
-    hs_stmt (BindStmt pat _ _ _) = lPatImplicits pat
+    hs_stmt (BindStmt pat _ _ _ _) = lPatImplicits pat
     hs_stmt (ApplicativeStmt args _ _) = unionNameSets (map do_arg args)
       where do_arg (_, ApplicativeArgOne pat _) = lPatImplicits pat
             do_arg (_, ApplicativeArgMany stmts _ _) = hs_lstmts stmts
     hs_stmt (LetStmt binds)      = hs_local_binds (unLoc binds)
     hs_stmt (BodyStmt {})        = emptyNameSet
     hs_stmt (LastStmt {})        = emptyNameSet
-    hs_stmt (ParStmt xs _ _)     = hs_lstmts [s | ParStmtBlock ss _ _ <- xs, s <- ss]
+    hs_stmt (ParStmt xs _ _ _)   = hs_lstmts [s | ParStmtBlock ss _ _ <- xs, s <- ss]
     hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts
     hs_stmt (RecStmt { recS_stmts = ss })     = hs_lstmts ss
 
diff --git a/compiler/hsSyn/PlaceHolder.hs b/compiler/hsSyn/PlaceHolder.hs
index 87736ac3d0..b4e109f045 100644
--- a/compiler/hsSyn/PlaceHolder.hs
+++ b/compiler/hsSyn/PlaceHolder.hs
@@ -3,7 +3,6 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 module PlaceHolder where
 
@@ -14,7 +13,7 @@ import NameSet
 import RdrName
 import Var
 import Coercion
-import {-# SOURCE #-} ConLike (ConLike)
+import ConLike (ConLike)
 import FieldLabel
 import SrcLoc (Located)
 import TcEvidence ( HsWrapper )
@@ -31,18 +30,21 @@ import BasicTypes       (Fixity)
 %************************************************************************
 -}
 
+-- NB: These are intentionally open, allowing API consumers (like Haddock)
+-- to declare new instances
+
 -- | used as place holder in PostTc and PostRn values
 data PlaceHolder = PlaceHolder
   deriving (Data,Typeable)
 
 -- | Types that are not defined until after type checking
-type family PostTc it ty :: * -- Note [Pass sensitive types]
+type family PostTc id ty  -- Note [Pass sensitive types]
 type instance PostTc Id      ty = ty
 type instance PostTc Name    ty = PlaceHolder
 type instance PostTc RdrName ty = PlaceHolder
 
 -- | Types that are not defined until after renaming
-type family PostRn id ty :: * -- Note [Pass sensitive types]
+type family PostRn id ty  -- Note [Pass sensitive types]
 type instance PostRn Id      ty = ty
 type instance PostRn Name    ty = ty
 type instance PostRn RdrName ty = PlaceHolder
@@ -86,10 +88,6 @@ pass-specific data types, implemented as a pair of open type families,
 one for PostTc and one for PostRn. These are then explicitly populated
 with a PlaceHolder value when they do not yet have meaning.
 
-Since the required bootstrap compiler at this stage does not have
-closed type families, an open type family had to be used, which
-unfortunately forces the requirement for UndecidableInstances.
-
 In terms of actual usage, we have the following
 
   PostTc id Kind