+----------------------------------------------------
+findCycles edges = [ ds | CyclicSCC ds <- stronglyConnComp edges]
+
+----------------------------------------------------
+-- Building edges for SCC analysis
+--
+-- When building the edges, we treat the 'main name' of the declaration as the
+-- key for the node, but when dealing with External Core we may come across
+-- references to one of the implicit names for the declaration. For example:
+-- class Eq a where ....
+-- data :TSig a = :TSig (:TEq a) ....
+-- The first decl is sucked in from an interface file; the second
+-- is in an External Core file, generated from a class decl for Sig.
+-- We have to recognise that the reference to :TEq represents a
+-- dependency on the class Eq declaration, else the SCC stuff won't work right.
+--
+-- This complication can only happen when consuming an External Core file
+--
+-- Solution: keep an "EdgeMap" (bad name) that maps :TEq -> Eq.
+-- Don't worry about data constructors, because we're only building
+-- SCCs for type and class declarations here. So the tiresome mapping
+-- is need only to map [class tycon -> class]
+
+type EdgeMap = NameEnv Name
+
+mkEdgeMap :: [RenamedTyClDecl] -> TcM EdgeMap
+mkEdgeMap decls = do { mb_pairs <- mapM mk_mb_pair decls ;
+ return (mkNameEnv (catMaybes mb_pairs)) }
+ where
+ mk_mb_pair (ClassDecl { tcdName = cls_name })
+ = do { tc_name <- lookupSysName cls_name mkClassTyConOcc ;
+ return (Just (tc_name, cls_name)) }
+ mk_mb_pair other = return Nothing
+
+mkEdges :: EdgeMap -> [RenamedTyClDecl] -> [(RenamedTyClDecl, Name, [Name])]
+-- We use the EdgeMap to map any implicit names to
+-- the 'main name' for the declaration
+mkEdges edge_map decls
+ = [ (decl, tyClDeclName decl, get_refs decl) | decl <- decls ]
+ where
+ get_refs decl = [ lookupNameEnv edge_map n `orElse` n
+ | n <- nameSetToList (tyClDeclFVs decl) ]
projects / ghc-hetmet.git / blobdiff