rnTopBinds,
rnMethodBinds,
rnBinds,
- FreeVars(..),
- DefinedVars(..)
+ SYN_IE(FreeVars),
+ SYN_IE(DefinedVars)
) where
IMP_Ubiq()
import CmdLineOpts ( opt_SigsRequired )
import Digraph ( stronglyConnComp )
import ErrUtils ( addErrLoc, addShortErrLocLine )
-import Name ( RdrName )
+import Name ( getLocalName, RdrName )
import Maybes ( catMaybes )
+--import PprStyle--ToDo:rm
import Pretty
import UniqSet ( emptyUniqSet, unitUniqSet, mkUniqSet,
unionUniqSets, unionManyUniqSets,
- elementOfUniqSet, uniqSetToList, UniqSet(..) )
+ elementOfUniqSet, uniqSetToList, SYN_IE(UniqSet) )
import Util ( thenCmp, isIn, removeDups, panic, panic#, assertPanic )
\end{code}
-- Do the SCC analysis
let vertices = mkVertices mbinds_info
- edges = mkEdges vertices mbinds_info
+ edges = mkEdges mbinds_info
scc_result = stronglyConnComp (==) edges vertices
flattenMonoBinds uniq sigs EmptyMonoBinds = returnRn (uniq, [])
-flattenMonoBinds uniq sigs (AndMonoBinds mB1 mB2)
- = flattenMonoBinds uniq sigs mB1 `thenRn` \ (uniq1, flat1) ->
- flattenMonoBinds uniq1 sigs mB2 `thenRn` \ (uniq2, flat2) ->
+flattenMonoBinds uniq sigs (AndMonoBinds bs1 bs2)
+ = flattenMonoBinds uniq sigs bs1 `thenRn` \ (uniq1, flat1) ->
+ flattenMonoBinds uniq1 sigs bs2 `thenRn` \ (uniq2, flat2) ->
returnRn (uniq2, flat1 ++ flat2)
flattenMonoBinds uniq sigs (PatMonoBind pat grhss_and_binds locn)
]
mkVertices :: FlatMonoBindsInfo -> [VertexTag]
-mkVertices info = [ vertex | (vertex,_,_,_,_) <- info]
+mkEdges :: FlatMonoBindsInfo -> [Edge]
-mkEdges :: [VertexTag] -> FlatMonoBindsInfo -> [Edge]
+mkVertices info = [ vertex | (vertex,_,_,_,_) <- info]
-mkEdges vertices flat_info
+mkEdges flat_info
-- An edge (v,v') indicates that v depends on v'
- = [ (source_vertex, target_vertex)
- | (source_vertex, _, used_names, _, _) <- flat_info,
- target_name <- uniqSetToList used_names,
- target_vertex <- vertices_defining target_name flat_info
- ]
- where
- -- If each name only has one binding in this group, then
- -- vertices_defining will always return the empty list, or a
- -- singleton. The case when there is more than one binding (an
- -- error) needs more thought.
-
- vertices_defining name flat_info2
- = [ vertex | (vertex, names_defined, _, _, _) <- flat_info2,
- name `elementOfUniqSet` names_defined
- ]
+ = -- pprTrace "mkEdges:" (ppAboves [ppAboves[ppInt v, ppCat [ppr PprDebug d|d <- uniqSetToList defd], ppCat [ppr PprDebug u|u <- uniqSetToList used]] | (v,defd,used,_,_) <- flat_info]) $
+ [ (source_vertex, target_vertex)
+ | (source_vertex, _, used_names, _, _) <- flat_info,
+ target_name <- uniqSetToList used_names,
+ target_vertex <- vertices_defining target_name flat_info
+ ]
+ where
+ -- If each name only has one binding in this group, then
+ -- vertices_defining will always return the empty list, or a
+ -- singleton. The case when there is more than one binding (an
+ -- error) needs more thought.
+
+ vertices_defining name flat_info2
+ = [ vertex | (vertex, names_defined, _, _, _) <- flat_info2,
+ name `elementOfUniqSet` names_defined
+ ]
\end{code}
-- Discard unbound ones we've already complained about, so we
-- complain about duplicate ones.
- (goodies, dups) = removeDups compare (filter not_unbound sigs')
+ (goodies, dups) = removeDups compare (filter (\ x -> not_unbound x && not_main x) sigs')
in
mapRn (addErrRn . dupSigDeclErr) dups `thenRn_`
lookupValue v `thenRn` \ new_v ->
returnRn (Just (MagicUnfoldingSig new_v str src_loc))
- not_unbound :: RenamedSig -> Bool
+ not_unbound, not_main :: RenamedSig -> Bool
not_unbound (Sig n _ _ _) = not (isRnUnbound n)
not_unbound (SpecSig n _ _ _) = not (isRnUnbound n)
not_unbound (DeforestSig n _) = not (isRnUnbound n)
not_unbound (MagicUnfoldingSig n _ _) = not (isRnUnbound n)
+ not_main (Sig n _ _ _) = let str = getLocalName n in
+ not (str == SLIT("main") || str == SLIT("mainPrimIO"))
+ not_main _ = True
+
-------------------------------------
sig_free :: [RdrNameSig] -> RdrName -> Maybe RdrName
-- Return "Just x" if "x" has no type signature in