From: sof <unknown>
Date: Thu, 5 Jun 1997 21:05:37 +0000 (+0000)
Subject: [project @ 1997-06-05 21:04:15 by sof]
X-Git-Tag: Approximately_1000_patches_recorded~370
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=e1c9eb13721d36b5e1875ecbd455d411e9dff52f;p=ghc-hetmet.git

[project @ 1997-06-05 21:04:15 by sof]
extra arg to dsBinds
---

diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index 32a0471..49329ab 100644
--- a/ghc/compiler/deSugar/DsExpr.lhs
+++ b/ghc/compiler/deSugar/DsExpr.lhs
@@ -9,7 +9,11 @@
 module DsExpr ( dsExpr ) where
 
 IMP_Ubiq()
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
 IMPORT_DELOOPER(DsLoop)		-- partly to get dsBinds, partly to chk dsExpr
+#else
+import {-# SOURCE #-} DsBinds (dsBinds )
+#endif
 
 import HsSyn		( failureFreePat,
 			  HsExpr(..), OutPat(..), HsLit(..), ArithSeqInfo(..),
@@ -262,8 +266,8 @@ dsExpr expr@(HsCase discrim matches src_loc)
     returnDs ( mkCoLetAny (NonRec discrim_var core_discrim) matching_code )
 
 dsExpr (HsLet binds expr)
-  = dsBinds binds	`thenDs` \ core_binds ->
-    dsExpr expr		`thenDs` \ core_expr ->
+  = dsBinds Nothing binds   `thenDs` \ core_binds ->
+    dsExpr expr		    `thenDs` \ core_expr ->
     returnDs ( mkCoLetsAny core_binds core_expr )
 
 dsExpr (HsDoOut do_or_lc stmts return_id then_id zero_id result_ty src_loc)
@@ -650,8 +654,8 @@ dsDo do_or_lc stmts return_id then_id zero_id result_ty
 				   VarArg (mkValLam [ignored_result_id] rest)]
     
 	go (LetStmt binds : stmts )
-	  = dsBinds binds	`thenDs` \ binds2 ->
-	    go stmts 		`thenDs` \ rest   ->
+	  = dsBinds Nothing binds `thenDs` \ binds2 ->
+	    go stmts 		  `thenDs` \ rest   ->
 	    returnDs (mkCoLetsAny binds2 rest)
     
 	go (BindStmt pat expr locn : stmts)
diff --git a/ghc/compiler/deSugar/DsGRHSs.lhs b/ghc/compiler/deSugar/DsGRHSs.lhs
index 8dcf96d..bf670d5 100644
--- a/ghc/compiler/deSugar/DsGRHSs.lhs
+++ b/ghc/compiler/deSugar/DsGRHSs.lhs
@@ -9,7 +9,13 @@
 module DsGRHSs ( dsGuarded, dsGRHSs ) where
 
 IMP_Ubiq()
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
 IMPORT_DELOOPER(DsLoop)		-- break dsExpr/dsBinds-ish loop
+#else
+import {-# SOURCE #-} DsExpr  ( dsExpr )
+import {-# SOURCE #-} DsBinds ( dsBinds )
+import {-# SOURCE #-} Match   ( match )
+#endif
 
 import HsSyn		( GRHSsAndBinds(..), GRHS(..),
 			  HsExpr(..), HsBinds, Stmt(..), 
@@ -53,7 +59,7 @@ dsGuarded :: TypecheckedGRHSsAndBinds
 	  -> DsM CoreExpr
 
 dsGuarded (GRHSsAndBindsOut grhss binds err_ty)
-  = dsBinds binds				`thenDs` \ core_binds ->
+  = dsBinds Nothing binds			`thenDs` \ core_binds ->
     dsGRHSs err_ty PatBindMatch [] grhss 	`thenDs` \ (MatchResult can_it_fail _ core_grhss_fn _) ->
     case can_it_fail of
 	CantFail -> returnDs (mkCoLetsAny core_binds (core_grhss_fn (panic "It can't fail")))
@@ -133,7 +139,7 @@ matchGuard (GuardStmt expr _ : stmts) body_result
 
 matchGuard (LetStmt binds : stmts) body_result
   = matchGuard stmts body_result	`thenDs` \ match_result ->
-    dsBinds binds			`thenDs` \ core_binds ->
+    dsBinds Nothing binds		`thenDs` \ core_binds ->
     returnDs (mkCoLetsMatchResult core_binds match_result)
 
 matchGuard (BindStmt pat rhs _ : stmts) body_result
diff --git a/ghc/compiler/deSugar/DsListComp.lhs b/ghc/compiler/deSugar/DsListComp.lhs
index 2730867..5f55784 100644
--- a/ghc/compiler/deSugar/DsListComp.lhs
+++ b/ghc/compiler/deSugar/DsListComp.lhs
@@ -9,7 +9,12 @@
 module DsListComp ( dsListComp ) where
 
 IMP_Ubiq()
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
 IMPORT_DELOOPER(DsLoop)		-- break dsExpr-ish loop
+#else
+import {-# SOURCE #-} DsExpr ( dsExpr )
+import {-# SOURCE #-} DsBinds ( dsBinds )
+#endif
 
 import HsSyn		( Stmt(..), HsExpr, HsBinds )
 import TcHsSyn		( SYN_IE(TypecheckedStmt), SYN_IE(TypecheckedHsExpr) , SYN_IE(TypecheckedHsBinds) )
@@ -127,7 +132,7 @@ deListComp (GuardStmt guard locn : quals) list	-- rule B above
 
 -- [e | let B, qs] = let B in [e | qs]
 deListComp (LetStmt binds : quals) list
-  = dsBinds binds		`thenDs` \ core_binds ->
+  = dsBinds Nothing binds	`thenDs` \ core_binds ->
     deListComp quals list	`thenDs` \ core_rest ->
     returnDs (mkCoLetsAny core_binds core_rest)
 
@@ -195,7 +200,7 @@ dfListComp c_ty c_id n_ty n_id (GuardStmt guard locn  : quals)
 
 dfListComp c_ty c_id n_ty n_id (LetStmt binds : quals)
   -- new in 1.3, local bindings
-  = dsBinds binds                         `thenDs` \ core_binds ->
+  = dsBinds Nothing binds                 `thenDs` \ core_binds ->
     dfListComp c_ty c_id n_ty n_id quals  `thenDs` \ core_rest ->
     returnDs (mkCoLetsAny core_binds core_rest)