-- Given such a statement it gives you back an expression representing how to compute the transformed
-- list and the tuple that you need to bind from that list in order to proceed with your desugaring
dsTransformStmt :: Stmt Id -> DsM (CoreExpr, LPat Id)
-dsTransformStmt (TransformStmt stmts binders usingExpr maybeByExpr) = do
- (expr, binders_tuple_type) <- dsInnerListComp (stmts, binders)
- usingExpr' <- dsLExpr usingExpr
+dsTransformStmt (TransformStmt stmts binders usingExpr maybeByExpr)
+ = do { (expr, binders_tuple_type) <- dsInnerListComp (stmts, binders)
+ ; usingExpr' <- dsLExpr usingExpr
- using_args <-
- case maybeByExpr of
+ ; using_args <-
+ case maybeByExpr of
Nothing -> return [expr]
Just byExpr -> do
byExpr' <- dsLExpr byExpr
return [Lam tuple_binder byExprWrapper, expr]
- let inner_list_expr = mkApps usingExpr' ((Type binders_tuple_type) : using_args)
-
- let pat = mkBigLHsVarPatTup binders
- return (inner_list_expr, pat)
+ ; let inner_list_expr = mkApps usingExpr' ((Type binders_tuple_type) : using_args)
+ pat = mkBigLHsVarPatTup binders
+ ; return (inner_list_expr, pat) }
-- This function factors out commonality between the desugaring strategies for GroupStmt.
-- Given such a statement it gives you back an expression representing how to compute the transformed
-- <<[:e' | qs:]>> p (filterP (\x -> case x of {p -> True; _ -> False}) e)
--
dsPArrComp (BindStmt p e _ _ : qs) body _ = do
- filterP <- dsLookupGlobalId filterPName
+ filterP <- dsLookupDPHId filterPName
ce <- dsLExpr e
let ety'ce = parrElemType ce
false = Var falseDataConId
dePArrComp qs body p gen
dsPArrComp qs body _ = do -- no ParStmt in `qs'
- sglP <- dsLookupGlobalId singletonPName
+ sglP <- dsLookupDPHId singletonPName
let unitArray = mkApps (Var sglP) [Type unitTy, mkCoreTup []]
dePArrComp qs body (noLoc $ WildPat unitTy) unitArray
-- <<[:e' | :]>> pa ea = mapP (\pa -> e') ea
--
dePArrComp [] e' pa cea = do
- mapP <- dsLookupGlobalId mapPName
+ mapP <- dsLookupDPHId mapPName
let ty = parrElemType cea
(clam, ty'e') <- deLambda ty pa e'
return $ mkApps (Var mapP) [Type ty, Type ty'e', clam, cea]
-- <<[:e' | b, qs:]>> pa ea = <<[:e' | qs:]>> pa (filterP (\pa -> b) ea)
--
dePArrComp (ExprStmt b _ _ : qs) body pa cea = do
- filterP <- dsLookupGlobalId filterPName
+ filterP <- dsLookupDPHId filterPName
let ty = parrElemType cea
(clam,_) <- deLambda ty pa b
dePArrComp qs body pa (mkApps (Var filterP) [Type ty, clam, cea])
-- <<[:e' | qs:]>> (pa, p) (crossMapP ea ef)
--
dePArrComp (BindStmt p e _ _ : qs) body pa cea = do
- filterP <- dsLookupGlobalId filterPName
- crossMapP <- dsLookupGlobalId crossMapPName
+ filterP <- dsLookupDPHId filterPName
+ crossMapP <- dsLookupDPHId crossMapPName
ce <- dsLExpr e
let ety'cea = parrElemType cea
ety'ce = parrElemType ce
-- {x_1, ..., x_n} = DV (ds) -- Defined Variables
--
dePArrComp (LetStmt ds : qs) body pa cea = do
- mapP <- dsLookupGlobalId mapPName
+ mapP <- dsLookupDPHId mapPName
let xs = collectLocalBinders ds
ty'cea = parrElemType cea
v <- newSysLocalDs ty'cea
---
parStmts [] pa cea = return (pa, cea)
parStmts ((qs, xs):qss) pa cea = do -- subsequent statements (zip'ed)
- zipP <- dsLookupGlobalId zipPName
+ zipP <- dsLookupDPHId zipPName
let pa' = mkLHsPatTup [pa, mkLHsVarPatTup xs]
ty'cea = parrElemType cea
res_expr = mkLHsVarTuple xs