X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsExpr.lhs;h=d09196d33b21f8fe3bed050a534d632da6f1442f;hb=fd1375dd261725eb00969a3017b924369c09835c;hp=f5df3ed225042d3533440093de37a4c38688a79d;hpb=90dc9026b091be5cca5da4c6cbd3713ecc493361;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index f5df3ed..d09196d 100644
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -22,11 +22,8 @@ import DsMonad
 
 #ifdef GHCI
 import PrelNames
-import DsBreakpoint
 	-- Template Haskell stuff iff bootstrapped
 import DsMeta
-#else
-import DsBreakpoint
 #endif
 
 import HsSyn
@@ -187,17 +184,6 @@ scrungleMatch var scrut body
 \begin{code}
 dsLExpr :: LHsExpr Id -> DsM CoreExpr
 
-#if defined(GHCI)
-dsLExpr (L loc expr@(HsWrap w (HsVar v)))
-    | idName v `elem` [breakpointName, breakpointCondName, breakpointAutoName]
-    = do areBreakpointsEnabled <- breakpoints_enabled
-         if areBreakpointsEnabled
-           then do
-              L _ breakpointExpr <- mkBreakpointExpr loc v
-              dsLExpr (L loc $ HsWrap w breakpointExpr)
-           else putSrcSpanDs loc $ dsExpr expr
-#endif
-
 dsLExpr (L loc e) = putSrcSpanDs loc $ dsExpr e
 
 dsExpr :: HsExpr Id -> DsM CoreExpr
@@ -221,7 +207,7 @@ dsExpr expr@(HsLam a_Match)
 dsExpr expr@(HsApp fun arg)      
   = dsLExpr fun		`thenDs` \ core_fun ->
     dsLExpr arg		`thenDs` \ core_arg ->
-    returnDs (core_fun `App` core_arg)
+    returnDs (core_fun `mkDsApp` core_arg)
 \end{code}
 
 Operator sections.  At first it looks as if we can convert
@@ -251,12 +237,12 @@ dsExpr (OpApp e1 op _ e2)
     -- for the type of y, we need the type of op's 2nd argument
     dsLExpr e1				`thenDs` \ x_core ->
     dsLExpr e2				`thenDs` \ y_core ->
-    returnDs (mkApps core_op [x_core, y_core])
+    returnDs (mkDsApps core_op [x_core, y_core])
     
 dsExpr (SectionL expr op)	-- Desugar (e !) to ((!) e)
   = dsLExpr op				`thenDs` \ core_op ->
     dsLExpr expr			`thenDs` \ x_core ->
-    returnDs (App core_op x_core)
+    returnDs (mkDsApp core_op x_core)
 
 -- dsLExpr (SectionR op expr)	-- \ x -> op x expr
 dsExpr (SectionR op expr)
@@ -271,7 +257,7 @@ dsExpr (SectionR op expr)
     newSysLocalDs y_ty			`thenDs` \ y_id ->
 
     returnDs (bindNonRec y_id y_core $
-	      Lam x_id (mkApps core_op [Var x_id, Var y_id]))
+	      Lam x_id (mkDsApps core_op [Var x_id, Var y_id]))
 
 dsExpr (HsSCC cc expr)
   = dsLExpr expr			`thenDs` \ core_expr ->
@@ -294,7 +280,7 @@ dsExpr (HsCase discrim matches)
 --       This is to avoid silliness in breakpoints
 dsExpr (HsLet binds body)
   = (bindLocalsDs (map unLoc $ collectLocalBinders binds) $ 
-     dsAndThenMaybeInsertBreakpoint body) `thenDs` \ body' ->
+     dsLExpr body) `thenDs` \ body' ->
     dsLocalBinds binds body'
 
 -- We need the `ListComp' form to use `deListComp' (rather than the "do" form)
@@ -423,7 +409,7 @@ We also handle @C{}@ as valid construction syntax for an unlabelled
 constructor @C@, setting all of @C@'s fields to bottom.
 
 \begin{code}
-dsExpr (RecordCon (L _ data_con_id) con_expr rbinds)
+dsExpr (RecordCon (L _ data_con_id) con_expr (HsRecordBinds rbinds))
   = dsExpr con_expr	`thenDs` \ con_expr' ->
     let
 	(arg_tys, _) = tcSplitFunTys (exprType con_expr')
@@ -471,10 +457,10 @@ might do some argument-evaluation first; and may have to throw away some
 dictionaries.
 
 \begin{code}
-dsExpr (RecordUpd record_expr [] record_in_ty record_out_ty)
+dsExpr (RecordUpd record_expr (HsRecordBinds []) record_in_ty record_out_ty)
   = dsLExpr record_expr
 
-dsExpr expr@(RecordUpd record_expr rbinds record_in_ty record_out_ty)
+dsExpr expr@(RecordUpd record_expr (HsRecordBinds rbinds) record_in_ty record_out_ty)
   = dsLExpr record_expr	 	`thenDs` \ record_expr' ->
 
 	-- Desugar the rbinds, and generate let-bindings if
@@ -596,10 +582,10 @@ dsDo	:: [LStmt Id]
 dsDo stmts body result_ty
   = go (map unLoc stmts)
   where
-    go [] = dsAndThenMaybeInsertBreakpoint body
+    go [] = dsLExpr body
     
     go (ExprStmt rhs then_expr _ : stmts)
-      = do { rhs2 <- dsAndThenMaybeInsertBreakpoint rhs
+      = do { rhs2 <- dsLExpr rhs
 	   ; then_expr2 <- dsExpr then_expr
 	   ; rest <- go stmts
 	   ; returnDs (mkApps then_expr2 [rhs2, rest]) }
@@ -619,7 +605,7 @@ dsDo stmts body result_ty
 	   ; match <- matchSinglePat (Var var) (StmtCtxt DoExpr) pat
     				  result_ty (cantFailMatchResult body)
 	   ; match_code <- handle_failure pat match fail_op
-           ; rhs'       <- dsAndThenMaybeInsertBreakpoint rhs
+           ; rhs'       <- dsLExpr rhs
 	   ; bind_op'   <- dsExpr bind_op
 	   ; returnDs (mkApps bind_op' [rhs', Lam var match_code]) }
     
@@ -669,7 +655,7 @@ dsMDo tbl stmts body result_ty
 	   ; dsLocalBinds binds rest }
 
     go (ExprStmt rhs _ rhs_ty : stmts)
-      = do { rhs2 <- dsAndThenMaybeInsertBreakpoint rhs
+      = do { rhs2 <- dsLExpr rhs
 	   ; rest <- go stmts
 	   ; returnDs (mkApps (Var then_id) [Type rhs_ty, Type b_ty, rhs2, rest]) }
     
@@ -682,7 +668,7 @@ dsMDo tbl stmts body result_ty
 	   ; let fail_expr = mkApps (Var fail_id) [Type b_ty, fail_msg]
 	   ; match_code <- extractMatchResult match fail_expr
 
-	   ; rhs'       <- dsAndThenMaybeInsertBreakpoint rhs
+	   ; rhs'       <- dsLExpr rhs
 	   ; returnDs (mkApps (Var bind_id) [Type (hsLPatType pat), Type b_ty, 
 					     rhs', Lam var match_code]) }