- 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
+ tidy_ty = tidyTopType (deNoteType (idType dfun_id))
+ -- The deNoteType is very important. It removes all type
+ -- synonyms from the instance type in interface files.
+ -- That in turn makes sure that when reading in instance decls
+ -- from interface files that the 'gating' mechanism works properly.
+ -- Otherwise you could have
+ -- type Tibble = T Int
+ -- instance Foo Tibble where ...
+ -- and this instance decl wouldn't get imported into a module
+ -- that mentioned T but not Tibble.
+
+ifaceRule (id, BuiltinRule _)
+ = pprTrace "toHsRule: builtin" (ppr id) (bogusIfaceRule id)
+
+ifaceRule (id, Rule name bndrs args rhs)
+ = IfaceRule name (map toUfBndr bndrs) (getName id)
+ (map toUfExpr args) (toUfExpr rhs) noSrcLoc
+
+bogusIfaceRule id
+ = IfaceRule SLIT("bogus") [] (getName id) [] (UfVar (getName id)) noSrcLoc