[Git][ghc/ghc][wip/int-index/tycl-inst-deps] Draft: instances in dependency analysis
Vladislav Zavialov (@int-index)
gitlab at gitlab.haskell.org
Thu Jun 29 20:20:17 UTC 2023
Vladislav Zavialov pushed to branch wip/int-index/tycl-inst-deps at Glasgow Haskell Compiler / GHC
Commits:
10315b70 by Vladislav Zavialov at 2023-06-29T23:19:21+03:00
Draft: instances in dependency analysis
- - - - -
16 changed files:
- compiler/GHC/Rename/Module.hs
- + testsuite/tests/dependent/should_compile/T12088a.hs
- + testsuite/tests/dependent/should_compile/T12088b.hs
- + testsuite/tests/dependent/should_compile/T12088c.hs
- + testsuite/tests/dependent/should_compile/T12239.hs
- testsuite/tests/dependent/should_compile/all.T
- testsuite/tests/deriving/should_compile/T17339.stderr
- testsuite/tests/ghci/scripts/T4175.stdout
- testsuite/tests/indexed-types/should_fail/OverDirectThisMod.stderr
- testsuite/tests/indexed-types/should_fail/OverIndirectThisMod.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr
- + testsuite/tests/perf/compiler/WWRec.stderr
- testsuite/tests/plugins/test-defaulting-plugin.stderr
- testsuite/tests/th/T17296.stderr
- testsuite/tests/typecheck/should_fail/T6018fail.stderr
Changes:
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -53,7 +53,7 @@ import GHC.Types.Name.Set
import GHC.Types.Name.Env
import GHC.Utils.Outputable
import GHC.Data.Bag
-import GHC.Types.Basic ( TypeOrKind(..) )
+import GHC.Types.Basic ( TypeOrKind(..), TyConFlavour(..) )
import GHC.Data.FastString
import GHC.Types.SrcLoc as SrcLoc
import GHC.Driver.DynFlags
@@ -62,7 +62,8 @@ import GHC.Utils.Panic
import GHC.Driver.Env ( HscEnv(..), hsc_home_unit)
import GHC.Data.List.SetOps ( findDupsEq, removeDupsOn, equivClasses )
import GHC.Data.Graph.Directed ( SCC, flattenSCC, flattenSCCs, Node(..)
- , stronglyConnCompFromEdgedVerticesUniq )
+ , stronglyConnCompFromEdgedVerticesUniq
+ , stronglyConnCompFromEdgedVerticesOrd )
import GHC.Types.Unique.Set
import GHC.Data.OrdList
import qualified GHC.LanguageExtensions as LangExt
@@ -71,8 +72,8 @@ import GHC.Core.DataCon ( isSrcStrict )
import Control.Monad
import Control.Arrow ( first )
import Data.Foldable ( toList )
-import Data.List ( mapAccumL )
-import Data.List.NonEmpty ( NonEmpty(..), head )
+import Data.List ( mapAccumL, sortBy )
+import Data.List.NonEmpty ( NonEmpty(..), head, groupAllWith )
import Data.Maybe ( isNothing, fromMaybe, mapMaybe )
import qualified Data.Set as Set ( difference, fromList, toList, null )
import GHC.Types.GREInfo (ConInfo, mkConInfo, conInfoFields)
@@ -1447,14 +1448,16 @@ rnTyClDecls tycl_ds
all_groups = first_group ++ groups
+ new_groups = depAnalTyClDecls' rdr_env role_annots kisigs_w_fvs tycls_w_fvs instds_w_fvs
+
; massertPpr (null final_inst_ds)
(ppr instds_w_fvs
$$ ppr inst_ds_map
$$ ppr (flattenSCCs tycl_sccs)
$$ ppr final_inst_ds)
- ; traceRn "rnTycl dependency analysis made groups" (ppr all_groups)
- ; return (all_groups, all_fvs) }
+ ; traceRn "rnTycl dependency analysis made groups" (ppr all_groups $$ text "new:" $$ ppr new_groups)
+ ; return (new_groups, all_fvs) }
where
mk_group :: RoleAnnotEnv
-> KindSigEnv
@@ -2705,3 +2708,213 @@ add_bind _ (XValBindsLR {}) = panic "GHC.Rename.Module.add_bind"
add_sig :: LSig (GhcPass a) -> HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)
add_sig s (ValBinds x bs sigs) = ValBinds x bs (s:sigs)
add_sig _ (XValBindsLR {}) = panic "GHC.Rename.Module.add_sig"
+
+
+----------------------------------------------------
+depAnalTyClDecls'
+ :: GlobalRdrEnv
+ -> [LRoleAnnotDecl GhcRn]
+ -> [(LStandaloneKindSig GhcRn, FreeVars)]
+ -> [(LTyClDecl GhcRn, FreeVars)]
+ -> [(LInstDecl GhcRn, FreeVars)]
+ -> [TyClGroup GhcRn]
+depAnalTyClDecls' rdr_env role_annots kisigs_w_fvs tycls_w_fvs instds_w_fvs =
+ concatMap (nestedDepAnalTyClDecls rdr_env) (stronglyConnCompFromEdgedVerticesOrd nodes)
+ where
+ kisig_fv_env :: NameEnv (LStandaloneKindSig GhcRn, FreeVars)
+ kisig_fv_env = mkNameEnvWith (standaloneKindSigName . unLoc . fst) kisigs_w_fvs
+
+ role_annot_env :: RoleAnnotEnv
+ role_annot_env = mkRoleAnnotEnv role_annots
+
+ insts :: [DepAnalInst]
+ insts = zipWith mk_inst [0..] instds_w_fvs
+ where
+ mk_inst i (inst, fvs) =
+ Inst { inst_index = i
+ , inst_name = name
+ , inst_inst = inst
+ , inst_fvs = fvs }
+ where name = get_inst_name inst
+
+ decls :: [DepAnalDecl]
+ decls = map mk_decl tycls_w_fvs
+ where
+ mk_decl (decl, fvs) =
+ Decl { decl_name = name
+ , decl_roles = roles
+ , decl_kisig = kisig
+ , decl_decl = decl
+ , decl_fvs = fvs `plusFV` kisig_fvs
+ }
+ where name = get_decl_name decl
+ roles = lookupRoleAnnot role_annot_env name
+ (kisig, kisig_fvs) = lookupKiSigFVs kisig_fv_env name
+
+ nodes :: [Node DepAnalKey DepAnalPayload]
+ nodes =
+ map (mk_decl_node get_deps) decls ++
+ map (mk_inst_node get_deps) insts
+
+ get_deps :: FreeVars -> [DepAnalKey]
+ get_deps = concatMap get_dep . mapMaybe (lookupGRE_Name rdr_env) . nonDetEltsUniqSet
+
+ get_dep :: GlobalRdrElt -> [DepAnalKey]
+ get_dep GRE{gre_name = name, gre_info = info, gre_par = par} =
+ case info of
+ IAmTyCon OpenFamilyFlavour{} ->
+ case par of
+ NoParent -> DeclKey name : instances_of name
+ ParentIs p -> DeclKey p : instances_of p
+ _ ->
+ case par of
+ NoParent -> [DeclKey name]
+ ParentIs p -> [DeclKey p]
+
+ instances_of :: Name -> [DepAnalKey]
+ instances_of name =
+ case lookupNameEnv inst_groups name of
+ Nothing -> []
+ Just (k :| ks) -> k : ks
+
+ inst_groups :: NameEnv (NonEmpty DepAnalKey)
+ inst_groups = (mkNameEnv . map mk_inst_group . groupAllWith inst_name) insts
+ where
+ mk_inst_group insts = (inst_name (head insts), fmap inst_key insts)
+ where inst_key inst = InstKey (inst_name inst) (inst_index inst)
+
+mk_decl_node :: (FreeVars -> [DepAnalKey]) -> DepAnalDecl -> Node DepAnalKey DepAnalPayload
+mk_decl_node get_deps decl = DigraphNode payload key deps
+ where
+ payload = DeclPayload decl
+ key = DeclKey (decl_name decl)
+ deps = get_deps (decl_fvs decl)
+
+mk_inst_node :: (FreeVars -> [DepAnalKey]) -> DepAnalInst -> Node DepAnalKey DepAnalPayload
+mk_inst_node get_deps inst = DigraphNode payload key deps
+ where
+ payload = InstPayload inst
+ key = InstKey (inst_name inst) (inst_index inst)
+ deps = get_deps (inst_fvs inst)
+
+{- Note [Nested dependency analysis]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The first pass of dependency analysis overapproximates the amount of dependencies,
+producing SCCs that are too big. Now we break them into smaller subgroups.
+
+TODO (int-index): explain why this happens.
+-}
+
+
+-- See [Nested dependency analysis]
+nestedDepAnalTyClDecls :: GlobalRdrEnv -> SCC DepAnalPayload -> [TyClGroup GhcRn]
+nestedDepAnalTyClDecls rdr_env = concatMap get_dep_anal_payload . merge_inst_groups . nested_dep_anal rdr_env
+
+-- Just so that sort-by-location would see the instances grouped together
+merge_inst_groups :: [[DepAnalPayload]] -> [[DepAnalPayload]]
+merge_inst_groups [] = []
+merge_inst_groups (g : gs) = go g gs
+ where
+ go :: [DepAnalPayload] -> [[DepAnalPayload]] -> [[DepAnalPayload]]
+ go acc (g' : gs') | all is_inst_payload g' = go (g' ++ acc) gs'
+ go acc gs' = acc : merge_inst_groups gs'
+
+ is_inst_payload (InstPayload _) = True
+ is_inst_payload (DeclPayload _) = False
+
+nested_dep_anal :: GlobalRdrEnv -> SCC DepAnalPayload -> [[DepAnalPayload]]
+nested_dep_anal rdr_env payload = map flattenSCC (stronglyConnCompFromEdgedVerticesOrd nodes)
+ where
+ nodes :: [Node DepAnalKey DepAnalPayload]
+ nodes = do
+ p <- flattenSCC payload
+ case p of
+ DeclPayload decl -> [mk_decl_node get_deps decl]
+ InstPayload inst -> [mk_inst_node get_deps inst]
+
+ get_deps :: FreeVars -> [DepAnalKey]
+ get_deps = concatMap get_dep . mapMaybe (lookupGRE_Name rdr_env) . nonDetEltsUniqSet
+
+ get_dep :: GlobalRdrElt -> [DepAnalKey]
+ get_dep GRE{gre_name = name, gre_par = par} =
+ case par of
+ NoParent -> [DeclKey name]
+ ParentIs p -> [DeclKey p]
+
+get_dep_anal_payload :: [DepAnalPayload] -> [TyClGroup GhcRn]
+get_dep_anal_payload ps =
+ let
+ group = foldr add_payload empty_group ps
+ insts = [ empty_group { group_instds = [inst] }
+ | inst <- sortBy cmpBufSpanA (group_instds group) ]
+ in
+ group { group_instds = [] } `cons` insts
+ where
+ empty_group = TyClGroup noExtField [] [] [] []
+ cons (TyClGroup _ [] [] [] []) gs = gs
+ cons g gs = g : gs
+
+lookupKiSigFVs :: NameEnv (LStandaloneKindSig GhcRn, FreeVars) -> Name -> (Maybe (LStandaloneKindSig GhcRn), FreeVars)
+lookupKiSigFVs env name =
+ case lookupNameEnv env name of
+ Nothing -> (Nothing, emptyFVs)
+ Just (kisig, fvs) -> (Just kisig, fvs)
+
+data DepAnalInst =
+ Inst { inst_index :: Int
+ , inst_name :: Name
+ , inst_inst :: LInstDecl GhcRn
+ , inst_fvs :: FreeVars }
+
+data DepAnalDecl =
+ Decl { decl_name :: Name
+ , decl_roles :: Maybe (LRoleAnnotDecl GhcRn)
+ , decl_kisig :: Maybe (LStandaloneKindSig GhcRn)
+ , decl_decl :: LTyClDecl GhcRn
+ , decl_fvs :: FreeVars }
+
+data DepAnalKey =
+ InstKey Name Int
+ | DeclKey Name
+ deriving (Eq, Ord)
+
+data DepAnalPayload = -- TyClGroupBuilder (TyClGroup GhcRn -> TyClGroup GhcRn)
+ InstPayload DepAnalInst
+ | DeclPayload DepAnalDecl
+
+
+add_payload :: DepAnalPayload -> TyClGroup GhcRn -> TyClGroup GhcRn
+add_payload (DeclPayload decl) g =
+ TyClGroup { group_ext = group_ext g
+ , group_tyclds = decl_decl decl : group_tyclds g
+ , group_kisigs = maybe id (:) (decl_kisig decl) (group_kisigs g)
+ , group_roles = maybe id (:) (decl_roles decl) (group_roles g)
+ , group_instds = group_instds g }
+add_payload (InstPayload inst) g =
+ TyClGroup { group_ext = group_ext g
+ , group_tyclds = group_tyclds g
+ , group_kisigs = group_kisigs g
+ , group_roles = group_roles g
+ , group_instds = inst_inst inst : group_instds g }
+
+cmpBufSpanA :: GenLocated (SrcSpanAnn' a1) a2 -> GenLocated (SrcSpanAnn' a3) a2 -> Ordering
+cmpBufSpanA (L la a) (L lb b) = cmpBufSpan (L (locA la) a) (L (locA lb) b)
+
+get_decl_name :: LTyClDecl GhcRn -> Name
+get_decl_name = tcdName . unLoc
+
+get_inst_name :: LInstDecl GhcRn -> Name
+get_inst_name (L _ inst) =
+ unLoc $ case inst of
+ ClsInstD { cid_inst = inst } ->
+ go ((unLoc . sig_body . unLoc . cid_poly_ty) inst)
+ where
+ go (HsTyVar _ _ name) = name
+ go (HsOpTy _ _ _ name _) = name
+ go HsQualTy{hst_body = L _ ty} = go ty
+ go (HsAppTy _ (L _ ty) _) = go ty
+ go (HsAppKindTy _ (L _ ty) _ _) = go ty
+ go (HsParTy _ (L _ ty)) = go ty
+ go _ = panic "get_inst_name: unsupported class instance head"
+ DataFamInstD { dfid_inst = inst } -> (feqn_tycon . dfid_eqn) inst
+ TyFamInstD { tfid_inst = inst } -> (feqn_tycon . tfid_eqn) inst
=====================================
testsuite/tests/dependent/should_compile/T12088a.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE DataKinds, TypeFamilies, UndecidableInstances #-}
+
+module T12088a where
+
+import Data.Kind
+import GHC.TypeLits
+
+type family Open a
+type instance Open Bool = Nat
+type instance Open Float = Type
+type instance Open Char = F Float
+
+type F :: forall a -> Open a
+type family F a
+type instance F Bool = 42
+type instance F Float = [Nat]
+type instance F Char = '[0, 1]
=====================================
testsuite/tests/dependent/should_compile/T12088b.hs
=====================================
@@ -0,0 +1,12 @@
+{-# LANGUAGE DataKinds, TypeFamilies #-}
+
+module T12088b where
+
+import Data.Kind
+
+type family IxKind (m :: Type) :: Type
+type family Value (m :: Type) :: IxKind m -> Type
+data T (k :: Type) (f :: k -> Type) = MkT
+
+type instance IxKind (T k f) = k
+type instance Value (T k f) = f
\ No newline at end of file
=====================================
testsuite/tests/dependent/should_compile/T12088c.hs
=====================================
@@ -0,0 +1,19 @@
+{-# LANGUAGE DataKinds, TypeFamilies #-}
+
+module T12088c where
+
+import Data.Kind
+
+type family K a
+
+class C a where -- C:def
+ type F a :: K a -- F:sig
+ type G a :: K a -- G:sig
+
+data T
+
+type instance K T = Type
+
+instance C T where -- C:inst
+ type F T = Bool -- F:def
+ type G T = String -- G:def
\ No newline at end of file
=====================================
testsuite/tests/dependent/should_compile/T12239.hs
=====================================
@@ -0,0 +1,23 @@
+{-# LANGUAGE PolyKinds, DataKinds, GADTs, TypeFamilies #-}
+
+module T12239 where
+
+import Data.Kind (Type)
+
+data N = Z | S N
+
+data Fin :: N -> Type where
+ FZ :: Fin (S n)
+ FS :: Fin n -> Fin (S n)
+
+type family FieldCount (t :: Type) :: N
+
+type family FieldType (t :: Type) (i :: Fin (FieldCount t)) :: Type
+
+data T
+
+type instance FieldCount T = S (S (S Z))
+
+type instance FieldType T FZ = Int
+type instance FieldType T (FS FZ) = Bool
+type instance FieldType T (FS (FS FZ)) = String
=====================================
testsuite/tests/dependent/should_compile/all.T
=====================================
@@ -63,3 +63,7 @@ test('T16347', normal, compile, [''])
test('T18660', normal, compile, [''])
test('T12174', normal, compile, [''])
test('LopezJuan', normal, compile, [''])
+test('T12239', normal, compile, [''])
+test('T12088a', normal, compile, [''])
+test('T12088b', normal, compile, [''])
+test('T12088c', normal, compile, [''])
\ No newline at end of file
=====================================
testsuite/tests/deriving/should_compile/T17339.stderr
=====================================
@@ -3,14 +3,14 @@
Result size of Tidy Core
= {terms: 8, types: 20, coercions: 0, joins: 0/0}
--- RHS size: {terms: 1, types: 2, coercions: 0, joins: 0/0}
-T17339.$fClsA1B1 :: Cls A1 B1
-T17339.$fClsA1B1 = T17339.C:Cls @A1 @B1
-
-- RHS size: {terms: 1, types: 2, coercions: 0, joins: 0/0}
T17339.$fClsA2B1 :: Cls A2 B1
T17339.$fClsA2B1 = T17339.C:Cls @A2 @B1
+-- RHS size: {terms: 1, types: 2, coercions: 0, joins: 0/0}
+T17339.$fClsA1B1 :: Cls A1 B1
+T17339.$fClsA1B1 = T17339.C:Cls @A1 @B1
+
-- RHS size: {terms: 1, types: 2, coercions: 0, joins: 0/0}
T17339.$fClsA1B2 :: Cls A1 B2
T17339.$fClsA1B2 = T17339.C:Cls @A1 @B2
=====================================
testsuite/tests/ghci/scripts/T4175.stdout
=====================================
@@ -2,8 +2,8 @@ type A :: * -> * -> *
type family A a b
-- Defined at T4175.hs:8:1
type instance A (B a) b = () -- Defined at T4175.hs:11:15
-type instance A Int Int = () -- Defined at T4175.hs:9:15
type instance A (Maybe a) a = a -- Defined at T4175.hs:10:15
+type instance A Int Int = () -- Defined at T4175.hs:9:15
type B :: * -> *
data family B a
-- Defined at T4175.hs:13:1
=====================================
testsuite/tests/indexed-types/should_fail/OverDirectThisMod.stderr
=====================================
@@ -1,10 +1,10 @@
OverDirectThisModC.hs:1:1: error: [GHC-34447]
Conflicting family instance declarations:
- D [Int] [a] = Int -- Defined in module OverDirectThisModB
- D [a] [Int] = Char -- Defined at OverDirectThisModC.hs:12:15
+ C [Int] [a] -- Defined in module OverDirectThisModB
+ C [a] [Int] -- Defined at OverDirectThisModC.hs:10:15
OverDirectThisModC.hs:1:1: error: [GHC-34447]
Conflicting family instance declarations:
- C [Int] [a] -- Defined in module OverDirectThisModB
- C [a] [Int] -- Defined at OverDirectThisModC.hs:10:15
+ D [Int] [a] = Int -- Defined in module OverDirectThisModB
+ D [a] [Int] = Char -- Defined at OverDirectThisModC.hs:12:15
=====================================
testsuite/tests/indexed-types/should_fail/OverIndirectThisMod.stderr
=====================================
@@ -1,10 +1,10 @@
OverIndirectThisModD.hs:1:1: error: [GHC-34447]
Conflicting family instance declarations:
- D [Int] [a] = Int -- Defined in module OverIndirectThisModB
- D [a] [Int] = Char -- Defined at OverIndirectThisModD.hs:13:15
+ C [Int] [a] -- Defined in module OverIndirectThisModB
+ C [a] [Int] -- Defined at OverIndirectThisModD.hs:11:15
OverIndirectThisModD.hs:1:1: error: [GHC-34447]
Conflicting family instance declarations:
- C [Int] [a] -- Defined in module OverIndirectThisModB
- C [a] [Int] -- Defined at OverIndirectThisModD.hs:11:15
+ D [Int] [a] = Int -- Defined in module OverIndirectThisModB
+ D [a] [Int] = Char -- Defined at OverIndirectThisModD.hs:13:15
=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -437,6 +437,12 @@
(Nothing))))]
[]
[]
+ [])
+ ,(TyClGroup
+ (NoExtField)
+ []
+ []
+ []
[(L
(SrcSpanAnn (EpAnn
(Anchor
@@ -1135,6 +1141,12 @@
[]))]
[]
[]
+ [])
+ ,(TyClGroup
+ (NoExtField)
+ []
+ []
+ []
[(L
(SrcSpanAnn (EpAnn
(Anchor
=====================================
testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr
=====================================
@@ -12,4 +12,4 @@ FAMILY INSTANCES
type instance F Bool _ = Bool
-- Defined at TypeFamilyInstanceLHS.hs:8:15
Dependent modules: []
-Dependent packages: [base-4.16.0.0]
+Dependent packages: [base-4.18.0.0]
=====================================
testsuite/tests/perf/compiler/WWRec.stderr
=====================================
@@ -0,0 +1,14 @@
+
+WWRec.hs:72:10: warning: [GHC-62412] [-Wsimplifiable-class-constraints (in -Wdefault)]
+ • The constraint ‘Rule f A30’ matches
+ instance Rule f A1 => Rule f A30 -- Defined at WWRec.hs:73:10
+ This makes type inference for inner bindings fragile;
+ either use MonoLocalBinds, or simplify it using the instance
+ • In the instance declaration for ‘Rule f A29’
+
+WWRec.hs:73:10: warning: [GHC-62412] [-Wsimplifiable-class-constraints (in -Wdefault)]
+ • The constraint ‘Rule f A1’ matches
+ instance Rule f A2 => Rule f A1 -- Defined at WWRec.hs:44:10
+ This makes type inference for inner bindings fragile;
+ either use MonoLocalBinds, or simplify it using the instance
+ • In the instance declaration for ‘Rule f A30’
=====================================
testsuite/tests/plugins/test-defaulting-plugin.stderr
=====================================
@@ -1,13 +1,13 @@
test-defaulting-plugin.hs:28:11: warning: [GHC-18042] [-Wtype-defaults (in -Wall)]
- • Defaulting the type variable ‘a0’ to type ‘0’ in the following constraint
+ • Defaulting the type variable ‘a0’ to type ‘4’ in the following constraint
KnownNat a0 arising from a use of ‘q’
• In the first argument of ‘(+)’, namely ‘q’
In the second argument of ‘($)’, namely ‘q + w’
In a stmt of a 'do' block: print $ q + w
test-defaulting-plugin.hs:28:15: warning: [GHC-18042] [-Wtype-defaults (in -Wall)]
- • Defaulting the type variable ‘a0’ to type ‘2’ in the following constraints
+ • Defaulting the type variable ‘a0’ to type ‘4’ in the following constraints
(KnownNat a0)
arising from a use of ‘w’ at test-defaulting-plugin.hs:28:15
(GHC.TypeError.Assert
@@ -19,7 +19,7 @@ test-defaulting-plugin.hs:28:15: warning: [GHC-18042] [-Wtype-defaults (in -Wall
In a stmt of a 'do' block: print $ q + w
test-defaulting-plugin.hs:29:11: warning: [GHC-18042] [-Wtype-defaults (in -Wall)]
- • Defaulting the type variable ‘b0’ to type ‘0’ in the following constraint
+ • Defaulting the type variable ‘b0’ to type ‘4’ in the following constraint
KnownNat b0 arising from a use of ‘mc’
• In the second argument of ‘($)’, namely ‘mc Proxy Proxy’
In a stmt of a 'do' block: print $ mc Proxy Proxy
@@ -28,7 +28,7 @@ test-defaulting-plugin.hs:29:11: warning: [GHC-18042] [-Wtype-defaults (in -Wall
print $ mc Proxy Proxy
test-defaulting-plugin.hs:29:11: warning: [GHC-18042] [-Wtype-defaults (in -Wall)]
- • Defaulting the type variable ‘a0’ to type ‘0’ in the following constraint
+ • Defaulting the type variable ‘a0’ to type ‘4’ in the following constraint
KnownNat a0 arising from a use of ‘mc’
• In the second argument of ‘($)’, namely ‘mc Proxy Proxy’
In a stmt of a 'do' block: print $ mc Proxy Proxy
=====================================
testsuite/tests/th/T17296.stderr
=====================================
@@ -3,17 +3,17 @@ data instance forall (a_0 :: *). T17296.Foo1 (GHC.Maybe.Maybe a_0)
data instance T17296.Foo1 GHC.Types.Bool = T17296.Foo1Bool
data family T17296.Foo2 :: k_0 -> *
+data instance T17296.Foo2 :: GHC.Types.Char -> *
data instance T17296.Foo2 :: (GHC.Types.Char -> GHC.Types.Char) ->
*
-data instance T17296.Foo2 :: GHC.Types.Char -> *
data instance forall (a_1 :: *). T17296.Foo2 (GHC.Maybe.Maybe a_1 :: *)
data instance T17296.Foo2 GHC.Types.Bool = T17296.Foo2Bool
data family T17296.Foo3 :: k_0
-data instance T17296.Foo3 :: GHC.Types.Char -> *
data instance T17296.Foo3 :: (GHC.Types.Char -> GHC.Types.Char) ->
*
-data instance forall (a_1 :: *). T17296.Foo3 (GHC.Maybe.Maybe a_1 :: *)
+data instance T17296.Foo3 :: GHC.Types.Char -> *
data instance T17296.Foo3 GHC.Types.Bool = T17296.Foo3Bool
+data instance forall (a_1 :: *). T17296.Foo3 (GHC.Maybe.Maybe a_1 :: *)
data instance T17296.Foo3 :: *
=====================================
testsuite/tests/typecheck/should_fail/T6018fail.stderr
=====================================
@@ -4,11 +4,11 @@
[4 of 5] Compiling T6018Dfail ( T6018Dfail.hs, T6018Dfail.o )
[5 of 5] Compiling T6018fail ( T6018fail.hs, T6018fail.o )
-T6018fail.hs:15:15: error: [GHC-05175]
+T6018fail.hs:14:15: error: [GHC-05175]
Type family equation right-hand sides overlap; this violates
the family's injectivity annotation:
- F Bool Int Char = Int -- Defined at T6018fail.hs:15:15
F Char Bool Int = Int -- Defined at T6018fail.hs:14:15
+ F Bool Int Char = Int -- Defined at T6018fail.hs:15:15
T6018fail.hs:21:15: error: [GHC-05175]
Type family equation right-hand sides overlap; this violates
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/10315b700cc2b0ad788769db8fe4b87a705af2b4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/10315b700cc2b0ad788769db8fe4b87a705af2b4
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230629/63a7fd2a/attachment-0001.html>
More information about the ghc-commits
mailing list