Permalink
Browse files

Revert "Add a new separate MetaInfo for holes, HoleTv, so after typec…

…hecking it can be verified if a class constraint was on a hole."

This reverts commit 006d203.
  • Loading branch information...
1 parent 40b8903 commit ce4d99947d9c87cf3e43023a5ce9a0acfe6027e5 @xnyhps committed Apr 27, 2012
@@ -221,8 +221,7 @@ tcExpr (HsType ty) _
tcExpr (HsHole name) res_ty
= do { traceTc "tcExpr.HsHole" (ppr $ res_ty)
; let origin = OccurrenceOf name
- ; tyvar <- newMetaTyVar HoleTv liftedTypeKind
- ; let ty = TyVarTy tyvar
+ ; ty <- newFlexiTyVarTy liftedTypeKind
-- Emit the constraint
; var <- emitWanted origin (mkHolePred name ty)
@@ -317,7 +317,6 @@ newMetaTyVar meta_info kind
TauTv -> fsLit "t"
TcsTv -> fsLit "u"
SigTv -> fsLit "a"
- HoleTv -> fsLit "h"
; return (mkTcTyVar name kind (MetaTv meta_info ref)) }
mkTcTyVarName :: Unique -> FastString -> Name
@@ -342,7 +342,6 @@ data MetaInfo
-- Its particular property is that it is always "touchable"
-- Nevertheless, the constraint solver has to try to guess
-- what type to instantiate it to
- | HoleTv
-------------------------------------
-- UserTypeCtxt describes the origin of the polymorphic type
@@ -352,7 +351,6 @@ instance Outputable MetaInfo where
ppr TauTv = ptext (sLit "TauTv")
ppr SigTv = ptext (sLit "SigTv")
ppr TcsTv = ptext (sLit "TcsTv")
- ppr HoleTv = ptext (sLit "HoleTv")
data UserTypeCtxt
= FunSigCtxt Name -- Function type signature
@@ -428,7 +426,6 @@ pprTcTyVarDetails (FlatSkol {}) = ptext (sLit "fsk")
pprTcTyVarDetails (MetaTv TauTv _) = ptext (sLit "tau")
pprTcTyVarDetails (MetaTv TcsTv _) = ptext (sLit "tcs")
pprTcTyVarDetails (MetaTv SigTv _) = ptext (sLit "sig")
-pprTcTyVarDetails (MetaTv HoleTv _) = ptext (sLit "hole")
pprUserTypeCtxt :: UserTypeCtxt -> SDoc
pprUserTypeCtxt (InfSigCtxt n) = ptext (sLit "the inferred type for") <+> quotes (ppr n)
@@ -744,7 +741,6 @@ isMetaTyVar tv
isAmbiguousTyVar tv
= ASSERT2( isTcTyVar tv, ppr tv )
case tcTyVarDetails tv of
- MetaTv HoleTv _ -> False
MetaTv {} -> True
RuntimeUnk {} -> True
_ -> False
@@ -777,8 +777,7 @@ uUnfilledVar origin swapped tv1 details1 (TyVarTy tv2)
uUnfilledVar origin swapped tv1 details1 non_var_ty2 -- ty2 is not a type variable
= case details1 of
MetaTv TauTv ref1
- -> do { traceTc "uUnfilledVar" empty
- ; mb_ty2' <- checkTauTvUpdate tv1 non_var_ty2
+ -> do { mb_ty2' <- checkTauTvUpdate tv1 non_var_ty2
; case mb_ty2' of
Nothing -> do { traceTc "Occ/kind defer" (ppr tv1); defer }
Just ty2' -> updateMeta tv1 ref1 ty2'
@@ -810,7 +809,6 @@ uUnfilledVars origin swapped tv1 details1 tv2 details2
; let ctxt = mkKindErrorCtxt ty1 ty2 k1 k2
; sub_kind <- addErrCtxtM ctxt $ unifyKind k1 k2
- ; traceTc "uUnfilledVars" ( text "details1:" <+> ppr details1 <+> text "details2:" <+> ppr details2)
; case (sub_kind, details1, details2) of
-- k1 < k2, so update tv2
(LT, _, MetaTv _ ref2) -> updateMeta tv2 ref2 ty1
@@ -834,8 +832,6 @@ uUnfilledVars origin swapped tv1 details1 tv2 details2
ty1 = mkTyVarTy tv1
ty2 = mkTyVarTy tv2
- nicer_to_update_tv1 _ HoleTv = True
- nicer_to_update_tv1 HoleTv _ = False
nicer_to_update_tv1 _ SigTv = True
nicer_to_update_tv1 SigTv _ = False
nicer_to_update_tv1 _ _ = isSystemName (Var.varName tv1)
@@ -988,8 +984,7 @@ lookupTcTyVar tyvar
updateMeta :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM TcCoercion
updateMeta tv1 ref1 ty2
- = do { traceTc "updateMeta" (ppr tv1 <+> ppr ty2)
- ; writeMetaTyVarRef tv1 ref1 ty2
+ = do { writeMetaTyVarRef tv1 ref1 ty2
; return (mkTcReflCo ty2) }
\end{code}

0 comments on commit ce4d999

Please sign in to comment.