Commit ce26c4b7 authored by simonpj's avatar simonpj
Browse files

[project @ 2002-01-04 11:39:00 by simonpj]

-----------------------------
	Fix a too-vigorous export bug
	-----------------------------

	MERGE TO STABLE

	[this is the Ian Lynagh -O2 bug]


CoreTidy didn't filter the rules that it exports, so it
exported some that mentioned Ids on the *left* hand side
that are not exported.  So an importing module fell over.

The fix is simple: filter the exposed rules.   On the way
I tidied up CoreFVs a little.
parent 13a428ca
......@@ -11,8 +11,7 @@ module CoreFVs (
exprSomeFreeVars, exprsSomeFreeVars,
idRuleVars, idFreeVars, idFreeTyVars,
ruleSomeFreeVars, ruleRhsFreeVars,
ruleLhsFreeNames, ruleLhsFreeIds,
ruleRhsFreeVars, ruleLhsFreeNames, ruleLhsFreeIds,
CoreExprWithFVs, -- = AnnExpr Id VarSet
CoreBindWithFVs, -- = AnnBind Id VarSet
......@@ -207,14 +206,6 @@ ruleRhsFreeVars (Rule str _ tpl_vars tpl_args rhs)
where
rule_fvs = addBndrs tpl_vars (expr_fvs rhs)
ruleSomeFreeVars :: InterestingVarFun -> CoreRule -> VarSet
ruleSomeFreeVars interesting (BuiltinRule _ _) = noFVs
ruleSomeFreeVars interesting (Rule _ _ tpl_vars tpl_args rhs)
= rule_fvs interesting emptyVarSet
where
rule_fvs = addBndrs tpl_vars $
foldr (union . expr_fvs) (expr_fvs rhs) tpl_args
ruleLhsFreeIds :: CoreRule -> VarSet
-- This finds all the free Ids on the LHS of the rule
-- *including* imported ids
......
......@@ -14,7 +14,7 @@ module CoreTidy (
import CmdLineOpts ( DynFlags, DynFlag(..), opt_OmitInterfacePragmas )
import CoreSyn
import CoreUnfold ( noUnfolding, mkTopUnfolding, okToUnfoldInHiFile )
import CoreFVs ( ruleSomeFreeVars, exprSomeFreeVars )
import CoreFVs ( ruleLhsFreeIds, ruleRhsFreeVars, exprSomeFreeVars )
import PprCore ( pprIdCoreRule )
import CoreLint ( showPass, endPass )
import CoreUtils ( exprArity )
......@@ -137,6 +137,11 @@ tidyCorePgm dflags mod pcs cg_info_env
; let ext_ids = findExternalSet binds_in orphans_in
; let ext_rules = findExternalRules binds_in orphans_in ext_ids
-- findExternalRules filters ext_rules to avoid binders that
-- aren't externally visible; but the externally-visible binders
-- are computed (by findExternalSet) assuming that all orphan
-- rules are exported. So in fact we may export more than we
-- need. (It's a sort of mutual recursion.)
-- We also make sure to avoid any exported binders. Consider
-- f{-u1-} = 1 -- Local decl
......@@ -248,17 +253,25 @@ findExternalRules :: [CoreBind]
findExternalRules binds orphan_rules ext_ids
| opt_OmitInterfacePragmas = []
| otherwise
= orphan_rules ++ local_rules
= filter needed_rule (orphan_rules ++ local_rules)
where
local_rules = [ (id, rule)
| id <- bindersOfBinds binds,
id `elemVarEnv` ext_ids,
rule <- rulesRules (idSpecialisation id),
not (isBuiltinRule rule)
rule <- rulesRules (idSpecialisation id)
]
needed_rule (id, rule)
= not (isBuiltinRule rule)
-- We can't print builtin rules in interface files
-- Since they are built in, an importing module
-- will have access to them anyway
]
&& not (any internal_id (varSetElems (ruleLhsFreeIds rule)))
-- Don't export a rule whose LHS mentions an Id that
-- is completely internal (i.e. not visible to an
-- importing module)
internal_id id = isLocalId id && not (id `elemVarEnv` ext_ids)
\end{code}
%************************************************************************
......@@ -276,7 +289,7 @@ findExternalSet binds orphan_rules
= foldr find init_needed binds
where
orphan_rule_ids :: IdSet
orphan_rule_ids = unionVarSets [ ruleSomeFreeVars isLocalId rule
orphan_rule_ids = unionVarSets [ ruleRhsFreeVars rule
| (_, rule) <- orphan_rules]
init_needed :: IdEnv Bool
init_needed = mapUFM (\_ -> False) orphan_rule_ids
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment