Skip to content
Snippets Groups Projects
Commit c3446000 authored by Simon Marlow's avatar Simon Marlow
Browse files

[project @ 1998-02-10 17:14:23 by simonm]

fixes for errors in last commit.
parent d3e697b8
No related branches found
No related tags found
No related merge requests found
...@@ -63,6 +63,8 @@ import Util ( thenCmp ) ...@@ -63,6 +63,8 @@ import Util ( thenCmp )
import HsPragmas ( GenPragmas, ClassPragmas, DataPragmas, ClassOpPragmas, InstancePragmas ) import HsPragmas ( GenPragmas, ClassPragmas, DataPragmas, ClassOpPragmas, InstancePragmas )
import List ( nub ) import List ( nub )
import Outputable import Outputable
import Char ( isUpper )
\end{code} \end{code}
\begin{code} \begin{code}
......
...@@ -266,12 +266,12 @@ rn_mono_binds top_lev binders mbinds sigs ...@@ -266,12 +266,12 @@ rn_mono_binds top_lev binders mbinds sigs
flattenMonoBinds siglist mbinds `thenRn` \ mbinds_info -> flattenMonoBinds siglist mbinds `thenRn` \ mbinds_info ->
-- Do the SCC analysis -- Do the SCC analysis
let edges = mkEdges (mbinds_info `zip` [0..]) let edges = mkEdges (mbinds_info `zip` [(0::Int)..])
scc_result = stronglyConnComp edges scc_result = stronglyConnComp edges
final_binds = foldr1 ThenBinds (map reconstructCycle scc_result) final_binds = foldr1 ThenBinds (map reconstructCycle scc_result)
-- Deal with bound and free-var calculation -- Deal with bound and free-var calculation
rhs_fvs = unionManyNameSets [fvs | (_,_,fvs,_,_) <- mbinds_info] rhs_fvs = unionManyNameSets [fvs | (_,fvs,_,_) <- mbinds_info]
in in
returnRn (final_binds, rhs_fvs) returnRn (final_binds, rhs_fvs)
\end{code} \end{code}
...@@ -282,7 +282,7 @@ unique ``vertex tags'' on its output; minor plumbing required. ...@@ -282,7 +282,7 @@ unique ``vertex tags'' on its output; minor plumbing required.
\begin{code} \begin{code}
flattenMonoBinds :: [RenamedSig] -- Signatures flattenMonoBinds :: [RenamedSig] -- Signatures
-> RdrNameMonoBinds -> RdrNameMonoBinds
-> RnMS s (Int, [FlatMonoBindsInfo]) -> RnMS s [FlatMonoBindsInfo]
flattenMonoBinds sigs EmptyMonoBinds = returnRn [] flattenMonoBinds sigs EmptyMonoBinds = returnRn []
...@@ -387,14 +387,14 @@ as the two cases are similar. ...@@ -387,14 +387,14 @@ as the two cases are similar.
reconstructCycle :: SCC FlatMonoBindsInfo reconstructCycle :: SCC FlatMonoBindsInfo
-> RenamedHsBinds -> RenamedHsBinds
reconstructCycle (AcyclicSCC (_, _, _, binds, sigs)) reconstructCycle (AcyclicSCC (_, _, binds, sigs))
= MonoBind binds sigs NonRecursive = MonoBind binds sigs NonRecursive
reconstructCycle (CyclicSCC cycle) reconstructCycle (CyclicSCC cycle)
= MonoBind this_gp_binds this_gp_sigs Recursive = MonoBind this_gp_binds this_gp_sigs Recursive
where where
this_gp_binds = foldr1 AndMonoBinds [binds | (_, _, _, binds, _) <- cycle] this_gp_binds = foldr1 AndMonoBinds [binds | (_, _, binds, _) <- cycle]
this_gp_sigs = foldr1 (++) [sigs | (_, _, _, _, sigs) <- cycle] this_gp_sigs = foldr1 (++) [sigs | (_, _, _, sigs) <- cycle]
\end{code} \end{code}
%************************************************************************ %************************************************************************
......
...@@ -473,7 +473,7 @@ addOneToGlobalNameEnv :: GlobalNameEnv -> RdrName -> (Name, HowInScope) -> RnM s ...@@ -473,7 +473,7 @@ addOneToGlobalNameEnv :: GlobalNameEnv -> RdrName -> (Name, HowInScope) -> RnM s
addOneToGlobalNameEnv env rdr_name name addOneToGlobalNameEnv env rdr_name name
= case lookupFM env rdr_name of = case lookupFM env rdr_name of
Just name2 | conflicting_name name name2 Just name2 | conflicting_name name name2
-> addNameClashErrRn (rdr_name, (name, name2))) `thenRn_` -> addNameClashErrRn (rdr_name, (name, name2)) `thenRn_`
returnRn env returnRn env
other -> returnRn (addToFM env rdr_name name) other -> returnRn (addToFM env rdr_name name)
...@@ -713,7 +713,7 @@ addNameClashErrRn (rdr_name, ((_,how_in_scope1), (_, how_in_scope2))) ...@@ -713,7 +713,7 @@ addNameClashErrRn (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
| otherwise | otherwise
= addErrRn (hang (hsep [ptext SLIT("Conflicting definitions for"), quotes (ppr rdr_name)]) = addErrRn (hang (hsep [ptext SLIT("Conflicting definitions for"), quotes (ppr rdr_name)])
4 (vcat [ppr how_in_scope1, 4 (vcat [ppr how_in_scope1,
ppr how_in_scope2]) ppr how_in_scope2]))
fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2))) fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
= hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)]) = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment