X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnTypes.lhs;h=82bf50a9fd6518802587ac1441ec003e4c210221;hb=3c4a732b0b011cf356eed1ecd4fdc4d5f1aab193;hp=8dbf8878b37f0c84177718a02431d909f15b768b;hpb=654a1ba16e47d3ddabeb74b809ee6097c0770d35;p=ghc-hetmet.git

diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index 8dbf887..82bf50a 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -21,7 +21,7 @@ module RnTypes (
 	dupFieldErr, patSigErr, checkTupSize
   ) where
 
-import DynFlags		( DynFlag(Opt_WarnUnusedMatches, Opt_GlasgowExts, Opt_ScopedTypeVariables ) )
+import DynFlags		( DynFlag(Opt_WarnUnusedMatches, Opt_GlasgowExts, Opt_ScopedTypeVariables, Opt_OverloadedStrings ) )
 
 import HsSyn
 import RdrHsSyn		( extractHsRhoRdrTyVars )
@@ -40,7 +40,7 @@ import RdrName		( RdrName, elemLocalRdrEnv )
 import PrelNames	( eqClassName, integralClassName, geName, eqName,
 		  	  negateName, minusName, lengthPName, indexPName,
 			  plusIntegerName, fromIntegerName, timesIntegerName,
-			  ratioDataConName, fromRationalName )
+			  ratioDataConName, fromRationalName, fromStringName )
 import TypeRep		( funTyCon )
 import Constants	( mAX_TUPLE_SIZE )
 import Name		( Name )
@@ -586,6 +586,10 @@ rnPat (SigPatIn pat ty)
   where
     doc = text "In a pattern type-signature"
     
+rnPat (LitPat lit@(HsString s))
+  = do { ovlStr <- doptM Opt_OverloadedStrings
+       ; if ovlStr then rnPat (mkNPat (mkHsIsString s) Nothing)
+         else do { rnLit lit; return (LitPat lit, emptyFVs) } }  -- Same as below
 rnPat (LitPat lit) 
   = rnLit lit 	`thenM_` 
     returnM (LitPat lit, emptyFVs) 
@@ -599,7 +603,7 @@ rnPat (NPat lit mb_neg eq _)
     )					`thenM` \ (mb_neg', fvs2) ->
     lookupSyntaxName eqName		`thenM` \ (eq', fvs3) -> 
     returnM (NPat lit' mb_neg' eq' placeHolderType, 
-	      fvs1 `plusFV` fvs2 `plusFV` fvs3 `addOneFV` eqClassName)	
+	      fvs1 `plusFV` fvs2 `plusFV` fvs3)	
 	-- Needed to find equality on pattern
 
 rnPat (NPlusKPat name lit _ _)
@@ -608,7 +612,7 @@ rnPat (NPlusKPat name lit _ _)
     lookupSyntaxName minusName		`thenM` \ (minus, fvs2) ->
     lookupSyntaxName geName		`thenM` \ (ge, fvs3) ->
     returnM (NPlusKPat name' lit' ge minus,
-	     fvs1 `plusFV` fvs2 `plusFV` fvs3 `addOneFV` integralClassName)
+	     fvs1 `plusFV` fvs2 `plusFV` fvs3)
 	-- The Report says that n+k patterns must be in Integral
 
 rnPat (LazyPat pat)
@@ -633,23 +637,19 @@ rnPat (ParPat pat)
 
 rnPat (ListPat pats _)
   = rnLPats pats			`thenM` \ (patslist, fvs) ->
-    returnM (ListPat patslist placeHolderType, fvs `addOneFV` listTyCon_name)
+    returnM (ListPat patslist placeHolderType, fvs)
 
 rnPat (PArrPat pats _)
   = rnLPats pats			`thenM` \ (patslist, fvs) ->
     returnM (PArrPat patslist placeHolderType, 
-	      fvs `plusFV` implicit_fvs `addOneFV` parrTyCon_name)
+	      fvs `plusFV` implicit_fvs)
   where
     implicit_fvs = mkFVs [lengthPName, indexPName]
 
 rnPat (TuplePat pats boxed _)
-  = checkTupSize tup_size	`thenM_`
+  = checkTupSize (length pats)	`thenM_`
     rnLPats pats			`thenM` \ (patslist, fvs) ->
-    returnM (TuplePat patslist boxed placeHolderType, 
-	     fvs `addOneFV` tycon_name)
-  where
-    tup_size   = length pats
-    tycon_name = tupleTyCon_name boxed tup_size
+    returnM (TuplePat patslist boxed placeHolderType, fvs)
 
 rnPat (TypePat name) =
     rnHsTypeFVs (text "In a type pattern") name	`thenM` \ (name', fvs) ->
@@ -741,6 +741,10 @@ rnOverLit (HsFractional i _)
 	-- and denominator (see DsUtils.mkIntegerLit)
     in
     returnM (HsFractional i from_rat_name, fvs `plusFV` extra_fvs)
+
+rnOverLit (HsIsString s _)
+  = lookupSyntaxName fromStringName	`thenM` \ (from_string_name, fvs) ->
+	returnM (HsIsString s from_string_name, fvs)
 \end{code}