Use LHsSigWcType in DerivDeclwip/T13324

This prepares the way for the fix for Trac #13324, by
using LHsSigWcType for the instance type in DerivDecl,
but nowhere else.

See comments on Phab:D4383

7 files changed, 18 insertions, 18 deletions

diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 5029f9df09..e1eaae1c5f 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -488,7 +488,7 @@ repStandaloneDerivD (L loc (DerivDecl { deriv_strategy = strat
                    ; repDeriv strat' cxt' inst_ty' }
        ; return (loc, dec) }
   where
-    (tvs, cxt, inst_ty) = splitLHsInstDeclTy ty
+    (tvs, cxt, inst_ty) = splitLHsInstDeclTy (hswc_body ty)
 
 repTyFamInstD :: TyFamInstDecl GhcRn -> DsM (Core TH.DecQ)
 repTyFamInstD decl@(TyFamInstDecl { tfid_eqn = eqn })
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 531f146a9d..6c2e58cce2 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -351,7 +351,7 @@ cvtDec (TH.StandaloneDerivD ds cxt ty)
        ; let inst_ty' = mkHsQualTy cxt loc cxt' $ L loc ty'
        ; returnJustL $ DerivD $
          DerivDecl { deriv_strategy = fmap (L loc . cvtDerivStrategy) ds
-                   , deriv_type = mkLHsSigType inst_ty'
+                   , deriv_type = mkLHsSigWcType inst_ty'
                    , deriv_overlap_mode = Nothing } }
 
 cvtDec (TH.DefaultSigD nm typ)
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs
index 475e31ea57..660fc2a794 100644
--- a/compiler/hsSyn/HsDecls.hs
+++ b/compiler/hsSyn/HsDecls.hs
@@ -1659,7 +1659,7 @@ type LDerivDecl pass = Located (DerivDecl pass)
 
 -- | Deriving Declaration
 data DerivDecl pass = DerivDecl
-        { deriv_type         :: LHsSigType pass
+        { deriv_type         :: LHsSigWcType pass
         , deriv_strategy     :: Maybe (Located DerivStrategy)
         , deriv_overlap_mode :: Maybe (Located OverlapMode)
          -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDeriving',
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 898ed3c5ae..bdb5e6b479 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1373,10 +1373,11 @@ capi_ctype : '{-# CTYPE' STRING STRING '#-}'
 
 -- Glasgow extension: stand-alone deriving declarations
 stand_alone_deriving :: { LDerivDecl GhcPs }
-  : 'deriving' deriv_strategy 'instance' overlap_pragma inst_type
+  : 'deriving' deriv_strategy 'instance' overlap_pragma sigtype
                 {% do { let { err = text "in the stand-alone deriving instance"
-                                    <> colon <+> quotes (ppr $5) }
-                      ; ams (sLL $1 (hsSigType $>) (DerivDecl $5 $2 $4))
+                                    <> colon <+> quotes (ppr $5)
+                            ; inst_ty = mkLHsSigWcType $5 }
+                      ; ams (sLL $1 $> (DerivDecl inst_ty $2 $4))
                             [mj AnnDeriving $1, mj AnnInstance $3] } }
 
 -----------------------------------------------------------------------------
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 447871a7f2..53feacb8df 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -634,7 +634,8 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
                            , cid_sigs = uprags, cid_tyfam_insts = ats
                            , cid_overlap_mode = oflag
                            , cid_datafam_insts = adts })
