X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsListComp.lhs;h=cd22b8ff8c927f999148ddcd8c904c5db7c8ad68;hp=166bfc244c54ec31ab5f0fa9fd7d444cf773c04d;hb=16b9e80dc14db24509f051f294b5b51943285090;hpb=7fc01c4671980ea3c66d549c0ece4d82fd3f5ade diff --git a/compiler/deSugar/DsListComp.lhs b/compiler/deSugar/DsListComp.lhs index 166bfc2..cd22b8f 100644 --- a/compiler/deSugar/DsListComp.lhs +++ b/compiler/deSugar/DsListComp.lhs @@ -92,12 +92,12 @@ dsInnerListComp (stmts, bndrs) = do -- 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 @@ -108,10 +108,9 @@ dsTransformStmt (TransformStmt stmts binders usingExpr maybeByExpr) = do 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 @@ -515,7 +514,7 @@ dsPArrComp [ParStmt qss] body _ = -- parallel comprehension -- <<[: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 @@ -527,7 +526,7 @@ dsPArrComp (BindStmt p e _ _ : qs) body _ = do 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 @@ -544,7 +543,7 @@ dePArrComp :: [Stmt Id] -- <<[: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] @@ -552,7 +551,7 @@ dePArrComp [] e' pa cea = do -- <<[: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]) @@ -571,8 +570,8 @@ dePArrComp (ExprStmt b _ _ : qs) body pa cea = do -- <<[: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 @@ -596,7 +595,7 @@ dePArrComp (BindStmt p e _ _ : qs) body pa cea = do -- {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 @@ -641,7 +640,7 @@ dePArrParComp qss body = do --- 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