From 6c8ce61812cfc8dcc4f388d765e30d6ddab71387 Mon Sep 17 00:00:00 2001 From: quintela Date: Tue, 2 Dec 1997 18:59:20 +0000 Subject: [PATCH] [project @ 1997-12-02 18:56:38 by quintela] Deleted old Shadow stuff --- ghc/compiler/deSugar/MatchCon.lhs | 30 ++++++++------------ ghc/compiler/deSugar/MatchLit.lhs | 55 ++++++++++++++++--------------------- 2 files changed, 36 insertions(+), 49 deletions(-) diff --git a/ghc/compiler/deSugar/MatchCon.lhs b/ghc/compiler/deSugar/MatchCon.lhs index d572e60..280103b 100644 --- a/ghc/compiler/deSugar/MatchCon.lhs +++ b/ghc/compiler/deSugar/MatchCon.lhs @@ -78,11 +78,10 @@ have-we-used-all-the-constructors? question; the local function \begin{code} matchConFamily :: [Id] -> [EquationInfo] - -> [EquationInfo] -- Shadows -> DsM MatchResult -matchConFamily (var:vars) eqns_info shadows - = match_cons_used vars eqns_info shadows `thenDs` \ alts -> +matchConFamily (var:vars) eqns_info + = match_cons_used vars eqns_info `thenDs` \ alts -> mkCoAlgCaseMatchResult var alts \end{code} @@ -90,24 +89,22 @@ And here is the local function that does all the work. It is more-or-less the @matchCon@/@matchClause@ functions on page~94 in Wadler's chapter in SLPJ. \begin{code} -match_cons_used _ [{- no more eqns -}] _ = returnDs [] +match_cons_used _ [{- no more eqns -}] = returnDs [] -match_cons_used vars eqns_info@(EqnInfo (ConPat data_con _ arg_pats : ps1) _ : eqns) shadows +match_cons_used vars eqns_info@(EqnInfo n ctx (ConPat data_con _ arg_pats : ps1) _ : eqns) = let (eqns_for_this_con, eqns_not_for_this_con) = splitByCon eqns_info - (shadows_for_this_con, shadows_not_for_this_con) = splitByCon shadows in -- Go ahead and do the recursive call to make the alts -- for the other ConPats in this con family... - match_cons_used vars eqns_not_for_this_con shadows_not_for_this_con `thenDs` \ rest_of_alts -> + match_cons_used vars eqns_not_for_this_con `thenDs` \ rest_of_alts -> -- Make new vars for the con arguments; avoid new locals where possible - selectMatchVars arg_pats `thenDs` \ new_vars -> + selectMatchVars arg_pats `thenDs` \ new_vars -> -- Now do the business to make the alt for _this_ ConPat ... match (new_vars++vars) - (map shift_con_pat eqns_for_this_con) - (map shift_con_pat shadows_for_this_con) `thenDs` \ match_result -> + (map shift_con_pat eqns_for_this_con) `thenDs` \ match_result -> returnDs ( (data_con, new_vars, match_result) @@ -116,21 +113,18 @@ match_cons_used vars eqns_info@(EqnInfo (ConPat data_con _ arg_pats : ps1) _ : e where splitByCon :: [EquationInfo] -> ([EquationInfo], [EquationInfo]) splitByCon [] = ([],[]) - splitByCon (info@(EqnInfo (pat : _) _) : rest) + splitByCon (info@(EqnInfo _ _ (pat : _) _) : rest) = case pat of ConPat n _ _ | n == data_con -> (info:rest_yes, rest_no) - WildPat _ -> (info:rest_yes, info:rest_no) - -- WildPats will be in the shadows only, - -- and they go into both groups other_pat -> (rest_yes, info:rest_no) where (rest_yes, rest_no) = splitByCon rest shift_con_pat :: EquationInfo -> EquationInfo - shift_con_pat (EqnInfo (ConPat _ _ pats': pats) match_result) - = EqnInfo (pats' ++ pats) match_result - shift_con_pat (EqnInfo (WildPat _: pats) match_result) -- Will only happen in shadow - = EqnInfo ([WildPat (outPatType arg_pat) | arg_pat <- arg_pats] ++ pats) match_result + shift_con_pat (EqnInfo n ctx (ConPat _ _ pats': pats) match_result) + = EqnInfo n ctx (pats' ++ pats) match_result + shift_con_pat (EqnInfo n ctx (WildPat _: pats) match_result) -- Will only happen in shadow + = EqnInfo n ctx ([WildPat (outPatType arg_pat) | arg_pat <- arg_pats] ++ pats) match_result shift_con_pat other = panic "matchConFamily:match_cons_used:shift_con_pat" \end{code} diff --git a/ghc/compiler/deSugar/MatchLit.lhs b/ghc/compiler/deSugar/MatchLit.lhs index 4a429fe..8b40044 100644 --- a/ghc/compiler/deSugar/MatchLit.lhs +++ b/ghc/compiler/deSugar/MatchLit.lhs @@ -36,7 +36,6 @@ import Util ( panic, assertPanic ) \begin{code} matchLiterals :: [Id] -> [EquationInfo] - -> [EquationInfo] -- Shadows -> DsM MatchResult \end{code} @@ -48,28 +47,26 @@ is much like @matchConFamily@, which uses @match_cons_used@ to create the alts---here we use @match_prims_used@. \begin{code} -matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo (LitPat literal lit_ty : ps1) _ : eqns) shadows +matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo n ctx (LitPat literal lit_ty : ps1) _ : eqns) = -- GENERATE THE ALTS - match_prims_used vars eqns_info shadows `thenDs` \ prim_alts -> + match_prims_used vars eqns_info `thenDs` \ prim_alts -> -- MAKE THE PRIMITIVE CASE mkCoPrimCaseMatchResult var prim_alts where - match_prims_used _ [{-no more eqns-}] _ = returnDs [] + match_prims_used _ [{-no more eqns-}] = returnDs [] - match_prims_used vars eqns_info@(EqnInfo ((LitPat literal lit_ty):ps1) _ : eqns) shadows + match_prims_used vars eqns_info@(EqnInfo n ctx ((LitPat literal lit_ty):ps1) _ : eqns) = let (shifted_eqns_for_this_lit, eqns_not_for_this_lit) = partitionEqnsByLit Nothing literal eqns_info - (shifted_shadows_for_this_lit, shadows_not_for_this_lit) - = partitionEqnsByLit Nothing literal shadows in -- recursive call to make other alts... - match_prims_used vars eqns_not_for_this_lit shadows_not_for_this_lit `thenDs` \ rest_of_alts -> + match_prims_used vars eqns_not_for_this_lit `thenDs` \ rest_of_alts -> -- (prim pats have no args; no selectMatchVars as in match_cons_used) -- now do the business to make the alt for _this_ LitPat ... - match vars shifted_eqns_for_this_lit shifted_shadows_for_this_lit `thenDs` \ match_result -> + match vars shifted_eqns_for_this_lit `thenDs` \ match_result -> returnDs ( (mk_core_lit lit_ty literal, match_result) : rest_of_alts @@ -88,22 +85,20 @@ matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo (LitPat literal lit_ty : ps \end{code} \begin{code} -matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo ((NPat literal lit_ty eq_chk):ps1) _ : eqns) shadows +matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo n ctx ((NPat literal lit_ty eq_chk):ps1) _ : eqns) = let (shifted_eqns_for_this_lit, eqns_not_for_this_lit) = partitionEqnsByLit Nothing literal eqns_info - (shifted_shadows_for_this_lit, shadows_not_for_this_lit) - = partitionEqnsByLit Nothing literal shadows in - dsExpr (HsApp eq_chk (HsVar var)) `thenDs` \ pred_expr -> - match vars shifted_eqns_for_this_lit shifted_shadows_for_this_lit `thenDs` \ inner_match_result -> - mkGuardedMatchResult pred_expr inner_match_result `thenDs` \ match_result1 -> + dsExpr (HsApp eq_chk (HsVar var)) `thenDs` \ pred_expr -> + match vars shifted_eqns_for_this_lit `thenDs` \ inner_match_result -> + mkGuardedMatchResult pred_expr inner_match_result `thenDs` \ match_result1 -> if (null eqns_not_for_this_lit) then returnDs match_result1 else - matchLiterals all_vars eqns_not_for_this_lit shadows_not_for_this_lit `thenDs` \ match_result2 -> + matchLiterals all_vars eqns_not_for_this_lit `thenDs` \ match_result2 -> combineMatchResults match_result1 match_result2 \end{code} @@ -119,14 +114,12 @@ We generate: \begin{code} -matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo ((NPlusKPat master_n k ty ge sub):ps1) _ : eqns) shadows +matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo n ctx ((NPlusKPat master_n k ty ge sub):ps1) _ : eqns) = let (shifted_eqns_for_this_lit, eqns_not_for_this_lit) = partitionEqnsByLit (Just master_n) k eqns_info - (shifted_shadows_for_this_lit, shadows_not_for_this_lit) - = partitionEqnsByLit (Just master_n) k shadows in - match vars shifted_eqns_for_this_lit shifted_shadows_for_this_lit `thenDs` \ inner_match_result -> + match vars shifted_eqns_for_this_lit `thenDs` \ inner_match_result -> dsExpr (HsApp ge (HsVar var)) `thenDs` \ ge_expr -> dsExpr (HsApp sub (HsVar var)) `thenDs` \ nminusk_expr -> @@ -140,7 +133,7 @@ matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo ((NPlusKPat master_n k ty g then returnDs match_result1 else - matchLiterals all_vars eqns_not_for_this_lit shadows_not_for_this_lit `thenDs` \ match_result2 -> + matchLiterals all_vars eqns_not_for_this_lit `thenDs` \ match_result2 -> combineMatchResults match_result1 match_result2 \end{code} @@ -168,24 +161,24 @@ partitionEqnsByLit nPlusK lit eqns partition_eqn :: Maybe Id -> HsLit -> EquationInfo -> (Maybe EquationInfo, Maybe EquationInfo) - partition_eqn Nothing lit (EqnInfo (LitPat k _ : remaining_pats) match_result) - | lit `eq_lit` k = (Just (EqnInfo remaining_pats match_result), Nothing) + partition_eqn Nothing lit (EqnInfo n ctx (LitPat k _ : remaining_pats) match_result) + | lit `eq_lit` k = (Just (EqnInfo n ctx remaining_pats match_result), Nothing) -- NB the pattern is stripped off the EquationInfo - partition_eqn Nothing lit (EqnInfo (NPat k _ _ : remaining_pats) match_result) - | lit `eq_lit` k = (Just (EqnInfo remaining_pats match_result), Nothing) + partition_eqn Nothing lit (EqnInfo n ctx (NPat k _ _ : remaining_pats) match_result) + | lit `eq_lit` k = (Just (EqnInfo n ctx remaining_pats match_result), Nothing) -- NB the pattern is stripped off the EquationInfo - partition_eqn (Just master_n) lit (EqnInfo (NPlusKPat n k _ _ _ : remaining_pats) match_result) - | lit `eq_lit` k = (Just (EqnInfo remaining_pats new_match_result), Nothing) + partition_eqn (Just master_n) lit (EqnInfo n ctx (NPlusKPat n' k _ _ _ : remaining_pats) match_result) + | lit `eq_lit` k = (Just (EqnInfo n ctx remaining_pats new_match_result), Nothing) -- NB the pattern is stripped off the EquationInfo where - new_match_result | master_n == n = match_result - | otherwise = mkCoLetsMatchResult [NonRec n (Var master_n)] match_result + new_match_result | master_n == n' = match_result + | otherwise = mkCoLetsMatchResult [NonRec n' (Var master_n)] match_result -- Wild-card patterns, which will only show up in the shadows, go into both groups - partition_eqn nPlusK lit eqn@(EqnInfo (WildPat _ : remaining_pats) match_result) - = (Just (EqnInfo remaining_pats match_result), Just eqn) + partition_eqn nPlusK lit eqn@(EqnInfo n ctx (WildPat _ : remaining_pats) match_result) + = (Just (EqnInfo n ctx remaining_pats match_result), Just eqn) -- Default case; not for this pattern partition_eqn nPlusK lit eqn = (Nothing, Just eqn) -- 1.7.10.4