From 314bc31489f1f4cd69e913c3b1e33236b2bdf553 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Tue, 21 Nov 2017 14:28:58 -0500 Subject: Revert "trees that grow" work As documented in #14490, the Data instances currently blow up compilation time by too much to stomach. Alan will continue working on this in a branch and we will perhaps merge to 8.2 before 8.2.1 to avoid having to perform painful cherry-picks in 8.2 minor releases. Reverts haddock submodule. This reverts commit 47ad6578ea460999b53eb4293c3a3b3017a56d65. This reverts commit e3ec2e7ae94524ebd111963faf34b84d942265b4. This reverts commit 438dd1cbba13d35f3452b4dcef3f94ce9a216905. This reverts commit 0ff152c9e633accca48815e26e59d1af1fe44ceb. --- compiler/deSugar/DsListComp.hs | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) (limited to 'compiler/deSugar/DsListComp.hs') diff --git a/compiler/deSugar/DsListComp.hs b/compiler/deSugar/DsListComp.hs index 860c1baa14..fea637fafe 100644 --- a/compiler/deSugar/DsListComp.hs +++ b/compiler/deSugar/DsListComp.hs @@ -82,7 +82,7 @@ dsListComp lquals res_ty = do -- of that comprehension that we need in the outer comprehension into such an expression -- and the type of the elements that it outputs (tuples of binders) dsInnerListComp :: (ParStmtBlock GhcTc GhcTc) -> DsM (CoreExpr, Type) -dsInnerListComp (ParStmtBlock _ stmts bndrs _) +dsInnerListComp (ParStmtBlock stmts bndrs _) = do { let bndrs_tuple_type = mkBigCoreVarTupTy bndrs list_ty = mkListTy bndrs_tuple_type @@ -90,7 +90,6 @@ dsInnerListComp (ParStmtBlock _ stmts bndrs _) ; expr <- dsListComp (stmts ++ [noLoc $ mkLastStmt (mkBigLHsVarTupId bndrs)]) list_ty ; return (expr, bndrs_tuple_type) } -dsInnerListComp (XParStmtBlock{}) = panic "dsInnerListComp" -- 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 @@ -106,8 +105,7 @@ dsTransStmt (TransStmt { trS_form = form, trS_stmts = stmts, trS_bndrs = binderM to_bndrs_tup_ty = mkBigCoreTupTy to_bndrs_tys -- Desugar an inner comprehension which outputs a list of tuples of the "from" binders - (expr', from_tup_ty) <- dsInnerListComp (ParStmtBlock noExt stmts - from_bndrs noSyntaxExpr) + (expr', from_tup_ty) <- dsInnerListComp (ParStmtBlock stmts from_bndrs noSyntaxExpr) -- Work out what arguments should be supplied to that expression: i.e. is an extraction -- function required? If so, create that desugared function and add to arguments @@ -255,7 +253,7 @@ deListComp (ParStmt stmtss_w_bndrs _ _ _ : quals) list ; deBindComp pat (Let (Rec [(zip_fn, zip_rhs)]) (mkApps (Var zip_fn) exps)) quals list } where - bndrs_s = [bs | ParStmtBlock _ _ bs _ <- stmtss_w_bndrs] + bndrs_s = [bs | ParStmtBlock _ bs _ <- stmtss_w_bndrs] -- pat is the pattern ((x1,..,xn), (y1,..,ym)) in the example above pat = mkBigLHsPatTupId pats @@ -625,15 +623,13 @@ dePArrParComp qss quals = do deParStmt [] = -- empty parallel statement lists have no source representation panic "DsListComp.dePArrComp: Empty parallel list comprehension" - deParStmt (ParStmtBlock _ qs xs _:qss) = do -- first statement + deParStmt (ParStmtBlock qs xs _:qss) = do -- first statement let res_expr = mkLHsVarTuple xs cqs <- dsPArrComp (map unLoc qs ++ [mkLastStmt res_expr]) parStmts qss (mkLHsVarPatTup xs) cqs - deParStmt (XParStmtBlock{}:_) = panic "dePArrParComp" --- parStmts [] pa cea = return (pa, cea) - parStmts (ParStmtBlock _ qs xs _:qss) pa cea = do - -- subsequent statements (zip'ed) + parStmts (ParStmtBlock qs xs _:qss) pa cea = do -- subsequent statements (zip'ed) zipP <- dsDPHBuiltin zipPVar let pa' = mkLHsPatTup [pa, mkLHsVarPatTup xs] ty'cea = parrElemType cea @@ -642,7 +638,6 @@ dePArrParComp qss quals = do let ty'cqs = parrElemType cqs cea' = mkApps (Var zipP) [Type ty'cea, Type ty'cqs, cea, cqs] parStmts qss pa' cea' - parStmts (XParStmtBlock{}:_) _ _ = panic "dePArrParComp" -- generate Core corresponding to `\p -> e' -- @@ -782,7 +777,7 @@ dsMcStmt (ParStmt blocks mzip_op bind_op bind_ty) stmts_rest ; mzip_op' <- dsExpr mzip_op ; let -- The pattern variables - pats = [ mkBigLHsVarPatTupId bs | ParStmtBlock _ _ bs _ <- blocks] + pats = [ mkBigLHsVarPatTupId bs | ParStmtBlock _ bs _ <- blocks] -- Pattern with tuples of variables -- [v1,v2,v3] => (v1, (v2, v3)) pat = foldr1 (\p1 p2 -> mkLHsPatTup [p1, p2]) pats @@ -793,10 +788,9 @@ dsMcStmt (ParStmt blocks mzip_op bind_op bind_ty) stmts_rest ; dsMcBindStmt pat rhs bind_op noSyntaxExpr bind_ty stmts_rest } where - ds_inner (ParStmtBlock _ stmts bndrs return_op) + ds_inner (ParStmtBlock stmts bndrs return_op) = do { exp <- dsInnerMonadComp stmts bndrs return_op ; return (exp, mkBigCoreVarTupTy bndrs) } - ds_inner (XParStmtBlock{}) = panic "dsMcStmt" dsMcStmt stmt _ = pprPanic "dsMcStmt: unexpected stmt" (ppr stmt) -- cgit v1.2.1