summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
28d732c)
A type variable has a flag saying whether it is a *type* variable or
a *coercion* variable. This patch adds assertions to check the flag.
And it adds fixes to places which were Wrong (and hence fired the
assertion)!
Also removed isCoVar from Coercion, since it's done by Var.isCoVar.
import {-# SOURCE #-} TcType( TcTyVarDetails, pprTcTyVarDetails )
import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId,
IdInfo, seqIdInfo )
import {-# SOURCE #-} TcType( TcTyVarDetails, pprTcTyVarDetails )
import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId,
IdInfo, seqIdInfo )
+#ifdef DEBUG
+import {-# SOURCE #-} TypeRep( isCoercionKind )
+#endif
+
import Name hiding (varName)
import Unique
import FastTypes
import Name hiding (varName)
import Unique
import FastTypes
\begin{code}
mkTyVar :: Name -> Kind -> TyVar
\begin{code}
mkTyVar :: Name -> Kind -> TyVar
-mkTyVar name kind = TyVar { varName = name
+mkTyVar name kind = ASSERT( not (isCoercionKind kind ) )
+ TyVar { varName = name
, realUnique = getKey# (nameUnique name)
, tyVarKind = kind
, isCoercionVar = False
, realUnique = getKey# (nameUnique name)
, tyVarKind = kind
, isCoercionVar = False
mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar
mkTcTyVar name kind details
mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar
mkTcTyVar name kind details
- = TcTyVar { varName = name,
+ = ASSERT( not (isCoercionKind kind) )
+ TcTyVar { varName = name,
realUnique = getKey# (nameUnique name),
tyVarKind = kind,
tcTyVarDetails = details
}
realUnique = getKey# (nameUnique name),
tyVarKind = kind,
tcTyVarDetails = details
}
-
-mkWildCoVar :: Kind -> TyVar
--- A type variable that is never referred to,
--- so its unique doesn't matter
-mkWildCoVar kind
- = TyVar { varName = mkSysTvName wild_uniq FSLIT("co_wild"),
- realUnique = _ILIT(1),
- tyVarKind = kind,
- isCoercionVar = True }
- where
- wild_uniq = mkBuiltinUnique 1
\end{code}
%************************************************************************
\end{code}
%************************************************************************
setCoVarName = setVarName
mkCoVar :: Name -> Kind -> CoVar
setCoVarName = setVarName
mkCoVar :: Name -> Kind -> CoVar
-mkCoVar name kind = TyVar { varName = name
+mkCoVar name kind = ASSERT( isCoercionKind kind )
+ TyVar { varName = name
, realUnique = getKey# (nameUnique name)
, tyVarKind = kind
, isCoercionVar = True
}
, realUnique = getKey# (nameUnique name)
, tyVarKind = kind
, isCoercionVar = True
}
+mkWildCoVar :: Kind -> TyVar
+-- A type variable that is never referred to,
+-- so its unique doesn't matter
+mkWildCoVar kind
+ = ASSERT( isCoercionKind kind )
+ TyVar { varName = mkSysTvName wild_uniq FSLIT("co_wild"),
+ realUnique = _ILIT(1),
+ tyVarKind = kind,
+ isCoercionVar = True }
+ where
+ wild_uniq = mkBuiltinUnique 1
\end{code}
%************************************************************************
\end{code}
%************************************************************************
Lam lam_tv (eta_expand n us2 (App expr (Type (mkTyVarTy lam_tv))) (substTyWith [tv] [mkTyVarTy lam_tv] ty'))
where
Lam lam_tv (eta_expand n us2 (App expr (Type (mkTyVarTy lam_tv))) (substTyWith [tv] [mkTyVarTy lam_tv] ty'))
where
- lam_tv = mkTyVar (mkSysTvName uniq FSLIT("etaT")) (tyVarKind tv)
+ lam_tv = setVarName tv (mkSysTvName uniq FSLIT("etaT"))
+ -- Using tv as a base retains its tyvar/covar-ness
(uniq:us2) = us
; Nothing ->
(uniq:us2) = us
; Nothing ->
(occs,kinds) = unzip bndrs
mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
(occs,kinds) = unzip bndrs
mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
-mk_iface_tyvar name ifKind = do { kind <- tcIfaceType ifKind
- ; return (Var.mkTyVar name kind)
- }
+mk_iface_tyvar name ifKind
+ = do { kind <- tcIfaceType ifKind
+ ; if isCoercionKind kind then
+ return (Var.mkCoVar name kind)
+ else
+ return (Var.mkTyVar name kind) }
)
import NewDemand ( isStrictDmd, isBotRes, splitStrictSig )
import SimplMonad
)
import NewDemand ( isStrictDmd, isBotRes, splitStrictSig )
import SimplMonad
-import Var ( tyVarKind, mkTyVar )
import Name ( mkSysTvName )
import Type ( Type, splitFunTys, dropForAlls, isStrictType,
splitTyConApp_maybe, tyConAppArgs, mkTyVarTys )
import Name ( mkSysTvName )
import Type ( Type, splitFunTys, dropForAlls, isStrictType,
splitTyConApp_maybe, tyConAppArgs, mkTyVarTys )
instToVar (Method {tci_id = id})
= id
instToVar (Dict {tci_name = nm, tci_pred = pred})
instToVar (Method {tci_id = id})
= id
instToVar (Dict {tci_name = nm, tci_pred = pred})
- | isEqPred pred = Var.mkTyVar nm (mkPredTy pred)
+ | isEqPred pred = Var.mkCoVar nm (mkPredTy pred)
| otherwise = mkLocalId nm (mkPredTy pred)
instLoc inst = tci_loc inst
| otherwise = mkLocalId nm (mkPredTy pred)
instLoc inst = tci_loc inst
import TypeRep
import Type
import TyCon
import TypeRep
import Type
import TyCon
-import Var hiding (isCoVar)
import Name
import OccName
import PrelNames
import Name
import OccName
import PrelNames
splitCoercionKind_maybe (PredTy (EqPred ty1 ty2)) = Just (ty1, ty2)
splitCoercionKind_maybe other = Nothing
splitCoercionKind_maybe (PredTy (EqPred ty1 ty2)) = Just (ty1, ty2)
splitCoercionKind_maybe other = Nothing
-isCoVar :: Var -> Bool
-isCoVar tv = isTyVar tv && isCoercionKind (tyVarKind tv)
-
type Coercion = Type
type CoercionKind = Kind -- A CoercionKind is always of form (ty1 :=: ty2)
type Coercion = Type
type CoercionKind = Kind -- A CoercionKind is always of form (ty1 :=: ty2)
| is_co_var = setTyVarKind old_var (substTy subst kind)
| otherwise = old_var
kind = tyVarKind old_var
| is_co_var = setTyVarKind old_var (substTy subst kind)
| otherwise = old_var
kind = tyVarKind old_var
- is_co_var = isCoercionKind kind
+ is_co_var = isCoVar old_var
\end{code}
----------------------------------------------------
\end{code}
----------------------------------------------------
| isSubArgTypeKind k = liftedTypeKind
| otherwise = k
| isSubArgTypeKind k = liftedTypeKind
| otherwise = k
-isCoercionKind :: Kind -> Bool
--- All coercions are of form (ty1 :=: ty2)
--- This function is here rather than in Coercion,
--- because it's used by substTy
-isCoercionKind k | Just k' <- kindView k = isCoercionKind k'
-isCoercionKind (PredTy (EqPred {})) = True
-isCoercionKind other = False
-
isEqPred :: PredType -> Bool
isEqPred (EqPred _ _) = True
isEqPred other = False
isEqPred :: PredType -> Bool
isEqPred (EqPred _ _) = True
isEqPred other = False
liftedTypeKind, unliftedTypeKind, openTypeKind,
argTypeKind, ubxTupleKind,
isLiftedTypeKindCon, isLiftedTypeKind,
liftedTypeKind, unliftedTypeKind, openTypeKind,
argTypeKind, ubxTupleKind,
isLiftedTypeKindCon, isLiftedTypeKind,
- mkArrowKind, mkArrowKinds,
+ mkArrowKind, mkArrowKinds, isCoercionKind,
-- Kind constructors...
liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
-- Kind constructors...
liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
isCoSuperKind other = False
-------------------
isCoSuperKind other = False
-------------------
--- lastly we need a few functions on Kinds
+-- Lastly we need a few functions on Kinds
isLiftedTypeKindCon tc = tc `hasKey` liftedTypeKindTyConKey
isLiftedTypeKindCon tc = tc `hasKey` liftedTypeKindTyConKey
+isLiftedTypeKind :: Kind -> Bool
isLiftedTypeKind (TyConApp tc []) = isLiftedTypeKindCon tc
isLiftedTypeKind other = False
isLiftedTypeKind (TyConApp tc []) = isLiftedTypeKindCon tc
isLiftedTypeKind other = False
+isCoercionKind :: Kind -> Bool
+-- All coercions are of form (ty1 :=: ty2)
+-- This function is here rather than in Coercion,
+-- because it's used in a knot-tied way to enforce invariants in Var
+isCoercionKind (NoteTy _ k) = isCoercionKind k
+isCoercionKind (PredTy (EqPred {})) = True
+isCoercionKind other = False
tySuperKind :: SuperKind
coSuperKind :: SuperKind
tySuperKind :: SuperKind
coSuperKind :: SuperKind
+isCoercionKind :: Kind -> Bool
+
isCoSuperKind :: SuperKind -> Bool
\end{code}
isCoSuperKind :: SuperKind -> Bool
\end{code}