From e1c9eb13721d36b5e1875ecbd455d411e9dff52f Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Thu, 5 Jun 1997 21:05:37 +0000
Subject: [PATCH] [project @ 1997-06-05 21:04:15 by sof] extra arg to dsBinds
---
ghc/compiler/deSugar/DsExpr.lhs | 12 ++++++++----
ghc/compiler/deSugar/DsGRHSs.lhs | 10 ++++++++--
ghc/compiler/deSugar/DsListComp.lhs | 9 +++++++--
3 files changed, 23 insertions(+), 8 deletions(-)
diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index 32a047128df0..49329ab8c9c0 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 8dcf96d0cb4f..bf670d59b5e6 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 2730867d008b..5f55784bd3cd 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)
--
GitLab