-checkLoops :: EdgeMap -> SCC RenamedTyClDecl
- -> TcM (Name -> AlgTyConFlavour -> RecFlag)
--- Check for illegal loops in a single strongly-connected component
--- a) type synonyms
--- b) superclass hierarchy
---
--- Also return a function that says which tycons are recursive.
--- Remember:
--- a newtype is recursive if it is part of a recursive
--- group consisting only of newtype and synonyms
-
-checkLoops edge_map (AcyclicSCC _)
- = returnM (\ _ _ -> NonRecursive)
-
-checkLoops edge_map (CyclicSCC decls)
- = let -- CHECK FOR CLASS CYCLES
- cls_edges = mapMaybe mkClassEdges decls
- cls_cycles = findCycles cls_edges
- in
- mapM_ (cycleErr "class") cls_cycles `thenM_`
-
- let -- CHECK FOR SYNONYM CYCLES
- syn_edges = mkEdges edge_map (filter isSynDecl decls)
- syn_cycles = findCycles syn_edges
- in
- mapM_ (cycleErr "type synonym") syn_cycles `thenM_`
-
- let -- CHECK FOR NEWTYPE CYCLES
- newtype_edges = mkEdges edge_map (filter is_nt_cycle_decl decls)
- newtype_cycles = findCycles newtype_edges
- rec_newtypes = mkNameSet [tcdName d | ds <- newtype_cycles, d <- ds]
-
- rec_tycon name (NewTyCon _)
- | name `elemNameSet` rec_newtypes = Recursive
- | otherwise = NonRecursive
- rec_tycon name other_flavour = Recursive
- in
- returnM rec_tycon
-
-----------------------------------------------------
--- A class with one op and no superclasses, or vice versa,
--- is treated just like a newtype.
--- It's a bit unclean that this test is repeated in buildTyConOrClass
-is_nt_cycle_decl (TySynonym {}) = True
-is_nt_cycle_decl (TyData {tcdND = NewType}) = True
-is_nt_cycle_decl (ClassDecl {tcdCtxt = ctxt, tcdSigs = sigs}) = length ctxt + length sigs == 1
-is_nt_cycle_decl other = False
-
-----------------------------------------------------
-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 ]