- final_id_map = listToUFM [(id,id) | id <- final_ids]
- get_idinfo id = case lookupUFM final_id_map id of
- Just id' -> idInfo id'
- Nothing -> pprTrace "ifaceBinds not found:" (ppr id) $
- idInfo id
-
- (pretties, emitted) = go needed_ids (reverse binds) emptyBag emptyVarSet
- -- Reverse so that later things will
- -- provoke earlier ones to be emitted
- go needed [] pretties emitted
- | not (isEmptyVarSet needed) = pprTrace "ifaceBinds: free vars:"
- (sep (map ppr (varSetElems needed)))
- (pretties, emitted)
- | otherwise = (pretties, emitted)
-
- go needed (NonRec id rhs : binds) pretties emitted
- = case ifaceId get_idinfo needed False id rhs of
- Nothing -> go needed binds pretties emitted
- Just (pretty, extras) -> let
- needed' = (needed `unionVarSet` extras) `delVarSet` id
- -- 'extras' can include the Id itself via a rule
- emitted' = emitted `extendVarSet` id
- in
- go needed' binds (pretty `consBag` pretties) emitted'
-
- -- Recursive groups are a bit more of a pain. We may only need one to
- -- start with, but it may call out the next one, and so on. So we
- -- have to look for a fixed point.
- go needed (Rec pairs : binds) pretties emitted
- = go needed' binds pretties' emitted'
- where
- (new_pretties, new_emitted, extras) = go_rec needed pairs
- pretties' = new_pretties `unionBags` pretties
- needed' = (needed `unionVarSet` extras) `minusVarSet` mkVarSet (map fst pairs)
- emitted' = emitted `unionVarSet` new_emitted
-
- go_rec :: IdSet -> [(Id,CoreExpr)] -> (Bag SDoc, IdSet, IdSet)
- go_rec needed pairs
- | null pretties = (emptyBag, emptyVarSet, emptyVarSet)
- | otherwise = (more_pretties `unionBags` listToBag pretties,
- more_emitted `unionVarSet` mkVarSet emitted,
- more_extras `unionVarSet` extras)
- where
- maybes = map do_one pairs
- emitted = [id | ((id,_), Just _) <- pairs `zip` maybes]
- reduced_pairs = [pair | (pair, Nothing) <- pairs `zip` maybes]
- (pretties, extras_s) = unzip (catMaybes maybes)
- extras = unionVarSets extras_s
- (more_pretties, more_emitted, more_extras) = go_rec extras reduced_pairs
-
- do_one (id,rhs) = ifaceId get_idinfo needed True id rhs
+ local_rules = [ (fn, rule)
+ | fn <- bindersOfBinds binds,
+ fn `elemVarSet` emitted,
+ rule <- rulesRules (idSpecialisation fn),
+ 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
+
+ -- Sept 00: I've disabled this test. It doesn't stop many, if any, rules
+ -- from coming out, and to make it work properly we need to add ????
+ -- (put it back in for now)
+ all (`elemVarSet` emitted) (varSetElems (ruleSomeLhsFreeVars interestingId rule))
+ -- Spit out a rule only if all its lhs free vars are emitted
+ -- This is a good reason not to do it when we emit the Id itself
+ ]