X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsListComp.lhs;h=bdbe65ee7e7a457b4c772d3735b5a4dcefe345cb;hb=4179e02ec7ec7aea79273cdcc166123c2ddd2063;hp=e5e1fd9472e23ef9e5cc452448dc095f109461b1;hpb=6febb616f1ff46942434e9df39c6e4977b07cc6f;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsListComp.lhs b/compiler/deSugar/DsListComp.lhs index e5e1fd9..bdbe65e 100644 --- a/compiler/deSugar/DsListComp.lhs +++ b/compiler/deSugar/DsListComp.lhs @@ -15,8 +15,6 @@ Desugaring list comprehensions and array comprehensions module DsListComp ( dsListComp, dsPArrComp ) where --- XXX This define is a bit of a hack, and should be done more nicely -#define FAST_STRING_NOT_NEEDED 1 #include "HsVersions.h" import {-# SOURCE #-} DsExpr ( dsLExpr, dsLocalBinds ) @@ -24,13 +22,14 @@ import {-# SOURCE #-} DsExpr ( dsLExpr, dsLocalBinds ) import HsSyn import TcHsSyn import CoreSyn +import MkCore import DsMonad -- the monadery used in the desugarer import DsUtils import DynFlags import CoreUtils -import Var +import Id import Type import TysWiredIn import Match @@ -57,7 +56,7 @@ dsListComp lquals body elt_ty = do dflags <- getDOptsDs let quals = map unLoc lquals - if not (dopt Opt_RewriteRules dflags) || dopt Opt_IgnoreInterfacePragmas dflags + if not (dopt Opt_EnableRewriteRules dflags) || 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 @@ -587,7 +586,7 @@ dePArrComp (LetStmt ds : qs) body pa cea = do v <- newSysLocalDs ty'cea clet <- dsLocalBinds ds (mkCoreTup (map Var xs)) let'v <- newSysLocalDs (exprType clet) - let projBody = mkDsLet (NonRec let'v clet) $ + let projBody = mkCoreLet (NonRec let'v clet) $ mkCoreTup [Var v, Var let'v] errTy = exprType projBody errMsg = "DsListComp.dePArrComp: internal error!"