Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-holes-branch
http://hackage.haskell.org/trac/ghc/changeset/ce4d99947d9c87cf3e43023a5ce9a0acfe6027e5 >--------------------------------------------------------------- commit ce4d99947d9c87cf3e43023a5ce9a0acfe6027e5 Author: Thijs Alkemade <[email protected]> Date: Fri Apr 27 11:54:55 2012 +0200 Revert "Add a new separate MetaInfo for holes, HoleTv, so after typechecking it can be verified if a class constraint was on a hole." This reverts commit 006d2030b08767c41a08303dcb31dc210bea6612. >--------------------------------------------------------------- compiler/typecheck/TcExpr.lhs | 3 +-- compiler/typecheck/TcMType.lhs | 1 - compiler/typecheck/TcType.lhs | 4 ---- compiler/typecheck/TcUnify.lhs | 9 ++------- 4 files changed, 3 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index 0df74e1..fdbaf29 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -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) diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs index 7a2c35a..e50392b 100644 --- a/compiler/typecheck/TcMType.lhs +++ b/compiler/typecheck/TcMType.lhs @@ -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 diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index a37a950..e41d33c 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -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 diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index cc1cf71..d22fbda 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -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} _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
