Make HsRecordBinds a data type instead of a synonym.

[ghc-hetmet.git] / compiler / rename / RnExpr.lhs

diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 261969b..bfd644f 100644 (file)
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -35,13 +35,7 @@ import SrcLoc           ( SrcSpan )
 import PrelNames       ( thFAKE, hasKey, assertIdKey, assertErrorName,
                          loopAName, choiceAName, appAName, arrAName, composeAName, firstAName,
                          negateName, thenMName, bindMName, failMName )
-#if defined(GHCI) && defined(BREAKPOINT)
-import PrelNames        ( breakpointJumpName, breakpointCondJumpName
-                        , undefined_RDR, breakpointIdKey, breakpointCondIdKey )
-import UniqFM           ( eltsUFM )
-import DynFlags         ( GhcMode(..) )
-import Name             ( isTyVarName )
-#endif
+
 import Name            ( Name, nameOccName, nameIsLocalOrFrom )
 import NameSet
 import RdrName         ( RdrName, extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals )
@@ -106,22 +100,6 @@ rnExpr (HsVar v)
                       && not ignore_asserts,
                       do (e, fvs) <- mkAssertErrorExpr
                          return (e, fvs `addOneFV` name))
-#if defined(GHCI) && defined(BREAKPOINT)
-                   , (name `hasKey` breakpointIdKey
-                      && not ignore_breakpoints
-                      && ghcMode == Interactive,
-                         do let isWantedName = not.isTyVarName
-                            (e, fvs) <- mkBreakpointExpr (filter isWantedName (eltsUFM localRdrEnv))
-                            return (e, fvs `addOneFV` name)
-                     )
-                   , (name `hasKey` breakpointCondIdKey
-                      && not ignore_breakpoints
-                      && ghcMode == Interactive,
-                         do let isWantedName = not.isTyVarName
-                            (e, fvs) <- mkBreakpointCondExpr (filter isWantedName (eltsUFM localRdrEnv))
-                            return (e, fvs `addOneFV` name)
-                     )
-#endif
                    ]
        case lookup True conds of
          Just action -> action
@@ -131,6 +109,16 @@ 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)
@@ -201,6 +189,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) ->
@@ -237,16 +228,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)
@@ -581,7 +572,7 @@ rnBracket (DecBr group)
        ; let new_occs = map nameOccName names
              trimmed_rdr_env = hideSomeUnquals (tcg_rdr_env gbl_env) new_occs
 
-       ; rdr_env' <- extendRdrEnvRn trimmed_rdr_env names
+       ; rdr_env' <- extendRdrEnvRn trimmed_rdr_env avails
        -- In this situation we want to *shadow* top-level bindings.
        --      foo = 1
        --      bar = [d| foo = 1|]
@@ -945,48 +936,14 @@ segsToStmts ((defs, uses, fwds, ss) : segs) fvs_later
 
 %************************************************************************
 %*                                                                     *
-\subsubsection{breakpoint utils}
+\subsubsection{Assertion utils}
 %*                                                                     *
 %************************************************************************
 
 \begin{code}
-#if defined(GHCI) && defined(BREAKPOINT)
-mkBreakpointExpr :: [Name] -> RnM (HsExpr Name, FreeVars)
-mkBreakpointExpr = mkBreakpointExpr' breakpointJumpName
-
-mkBreakpointCondExpr :: [Name] -> RnM (HsExpr Name, FreeVars)
-mkBreakpointCondExpr = mkBreakpointExpr' breakpointCondJumpName
-
-mkBreakpointExpr' :: Name -> [Name] -> RnM (HsExpr Name, FreeVars)
-mkBreakpointExpr' breakpointFunc scope
-    = do sloc <- getSrcSpanM
-         undef <- lookupOccRn undefined_RDR
-         let inLoc = L sloc
-             lHsApp x y = inLoc (HsApp x y)
-             mkExpr fnName args = mkExpr' fnName (reverse args)
-             mkExpr' fnName [] = inLoc (HsVar fnName)
-             mkExpr' fnName (arg:args)
-                 = lHsApp (mkExpr' fnName args) (inLoc arg)
-             expr = unLoc $ mkExpr breakpointFunc [mkScopeArg scope, HsVar undef, msg]
-             mkScopeArg args = unLoc $ mkExpr undef (map HsVar args)
-             msg = srcSpanLit sloc
-         return (expr, emptyFVs)
-
-srcSpanLit :: SrcSpan -> HsExpr Name
-srcSpanLit span = HsLit (HsString (mkFastString (showSDoc (ppr span))))
-#endif
-
 srcSpanPrimLit :: SrcSpan -> HsExpr Name
 srcSpanPrimLit span = HsLit (HsStringPrim (mkFastString (showSDoc (ppr span))))
-\end{code}
 
-%************************************************************************
-%*                                                                     *
-\subsubsection{Assertion utils}
-%*                                                                     *
-%************************************************************************
-
-\begin{code}
 mkAssertErrorExpr :: RnM (HsExpr Name, FreeVars)
 -- Return an expression for (assertError "Foo.hs:27")
 mkAssertErrorExpr
@@ -1015,3 +972,5 @@ badIpBinds what binds
   = hang (ptext SLIT("Implicit-parameter bindings illegal in") <+> what)
         2 (ppr binds)
 \end{code}
+
+