[project @ 1998-08-14 12:09:33 by sof]

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

diff --git a/ghc/compiler/deSugar/DsListComp.lhs b/ghc/compiler/deSugar/DsListComp.lhs
index bec2c8a..5644096 100644 (file)
--- a/ghc/compiler/deSugar/DsListComp.lhs
+++ b/ghc/compiler/deSugar/DsListComp.lhs
@@ -4,15 +4,15 @@
 \section[DsListComp]{Desugaring list comprehensions}
 
 \begin{code}
-#include "HsVersions.h"
-
 module DsListComp ( dsListComp ) where
 
-IMP_Ubiq()
-IMPORT_DELOOPER(DsLoop)                -- break dsExpr-ish loop
+#include "HsVersions.h"
+
+import {-# SOURCE #-} DsExpr ( dsExpr )
+import {-# SOURCE #-} DsBinds ( dsBinds )
 
 import HsSyn           ( Stmt(..), HsExpr, HsBinds )
-import TcHsSyn         ( SYN_IE(TypecheckedStmt), SYN_IE(TypecheckedHsExpr) , SYN_IE(TypecheckedHsBinds) )
+import TcHsSyn         ( TypecheckedStmt, TypecheckedHsExpr , TypecheckedHsBinds )
 import DsHsSyn         ( outPatType )
 import CoreSyn
 
@@ -21,8 +21,9 @@ import DsUtils
 
 import CmdLineOpts     ( opt_FoldrBuildOn )
 import CoreUtils       ( coreExprType, mkCoreIfThenElse )
+import Id               ( Id )
 import PrelVals                ( mkBuild, foldrId )
-import Type            ( mkTyVarTy, mkForAllTy, mkFunTys, mkFunTy )
+import Type            ( mkTyVarTy, mkForAllTy, mkFunTys, mkFunTy, Type )
 import TysPrim         ( alphaTy )
 import TysWiredIn      ( nilDataCon, consDataCon, listTyCon )
 import TyVar           ( alphaTyVar )
@@ -66,7 +67,7 @@ dsListComp quals elt_ty
 
     returnDs (mkBuild elt_ty n_tyvar c n g result)
   where
-    nil_expr    = mkCon nilDataCon [] [elt_ty] []
+    nil_expr    = mkCon nilDataCon [elt_ty] []
 \end{code}
 
 %************************************************************************
@@ -126,8 +127,8 @@ 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 ->
-    deListComp quals list      `thenDs` \ core_rest ->
+  = dsBinds False{-don't auto scc-} binds       `thenDs` \ core_binds ->
+    deListComp quals list                      `thenDs` \ core_rest ->
     returnDs (mkCoLetsAny core_binds core_rest)
 
 deListComp (BindStmt pat list1 locn : quals) core_list2 -- rule A' above
@@ -146,7 +147,7 @@ deListComp (BindStmt pat list1 locn : quals) core_list2 -- rule A' above
     -- the "fail" value ...
     mkAppDs (Var h) [VarArg (Var u3)]          `thenDs` \ core_fail ->
     deListComp quals core_fail                 `thenDs` \ rest_expr ->
-    matchSimply (Var u2) pat res_ty 
+    matchSimply (Var u2) ListCompMatch pat res_ty 
                rest_expr core_fail             `thenDs` \ core_match ->
     mkAppDs (Var h) [VarArg core_list1]                `thenDs` \ letrec_body ->
 
@@ -194,8 +195,8 @@ 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 ->
-    dfListComp c_ty c_id n_ty n_id quals  `thenDs` \ core_rest ->
+  = dsBinds False{-don't auto scc-} binds        `thenDs` \ core_binds ->
+    dfListComp c_ty c_id n_ty n_id quals        `thenDs` \ core_rest ->
     returnDs (mkCoLetsAny core_binds core_rest)
 
 dfListComp c_ty c_id n_ty n_id (BindStmt pat list1 locn : quals)
@@ -219,7 +220,7 @@ dfListComp c_ty c_id n_ty n_id (BindStmt pat list1 locn : quals)
     dfListComp c_ty c_id b_ty b quals                  `thenDs` \ core_rest ->
     -- build the pattern match
 
-    matchSimply (Var p) pat b_ty core_rest (Var b)     `thenDs` \ core_expr ->
+    matchSimply (Var p) ListCompMatch pat b_ty core_rest (Var b)       `thenDs` \ core_expr ->
 
     -- now build the outermost foldr, and return