Commit ffa4651e authored by simonpj's avatar simonpj
Browse files

[project @ 2003-10-10 15:45:04 by simonpj]

Use tcIsTyVarTy not isTyVarTy; and move isPredTy
parent ec53c99c
......@@ -56,7 +56,7 @@ import TcMType ( zonkTcType, zonkTcTypes, zonkTcPredType,
import TcType ( Type, TcType, TcThetaType, TcTyVarSet,
PredType(..), TyVarDetails(VanillaTv),
tcSplitForAllTys, tcSplitForAllTys, mkTyConApp,
tcSplitPhiTy, isTyVarTy, tcSplitDFunTy,
tcSplitPhiTy, tcIsTyVarTy, tcSplitDFunTy,
isIntTy,isFloatTy, isIntegerTy, isDoubleTy,
tcIsTyVarTy, mkPredTy, mkTyVarTy, mkTyVarTys,
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tidyPred,
......@@ -622,7 +622,8 @@ lookupInst inst@(LitInst u (HsFractional f from_rat_name) ty loc)
-- Dictionaries
lookupInst dict@(Dict _ pred@(ClassP clas tys) loc)
| all isTyVarTy tys -- Common special case; no lookup
| all tcIsTyVarTy tys -- Common special case; no lookup
-- NB: tcIsTyVarTy... don't look through newtypes!
= returnM NoInstance
| otherwise
......@@ -632,7 +633,10 @@ lookupInst dict@(Dict _ pred@(ClassP clas tys) loc)
; dflags <- getDOpts
; case lookupInstEnv dflags (pkg_ie, tcg_inst_env tcg_env) clas tys of {
([(tenv, (_,_,dfun_id))], []) -> instantiate_dfun tenv dfun_id pred loc ;
other -> return NoInstance } }
(matches, unifs) -> do
{ traceTc (text "lookupInst" <+> vcat [text "matches" <+> ppr matches,
text "unifs" <+> ppr unifs])
; return NoInstance } } }
-- In the case of overlap (multiple matches) we report
-- NoInstance here. That has the effect of making the
-- context-simplifier return the dict as an irreducible one.
......@@ -654,7 +658,6 @@ instantiate_dfun tenv dfun_id pred loc
getStage `thenM` \ use_stage ->
checkWellStaged (ptext SLIT("instance for") <+> quotes (ppr pred))
(topIdLvl dfun_id) use_stage `thenM_`
traceTc (text "lookupInst" <+> ppr dfun_id <+> ppr (topIdLvl dfun_id) <+> ppr use_stage) `thenM_`
let
(tyvars, rho) = tcSplitForAllTys (idType dfun_id)
mk_ty_arg tv = case lookupSubstEnv tenv tv of
......
......@@ -59,7 +59,7 @@ module TcType (
getClassPredTys_maybe, getClassPredTys,
isClassPred, isTyVarClassPred,
mkDictTy, tcSplitPredTy_maybe,
isDictTy, tcSplitDFunTy, predTyUnique,
isPredTy, isDictTy, tcSplitDFunTy, predTyUnique,
mkClassPred, isInheritablePred, isLinearPred, isIPPred, mkPredName,
---------------------------------
......@@ -96,7 +96,7 @@ module TcType (
isUnLiftedType, -- Source types are always lifted
isUnboxedTupleType, -- Ditto
isPrimitiveType, isTyVarTy, isPredTy,
isPrimitiveType,
tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars,
......@@ -125,7 +125,7 @@ import Type ( -- Re-exports
mkTyConApp, mkGenTyConApp, mkAppTy,
mkAppTys, mkSynTy, applyTy, applyTys,
mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy,
mkPredTys, isUnLiftedType, isPredTy,
mkPredTys, isUnLiftedType,
isUnboxedTupleType, isPrimitiveType,
splitTyConApp_maybe,
tidyTopType, tidyType, tidyPred, tidyTypes,
......@@ -669,6 +669,12 @@ isOverloadedTy (ForAllTy tyvar ty) = isOverloadedTy ty
isOverloadedTy (FunTy a b) = isPredTy a
isOverloadedTy (NoteTy n ty) = isOverloadedTy ty
isOverloadedTy _ = False
isPredTy :: Type -> Bool -- Belongs in TcType because it does
-- not look through newtypes, or predtypes (of course)
isPredTy (NoteTy _ ty) = isPredTy ty
isPredTy (PredTy sty) = True
isPredTy _ = False
\end{code}
\begin{code}
......
......@@ -41,7 +41,7 @@ module Type (
applyTy, applyTys, isForAllTy, dropForAlls,
-- Source types
isPredTy, predTypeRep, mkPredTy, mkPredTys,
predTypeRep, mkPredTy, mkPredTys,
-- Newtypes
splitRecNewType_maybe,
......@@ -182,8 +182,7 @@ invariant: use it.
\begin{code}
mkAppTy orig_ty1 orig_ty2
= ASSERT2( not (isPredTy orig_ty1), crudePprType orig_ty1 ) -- Source types are of kind *
mk_app orig_ty1
= mk_app orig_ty1
where
mk_app (NoteTy _ ty1) = mk_app ty1
mk_app (NewTcApp tc tys) = NewTcApp tc (tys ++ [orig_ty2])
......@@ -206,8 +205,7 @@ mkAppTys orig_ty1 [] = orig_ty1
-- returns to (Ratio Integer), which has needlessly lost
-- the Rational part.
mkAppTys orig_ty1 orig_tys2
= ASSERT( not (isPredTy orig_ty1) ) -- Source types are of kind *
mk_app orig_ty1
= mk_app orig_ty1
where
mk_app (NoteTy _ ty1) = mk_app ty1
mk_app (NewTcApp tc tys) = NewTcApp tc (tys ++ orig_tys2)
......@@ -555,11 +553,6 @@ predTypeRep (IParam _ ty) = ty
predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
-- Result might be a NewTcApp, but the consumer will
-- look through that too if necessary
isPredTy :: Type -> Bool
isPredTy (NoteTy _ ty) = isPredTy ty
isPredTy (PredTy sty) = True
isPredTy _ = False
\end{code}
......
Supports Markdown
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