summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/iface/IfaceSyn.hs30
-rw-r--r--testsuite/tests/driver/sigof01/sigof01i2.stdout1
-rw-r--r--testsuite/tests/ghci/prog008/ghci.prog008.stdout2
-rw-r--r--testsuite/tests/ghci/scripts/T9181.stdout2
-rw-r--r--testsuite/tests/ghci/scripts/ghci008.stdout3
-rw-r--r--testsuite/tests/ghci/scripts/ghci025.stdout5
-rw-r--r--testsuite/tests/indexed-types/should_compile/T3017.stderr1
-rw-r--r--testsuite/tests/rename/should_fail/rnfail055.stderr2
-rw-r--r--testsuite/tests/roles/should_compile/Roles14.stderr1
-rw-r--r--testsuite/tests/roles/should_compile/Roles3.stderr4
-rw-r--r--testsuite/tests/roles/should_compile/Roles4.stderr2
-rw-r--r--testsuite/tests/typecheck/should_compile/tc231.stderr1
12 files changed, 51 insertions, 3 deletions
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index 6371c43b0e..61ec33e56c 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -53,13 +53,14 @@ import Module
import SrcLoc
import Fingerprint
import Binary
-import BooleanFormula ( BooleanFormula )
+import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
import HsBinds
import TyCon ( Role (..), Injectivity(..) )
import StaticFlags (opt_PprStyle_Debug)
import Util( filterOut, filterByList )
import InstEnv
import DataCon (SrcStrictness(..), SrcUnpackedness(..))
+import Lexeme (isLexSym)
import Control.Monad
import System.IO.Unsafe
@@ -529,6 +530,15 @@ instance HasOccName IfaceDecl where
instance Outputable IfaceDecl where
ppr = pprIfaceDecl showAll
+{-
+Note [Minimal complete definition] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The minimal complete definition should only be included if a complete
+class definition is shown. Since the minimal complete definition is
+anonymous we can't reuse the same mechanism that is used for the
+filtering of method signatures. Instead we just check if anything at all is
+filtered and hide it in that case.
+-}
+
data ShowSub
= ShowSub
{ ss_ppr_bndr :: OccName -> SDoc -- Pretty-printer for binders in IfaceDecl
@@ -550,6 +560,12 @@ ppShowIface :: ShowSub -> SDoc -> SDoc
ppShowIface (ShowSub { ss_how_much = ShowIface }) doc = doc
ppShowIface _ _ = Outputable.empty
+-- show if all sub-components or the complete interface is shown
+ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]
+ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] }) doc = doc
+ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc
+ppShowAllSubs _ _ = Outputable.empty
+
ppShowRhs :: ShowSub -> SDoc -> SDoc
ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _ = Outputable.empty
ppShowRhs _ doc = doc
@@ -662,11 +678,12 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
, ifCtxt = context, ifName = clas
, ifTyVars = tyvars, ifRoles = roles
- , ifFDs = fds })
+ , ifFDs = fds, ifMinDef = minDef })
= vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss clas) tyvars roles
, ptext (sLit "class") <+> pprIfaceDeclHead context ss clas tyvars
<+> pprFundeps fds <+> pp_where
- , nest 2 (vcat [vcat asocs, vcat dsigs, pprec])]
+ , nest 2 (vcat [ vcat asocs, vcat dsigs, pprec
+ , ppShowAllSubs ss (pprMinDef minDef)])]
where
pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (ptext (sLit "where"))
@@ -684,6 +701,13 @@ pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
| showSub ss sg = Just $ pprIfaceClassOp ss sg
| otherwise = Nothing
+ pprMinDef :: BooleanFormula IfLclName -> SDoc
+ pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
+ ptext (sLit "{-# MINIMAL") <+>
+ pprBooleanFormula
+ (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>
+ ptext (sLit "#-}")
+
pprIfaceDecl ss (IfaceSynonym { ifName = tc
, ifTyVars = tv
, ifSynRhs = mono_ty })
diff --git a/testsuite/tests/driver/sigof01/sigof01i2.stdout b/testsuite/tests/driver/sigof01/sigof01i2.stdout
index ac15dcfa1e..1ee81c10d2 100644
--- a/testsuite/tests/driver/sigof01/sigof01i2.stdout
+++ b/testsuite/tests/driver/sigof01/sigof01i2.stdout
@@ -1,5 +1,6 @@
class Foo a where
foo :: a -> a
+ {-# MINIMAL foo #-}
data T = A.T
mkT :: T
x :: Bool
diff --git a/testsuite/tests/ghci/prog008/ghci.prog008.stdout b/testsuite/tests/ghci/prog008/ghci.prog008.stdout
index 99e63a1b14..df6767bb84 100644
--- a/testsuite/tests/ghci/prog008/ghci.prog008.stdout
+++ b/testsuite/tests/ghci/prog008/ghci.prog008.stdout
@@ -2,7 +2,9 @@ class C a b where
c1 :: Num b => a -> b
c2 :: (Num b, Show b) => a -> b
c3 :: a1 -> b
+ {-# MINIMAL c1, c2, c3 #-}
class C a b where
c1 :: Num b => a -> b
c2 :: (Num b, Show b) => a -> b
c3 :: forall a1. a1 -> b
+ {-# MINIMAL c1, c2, c3 #-} \ No newline at end of file
diff --git a/testsuite/tests/ghci/scripts/T9181.stdout b/testsuite/tests/ghci/scripts/T9181.stdout
index 7e8b95af80..3ea130d177 100644
--- a/testsuite/tests/ghci/scripts/T9181.stdout
+++ b/testsuite/tests/ghci/scripts/T9181.stdout
@@ -7,8 +7,10 @@ type family CmpNat (a :: Nat) (b :: Nat) :: Ordering
type family CmpSymbol (a :: Symbol) (b :: Symbol) :: Ordering
class KnownNat (n :: Nat) where
natSing :: SNat n
+ {-# MINIMAL natSing #-}
class KnownSymbol (n :: Symbol) where
symbolSing :: SSymbol n
+ {-# MINIMAL symbolSing #-}
data SomeNat where
SomeNat :: KnownNat n => (Proxy n) -> SomeNat
data SomeSymbol where
diff --git a/testsuite/tests/ghci/scripts/ghci008.stdout b/testsuite/tests/ghci/scripts/ghci008.stdout
index 9a1bcf7551..eb057ca4bd 100644
--- a/testsuite/tests/ghci/scripts/ghci008.stdout
+++ b/testsuite/tests/ghci/scripts/ghci008.stdout
@@ -27,6 +27,9 @@ class (RealFrac a, Floating a) => RealFloat a where
isNegativeZero :: a -> Bool
isIEEE :: a -> Bool
atan2 :: a -> a -> a
+ {-# MINIMAL floatRadix, floatDigits, floatRange, decodeFloat,
+ encodeFloat, isNaN, isInfinite, isDenormalized, isNegativeZero,
+ isIEEE #-}
-- Defined in ‘GHC.Float’
instance RealFloat Float -- Defined in ‘GHC.Float’
instance RealFloat Double -- Defined in ‘GHC.Float’
diff --git a/testsuite/tests/ghci/scripts/ghci025.stdout b/testsuite/tests/ghci/scripts/ghci025.stdout
index e5b5bc34b7..fc9bd6e2b1 100644
--- a/testsuite/tests/ghci/scripts/ghci025.stdout
+++ b/testsuite/tests/ghci/scripts/ghci025.stdout
@@ -9,6 +9,7 @@ class C a b where
c2 :: (N b, S b) => a -> b
c3 :: a1 -> b
c4 :: a1 -> b
+ {-# MINIMAL c1, c2, c3, c4 #-}
c1 :: (C a b, N b) => a -> b
c2 :: (C a b, N b, S b) => a -> b
c3 :: C a b => forall a. a -> b
@@ -30,6 +31,7 @@ class Applicative m => Monad (m :: * -> *) where
(>>) :: m a -> m b -> m b
return :: a -> m a
fail :: String -> m a
+ {-# MINIMAL (>>=) #-}
-- imported via Data.Maybe
catMaybes :: [Maybe a] -> [a]
fromJust :: Maybe a -> a
@@ -50,6 +52,7 @@ Nothing :: Maybe a
class Eq a where
(==) :: a -> a -> Bool
(/=) :: a -> a -> Bool
+ {-# MINIMAL (==) | (/=) #-}
-- imported via Prelude, T
Prelude.length :: Foldable t => forall a. t a -> Int
-- imported via T
@@ -68,6 +71,7 @@ class C a b where
c2 :: (N b, S b) => a -> b
c3 :: a1 -> b
c4 :: a1 -> b
+ {-# MINIMAL c1, c2, c3, c4 #-}
c1 :: (C a b, N b) => a -> b
c2 :: (C a b, N b, S b) => a -> b
c3 :: C a b => forall a. a -> b
@@ -82,6 +86,7 @@ class C a b where
c2 :: (N b, S b) => a -> b
c3 :: forall a1. a1 -> b
c4 :: forall a1. a1 -> b
+ {-# MINIMAL c1, c2, c3, c4 #-}
c1 :: forall a b. (C a b, N b) => a -> b
c2 :: forall a b. (C a b, N b, S b) => a -> b
c3 :: forall a b. C a b => forall a. a -> b
diff --git a/testsuite/tests/indexed-types/should_compile/T3017.stderr b/testsuite/tests/indexed-types/should_compile/T3017.stderr
index cffbf700a6..2d2187c5a7 100644
--- a/testsuite/tests/indexed-types/should_compile/T3017.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T3017.stderr
@@ -7,6 +7,7 @@ TYPE CONSTRUCTORS
type family Elem c :: * open
empty :: c
insert :: Elem c -> c -> c
+ {-# MINIMAL empty, insert #-}
data ListColl a = L [a]
Promotable
COERCION AXIOMS
diff --git a/testsuite/tests/rename/should_fail/rnfail055.stderr b/testsuite/tests/rename/should_fail/rnfail055.stderr
index 4611e867ec..d87054e926 100644
--- a/testsuite/tests/rename/should_fail/rnfail055.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail055.stderr
@@ -87,8 +87,10 @@ RnFail055.hs-boot:28:1: error:
Main module: class C2 a b where
m2 :: a -> b
m2' :: a -> b
+ {-# MINIMAL m2, m2' #-}
Boot file: class C2 a b where
m2 :: a -> b
+ {-# MINIMAL m2 #-}
The methods do not match: There are different numbers of methods
RnFail055.hs-boot:29:1: error:
diff --git a/testsuite/tests/roles/should_compile/Roles14.stderr b/testsuite/tests/roles/should_compile/Roles14.stderr
index 230603cf09..bb61133ce0 100644
--- a/testsuite/tests/roles/should_compile/Roles14.stderr
+++ b/testsuite/tests/roles/should_compile/Roles14.stderr
@@ -3,6 +3,7 @@ TYPE CONSTRUCTORS
type role C2 representational
class C2 a where
meth2 :: a -> a
+ {-# MINIMAL meth2 #-}
COERCION AXIOMS
axiom Roles12.NTCo:C2 :: C2 a = a -> a
Dependent modules: []
diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr
index 93cafc0c94..6f25b63691 100644
--- a/testsuite/tests/roles/should_compile/Roles3.stderr
+++ b/testsuite/tests/roles/should_compile/Roles3.stderr
@@ -2,13 +2,17 @@ TYPE SIGNATURES
TYPE CONSTRUCTORS
class C1 a where
meth1 :: a -> a
+ {-# MINIMAL meth1 #-}
class C2 a b where
meth2 :: a ~ b => a -> b
+ {-# MINIMAL meth2 #-}
class C3 a b where
type family F3 b :: * open
meth3 :: a -> F3 b -> F3 b
+ {-# MINIMAL meth3 #-}
class C4 a b where
meth4 :: a -> F4 b -> F4 b
+ {-# MINIMAL meth4 #-}
type family F4 a :: * open
type Syn1 a = F4 a
type Syn2 a = [a]
diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr
index 109a2bb96f..0113869e42 100644
--- a/testsuite/tests/roles/should_compile/Roles4.stderr
+++ b/testsuite/tests/roles/should_compile/Roles4.stderr
@@ -2,8 +2,10 @@ TYPE SIGNATURES
TYPE CONSTRUCTORS
class C1 a where
meth1 :: a -> a
+ {-# MINIMAL meth1 #-}
class C3 a where
meth3 :: a -> Syn1 a
+ {-# MINIMAL meth3 #-}
type Syn1 a = [a]
COERCION AXIOMS
axiom Roles4.NTCo:C1 :: C1 a = a -> a
diff --git a/testsuite/tests/typecheck/should_compile/tc231.stderr b/testsuite/tests/typecheck/should_compile/tc231.stderr
index fb011c66c5..5503eaf295 100644
--- a/testsuite/tests/typecheck/should_compile/tc231.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc231.stderr
@@ -11,6 +11,7 @@ TYPE CONSTRUCTORS
Promotable
class Zork s a b | a -> b where
huh :: Q s a chain -> ST s ()
+ {-# MINIMAL huh #-}
COERCION AXIOMS
axiom NTCo:Zork ::
Zork s a b = forall chain. Q s a chain -> ST s ()
View Lorry Controller Status