X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsListComp.lhs;h=fc3a689773753c6eed02876255171c413e79c98a;hb=8fc898cb0b722e72c08dce3acadbc4b2aa2249ff;hp=713d026182069c5d82a3c3be4af4591e1f156024;hpb=538cf5105b079fa779b612c6154db2bb4febb586;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/DsListComp.lhs b/ghc/compiler/deSugar/DsListComp.lhs
index 713d026..fc3a689 100644
--- a/ghc/compiler/deSugar/DsListComp.lhs
+++ b/ghc/compiler/deSugar/DsListComp.lhs
@@ -11,7 +11,6 @@ module DsListComp ( dsListComp, dsPArrComp ) where
 import {-# SOURCE #-} DsExpr ( dsExpr, dsLet )
 
 import BasicTypes	( Boxity(..) )
-import TyCon		( tyConName )
 import HsSyn		( Pat(..), HsExpr(..), Stmt(..),
 			  HsMatchContext(..), HsStmtContext(..),
 			  collectHsBinders )
@@ -22,7 +21,7 @@ import CoreSyn
 import DsMonad		-- the monadery used in the desugarer
 import DsUtils
 
-import CmdLineOpts	( opt_IgnoreIfacePragmas, opt_RulesOff )
+import CmdLineOpts	( DynFlag(..), dopt, opt_RulesOff )
 import CoreUtils	( exprType, mkIfThenElse )
 import Id		( idType )
 import Var              ( Id )
@@ -30,10 +29,10 @@ import Type		( mkTyVarTy, mkFunTys, mkFunTy, Type,
 			  splitTyConApp_maybe )
 import TysPrim		( alphaTyVar )
 import TysWiredIn	( nilDataCon, consDataCon, trueDataConId, falseDataConId, 
-			  unitDataConId, unitTy, mkListTy )
+			  unitDataConId, unitTy, mkListTy, parrTyCon )
 import Match		( matchSimply )
 import PrelNames	( foldrName, buildName, replicatePName, mapPName, 
-			  filterPName, zipPName, crossPName, parrTyConName ) 
+			  filterPName, zipPName, crossPName ) 
 import PrelInfo		( pAT_ERROR_ID )
 import SrcLoc		( noSrcLoc )
 import Panic		( panic )
@@ -51,17 +50,19 @@ dsListComp :: [TypecheckedStmt]
 	   -> DsM CoreExpr
 
 dsListComp quals elt_ty
-  |  opt_RulesOff || opt_IgnoreIfacePragmas 	-- Either rules are switched off, or
-						--   we are ignoring what there are;
-						--   Either way foldr/build won't happen, so
-						--   use the more efficient Wadler-style desugaring
-  || isParallelComp quals			-- Foldr-style desugaring can't handle
-						--   parallel list comprehensions
-  = deListComp quals (mkNilExpr elt_ty)
-
-  | otherwise		-- Foldr/build should be enabled, so desugar 
-			-- into foldrs and builds
-  = newTyVarsDs [alphaTyVar]    `thenDs` \ [n_tyvar] ->
+  = getDOptsDs  `thenDs` \dflags ->
+    if opt_RulesOff || dopt Opt_IgnoreInterfacePragmas dflags
+	-- Either rules are switched off, or we are ignoring what there are;
+	-- Either way foldr/build won't happen, so use the more efficient
+	-- Wadler-style desugaring
+  	|| isParallelComp quals
+		-- Foldr-style desugaring can't handle
+		-- parallel list comprehensions
+  	then deListComp quals (mkNilExpr elt_ty)
+
+   else		-- Foldr/build should be enabled, so desugar 
+		-- into foldrs and builds
+    newTyVarsDs [alphaTyVar]    `thenDs` \ [n_tyvar] ->
     let
 	n_ty = mkTyVarTy n_tyvar
         c_ty = mkFunTys [elt_ty, n_ty] n_ty
@@ -145,7 +146,7 @@ with the Unboxed variety.
 deListComp :: [TypecheckedStmt] -> CoreExpr -> DsM CoreExpr
 
 deListComp (ParStmt stmtss_w_bndrs : quals) list
-  = mapDs do_list_comp stmtss_w_bndrs	`thenDs` \ exps ->
+  = mappM do_list_comp stmtss_w_bndrs	`thenDs` \ exps ->
     mkZipBind qual_tys			`thenDs` \ (zip_fn, zip_rhs) ->
 
 	-- Deal with [e | pat <- zip l1 .. ln] in example above
@@ -231,9 +232,9 @@ mkZipBind :: [Type] -> DsM (Id, CoreExpr)
 --				(a2:as'2) -> (a2,a2) : zip as'1 as'2)]
 
 mkZipBind elt_tys 
-  = mapDs newSysLocalDs  list_tys	`thenDs` \ ass ->
-    mapDs newSysLocalDs  elt_tys	`thenDs` \ as' ->
-    mapDs newSysLocalDs  list_tys	`thenDs` \ as's ->
+  = mappM newSysLocalDs  list_tys	`thenDs` \ ass ->
+    mappM newSysLocalDs  elt_tys	`thenDs` \ as' ->
+    mappM newSysLocalDs  list_tys	`thenDs` \ as's ->
     newSysLocalDs zip_fn_ty		`thenDs` \ zip_fn ->
     let 
 	inner_rhs = mkConsExpr ret_elt_ty 
@@ -471,7 +472,7 @@ deLambda ty p e  =
 parrElemType   :: CoreExpr -> Type
 parrElemType e  = 
   case splitTyConApp_maybe (exprType e) of
-    Just (tycon, [ty]) | tyConName tycon == parrTyConName -> ty
+    Just (tycon, [ty]) | tycon == parrTyCon -> ty
     _							  -> panic
       "DsListComp.parrElemType: not a parallel array type"
 \end{code}