[commit: ghc] type-holes-branch: Revert "Add a new separate MetaInfo for holes, HoleTv, so after typechecking it can be verified if a class constraint was on a hole." (ce4d999)

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}