import {-# SOURCE #-} DsExpr ( dsExpr, dsLet )
import BasicTypes ( Boxity(..) )
-import TyCon ( tyConName )
import HsSyn ( Pat(..), HsExpr(..), Stmt(..),
HsMatchContext(..), HsStmtContext(..),
collectHsBinders )
import DsMonad -- the monadery used in the desugarer
import DsUtils
-import CmdLineOpts ( opt_FoldrBuildOn )
+import CmdLineOpts ( DynFlag(..), dopt, opt_RulesOff )
import CoreUtils ( exprType, mkIfThenElse )
import Id ( idType )
import Var ( Id )
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 )
-> DsM CoreExpr
dsListComp quals elt_ty
- | not opt_FoldrBuildOn -- Be boring
- || isParallelComp quals
- = deListComp quals (mkNilExpr elt_ty)
-
- | otherwise -- foldr/build lives!
- = 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
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
-- (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
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}