diff options
Diffstat (limited to 'compiler/deSugar/DsListComp.hs')
| -rw-r--r-- | compiler/deSugar/DsListComp.hs | 52 |
1 files changed, 30 insertions, 22 deletions
diff --git a/compiler/deSugar/DsListComp.hs b/compiler/deSugar/DsListComp.hs index 36c2730aff..8c9fa72e03 100644 --- a/compiler/deSugar/DsListComp.hs +++ b/compiler/deSugar/DsListComp.hs @@ -220,20 +220,20 @@ deListComp :: [ExprStmt GhcTc] -> CoreExpr -> DsM CoreExpr deListComp [] _ = panic "deListComp" -deListComp (LastStmt body _ _ : quals) list +deListComp (LastStmt _ body _ _ : quals) list = -- Figure 7.4, SLPJ, p 135, rule C above ASSERT( null quals ) do { core_body <- dsLExpr body ; return (mkConsExpr (exprType core_body) core_body list) } -- Non-last: must be a guard -deListComp (BodyStmt guard _ _ _ : quals) list = do -- rule B above +deListComp (BodyStmt _ guard _ _ : quals) list = do -- rule B above core_guard <- dsLExpr guard core_rest <- deListComp quals list return (mkIfThenElse core_guard core_rest list) -- [e | let B, qs] = let B in [e | qs] -deListComp (LetStmt binds : quals) list = do +deListComp (LetStmt _ binds : quals) list = do core_rest <- deListComp quals list dsLocalBinds binds core_rest @@ -241,11 +241,11 @@ deListComp (stmt@(TransStmt {}) : quals) list = do (inner_list_expr, pat) <- dsTransStmt stmt deBindComp pat inner_list_expr quals list -deListComp (BindStmt pat list1 _ _ _ : quals) core_list2 = do -- rule A' above +deListComp (BindStmt _ pat list1 _ _ : quals) core_list2 = do -- rule A' above core_list1 <- dsLExprNoLP list1 deBindComp pat core_list1 quals core_list2 -deListComp (ParStmt stmtss_w_bndrs _ _ _ : quals) list +deListComp (ParStmt _ stmtss_w_bndrs _ _ : quals) list = do { exps_and_qual_tys <- mapM dsInnerListComp stmtss_w_bndrs ; let (exps, qual_tys) = unzip exps_and_qual_tys @@ -266,6 +266,9 @@ deListComp (RecStmt {} : _) _ = panic "deListComp RecStmt" deListComp (ApplicativeStmt {} : _) _ = panic "deListComp ApplicativeStmt" +deListComp (XStmtLR {} : _) _ = + panic "deListComp XStmtLR" + deBindComp :: OutPat GhcTc -> CoreExpr -> [ExprStmt GhcTc] @@ -328,18 +331,18 @@ dfListComp :: Id -> Id -- 'c' and 'n' dfListComp _ _ [] = panic "dfListComp" -dfListComp c_id n_id (LastStmt body _ _ : quals) +dfListComp c_id n_id (LastStmt _ body _ _ : quals) = ASSERT( null quals ) do { core_body <- dsLExprNoLP body ; return (mkApps (Var c_id) [core_body, Var n_id]) } -- Non-last: must be a guard -dfListComp c_id n_id (BodyStmt guard _ _ _ : quals) = do +dfListComp c_id n_id (BodyStmt _ guard _ _ : quals) = do core_guard <- dsLExpr guard core_rest <- dfListComp c_id n_id quals return (mkIfThenElse core_guard core_rest (Var n_id)) -dfListComp c_id n_id (LetStmt binds : quals) = do +dfListComp c_id n_id (LetStmt _ binds : quals) = do -- new in 1.3, local bindings core_rest <- dfListComp c_id n_id quals dsLocalBinds binds core_rest @@ -349,7 +352,7 @@ dfListComp c_id n_id (stmt@(TransStmt {}) : quals) = do -- Anyway, we bind the newly grouped list via the generic binding function dfBindComp c_id n_id (pat, inner_list_expr) quals -dfListComp c_id n_id (BindStmt pat list1 _ _ _ : quals) = do +dfListComp c_id n_id (BindStmt _ pat list1 _ _ : quals) = do -- evaluate the two lists core_list1 <- dsLExpr list1 @@ -360,6 +363,8 @@ dfListComp _ _ (ParStmt {} : _) = panic "dfListComp ParStmt" dfListComp _ _ (RecStmt {} : _) = panic "dfListComp RecStmt" dfListComp _ _ (ApplicativeStmt {} : _) = panic "dfListComp ApplicativeStmt" +dfListComp _ _ (XStmtLR {} : _) = + panic "dfListComp XStmtLR" dfBindComp :: Id -> Id -- 'c' and 'n' -> (LPat GhcTc, CoreExpr) @@ -487,7 +492,7 @@ dsPArrComp :: [ExprStmt GhcTc] -> DsM CoreExpr -- Special case for parallel comprehension -dsPArrComp (ParStmt qss _ _ _ : quals) = dePArrParComp qss quals +dsPArrComp (ParStmt _ qss _ _ : quals) = dePArrParComp qss quals -- Special case for simple generators: -- @@ -498,7 +503,7 @@ dsPArrComp (ParStmt qss _ _ _ : quals) = dePArrParComp qss quals -- <<[:e' | p <- e, qs:]>> = -- <<[:e' | qs:]>> p (filterP (\x -> case x of {p -> True; _ -> False}) e) -- -dsPArrComp (BindStmt p e _ _ _ : qs) = do +dsPArrComp (BindStmt _ p e _ _ : qs) = do filterP <- dsDPHBuiltin filterPVar ce <- dsLExprNoLP e let ety'ce = parrElemType ce @@ -529,7 +534,7 @@ dePArrComp [] _ _ = panic "dePArrComp" -- -- <<[:e' | :]>> pa ea = mapP (\pa -> e') ea -- -dePArrComp (LastStmt e' _ _ : quals) pa cea +dePArrComp (LastStmt _ e' _ _ : quals) pa cea = ASSERT( null quals ) do { mapP <- dsDPHBuiltin mapPVar ; let ty = parrElemType cea @@ -538,7 +543,7 @@ dePArrComp (LastStmt e' _ _ : quals) pa cea -- -- <<[:e' | b, qs:]>> pa ea = <<[:e' | qs:]>> pa (filterP (\pa -> b) ea) -- -dePArrComp (BodyStmt b _ _ _ : qs) pa cea = do +dePArrComp (BodyStmt _ b _ _ : qs) pa cea = do filterP <- dsDPHBuiltin filterPVar let ty = parrElemType cea (clam,_) <- deLambda ty pa b @@ -557,7 +562,7 @@ dePArrComp (BodyStmt b _ _ _ : qs) pa cea = do -- in -- <<[:e' | qs:]>> (pa, p) (crossMapP ea ef) -- -dePArrComp (BindStmt p e _ _ _ : qs) pa cea = do +dePArrComp (BindStmt _ p e _ _ : qs) pa cea = do filterP <- dsDPHBuiltin filterPVar crossMapP <- dsDPHBuiltin crossMapPVar ce <- dsLExpr e @@ -582,7 +587,7 @@ dePArrComp (BindStmt p e _ _ _ : qs) pa cea = do -- where -- {x_1, ..., x_n} = DV (ds) -- Defined Variables -- -dePArrComp (LetStmt lds@(L _ ds) : qs) pa cea = do +dePArrComp (LetStmt _ lds@(L _ ds) : qs) pa cea = do mapP <- dsDPHBuiltin mapPVar let xs = collectLocalBinders ds ty'cea = parrElemType cea @@ -610,6 +615,8 @@ dePArrComp (TransStmt {} : _) _ _ = panic "DsListComp.dePArrComp: TransStmt" dePArrComp (RecStmt {} : _) _ _ = panic "DsListComp.dePArrComp: RecStmt" dePArrComp (ApplicativeStmt {} : _) _ _ = panic "DsListComp.dePArrComp: ApplicativeStmt" +dePArrComp (XStmtLR {} : _) _ _ = + panic "DsListComp.dePArrComp: XStmtLR" -- <<[:e' | qs | qss:]>> pa ea = -- <<[:e' | qss:]>> (pa, (x_1, ..., x_n)) @@ -690,18 +697,18 @@ dsMcStmts (L loc stmt : lstmts) = putSrcSpanDs loc (dsMcStmt stmt lstmts) --------------- dsMcStmt :: ExprStmt GhcTc -> [ExprLStmt GhcTc] -> DsM CoreExpr -dsMcStmt (LastStmt body _ ret_op) stmts +dsMcStmt (LastStmt _ body _ ret_op) stmts = ASSERT( null stmts ) do { body' <- dsLExpr body ; dsSyntaxExpr ret_op [body'] } -- [ .. | let binds, stmts ] -dsMcStmt (LetStmt binds) stmts +dsMcStmt (LetStmt _ binds) stmts = do { rest <- dsMcStmts stmts ; dsLocalBinds binds rest } -- [ .. | a <- m, stmts ] -dsMcStmt (BindStmt pat rhs bind_op fail_op bind_ty) stmts +dsMcStmt (BindStmt bind_ty pat rhs bind_op fail_op) stmts = do { rhs' <- dsLExpr rhs ; dsMcBindStmt pat rhs' bind_op fail_op bind_ty stmts } @@ -709,7 +716,7 @@ dsMcStmt (BindStmt pat rhs bind_op fail_op bind_ty) stmts -- -- [ .. | exp, stmts ] -- -dsMcStmt (BodyStmt exp then_exp guard_exp _) stmts +dsMcStmt (BodyStmt _ exp then_exp guard_exp) stmts = do { exp' <- dsLExpr exp ; rest <- dsMcStmts stmts ; guard_exp' <- dsSyntaxExpr guard_exp [exp'] @@ -732,7 +739,7 @@ dsMcStmt (BodyStmt exp then_exp guard_exp _) stmts dsMcStmt (TransStmt { trS_stmts = stmts, trS_bndrs = bndrs , trS_by = by, trS_using = using , trS_ret = return_op, trS_bind = bind_op - , trS_bind_arg_ty = n_tup_ty' -- n (a,b,c) + , trS_ext = n_tup_ty' -- n (a,b,c) , trS_fmap = fmap_op, trS_form = form }) stmts_rest = do { let (from_bndrs, to_bndrs) = unzip bndrs @@ -777,7 +784,7 @@ dsMcStmt (TransStmt { trS_stmts = stmts, trS_bndrs = bndrs -- mzip :: forall a b. m a -> m b -> m (a,b) -- NB: we need a polymorphic mzip because we call it several times -dsMcStmt (ParStmt blocks mzip_op bind_op bind_ty) stmts_rest +dsMcStmt (ParStmt bind_ty blocks mzip_op bind_op) stmts_rest = do { exps_w_tys <- mapM ds_inner blocks -- Pairs (exp :: m ty, ty) ; mzip_op' <- dsExpr mzip_op @@ -854,7 +861,8 @@ dsInnerMonadComp :: [ExprLStmt GhcTc] -> SyntaxExpr GhcTc -- The monomorphic "return" operator -> DsM CoreExpr dsInnerMonadComp stmts bndrs ret_op - = dsMcStmts (stmts ++ [noLoc (LastStmt (mkBigLHsVarTupId bndrs) False ret_op)]) + = dsMcStmts (stmts ++ + [noLoc (LastStmt noExt (mkBigLHsVarTupId bndrs) False ret_op)]) -- The `unzip` function for `GroupStmt` in a monad comprehensions |