[GHC] #16114: strange "instance .. => .. => .. where ..."

[GHC]

#16114: strange "instance .. => .. => .. where ..."
-------------------------------------+-------------------------------------
        Reporter:  j.waldmann        |                Owner:  (none)
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Compiler          |              Version:  8.6.3
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by RyanGlScott):

 Assuming that we don't wish to accept the original program, I think we can
 blame `rnClsInstDecl`.
 [https://gitlab.haskell.org/ghc/ghc/blob/master/compiler/rename/RnSource.hs#L646-657
 This] is the first part of that function:

 {{{#!hs
 rnClsInstDecl :: ClsInstDecl GhcPs -> RnM (ClsInstDecl GhcRn, FreeVars)
 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
        ; let (ktv_names, _, head_ty') = splitLHsInstDeclTy inst_ty'
        ; let cls = case hsTyGetAppHead_maybe head_ty' of
                      Nothing -> mkUnboundName (mkTcOccFS (fsLit
 "<class>"))
                      Just (dL->L _ cls) -> cls
                      -- rnLHsInstType has added an error message
                      -- if hsTyGetAppHead_maybe fails
 }}}

 Since we're using `splitLHsInstDeclTy` to decompose `inst_ty`, if we feed
 it something sketchy like `Eq a => Eq a => Eq (T a)` as input, then
 `head_ty'` will be `Eq a => Eq (T a)` (which is not headed by a class,
 leading to havoc later on). Notice that that comment at the bottom assumes
 that `rnLHsInstType` throws an error message if `inst_ty` is malformed.
 But in commit 1c062b794bf71a329f65813ce7b72fe2bd3935f0, we have:

 {{{#!diff
 diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
 index 2305a04..b2dafb2 100644 (file)
 --- a/compiler/rename/RnTypes.hs
 +++ b/compiler/rename/RnTypes.hs
 @@ -326,20 +326,8 @@ rnImplicitBndrs bind_free_tvs doc
  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"
 -rnLHsInstType doc_str inst_ty
 -  | Just cls <- getLHsInstDeclClass_maybe inst_ty
 -  , isTcOcc (rdrNameOcc (unLoc cls))
 -         -- The guards check that the instance type looks like
 -         --   blah => C ty1 .. tyn
 -  = do { let full_doc = doc_str <+> text "for" <+> quotes (ppr cls)
 -       ; rnHsSigType (GenericCtx full_doc) inst_ty }
 -
 -  | otherwise  -- The instance is malformed, but we'd still like
 -               -- to make progress rather than failing outright, so
 -               -- we report more errors.  So we rename it anyway.
 -  = do { addErrAt (getLoc (hsSigType inst_ty)) $
 -         text "Malformed instance:" <+> ppr inst_ty
 -       ; rnHsSigType (GenericCtx doc_str) inst_ty }
 +-- 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
 }}}

 Notice that `rnLHsInstType` no longer errors if given malformed input! So
 `rnClsInstDecl` charges on under the false pretense that `rnLHsInstType`
 succeeded.

 Perhaps the right thing to do would be to move the old validity check from
 `rnLHsInstType` to `rnClsInstDecl`?

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/16114#comment:2>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler