diff options
| author | Simon Peyton Jones <simon.peytonjones@gmail.com> | 2023-02-22 23:17:04 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simon.peytonjones@gmail.com> | 2023-02-22 23:20:07 +0000 |
| commit | 6b718cfcfc23bba795da0fd74a3d8f45b6f3bd7f (patch) | |
| tree | 0b2faf989fc6603dc9bf1b6122ad856713308aa3 /compiler/GHC/HsToCore.hs | |
| parent | f11d9c274d728696bc173c62a2ead62b8288836f (diff) | |
| download | haskell-wip/T23024.tar.gz | |
Account for local rules in specImportswip/T23024
As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were
generating specialisations (a locally-define function) for imported
functions; and then generating specialisations for those
locally-defined functions. The RULE for the latter should be
attached to the local Id, not put in the rules-for-imported-ids
set.
Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules
Diffstat (limited to 'compiler/GHC/HsToCore.hs')
| -rw-r--r-- | compiler/GHC/HsToCore.hs | 28 |
1 files changed, 12 insertions, 16 deletions
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs index 3c6ec71079..5a6bae315d 100644 --- a/compiler/GHC/HsToCore.hs +++ b/compiler/GHC/HsToCore.hs @@ -362,32 +362,28 @@ deSugarExpr hsc_env tc_expr = do addExportFlagsAndRules :: Backend -> NameSet -> NameSet -> [CoreRule] -> [(Id, t)] -> [(Id, t)] -addExportFlagsAndRules bcknd exports keep_alive rules = mapFst add_one +addExportFlagsAndRules bcknd exports keep_alive rules + = mapFst (addRulesToId rule_base . add_export_flag) + -- addRulesToId: see Note [Attach rules to local ids] + -- NB: the binder might have some existing rules, + -- arising from specialisation pragmas + where - add_one bndr = add_rules name (add_export name bndr) - where - name = idName bndr ---------- Rules -------- - -- See Note [Attach rules to local ids] - -- NB: the binder might have some existing rules, - -- arising from specialisation pragmas - add_rules name bndr - | Just rules <- lookupNameEnv rule_base name - = bndr `addIdSpecialisations` rules - | otherwise - = bndr rule_base = extendRuleBaseList emptyRuleBase rules ---------- Export flag -------- -- See Note [Adding export flags] - add_export name bndr - | dont_discard name = setIdExported bndr + add_export_flag bndr + | dont_discard bndr = setIdExported bndr | otherwise = bndr - dont_discard :: Name -> Bool - dont_discard name = is_exported name + dont_discard :: Id -> Bool + dont_discard bndr = is_exported name || name `elemNameSet` keep_alive + where + name = idName bndr -- In interactive mode, we don't want to discard any top-level -- entities at all (eg. do not inline them away during |