Add support for overloaded string literals.

[ghc-hetmet.git] / compiler / typecheck / TcPat.lhs

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 5fda4f4..4fe704a 100644 (file)
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -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