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,
_ ) ->
zipName, foldrName, buildName, augmentName, appendName,
-- Parallel array operations
- nullPName, lengthPName, replicatePName, mapPName,
+ nullPName, lengthPName, replicatePName, singletonPName, mapPName,
filterPName, zipPName, crossMapPName, indexPName,
toPName, bpermutePName, bpermuteDftPName, indexOfPName,
enumFromThenToPName= varQual gHC_PARR FSLIT("enumFromThenToP") enumFromThenToPIdKey
nullPName = varQual gHC_PARR FSLIT("nullP") nullPIdKey
lengthPName = varQual gHC_PARR FSLIT("lengthP") lengthPIdKey
+singletonPName = varQual gHC_PARR FSLIT("singletonP") singletonPIdKey
replicatePName = varQual gHC_PARR FSLIT("replicateP") replicatePIdKey
mapPName = varQual gHC_PARR FSLIT("mapP") mapPIdKey
filterPName = varQual gHC_PARR FSLIT("filterP") filterPIdKey
inlineIdKey = mkPreludeMiscIdUnique 68
-- Parallel array functions
+singletonPIdKey = mkPreludeMiscIdUnique 79
nullPIdKey = mkPreludeMiscIdUnique 80
lengthPIdKey = mkPreludeMiscIdUnique 81
replicatePIdKey = mkPreludeMiscIdUnique 82