[project @ 2003-02-19 13:05:45 by simonpj]

[ghc-hetmet.git] / ghc / compiler / deSugar / DsListComp.lhs

diff --git a/ghc/compiler/deSugar/DsListComp.lhs b/ghc/compiler/deSugar/DsListComp.lhs
index ee25c8b..9824aa3 100644 (file)
--- a/ghc/compiler/deSugar/DsListComp.lhs
+++ b/ghc/compiler/deSugar/DsListComp.lhs
@@ -13,7 +13,7 @@ import {-# SOURCE #-} DsExpr ( dsExpr, dsLet )
 import BasicTypes      ( Boxity(..) )
 import TyCon           ( tyConName )
 import HsSyn           ( Pat(..), HsExpr(..), Stmt(..),
-                         HsMatchContext(..), HsDoContext(..),
+                         HsMatchContext(..), HsStmtContext(..),
                          collectHsBinders )
 import TcHsSyn         ( TypecheckedStmt, TypecheckedPat, TypecheckedHsExpr,
                          hsPatType )
@@ -29,12 +29,12 @@ import Var              ( Id )
 import Type            ( mkTyVarTy, mkFunTys, mkFunTy, Type,
                          splitTyConApp_maybe )
 import TysPrim         ( alphaTyVar )
-import TysWiredIn      ( nilDataCon, consDataCon, unitDataConId, unitTy,
+import TysWiredIn      ( nilDataCon, consDataCon, trueDataConId, falseDataConId, 
+                         unitDataConId, unitTy,
                          mkListTy, mkTupleTy )
 import Match           ( matchSimply )
-import PrelNames       ( trueDataConName, falseDataConName, foldrName,
-                         buildName, replicatePName, mapPName, filterPName,
-                         zipPName, crossPName, parrTyConName ) 
+import PrelNames       ( foldrName, buildName, replicatePName, mapPName, 
+                         filterPName, zipPName, crossPName, parrTyConName ) 
 import PrelInfo                ( pAT_ERROR_ID )
 import SrcLoc          ( noSrcLoc )
 import Panic           ( panic )
@@ -202,7 +202,7 @@ deBindComp pat core_list1 quals core_list2
        letrec_body = App (Var h) core_list1
     in
     deListComp quals core_fail                 `thenDs` \ rest_expr ->
-    matchSimply (Var u2) (DoCtxt ListComp) pat
+    matchSimply (Var u2) (StmtCtxt ListComp) pat
                rest_expr core_fail             `thenDs` \ core_match ->
     let
        rhs = Lam u1 $
@@ -315,7 +315,7 @@ dfListComp c_id n_id (BindStmt pat list1 locn : quals)
     dfListComp c_id b quals                    `thenDs` \ core_rest ->
 
     -- build the pattern match
-    matchSimply (Var x) (DoCtxt ListComp) 
+    matchSimply (Var x) (StmtCtxt ListComp) 
                pat core_rest (Var b)           `thenDs` \ core_expr ->
 
     -- now build the outermost foldr, and return
@@ -384,18 +384,16 @@ dePArrComp (ExprStmt b _ _ : qs) pa cea =
 --    <<[:e' | qs:]>> (pa, p) (crossP ea ef)
 --
 dePArrComp (BindStmt p e _ : qs) pa cea =
-  dsLookupGlobalId falseDataConName                      `thenDs` \falseId ->
-  dsLookupGlobalId trueDataConName                       `thenDs` \trueId ->
   dsLookupGlobalId filterPName                   `thenDs` \filterP ->
   dsLookupGlobalId crossPName                    `thenDs` \crossP  ->
-  dsExpr e                                               `thenDs` \ce      ->
+  dsExpr e                                       `thenDs` \ce      ->
   let ty'cea = parrElemType cea
       ty'ce  = parrElemType ce
-      false  = Var falseId
-      true   = Var trueId
+      false  = Var falseDataConId
+      true   = Var trueDataConId
   in
   newSysLocalDs ty'ce                                    `thenDs` \v       ->
-  matchSimply (Var v) (DoCtxt PArrComp) p true false      `thenDs` \pred    ->
+  matchSimply (Var v) (StmtCtxt PArrComp) p true false      `thenDs` \pred    ->
   let cef    = mkApps (Var filterP) [Type ty'ce, mkLams [v] pred, ce]
       ty'cef = ty'ce                           -- filterP preserves the type
       pa'    = TuplePat [pa, p] Boxed
@@ -421,7 +419,7 @@ dePArrComp (LetStmt ds : qs) pa cea =
       errMsg   = "DsListComp.dePArrComp: internal error!"
   in
   mkErrorAppDs pAT_ERROR_ID errTy errMsg                  `thenDs` \cerr    ->
-  matchSimply (Var v) (DoCtxt PArrComp) pa projBody cerr  `thenDs` \ccase   ->
+  matchSimply (Var v) (StmtCtxt PArrComp) pa projBody cerr  `thenDs` \ccase   ->
   let pa'    = TuplePat [pa, TuplePat (map VarPat xs) Boxed] Boxed
       proj   = mkLams [v] ccase
   in
@@ -459,7 +457,7 @@ deLambda ty p e  =
       errMsg   = "DsListComp.deLambda: internal error!"
   in
   mkErrorAppDs pAT_ERROR_ID errTy errMsg                  `thenDs` \cerr    ->
-  matchSimply (Var v) (DoCtxt PArrComp) p ce cerr        `thenDs` \res     ->
+  matchSimply (Var v) (StmtCtxt PArrComp) p ce cerr      `thenDs` \res     ->
   returnDs (mkLams [v] res, errTy)
 
 -- obtain the element type of the parallel array produced by the given Core