X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnExpr.lhs;h=e78e942bf20b7e9da8417a65cde530f6142a5f71;hb=72e37dedee9e8a109ebda4b13e49b7133b530591;hp=1c80bc0101bb4c28af993991731ced3f96ece765;hpb=3a99fa889bdff0c86df20cb18c71d30e30a79b43;p=ghc-hetmet.git

diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 1c80bc0..e78e942 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -24,7 +24,6 @@ import RnHsSyn
 import TcRnMonad
 import RnEnv
 import HscTypes         ( availNames )
-import OccName		( plusOccEnv )
 import RnNames		( getLocalDeclBinders, extendRdrEnvRn )
 import RnTypes		( rnHsTypeFVs, rnLPat, rnOverLit, rnPatsAndThen, rnLit,
 			  mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec, 
@@ -91,24 +90,30 @@ rnExpr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
 
 rnExpr (HsVar v)
   = do name           <- lookupOccRn v
-       localRdrEnv    <- getLocalRdrEnv
-       lclEnv         <- getLclEnv
        ignore_asserts <- doptM Opt_IgnoreAsserts
-       ignore_breakpoints <- doptM Opt_IgnoreBreakpoints
-       ghcMode        <- getGhcMode
-       let conds = [ (name `hasKey` assertIdKey
-                      && not ignore_asserts,
-                      do (e, fvs) <- mkAssertErrorExpr
-                         return (e, fvs `addOneFV` name))
-                   ]
-       case lookup True conds of
-         Just action -> action
-         Nothing     -> return (HsVar name, unitFV name)
+       finish_var ignore_asserts name
+  where
+    finish_var ignore_asserts name
+	| ignore_asserts || not (name `hasKey` assertIdKey)
+	= return (HsVar name, unitFV name)
+  	| otherwise
+	= do { (e, fvs) <- mkAssertErrorExpr
+             ; return (e, fvs `addOneFV` name) }
 
 rnExpr (HsIPVar v)
   = newIPNameRn v		`thenM` \ name ->
     returnM (HsIPVar name, emptyFVs)
 
+rnExpr (HsLit lit@(HsString s))
+  = do {
+         opt_OverloadedStrings <- doptM Opt_OverloadedStrings
+       ; if opt_OverloadedStrings then
+            rnExpr (HsOverLit (mkHsIsString s))
+	 else -- Same as below
+	    rnLit lit		`thenM_`
+            returnM (HsLit lit, emptyFVs)
+       }
+
 rnExpr (HsLit lit) 
   = rnLit lit		`thenM_`
     returnM (HsLit lit, emptyFVs)
@@ -179,6 +184,9 @@ rnExpr (HsCoreAnn ann expr)
 rnExpr (HsSCC lbl expr)
   = rnLExpr expr	 	`thenM` \ (expr', fvs_expr) ->
     returnM (HsSCC lbl expr', fvs_expr)
+rnExpr (HsTickPragma info expr)
+  = rnLExpr expr	 	`thenM` \ (expr', fvs_expr) ->
+    returnM (HsTickPragma info expr', fvs_expr)
 
 rnExpr (HsLam matches)
   = rnMatchGroup LambdaExpr matches	`thenM` \ (matches', fvMatch) ->
@@ -215,16 +223,16 @@ rnExpr e@(ExplicitTuple exps boxity)
     tup_size   = length exps
     tycon_name = tupleTyCon_name boxity tup_size
 
-rnExpr (RecordCon con_id _ rbinds)
+rnExpr (RecordCon con_id _ (HsRecordBinds rbinds))
   = lookupLocatedOccRn con_id		`thenM` \ conname ->
     rnRbinds "construction" rbinds	`thenM` \ (rbinds', fvRbinds) ->
-    returnM (RecordCon conname noPostTcExpr rbinds', 
+    returnM (RecordCon conname noPostTcExpr (HsRecordBinds rbinds'), 
 	     fvRbinds `addOneFV` unLoc conname)
 
-rnExpr (RecordUpd expr rbinds _ _)
+rnExpr (RecordUpd expr (HsRecordBinds rbinds) _ _)
   = rnLExpr expr		`thenM` \ (expr', fvExpr) ->
     rnRbinds "update" rbinds	`thenM` \ (rbinds', fvRbinds) ->
-    returnM (RecordUpd expr' rbinds' placeHolderType placeHolderType, 
+    returnM (RecordUpd expr' (HsRecordBinds rbinds') placeHolderType placeHolderType, 
 	     fvExpr `plusFV` fvRbinds)
 
 rnExpr (ExprWithTySig expr pty)