Skip to content
Snippets Groups Projects
Commit e1c9eb13 authored by sof's avatar sof
Browse files

[project @ 1997-06-05 21:04:15 by sof]

extra arg to dsBinds
parent 15d05cf3
No related merge requests found
......@@ -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)
......
......@@ -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
......
......@@ -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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment