From 78f85b1ef880f3020a0a4c02d05d7009c9fc42ff Mon Sep 17 00:00:00 2001
From: simonm <unknown>
Date: Tue, 25 Nov 1997 10:52:29 +0000
Subject: [PATCH] [project @ 1997-11-25 10:52:29 by simonm] fix for "TyCon used
as Class" bug.
---
ghc/compiler/typecheck/TcEnv.lhs | 18 +++++++++++-------
1 file changed, 11 insertions(+), 7 deletions(-)
diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index 32fdf22f2370..e406b2868c2f 100644
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ b/ghc/compiler/typecheck/TcEnv.lhs
@@ -55,6 +55,7 @@ import UniqFM
import Util ( zipEqual, zipWithEqual, zipWith3Equal, zipLazy,
panic, pprPanic, pprTrace
)
+import Maybes ( maybeToBool )
import Outputable
\end{code}
@@ -175,14 +176,17 @@ tcLookupTyConByKey uniq
tcLookupClass name
= tcGetEnv `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
--- pprTrace "tcLookupClass:" (hsep [text "Uniq:", pprUnique10 (uniqueOf name), text "; avail:", hsep (map (pprUnique10 . fst) (ufmToList ce))]) $
--- pprTrace "tcLookupClass:" (hsep [text "Uniq:", pprUnique (uniqueOf name), text "; avail:", hsep (map (pprUnique . fst) (ufmToList ce))]) $
case lookupUFM ce name of
- Just stuff -> returnTc stuff
- Nothing -> -- Could be that he's using a type constructor as a class
- case lookupUFM tce name of
- Just _ -> failTc (tyConAsClassErr name)
- Nothing -> pprPanic "tcLookupClass:" (ppr PprShowAll name)
+ Just stuff -- Common case: it's ok
+ -> returnTc stuff
+
+ Nothing -- Could be that he's using a type constructor as a class
+ | maybeToBool (maybeWiredInTyConName name)
+ || maybeToBool (lookupUFM tce name)
+ -> failTc (tyConAsClassErr name)
+
+ | otherwise -- Wierd! Renamer shouldn't let this happen
+ -> pprPanic "tcLookupClass:" (ppr PprShowAll name)
tcLookupClassByKey uniq
= tcGetEnv `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
--
GitLab