Commit d46b38d8 authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au
Browse files

Optimise desugaring of parallel array comprehensions

parent b87a8ec2
......@@ -361,9 +361,8 @@ dsPArrComp :: [Stmt Id]
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
......@@ -396,6 +395,14 @@ dePArrComp (ExprStmt b _ _ : qs) body pa cea =
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
......@@ -413,7 +420,8 @@ dePArrComp (BindStmt p e _ _ : qs) body pa cea =
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,
_ ) ->
......
......@@ -184,7 +184,7 @@ basicKnownKeyNames
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,
......@@ -603,6 +603,7 @@ enumFromToPName = varQual gHC_PARR FSLIT("enumFromToP") enumFromToPIdKey
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
......@@ -975,6 +976,7 @@ breakpointAutoJumpIdKey = mkPreludeMiscIdUnique 67
inlineIdKey = mkPreludeMiscIdUnique 68
-- Parallel array functions
singletonPIdKey = mkPreludeMiscIdUnique 79
nullPIdKey = mkPreludeMiscIdUnique 80
lengthPIdKey = mkPreludeMiscIdUnique 81
replicatePIdKey = mkPreludeMiscIdUnique 82
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment