Commit 0239d783 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Fix egregious typo in cmpTypeX

Reported in Trac #7272.  "tv1" should be "tv2"!

However, things weren't as simple as they sound, because
treating (x:Open) as different from (x:*) gave rise to
new failures; see Note [Comparison with OpenTypeKind] in Type.

My hacky solution is to treat OpenKind as equal to * and #,
at least in Core etc.  Hence the faff in Type.cmpTc.

I do not like this.  But it seems like another messy consequence
of including sub-kinding.  Sigh.
parent 8c846f71
......@@ -23,6 +23,7 @@ import TcMType as TcM
import TcType
import TcSMonad as TcS
import TcInteract
import Kind ( defaultKind_maybe )
import Inst
import FunDeps ( growThetaTyVars )
import Type ( classifyPredType, PredTree(..), getClassPredTys_maybe )
......@@ -782,7 +783,7 @@ defaultTyVar :: TcTyVar -> TcS TcTyVar
-- Precondition: MetaTyVars only
-- See Note [DefaultTyVar]
defaultTyVar the_tv
| not (k `eqKind` default_k)
| Just default_k <- defaultKind_maybe (tyVarKind the_tv)
= do { tv' <- TcS.cloneMetaTyVar the_tv
; let new_tv = setTyVarKind tv' default_k
; traceTcS "defaultTyVar" (ppr the_tv <+> ppr new_tv)
......@@ -793,9 +794,6 @@ defaultTyVar the_tv
-- We keep the same Untouchables on tv'
| otherwise = return the_tv -- The common case
where
k = tyVarKind the_tv
default_k = defaultKind k
approximateWC :: WantedConstraints -> Cts
-- Postcondition: Wanted or Derived Cts
......
......@@ -43,7 +43,7 @@ module Kind (
isSubOpenTypeKind,
isSubKind, isSubKindCon,
tcIsSubKind, tcIsSubKindCon,
defaultKind,
defaultKind, defaultKind_maybe,
-- ** Functions on variables
kiVarsOfKind, kiVarsOfKinds
......@@ -60,6 +60,7 @@ import TyCon
import VarSet
import PrelNames
import Outputable
import Maybes( orElse )
import Util
\end{code}
......@@ -271,7 +272,8 @@ tcIsSubKindCon kc1 kc2
| otherwise = isSubKindCon kc1 kc2
-------------------------
defaultKind :: Kind -> Kind
defaultKind :: Kind -> Kind
defaultKind_maybe :: Kind -> Maybe Kind
-- ^ Used when generalising: default OpenKind and ArgKind to *.
-- See "Type#kind_subtyping" for more information on what that means
......@@ -289,9 +291,11 @@ defaultKind :: Kind -> Kind
-- This defaulting is done in TcMType.zonkTcTyVarBndr.
--
-- The test is really whether the kind is strictly above '*'
defaultKind (TyConApp kc _args)
| isOpenTypeKindCon kc = ASSERT( null _args ) liftedTypeKind
defaultKind k = k
defaultKind_maybe (TyConApp kc _args)
| isOpenTypeKindCon kc = ASSERT( null _args ) Just liftedTypeKind
defaultKind_maybe _ = Nothing
defaultKind k = defaultKind_maybe k `orElse` k
-- Returns the free kind variables in a kind
kiVarsOfKind :: Kind -> VarSet
......
......@@ -6,7 +6,7 @@
Type - public interface
\begin{code}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-orphans -w #-}
-- | Main functions for manipulating types and type-related things
module Type (
......@@ -159,8 +159,8 @@ import Class
import TyCon
import TysPrim
import {-# SOURCE #-} TysWiredIn ( eqTyCon, typeNatKind, typeSymbolKind )
import PrelNames ( eqTyConKey, ipClassNameKey,
constraintKindTyConKey, liftedTypeKindTyConKey )
import PrelNames ( eqTyConKey, ipClassNameKey, openTypeKindTyConKey,
constraintKindTyConKey, liftedTypeKindTyConKey, unliftedTypeKindTyConKey )
import CoAxiom
-- others
......@@ -1257,14 +1257,34 @@ cmpTypesX _ _ [] = GT
cmpTc :: TyCon -> TyCon -> Ordering
-- Here we treat * and Constraint as equal
-- See Note [Kind Constraint and kind *] in Kinds.lhs
cmpTc tc1 tc2 = nu1 `compare` nu2
--
-- Also we treat OpenTypeKind as equal to either * or #
-- See Note [Comparison with OpenTypeKind]
cmpTc tc1 tc2
-- | u1 == openTypeKindTyConKey, is_type nu2 = EQ
-- | u2 == openTypeKindTyConKey, is_type nu1 = EQ
| otherwise = nu1 `compare` nu2
where
u1 = tyConUnique tc1
nu1 = if u1==constraintKindTyConKey then liftedTypeKindTyConKey else u1
u2 = tyConUnique tc2
nu2 = if u2==constraintKindTyConKey then liftedTypeKindTyConKey else u2
is_type u = u == liftedTypeKindTyConKey || u == unliftedTypeKindTyConKey
\end{code}
Note [Comparison with OpenTypeKind]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In PrimOpWrappers we have things like
PrimOpWrappers.mkWeak# = /\ a b c. Prim.mkWeak# a b c
where
Prim.mkWeak# :: forall (a:Open) b c. a -> b -> c
-> State# RealWorld -> (# State# RealWorld, Weak# b #)
Now, eta reduction will turn the definition into
PrimOpWrappers.mkWeak# = Prim.mkWeak#
which is kind-of OK, but now the types aren't really equal. So HACK HACK
we pretend (in Core) that Open is equal to * or #. I hate this.
Note [cmpTypeX]
~~~~~~~~~~~~~~~
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment