diff options
Diffstat (limited to 'compiler/deSugar')
| -rw-r--r-- | compiler/deSugar/Desugar.lhs | 21 | ||||
| -rw-r--r-- | compiler/deSugar/MatchCon.lhs | 2 |
2 files changed, 7 insertions, 16 deletions
diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs index a103e7e0fe..3160b35f15 100644 --- a/compiler/deSugar/Desugar.lhs +++ b/compiler/deSugar/Desugar.lhs @@ -52,8 +52,6 @@ import OrdList import Data.List import Data.IORef import Control.Monad( when ) -import Data.Maybe ( mapMaybe ) -import UniqFM \end{code} %************************************************************************ @@ -125,27 +123,20 @@ deSugar hsc_env ; let hpc_init | gopt Opt_Hpc dflags = hpcInitCode mod ds_hpc_info | otherwise = empty - ; let patsyn_defs = [(patSynId ps, ps) | ps <- patsyns] ; return ( ds_ev_binds , foreign_prs `appOL` core_prs `appOL` spec_prs , spec_rules ++ ds_rules, ds_vects - , ds_fords `appendStubC` hpc_init - , patsyn_defs) } + , ds_fords `appendStubC` hpc_init) } ; case mb_res of { Nothing -> return (msgs, Nothing) ; - Just (ds_ev_binds, all_prs, all_rules, vects0, ds_fords, patsyn_defs) -> do + Just (ds_ev_binds, all_prs, all_rules, vects0, ds_fords) -> do do { -- Add export flags to bindings keep_alive <- readIORef keep_var - ; let (rules_for_locals, rules_for_imps) - = partition isLocalRule all_rules - final_patsyns = addExportFlagsAndRules target export_set keep_alive [] patsyn_defs - exp_patsyn_wrappers = mapMaybe (patSynWrapper . snd) final_patsyns - exp_patsyn_matchers = map (patSynMatcher . snd) final_patsyns - keep_alive' = addListToUFM keep_alive (map (\x -> (x, getName x)) (exp_patsyn_wrappers ++ exp_patsyn_matchers)) - final_prs = addExportFlagsAndRules target - export_set keep_alive' rules_for_locals (fromOL all_prs) + ; let (rules_for_locals, rules_for_imps) = partition isLocalRule all_rules + final_prs = addExportFlagsAndRules target export_set keep_alive + rules_for_locals (fromOL all_prs) final_pgm = combineEvBinds ds_ev_binds final_prs -- Notice that we put the whole lot in a big Rec, even the foreign binds @@ -189,7 +180,7 @@ deSugar hsc_env mg_fam_insts = fam_insts, mg_inst_env = inst_env, mg_fam_inst_env = fam_inst_env, - mg_patsyns = map snd . filter (isExportedId . fst) $ final_patsyns, + mg_patsyns = filter ((`elemNameSet` export_set) . patSynName) patsyns, mg_rules = ds_rules_for_imps, mg_binds = ds_binds, mg_foreign = ds_fords, diff --git a/compiler/deSugar/MatchCon.lhs b/compiler/deSugar/MatchCon.lhs index 4eec0d24bd..8e581f66e2 100644 --- a/compiler/deSugar/MatchCon.lhs +++ b/compiler/deSugar/MatchCon.lhs @@ -158,7 +158,7 @@ matchOneConLike vars ty (eqn1 : eqns) -- All eqns for a single constructor ex_tvs = case con1 of RealDataCon dcon1 -> dataConExTyVars dcon1 - PatSynCon psyn1 -> patSynExTyVars psyn1 + PatSynCon psyn1 -> patSynExTyVars psyn1 match_group :: [Id] -> [(ConArgPats, EquationInfo)] -> DsM MatchResult -- All members of the group have compatible ConArgPats |