X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Ftypecheck%2FTcPat.lhs;h=4fe704a84abca4f32842bce3370be85f5cac1312;hb=90dc9026b091be5cca5da4c6cbd3713ecc493361;hp=8dd5a7aec909783202606efcb40cda13322da996;hpb=d2359864dfb6d8cc419b8ee55f1948c93f796d0b;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 8dd5a7a..4fe704a 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -555,7 +555,7 @@ tcConPat pstate con_span data_con tycon pat_ty arg_pats thing_inside
 	; ex_tvs' <- tcInstSkolTyVars skol_info ex_tvs	-- Get location from monad,
 							-- not from ex_tvs
 	; let tenv     = zipTopTvSubst (univ_tvs ++ ex_tvs)
-				      (ctxt_res_tys ++ mkTyVarTys ex_tvs')
+				       (ctxt_res_tys ++ mkTyVarTys ex_tvs')
 	      eq_spec' = substEqSpec tenv eq_spec
 	      theta'   = substTheta  tenv theta
 	      arg_tys' = substTys    tenv arg_tys
@@ -813,6 +813,19 @@ tcOverloadedLit orig lit@(HsFractional r fr) res_ty
   = do 	{ expr <- newLitInst orig lit res_ty
 	; return (HsFractional r expr) }
 
+tcOverloadedLit orig lit@(HsIsString s fr) res_ty
+  | not (fr `isHsVar` fromStringName)	-- c.f. HsIntegral case
+  = do	{ str_ty <- tcMetaTy stringTyConName
+	; fr' <- tcSyntaxOp orig fr (mkFunTy str_ty res_ty)
+	; return (HsIsString s (HsApp (noLoc fr') (nlHsLit (HsString s)))) }
+
+  | Just expr <- shortCutStringLit s res_ty 
+  = return (HsIsString s expr)
+
+  | otherwise
+  = do 	{ expr <- newLitInst orig lit res_ty
+	; return (HsIsString s expr) }
+
 newLitInst :: InstOrigin -> HsOverLit Name -> BoxyRhoType -> TcM (HsExpr TcId)
 newLitInst orig lit res_ty	-- Make a LitInst
   = do 	{ loc <- getInstLoc orig
@@ -924,7 +937,7 @@ sigPatCtxt pats bound_tvs pat_tys body_ty tidy_env
   where
     bound_ids = collectPatsBinders pats
     show_ids = filter is_interesting bound_ids
-    is_interesting id = any (`elemVarSet` idFreeTyVars id) bound_tvs
+    is_interesting id = any (`elemVarSet` varTypeTyVars id) bound_tvs
 
     ppr_id id ty = ppr id <+> dcolon <+> ppr ty
 	-- Don't zonk the types so we get the separate, un-unified versions