Desugaring list comprehensions and array comprehensions
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module DsListComp ( dsListComp, dsPArrComp ) where
#include "HsVersions.h"
import DsUtils
import DynFlags
-import StaticFlags
import CoreUtils
import Var
import Type
let
quals = map unLoc lquals
in
- if opt_RulesOff || dopt Opt_IgnoreInterfacePragmas dflags
+ if not (dopt Opt_RewriteRules 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
dsPArrComp [ParStmt qss] body _ = -- parallel comprehension
dePArrParComp qss body
dsPArrComp qs body _ = -- no ParStmt in `qs'
- dsLookupGlobalId replicatePName `thenDs` \repP ->
- let unitArray = mkApps (Var repP) [Type unitTy,
- mkIntExpr 1,
+ dsLookupGlobalId singletonPName `thenDs` \sglP ->
+ let unitArray = mkApps (Var sglP) [Type unitTy,
mkCoreTup []]
in
dePArrComp qs body (mkTuplePat []) unitArray
in
deLambda ty pa b `thenDs` \(clam,_) ->
dePArrComp qs body pa (mkApps (Var filterP) [Type ty, clam, cea])
+
+--
+-- <<[:e' | p <- e, qs:]>> pa ea =
+-- let ef = \pa -> e
+-- in
+-- <<[:e' | qs:]>> (pa, p) (crossMap ea ef)
+--
+-- if matching again p cannot fail, or else
--
-- <<[:e' | p <- e, qs:]>> pa ea =
-- let ef = \pa -> filterP (\x -> case x of {p -> True; _ -> False}) e
in
newSysLocalDs ety'ce `thenDs` \v ->
matchSimply (Var v) (StmtCtxt PArrComp) p true false `thenDs` \pred ->
- let cef = mkApps (Var filterP) [Type ety'ce, mkLams [v] pred, ce]
+ let cef | isIrrefutableHsPat p = ce
+ | otherwise = mkApps (Var filterP) [Type ety'ce, mkLams [v] pred, ce]
in
mkLambda ety'cea pa cef `thenDs` \(clam,
_ ) ->