From 50879af16ed6fedefb2d8b3db37a5852d11b461d Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 7 May 2026 01:38:11 +0200 Subject: [PATCH] Fix data-family R: rewrite to substitute rep tyvars with use-site args MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit The previous rewrite (commit 723a7c3) called tyConFamInst_maybe and fed parentArgs straight into typeArg. parentArgs reference the rep TyCon's *internal* type variables, not the use-site args; without a substitution they leak through typeArg's TyVar lookup as @OtherArg ""@ because they're absent from boundTvs. So @R:CrateList Int@ was rewriting to @Crate []@ — which broke both the rendering (the user saw rep-internal names) and the chain resolution (replaceFamilyApp's biUnify still succeeded by luck of the wildcard rule, but the visible label was wrong). Build a Subst from the rep's tyConTyVars to the actual use-site args and apply it to parentArgs before recursing. With this fix @R:CrateList Int@ extracts as @FamilyApp Crate [TyConApp List [TyConApp Int []]]@ and renders as @Crate [Int]@; the polymorphic case @R:CrateList a@ in an instance head extracts as @FamilyApp Crate [TyConApp List [TyVarRef 0]]@ and renders as @Crate [a]@. Demo gains a @CrateBound (Crate [a])@ instance so the polymorphic-rep path is regression-covered. Co-Authored-By: Claude Opus 4.7 (1M context) --- examples/demo/src/Demo/MoreFamilies.hs | 12 ++++++++++++ src/Classgraph/Extract.hs | 17 +++++++++++++++-- 2 files changed, 27 insertions(+), 2 deletions(-) diff --git a/examples/demo/src/Demo/MoreFamilies.hs b/examples/demo/src/Demo/MoreFamilies.hs index f9d6275..9d3b533 100644 --- a/examples/demo/src/Demo/MoreFamilies.hs +++ b/examples/demo/src/Demo/MoreFamilies.hs @@ -54,6 +54,18 @@ data instance Crate Int = CrateInt Int data instance Crate Bool = CrateBool Bool data instance Crate [a] = CrateList [a] +-- Exercises the data-family rep-tyvar substitution: a polymorphic +-- instance whose head mentions @Crate [a]@. After typechecking GHC +-- represents the head as the synthetic rep TyCon @R:CrateList a@; the +-- viewer should rewrite that back to the abstract @Crate [a]@ form +-- with @a@ properly bound to the instance's tyvar (NOT leak the rep +-- TyCon's internal tyvar as @OtherArg "a"@). +class CrateBound a where + cbDescribe :: proxy a -> String + +instance CrateBound (Crate [a]) where + cbDescribe _ = "list crate" + -- A class parameterised by a /promoted-list/ kind. Demonstrates that -- the viewer renders `'[Int, Bool]` as `[Int, Bool]`, not the -- nested-cons `(: Int (: Bool []))` shape. diff --git a/src/Classgraph/Extract.hs b/src/Classgraph/Extract.hs index c620aa1..ebd0b8d 100644 --- a/src/Classgraph/Extract.hs +++ b/src/Classgraph/Extract.hs @@ -73,6 +73,8 @@ import GHC.Core.Type , isLitTy , splitTyConApp_maybe , splitVisibleFunTy_maybe + , substTys + , zipTvSubst ) import GHC.Hs.Doc (Docs (..), HsDoc, hsDocString) import GHC.Hs.DocString (renderHsDocString) @@ -439,8 +441,19 @@ typeArg boundTvs t = -- finding the matching @data instance@ row and connecting -- it to any class instance of e.g. @NoThunks (Foo Args)@. | Just (parent, parentArgs) <- tyConFamInst_maybe tc -> - FamilyApp (qualName (tyConName parent)) - (map (typeArg boundTvs) parentArgs) + -- @parentArgs@ are the abstract data-instance LHS args + -- (e.g. @[ShelleyBlock ]@), referencing + -- the *rep TyCon's* type variables — NOT the use-site + -- args. Without substitution those rep tyvars leak into + -- the rendered form as @OtherArg ""@ because + -- they're not in the caller's @boundTvs@. Build a + -- Subst from the rep's tyvars to the actual use-site + -- args and apply it before recursing. + let repTvs = tyConTyVars tc + sub = zipTvSubst repTvs args + instantiated = substTys sub parentArgs + in FamilyApp (qualName (tyConName parent)) + (map (typeArg boundTvs) instantiated) | otherwise -> let visArgs = visibleArgs tc args kids = map (typeArg boundTvs) visArgs -- 2.54.0