add -fsimpleopt-before-flatten

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

diff --git a/compiler/deSugar/DsListComp.lhs b/compiler/deSugar/DsListComp.lhs
index 166bfc2..cd22b8f 100644 (file)
--- a/compiler/deSugar/DsListComp.lhs
+++ b/compiler/deSugar/DsListComp.lhs
@@ -92,12 +92,12 @@ dsInnerListComp (stmts, bndrs) = do
 -- Given such a statement it gives you back an expression representing how to compute the transformed
 -- list and the tuple that you need to bind from that list in order to proceed with your desugaring
 dsTransformStmt :: Stmt Id -> DsM (CoreExpr, LPat Id)
-dsTransformStmt (TransformStmt stmts binders usingExpr maybeByExpr) = do
-    (expr, binders_tuple_type) <- dsInnerListComp (stmts, binders)
-    usingExpr' <- dsLExpr usingExpr
+dsTransformStmt (TransformStmt stmts binders usingExpr maybeByExpr)
+ = do { (expr, binders_tuple_type) <- dsInnerListComp (stmts, binders)
+      ; usingExpr' <- dsLExpr usingExpr
     
-    using_args <- 
-        case maybeByExpr of
+      ; using_args <-
+          case maybeByExpr of
             Nothing -> return [expr]
             Just byExpr -> do
                 byExpr' <- dsLExpr byExpr
@@ -108,10 +108,9 @@ dsTransformStmt (TransformStmt stmts binders usingExpr maybeByExpr) = do
                 
                 return [Lam tuple_binder byExprWrapper, expr]
 
-    let inner_list_expr = mkApps usingExpr' ((Type binders_tuple_type) : using_args)
-    
-    let pat = mkBigLHsVarPatTup binders
-    return (inner_list_expr, pat)
+      ; let inner_list_expr = mkApps usingExpr' ((Type binders_tuple_type) : using_args)
+            pat = mkBigLHsVarPatTup binders
+      ; return (inner_list_expr, pat) }
     
 -- This function factors out commonality between the desugaring strategies for GroupStmt.
 -- Given such a statement it gives you back an expression representing how to compute the transformed
@@ -515,7 +514,7 @@ dsPArrComp [ParStmt qss] body _  =  -- parallel comprehension
 --    <<[:e' | qs:]>> p (filterP (\x -> case x of {p -> True; _ -> False}) e)
 --
 dsPArrComp (BindStmt p e _ _ : qs) body _ = do
-    filterP <- dsLookupGlobalId filterPName
+    filterP <- dsLookupDPHId filterPName
     ce <- dsLExpr e
     let ety'ce  = parrElemType ce
         false   = Var falseDataConId
@@ -527,7 +526,7 @@ dsPArrComp (BindStmt p e _ _ : qs) body _ = do
     dePArrComp qs body p gen
 
 dsPArrComp qs            body _  = do -- no ParStmt in `qs'
-    sglP <- dsLookupGlobalId singletonPName
+    sglP <- dsLookupDPHId singletonPName
     let unitArray = mkApps (Var sglP) [Type unitTy, mkCoreTup []]
     dePArrComp qs body (noLoc $ WildPat unitTy) unitArray
 
@@ -544,7 +543,7 @@ dePArrComp :: [Stmt Id]
 --  <<[:e' | :]>> pa ea = mapP (\pa -> e') ea
 --
 dePArrComp [] e' pa cea = do
-    mapP <- dsLookupGlobalId mapPName
+    mapP <- dsLookupDPHId mapPName
     let ty = parrElemType cea
     (clam, ty'e') <- deLambda ty pa e'
     return $ mkApps (Var mapP) [Type ty, Type ty'e', clam, cea]
@@ -552,7 +551,7 @@ dePArrComp [] e' pa cea = do
 --  <<[:e' | b, qs:]>> pa ea = <<[:e' | qs:]>> pa (filterP (\pa -> b) ea)
 --
 dePArrComp (ExprStmt b _ _ : qs) body pa cea = do
-    filterP <- dsLookupGlobalId filterPName
+    filterP <- dsLookupDPHId filterPName
     let ty = parrElemType cea
     (clam,_) <- deLambda ty pa b
     dePArrComp qs body pa (mkApps (Var filterP) [Type ty, clam, cea])
@@ -571,8 +570,8 @@ dePArrComp (ExprStmt b _ _ : qs) body pa cea = do
 --    <<[:e' | qs:]>> (pa, p) (crossMapP ea ef)
 --
 dePArrComp (BindStmt p e _ _ : qs) body pa cea = do
-    filterP <- dsLookupGlobalId filterPName
-    crossMapP <- dsLookupGlobalId crossMapPName
+    filterP <- dsLookupDPHId filterPName
+    crossMapP <- dsLookupDPHId crossMapPName
     ce <- dsLExpr e
     let ety'cea = parrElemType cea
         ety'ce  = parrElemType ce
@@ -596,7 +595,7 @@ dePArrComp (BindStmt p e _ _ : qs) body pa cea = do
 --    {x_1, ..., x_n} = DV (ds)                -- Defined Variables
 --
 dePArrComp (LetStmt ds : qs) body pa cea = do
-    mapP <- dsLookupGlobalId mapPName
+    mapP <- dsLookupDPHId mapPName
     let xs     = collectLocalBinders ds
         ty'cea = parrElemType cea
     v <- newSysLocalDs ty'cea
@@ -641,7 +640,7 @@ dePArrParComp qss body = do
     ---
     parStmts []             pa cea = return (pa, cea)
     parStmts ((qs, xs):qss) pa cea = do  -- subsequent statements (zip'ed)
-      zipP <- dsLookupGlobalId zipPName
+      zipP <- dsLookupDPHId zipPName
       let pa'      = mkLHsPatTup [pa, mkLHsVarPatTup xs]
           ty'cea   = parrElemType cea
           res_expr = mkLHsVarTuple xs