-  = do { (inst_ty', inst_fvs) <- rnLHsInstType (text "an instance declaration") inst_ty
+  = do { let ctxt = GenericCtx (text "an instance declaration")
+       ; (inst_ty', inst_fvs) <- rnHsSigType ctxt inst_ty
        ; let (ktv_names, _, head_ty') = splitLHsInstDeclTy inst_ty'
        ; let cls = case hsTyGetAppHead_maybe head_ty' of
                      Nothing -> mkUnboundName (mkTcOccFS (fsLit "<class>"))
@@ -945,7 +946,8 @@ rnSrcDerivDecl (DerivDecl ty deriv_strat overlap)
        ; unless standalone_deriv_ok (addErr standaloneDerivErr)
        ; failIfTc (isJust deriv_strat && not deriv_strats_ok) $
            illegalDerivStrategyErr $ fmap unLoc deriv_strat
-       ; (ty', fvs) <- rnLHsInstType (text "a deriving declaration") ty
+       ; let ctxt = GenericCtx (text "a deriving declaration")
+       ; (ty', fvs) <- rnHsSigWcType ctxt ty
        ; return (DerivDecl ty' deriv_strat overlap, fvs) }
 
 standaloneDerivErr :: SDoc
@@ -1124,7 +1126,8 @@ rnHsVectDecl (HsVectClassIn s cls)
 rnHsVectDecl (HsVectClassOut _)
   = panic "RnSource.rnHsVectDecl: Unexpected 'HsVectClassOut'"
 rnHsVectDecl (HsVectInstIn instTy)
-  = do { (instTy', fvs) <- rnLHsInstType (text "a VECTORISE pragma") instTy
+  = do { let ctxt = GenericCtx (text "a VECTORISE pragma")
+       ; (instTy', fvs) <- rnHsSigType ctxt instTy
        ; return (HsVectInstIn instTy', fvs)
        }
 rnHsVectDecl (HsVectInstOut _)
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index b2dafb2bf7..791881bbd0 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -13,7 +13,6 @@ module RnTypes (
         rnHsKind, rnLHsKind,
         rnHsSigType, rnHsWcType,
         rnHsSigWcType, rnHsSigWcTypeScoped,
-        rnLHsInstType,
         newTyVarNameRn, collectAnonWildCards,
         rnConDeclFields,
         rnLTyVar,
@@ -323,12 +322,6 @@ rnImplicitBndrs bind_free_tvs doc
        ; bindLocalNamesFV vars $
          thing_inside vars }
 
-rnLHsInstType :: SDoc -> LHsSigType GhcPs -> RnM (LHsSigType GhcRn, FreeVars)
--- Rename the type in an instance or standalone deriving decl
--- The 'doc_str' is "an instance declaration" or "a VECTORISE pragma"
--- Do not try to decompose the inst_ty in case it is malformed
-rnLHsInstType doc inst_ty = rnHsSigType (GenericCtx doc) inst_ty
-
 mk_implicit_bndrs :: [Name]  -- implicitly bound
                   -> a           -- payload
                   -> FreeVars    -- FreeVars of payload
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index 294b42c530..35d95b97e4 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -607,13 +607,16 @@ deriveStandalone :: LDerivDecl GhcRn -> TcM (Maybe EarlyDerivSpec)
 -- This returns a Maybe because the user might try to derive Typeable, which is
 -- a no-op nowadays.
 deriveStandalone (L loc (DerivDecl deriv_ty deriv_strat' overlap_mode))
+  | let deriv_ty_no_wc = dropWildCards deriv_ty
+            -- dropWildCards; just awaiting the rest of Phab:D4383
   = setSrcSpan loc                   $
-    addErrCtxt (standaloneCtxt deriv_ty)  $
+    addErrCtxt (standaloneCtxt deriv_ty_no_wc)  $
     do { traceTc "Standalone deriving decl for" (ppr deriv_ty)
        ; let deriv_strat = fmap unLoc deriv_strat'
        ; traceTc "Deriving strategy (standalone deriving)" $
            vcat [ppr deriv_strat, ppr deriv_ty]
-       ; (tvs, theta, cls, inst_tys) <- tcHsClsInstType TcType.InstDeclCtxt deriv_ty
+       ; (tvs, theta, cls, inst_tys) <- tcHsClsInstType TcType.InstDeclCtxt
+                                                        deriv_ty_no_wc
        ; traceTc "Standalone deriving;" $ vcat
               [ text "tvs:" <+> ppr tvs
               , text "theta:" <+> ppr theta