summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/main/HscTypes.hs3
-rw-r--r--compiler/parser/Parser.y3
-rw-r--r--compiler/parser/RdrHsSyn.hs4
-rw-r--r--compiler/prelude/PrelNames.hs40
-rw-r--r--compiler/prelude/PrelRules.hs6
-rw-r--r--compiler/prelude/TysPrim.hs25
-rw-r--r--compiler/prelude/TysWiredIn.hs72
-rw-r--r--compiler/typecheck/ClsInst.hs24
-rw-r--r--compiler/typecheck/Inst.hs9
-rw-r--r--compiler/typecheck/TcValidity.hs2
-rw-r--r--libraries/base/Data/Type/Equality.hs24
-rw-r--r--libraries/ghc-prim/GHC/Types.hs6
-rw-r--r--testsuite/tests/ghci/scripts/T10059.stdout13
-rw-r--r--testsuite/tests/indexed-types/should_compile/T7837.stderr3
-rw-r--r--testsuite/tests/perf/compiler/all.T6
-rw-r--r--testsuite/tests/roles/should_compile/Roles3.stderr3
-rw-r--r--testsuite/tests/th/T10828.stderr6
17 files changed, 130 insertions, 119 deletions
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 0c375f074c..27c699c190 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -174,8 +174,7 @@ import CoAxiom
import ConLike
import DataCon
import PatSyn
-import PrelNames ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule
- , eqTyConName )
+import PrelNames ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule )
import TysWiredIn
import Packages hiding ( Version(..) )
import CmdLineParser
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index d038562a73..dd9beadc4d 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -76,10 +76,9 @@ import TcEvidence ( emptyTcEvBinds )
-- compiler/prelude
import ForeignCall
import TysPrim ( eqPrimTyCon )
-import PrelNames ( eqTyCon_RDR )
import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon,
unboxedUnitTyCon, unboxedUnitDataCon,
- listTyCon_RDR, consDataCon_RDR )
+ listTyCon_RDR, consDataCon_RDR, eqTyCon_RDR )
-- compiler/utils
import Util ( looksLikePackageName )
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 1ffde2222c..681ecdeae0 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -92,9 +92,9 @@ import Lexeme ( isLexCon )
import Type ( TyThing(..) )
import TysWiredIn ( cTupleTyConName, tupleTyCon, tupleDataCon,
nilDataConName, nilDataConKey,
- listTyConName, listTyConKey )
+ listTyConName, listTyConKey, eqTyCon_RDR )
import ForeignCall
-import PrelNames ( forall_tv_RDR, eqTyCon_RDR, allNameStrings )
+import PrelNames ( forall_tv_RDR, allNameStrings )
import SrcLoc
import Unique ( hasKey )
import OrdList ( OrdList, fromOL )
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index d971a8be90..90f1f44713 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -393,7 +393,7 @@ basicKnownKeyNames
-- The Ordering type
, orderingTyConName
- , ltDataConName, eqDataConName, gtDataConName
+ , ordLTDataConName, ordEQDataConName, ordGTDataConName
-- The SPEC type for SpecConstr
, specTyConName
@@ -433,9 +433,6 @@ basicKnownKeyNames
, typeErrorVAppendDataConName
, typeErrorShowTypeDataConName
- -- homogeneous equality
- , eqTyConName
-
] ++ case cIntegerLibraryType of
IntegerGMP -> [integerSDataConName,naturalSDataConName]
IntegerSimple -> []
@@ -859,9 +856,6 @@ traverse_RDR = varQual_RDR dATA_TRAVERSABLE (fsLit "traverse")
mempty_RDR = varQual_RDR gHC_BASE (fsLit "mempty")
mappend_RDR = varQual_RDR gHC_BASE (fsLit "mappend")
-eqTyCon_RDR :: RdrName
-eqTyCon_RDR = tcQual_RDR dATA_TYPE_EQUALITY (fsLit "~")
-
----------------------
varQual_RDR, tcQual_RDR, clsQual_RDR, dataQual_RDR
:: Module -> FastString -> RdrName
@@ -889,11 +883,11 @@ runMainIOName, runRWName :: Name
runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey
runRWName = varQual gHC_MAGIC (fsLit "runRW#") runRWKey
-orderingTyConName, ltDataConName, eqDataConName, gtDataConName :: Name
+orderingTyConName, ordLTDataConName, ordEQDataConName, ordGTDataConName :: Name
orderingTyConName = tcQual gHC_TYPES (fsLit "Ordering") orderingTyConKey
-ltDataConName = dcQual gHC_TYPES (fsLit "LT") ltDataConKey
-eqDataConName = dcQual gHC_TYPES (fsLit "EQ") eqDataConKey
-gtDataConName = dcQual gHC_TYPES (fsLit "GT") gtDataConKey
+ordLTDataConName = dcQual gHC_TYPES (fsLit "LT") ordLTDataConKey
+ordEQDataConName = dcQual gHC_TYPES (fsLit "EQ") ordEQDataConKey
+ordGTDataConName = dcQual gHC_TYPES (fsLit "GT") ordGTDataConKey
specTyConName :: Name
specTyConName = tcQual gHC_TYPES (fsLit "SPEC") specTyConKey
@@ -1531,10 +1525,6 @@ fingerprintDataConName :: Name
fingerprintDataConName =
dcQual gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey
--- homogeneous equality. See Note [The equality types story] in TysPrim
-eqTyConName :: Name
-eqTyConName = tcQual dATA_TYPE_EQUALITY (fsLit "~") eqTyConKey
-
{-
************************************************************************
* *
@@ -1916,7 +1906,7 @@ charDataConKey, consDataConKey, doubleDataConKey, falseDataConKey,
floatDataConKey, intDataConKey, integerSDataConKey, nilDataConKey,
ratioDataConKey, stableNameDataConKey, trueDataConKey, wordDataConKey,
word8DataConKey, ioDataConKey, integerDataConKey, heqDataConKey,
- coercibleDataConKey, nothingDataConKey, justDataConKey :: Unique
+ coercibleDataConKey, eqDataConKey, nothingDataConKey, justDataConKey :: Unique
charDataConKey = mkPreludeDataConUnique 1
consDataConKey = mkPreludeDataConUnique 2
@@ -1927,6 +1917,7 @@ intDataConKey = mkPreludeDataConUnique 6
integerSDataConKey = mkPreludeDataConUnique 7
nothingDataConKey = mkPreludeDataConUnique 8
justDataConKey = mkPreludeDataConUnique 9
+eqDataConKey = mkPreludeDataConUnique 10
nilDataConKey = mkPreludeDataConUnique 11
ratioDataConKey = mkPreludeDataConUnique 12
word8DataConKey = mkPreludeDataConUnique 13
@@ -1948,10 +1939,11 @@ leftDataConKey, rightDataConKey :: Unique
leftDataConKey = mkPreludeDataConUnique 25
rightDataConKey = mkPreludeDataConUnique 26
-ltDataConKey, eqDataConKey, gtDataConKey :: Unique
-ltDataConKey = mkPreludeDataConUnique 27
-eqDataConKey = mkPreludeDataConUnique 28
-gtDataConKey = mkPreludeDataConUnique 29
+ordLTDataConKey, ordEQDataConKey, ordGTDataConKey :: Unique
+ordLTDataConKey = mkPreludeDataConUnique 27
+ordEQDataConKey = mkPreludeDataConUnique 28
+ordGTDataConKey = mkPreludeDataConUnique 29
+
coercibleDataConKey = mkPreludeDataConUnique 32
@@ -2376,12 +2368,14 @@ starArrStarArrStarKindRepKey = mkPreludeMiscIdUnique 522
-- Dynamic
toDynIdKey :: Unique
-toDynIdKey = mkPreludeMiscIdUnique 550
+toDynIdKey = mkPreludeMiscIdUnique 523
+
bitIntegerIdKey :: Unique
-bitIntegerIdKey = mkPreludeMiscIdUnique 551
+bitIntegerIdKey = mkPreludeMiscIdUnique 550
-heqSCSelIdKey, coercibleSCSelIdKey :: Unique
+heqSCSelIdKey, eqSCSelIdKey, coercibleSCSelIdKey :: Unique
+eqSCSelIdKey = mkPreludeMiscIdUnique 551
heqSCSelIdKey = mkPreludeMiscIdUnique 552
coercibleSCSelIdKey = mkPreludeMiscIdUnique 553
diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs
index 78d753525f..695e879ba2 100644
--- a/compiler/prelude/PrelRules.hs
+++ b/compiler/prelude/PrelRules.hs
@@ -934,9 +934,9 @@ trueValBool = Var trueDataConId -- see Note [What's true and false]
falseValBool = Var falseDataConId
ltVal, eqVal, gtVal :: Expr CoreBndr
-ltVal = Var ltDataConId
-eqVal = Var eqDataConId
-gtVal = Var gtDataConId
+ltVal = Var ordLTDataConId
+eqVal = Var ordEQDataConId
+gtVal = Var ordGTDataConId
mkIntVal :: DynFlags -> Integer -> Expr CoreBndr
mkIntVal dflags i = Lit (mkMachInt dflags i)
diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs
index 754bb8fb09..30dca25eea 100644
--- a/compiler/prelude/TysPrim.hs
+++ b/compiler/prelude/TysPrim.hs
@@ -599,7 +599,7 @@ GHC sports a veritable menagerie of equality types:
-----------------------------------------------------------------------------------------
~# T U hetero nominal eqPrimTyCon GHC.Prim
~~ C L hetero nominal hEqTyCon GHC.Types
-~ C L homo nominal eqTyCon Data.Type.Equality
+~ C L homo nominal eqTyCon GHC.Types
:~: T L homo nominal (not built-in) Data.Type.Equality
:~~: T L hetero nominal (not built-in) Data.Type.Equality
@@ -642,6 +642,7 @@ This is (almost) an ordinary class, defined as if by
class a ~# b => a ~~ b
instance a ~# b => a ~~ b
Here's what's unusual about it:
+
* We can't actually declare it that way because we don't have syntax for ~#.
And ~# isn't a constraint, so even if we could write it, it wouldn't kind
check.
@@ -671,21 +672,23 @@ Within GHC, ~~ is called heqTyCon, and it is defined in TysWiredIn.
--------------------------
(~) :: forall k. k -> k -> Constraint
--------------------------
-This is defined in Data.Type.Equality:
- class a ~~ b => (a :: k) ~ (b :: k)
- instance a ~~ b => a ~ b
-This is even more so an ordinary class than (~~), with the following exceptions:
- * Users cannot write instances of it.
+This is /exactly/ like (~~), except with a homogeneous kind.
+It is an almost-ordinary class defined as if by
+ class a ~# b => (a :: k) ~ (b :: k)
+ instance a ~# b => a ~ b
- * It is "naturally coherent". (See (~~).)
+ * All the bullets for (~~) apply
- * (~) is magical syntax, as ~ is a reserved symbol.
+ * In addition (~) is magical syntax, as ~ is a reserved symbol.
It cannot be exported or imported.
- * It always terminates.
+Within GHC, ~ is called eqTyCon, and it is defined in TysWiredIn.
-Within GHC, ~ is called eqTyCon, and it is defined in PrelNames. Note that
-it is *not* wired in.
+Historical note: prior to July 18 (~) was defined as a
+ more-ordinary class with (~~) as a superclass. But that made it
+ special in different ways; and the extra superclass selections to
+ get from (~) to (~#) via (~~) were tiresome. Now it's defined
+ uniformly with (~~) and Coercible; much nicer.)
--------------------------
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 56c1987852..740d0d772d 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -29,9 +29,9 @@ module TysWiredIn (
-- * Ordering
orderingTyCon,
- ltDataCon, ltDataConId,
- eqDataCon, eqDataConId,
- gtDataCon, gtDataConId,
+ ordLTDataCon, ordLTDataConId,
+ ordEQDataCon, ordEQDataConId,
+ ordGTDataCon, ordGTDataConId,
promotedLTDataCon, promotedEQDataCon, promotedGTDataCon,
-- * Boxing primitive types
@@ -96,6 +96,7 @@ module TysWiredIn (
-- * Equality predicates
heqTyCon, heqTyConName, heqClass, heqDataCon,
+ eqTyCon, eqTyConName, eqClass, eqDataCon, eqTyCon_RDR,
coercibleTyCon, coercibleTyConName, coercibleDataCon, coercibleClass,
-- * RuntimeRep and friends
@@ -215,6 +216,7 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because then
, listTyCon
, maybeTyCon
, heqTyCon
+ , eqTyCon
, coercibleTyCon
, typeNatKindCon
, typeSymbolKindCon
@@ -243,9 +245,19 @@ mkWiredInIdName mod fs uniq id
-- See Note [Kind-changing of (~) and Coercible]
-- in libraries/ghc-prim/GHC/Types.hs
+eqTyConName, eqDataConName, eqSCSelIdName :: Name
+eqTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "~") eqTyConKey eqTyCon
+eqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Eq#") eqDataConKey eqDataCon
+eqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "eq_sel") eqSCSelIdKey eqSCSelId
+
+eqTyCon_RDR :: RdrName
+eqTyCon_RDR = nameRdrName eqTyConName
+
+-- See Note [Kind-changing of (~) and Coercible]
+-- in libraries/ghc-prim/GHC/Types.hs
heqTyConName, heqDataConName, heqSCSelIdName :: Name
heqTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "~~") heqTyConKey heqTyCon
-heqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Eq#") heqDataConKey heqDataCon
+heqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "HEq#") heqDataConKey heqDataCon
heqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "heq_sel") heqSCSelIdKey heqSCSelId
-- See Note [Kind-changing of (~) and Coercible] in libraries/ghc-prim/GHC/Types.hs
@@ -1000,10 +1012,28 @@ mk_sum arity = (tycon, sum_cons)
-- necessary because the functional-dependency coverage check looks
-- through superclasses, and (~#) is handled in that check.
-heqTyCon, coercibleTyCon :: TyCon
-heqClass, coercibleClass :: Class
-heqDataCon, coercibleDataCon :: DataCon
-heqSCSelId, coercibleSCSelId :: Id
+eqTyCon, heqTyCon, coercibleTyCon :: TyCon
+eqClass, heqClass, coercibleClass :: Class
+eqDataCon, heqDataCon, coercibleDataCon :: DataCon
+eqSCSelId, heqSCSelId, coercibleSCSelId :: Id
+
+(eqTyCon, eqClass, eqDataCon, eqSCSelId)
+ = (tycon, klass, datacon, sc_sel_id)
+ where
+ tycon = mkClassTyCon eqTyConName binders roles
+ rhs klass
+ (mkPrelTyConRepName eqTyConName)
+ klass = mk_class tycon sc_pred sc_sel_id
+ datacon = pcDataCon eqDataConName tvs [sc_pred] tycon
+
+ -- Kind: forall k. k -> k -> Constraint
+ binders = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k])
+ roles = [Nominal, Nominal, Nominal]
+ rhs = mkDataTyConRhs [datacon]
+
+ tvs@[k,a,b] = binderVars binders
+ sc_pred = mkTyConApp eqPrimTyCon (mkTyVarTys [k,k,a,b])
+ sc_sel_id = mkDictSelId eqSCSelIdName klass
(heqTyCon, heqClass, heqDataCon, heqSCSelId)
= (tycon, klass, datacon, sc_sel_id)
@@ -1046,6 +1076,8 @@ mk_class tycon sc_pred sc_sel_id
= mkClass (tyConName tycon) (tyConTyVars tycon) [] [sc_pred] [sc_sel_id]
[] [] (mkAnd []) tycon
+
+
{- *********************************************************************
* *
Kinds and RuntimeRep
@@ -1354,17 +1386,17 @@ trueDataConId = dataConWorkId trueDataCon
orderingTyCon :: TyCon
orderingTyCon = pcTyCon orderingTyConName Nothing
- [] [ltDataCon, eqDataCon, gtDataCon]
+ [] [ordLTDataCon, ordEQDataCon, ordGTDataCon]
-ltDataCon, eqDataCon, gtDataCon :: DataCon
-ltDataCon = pcDataCon ltDataConName [] [] orderingTyCon
-eqDataCon = pcDataCon eqDataConName [] [] orderingTyCon
-gtDataCon = pcDataCon gtDataConName [] [] orderingTyCon
+ordLTDataCon, ordEQDataCon, ordGTDataCon :: DataCon
+ordLTDataCon = pcDataCon ordLTDataConName [] [] orderingTyCon
+ordEQDataCon = pcDataCon ordEQDataConName [] [] orderingTyCon
+ordGTDataCon = pcDataCon ordGTDataConName [] [] orderingTyCon
-ltDataConId, eqDataConId, gtDataConId :: Id
-ltDataConId = dataConWorkId ltDataCon
-eqDataConId = dataConWorkId eqDataCon
-gtDataConId = dataConWorkId gtDataCon
+ordLTDataConId, ordEQDataConId, ordGTDataConId :: Id
+ordLTDataConId = dataConWorkId ordLTDataCon
+ordEQDataConId = dataConWorkId ordEQDataCon
+ordGTDataConId = dataConWorkId ordGTDataCon
{-
************************************************************************
@@ -1505,9 +1537,9 @@ promotedLTDataCon
, promotedEQDataCon
, promotedGTDataCon
:: TyCon
-promotedLTDataCon = promoteDataCon ltDataCon
-promotedEQDataCon = promoteDataCon eqDataCon
-promotedGTDataCon = promoteDataCon gtDataCon
+promotedLTDataCon = promoteDataCon ordLTDataCon
+promotedEQDataCon = promoteDataCon ordEQDataCon
+promotedGTDataCon = promoteDataCon ordGTDataCon
-- Promoted List
promotedConsDataCon, promotedNilDataCon :: TyCon
diff --git a/compiler/typecheck/ClsInst.hs b/compiler/typecheck/ClsInst.hs
index 99cd1366be..de957b71fd 100644
--- a/compiler/typecheck/ClsInst.hs
+++ b/compiler/typecheck/ClsInst.hs
@@ -94,8 +94,9 @@ matchGlobalInst dflags short_cut clas tys
| cls_name == knownSymbolClassName = matchKnownSymbol clas tys
| isCTupleClass clas = matchCTuple clas tys
| cls_name == typeableClassName = matchTypeable clas tys
- | clas `hasKey` heqTyConKey = matchLiftedEquality tys
- | clas `hasKey` coercibleTyConKey = matchLiftedCoercible tys
+ | clas `hasKey` heqTyConKey = matchHeteroEquality tys
+ | clas `hasKey` eqTyConKey = matchHomoEquality tys
+ | clas `hasKey` coercibleTyConKey = matchCoercible tys
| cls_name == hasFieldClassName = matchHasField dflags short_cut clas tys
| otherwise = matchInstEnv dflags short_cut clas tys
where
@@ -449,22 +450,31 @@ if you'd written
***********************************************************************-}
-- See also Note [The equality types story] in TysPrim
-matchLiftedEquality :: [Type] -> TcM ClsInstResult
-matchLiftedEquality args
+matchHeteroEquality :: [Type] -> TcM ClsInstResult
+-- Solves (t1 ~~ t2)
+matchHeteroEquality args
= return (OneInst { cir_new_theta = [ mkTyConApp eqPrimTyCon args ]
, cir_mk_ev = evDFunApp (dataConWrapId heqDataCon) args
, cir_what = BuiltinInstance })
+matchHomoEquality :: [Type] -> TcM ClsInstResult
+-- Solves (t1 ~ t2)
+matchHomoEquality args@[k,t1,t2]
+ = return (OneInst { cir_new_theta = [ mkTyConApp eqPrimTyCon [k,k,t1,t2] ]
+ , cir_mk_ev = evDFunApp (dataConWrapId eqDataCon) args
+ , cir_what = BuiltinInstance })
+matchHomoEquality args = pprPanic "matchHomoEquality" (ppr args)
+
-- See also Note [The equality types story] in TysPrim
-matchLiftedCoercible :: [Type] -> TcM ClsInstResult
-matchLiftedCoercible args@[k, t1, t2]
+matchCoercible :: [Type] -> TcM ClsInstResult
+matchCoercible args@[k, t1, t2]
= return (OneInst { cir_new_theta = [ mkTyConApp eqReprPrimTyCon args' ]
, cir_mk_ev = evDFunApp (dataConWrapId coercibleDataCon)
args
, cir_what = BuiltinInstance })
where
args' = [k, k, t1, t2]
-matchLiftedCoercible args = pprPanic "matchLiftedCoercible" (ppr args)
+matchCoercible args = pprPanic "matchLiftedCoercible" (ppr args)
{- ********************************************************************
diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs
index f8f3bbe191..4e854fc8c8 100644
--- a/compiler/typecheck/Inst.hs
+++ b/compiler/typecheck/Inst.hs
@@ -45,7 +45,7 @@ import TcRnMonad
import TcEnv
import TcEvidence
import InstEnv
-import TysWiredIn ( heqDataCon )
+import TysWiredIn ( heqDataCon, eqDataCon )
import CoreSyn ( isOrphan )
import FunDeps
import TcMType
@@ -60,7 +60,6 @@ import Id
import Name
import Var ( EvVar, mkTyVar, tyVarName, TyVarBndr(..) )
import DataCon
-import TyCon
import VarEnv
import PrelNames
import SrcLoc
@@ -577,10 +576,8 @@ mkHEqBoxTy co ty1 ty2
-- | This takes @a ~# b@ and returns @a ~ b@.
mkEqBoxTy :: TcCoercion -> Type -> Type -> TcM Type
mkEqBoxTy co ty1 ty2
- = do { eq_tc <- tcLookupTyCon eqTyConName
- ; let [datacon] = tyConDataCons eq_tc
- ; hetero <- mkHEqBoxTy co ty1 ty2
- ; return $ mkTyConApp (promoteDataCon datacon) [k, ty1, ty2, hetero] }
+ = return $
+ mkTyConApp (promoteDataCon eqDataCon) [k, ty1, ty2, mkCoercionTy co]
where k = typeKind ty1
{-
diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs
index 0e97a0cfd3..1dc60e7312 100644
--- a/compiler/typecheck/TcValidity.hs
+++ b/compiler/typecheck/TcValidity.hs
@@ -30,7 +30,7 @@ import TcSimplify ( simplifyAmbiguityCheck )
import ClsInst ( matchGlobalInst, ClsInstResult(..), InstanceWhat(..) )
import TyCoRep
import TcType hiding ( sizeType, sizeTypes )
-import TysWiredIn ( heqTyConName, coercibleTyConName )
+import TysWiredIn ( heqTyConName, eqTyConName, coercibleTyConName )
import PrelNames
import Type
import Coercion
diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs
index 50b96c08c1..dfdf23b5f0 100644
--- a/libraries/base/Data/Type/Equality.hs
+++ b/libraries/base/Data/Type/Equality.hs
@@ -53,30 +53,6 @@ import GHC.Read
import GHC.Base
import Data.Type.Bool
--- | Lifted, homogeneous equality. By lifted, we mean that it can be
--- bogus (deferred type error). By homogeneous, the two types @a@
--- and @b@ must have the same kind.
-class a ~~ b => (a :: k) ~ (b :: k)
- -- See Note [The equality types story] in TysPrim
- -- NB: All this class does is to wrap its superclass, which is
- -- the "real", inhomogeneous equality; this is needed when
- -- we have a Given (a~b), and we want to prove things from it
- -- NB: Not exported, as (~) is magical syntax. That's also why there's
- -- no fixity.
-
- -- It's tempting to put functional dependencies on (~), but it's not
- -- necessary because the functional-dependency coverage check looks
- -- through superclasses, and (~#) is handled in that check.
-
--- | @since 4.9.0.0
-instance {-# INCOHERENT #-} a ~~ b => a ~ b
- -- See Note [The equality types story] in TysPrim
- -- If we have a Wanted (t1 ~ t2), we want to immediately
- -- simplify it to (t1 ~~ t2) and solve that instead
- --
- -- INCOHERENT because we want to use this instance eagerly, even when
- -- the tyvars are partially unknown.
-
infix 4 :~:, :~~:
-- | Propositional equality. If @a :~: b@ is inhabited by some terminating
diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs
index 26c92cec83..3275d571d9 100644
--- a/libraries/ghc-prim/GHC/Types.hs
+++ b/libraries/ghc-prim/GHC/Types.hs
@@ -211,6 +211,12 @@ inside GHC, to change the kind and type.
class a ~~ b
-- See also Note [The equality types story] in TysPrim
+-- | Lifted, homogeneous equality. By lifted, we mean that it
+-- can be bogus (deferred type error). By homogeneous, the two
+-- types @a@ and @b@ must have the sme kinds.
+class a ~ b
+ -- See also Note [The equality types story] in TysPrim
+
-- | @Coercible@ is a two-parameter class that has instances for types @a@ and @b@ if
-- the compiler can infer that they have the same representation. This class
-- does not have regular instances; instead they are created on-the-fly during
diff --git a/testsuite/tests/ghci/scripts/T10059.stdout b/testsuite/tests/ghci/scripts/T10059.stdout
index 26e1e7e28f..92fbb45ef7 100644
--- a/testsuite/tests/ghci/scripts/T10059.stdout
+++ b/testsuite/tests/ghci/scripts/T10059.stdout
@@ -1,9 +1,4 @@
-class (a ~ b) => (~) (a :: k) (b :: k)
- -- Defined in ‘Data.Type.Equality’
-instance [incoherent] forall k (a :: k) (b :: k). (a ~ b) => a ~ b
- -- Defined in ‘Data.Type.Equality’
-(~) :: k -> k -> Constraint
-class (a ~~ b) => (~) (a :: k) (b :: k)
- -- Defined in ‘Data.Type.Equality’
-instance [incoherent] forall k (a :: k) (b :: k). (a ~~ b) => a ~ b
- -- Defined in ‘Data.Type.Equality’
+class (a ~ b) => (~) (a :: k0) (b :: k0) -- Defined in ‘GHC.Types’
+(~) :: k0 -> k0 -> Constraint
+class (a GHC.Prim.~# b) => (~) (a :: k0) (b :: k0)
+ -- Defined in ‘GHC.Types’
diff --git a/testsuite/tests/indexed-types/should_compile/T7837.stderr b/testsuite/tests/indexed-types/should_compile/T7837.stderr
index 7900ce5ba2..dec839f72b 100644
--- a/testsuite/tests/indexed-types/should_compile/T7837.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T7837.stderr
@@ -1,8 +1,7 @@
Rule fired: Class op signum (BUILTIN)
Rule fired: Class op abs (BUILTIN)
-Rule fired: Class op heq_sel (BUILTIN)
Rule fired: normalize/Double (T7837)
-Rule fired: Class op heq_sel (BUILTIN)
+Rule fired: Class op eq_sel (BUILTIN)
Rule fired: Class op $p1Norm (BUILTIN)
Rule fired: Class op / (BUILTIN)
Rule fired: Class op norm (BUILTIN)
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index eed616b7e9..3488a59a44 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -1033,13 +1033,14 @@ test('T10547',
test('T12227',
[ only_ways(['normal']),
compiler_stats_num_field('bytes allocated',
- [(wordsize(64), 812869424, 5),
+ [(wordsize(64), 752214784, 5),
# 2016-07-11 5650186880 (Windows) before fix for #12227
# 2016-07-11 1822822016 (Windows) after fix for #12227
# 2016-12-20 1715827784 after d250d493 (INLINE in Traversable dms)
# (or thereabouts in the commit history)
# 2017-02-14 1060158624 Early inlining: 35% improvement
# 2018-01-04 812869424 Drop unused givens (#13032): 23% better
+ # 2018-06-27 752214784 Trac #15421
]),
],
compile,
@@ -1090,8 +1091,9 @@ test('T12234',
test('T12545',
[ only_ways(['normal']),
compiler_stats_num_field('bytes allocated',
- [(wordsize(64), 3538652464, 5),
+ [(wordsize(64), 3249613688, 5),
# 2017-06-08 3538652464 initial
+ # 2018-06-27 3249613688 Trac #15421
]),
extra_clean(['T12545a.hi', 'T12545a.o'])
],
diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr
index 93c0ab7cb5..aa2a07f459 100644
--- a/testsuite/tests/roles/should_compile/Roles3.stderr
+++ b/testsuite/tests/roles/should_compile/Roles3.stderr
@@ -96,8 +96,7 @@ $krep [InlPrag=NOUSERINLINE[~]]
= GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint []
$krep [InlPrag=NOUSERINLINE[~]]
= GHC.Types.KindRepTyConApp
- Data.Type.Equality.$tc~
- ((:) GHC.Types.krep$* ((:) $krep ((:) $krep [])))
+ GHC.Types.$tc~ ((:) GHC.Types.krep$* ((:) $krep ((:) $krep [])))
$krep [InlPrag=NOUSERINLINE[~]]
= GHC.Types.KindRepTyConApp Roles3.$tcC2 ((:) $krep ((:) $krep []))
$krep [InlPrag=NOUSERINLINE[~]]
diff --git a/testsuite/tests/th/T10828.stderr b/testsuite/tests/th/T10828.stderr
index 70ed74bc1e..455be91914 100644
--- a/testsuite/tests/th/T10828.stderr
+++ b/testsuite/tests/th/T10828.stderr
@@ -8,9 +8,9 @@ newtype Bar_13 :: * -> GHC.Types.Bool -> *
= MkBar_14 :: a_15 -> Bar_13 a_15 b_16
data T10828.T (a_0 :: *) where
T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1
- T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (Data.Type.Equality.~) a_2
- GHC.Types.Int => {T10828.foo :: a_2,
- T10828.bar :: b_3} -> T10828.T GHC.Types.Int
+ T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2
+ GHC.Types.Int => {T10828.foo :: a_2,
+ T10828.bar :: b_3} -> T10828.T GHC.Types.Int
data T'_0 a_1 :: * where
MkT'_2 :: a_3 -> a_3 -> T'_0 a_3
MkC'_4 :: forall a_5 b_6 . a_5 ~ GHC.Types.Int => {foo_7 :: a_5,
View Lorry Controller Status