X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnTypes.lhs;h=ebf410169c8c29c8aaf0769d01fc768125bb9cd1;hp=a72caa48556b39d9c4ff4538784b9dbf0bd069d9;hb=7539ed8cade66d09fae1e0ccc66c519cafa3b55b;hpb=526c3af1dc98987b6949f4df73c0debccf9875bd

diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index a72caa4..ebf4101 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -3,13 +3,6 @@
 % (c) The GRASP Project, Glasgow University, 1992-2002
 %
 \begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 module TcRnTypes(
 	TcRnIf, TcRn, TcM, RnM,	IfM, IfL, IfG, -- The monad is opaque outside this module
 	TcRef,
@@ -49,7 +42,6 @@ module TcRnTypes(
 
 import HsSyn hiding (LIE)
 import HscTypes
-import Packages
 import Type
 import Coercion
 import TcType
@@ -73,7 +65,6 @@ import Util
 import Bag
 import Outputable
 import ListSetOps
-import FiniteMap
 import FastString
 
 import Data.Maybe
@@ -228,7 +219,7 @@ data TcGblEnv
 		-- Nothing <=> Don't retain renamed decls
 
 	tcg_binds     :: LHsBinds Id,	    -- Value bindings in this module
-	tcg_deprecs   :: Deprecations,	    -- ...Deprecations 
+	tcg_warns     :: Warnings,	    -- ...Warnings and deprecations
 	tcg_insts     :: [Instance],	    -- ...Instances
 	tcg_fam_insts :: [FamInst],	    -- ...Family instances
 	tcg_rules     :: [LRuleDecl Id],    -- ...Rules
@@ -243,9 +234,9 @@ type RecFieldEnv = NameEnv [Name]	-- Maps a constructor name *in this module*
 					-- to the fields for that constructor
 	-- This is used when dealing with ".." notation in record 
 	-- construction and pattern matching.
-	-- The FieldEnv deals *only* with constructors defined in
-	-- *thie* module.  For imported modules, we get the same info
-	-- from the TypeEnv
+	-- The FieldEnv deals *only* with constructors defined in *thie*
+	-- module.  For imported modules, we get the same info from the
+	-- TypeEnv
 \end{code}
 
 %************************************************************************
@@ -739,26 +730,28 @@ than with the Avails handling stuff in TcSimplify
 
 \begin{code}
 instance Ord Inst where
-  compare = cmpInst
+   compare = cmpInst
+	-- Used *only* for AvailEnv in TcSimplify
 
 instance Eq Inst where
   (==) i1 i2 = case i1 `cmpInst` i2 of
-	         EQ    -> True
-		 other -> False
+               EQ -> True
+               _  -> False
 
+cmpInst :: Inst -> Inst -> Ordering
 cmpInst d1@(Dict {}) 	d2@(Dict {})	= tci_pred d1 `tcCmpPred` tci_pred d2
-cmpInst (Dict {})	other 		= LT
+cmpInst (Dict {})       _               = LT
 
 cmpInst (Method {}) 	(Dict {})	= GT
 cmpInst m1@(Method {}) 	m2@(Method {})	= (tci_oid m1 `compare` tci_oid m2) `thenCmp`
 					  (tci_tys m1 `tcCmpTypes` tci_tys m2)
-cmpInst (Method {})  	other		= LT
+cmpInst (Method {})     _               = LT
 
 cmpInst (LitInst {})	(Dict {}) 	= GT
 cmpInst (LitInst {})	(Method {})	= GT
 cmpInst l1@(LitInst {})	l2@(LitInst {})	= (tci_lit l1 `compare` tci_lit l2) `thenCmp`
 					  (tci_ty l1 `tcCmpType` tci_ty l2)
-cmpInst (LitInst {})  	other		= LT
+cmpInst (LitInst {})    _               = LT
 
 	-- Implication constraints are compared by *name*
 	-- not by type; that is, we make no attempt to do CSE on them
@@ -766,14 +759,15 @@ cmpInst (ImplicInst {})    (Dict {})	      = GT
 cmpInst (ImplicInst {})    (Method {})	      = GT
 cmpInst (ImplicInst {})    (LitInst {})	      = GT
 cmpInst i1@(ImplicInst {}) i2@(ImplicInst {}) = tci_name i1 `compare` tci_name i2
-cmpInst (ImplicInst {})    other	      = LT
+cmpInst (ImplicInst {})    _                  = LT
 
 	-- same for Equality constraints
-cmpInst (EqInst {})    (Dict {})	      = GT
-cmpInst (EqInst {})    (Method {})	      = GT
-cmpInst (EqInst {})    (LitInst {})	      = GT
-cmpInst (EqInst {})    (ImplicInst {})	      = GT
-cmpInst i1@(EqInst {}) i2@(EqInst {})         = tci_name i1 `compare` tci_name i2
+cmpInst (EqInst {})    (Dict {})       = GT
+cmpInst (EqInst {})    (Method {})     = GT
+cmpInst (EqInst {})    (LitInst {})    = GT
+cmpInst (EqInst {})    (ImplicInst {}) = GT
+cmpInst i1@(EqInst {}) i2@(EqInst {})  = (tci_left  i1 `tcCmpType` tci_left  i2) `thenCmp`
+                                         (tci_right i1 `tcCmpType` tci_right i2)
 \end{code}
 
 
@@ -787,15 +781,31 @@ cmpInst i1@(EqInst {}) i2@(EqInst {})         = tci_name i1 `compare` tci_name i
 -- FIXME: Rename this. It clashes with (Located (IE ...))
 type LIE = Bag Inst
 
-isEmptyLIE	  = isEmptyBag
-emptyLIE          = emptyBag
-unitLIE inst 	  = unitBag inst
-mkLIE insts	  = listToBag insts
+isEmptyLIE :: LIE -> Bool
+isEmptyLIE = isEmptyBag
+
+emptyLIE :: LIE
+emptyLIE = emptyBag
+
+unitLIE :: Inst -> LIE
+unitLIE inst = unitBag inst
+
+mkLIE :: [Inst] -> LIE
+mkLIE insts = listToBag insts
+
+plusLIE :: LIE -> LIE -> LIE
 plusLIE lie1 lie2 = lie1 `unionBags` lie2
-plusLIEs lies	  = unionManyBags lies
-lieToList	  = bagToList
-listToLIE	  = listToBag
 
+plusLIEs :: [LIE] -> LIE
+plusLIEs lies = unionManyBags lies
+
+lieToList :: LIE -> [Inst]
+lieToList = bagToList
+
+listToLIE :: [Inst] -> LIE
+listToLIE = listToBag
+
+consLIE :: Inst -> LIE -> LIE
 consLIE inst lie  = lie `snocBag` inst
 -- Putting the new Inst at the *end* of the bag is a half-hearted attempt
 -- to ensure that we tend to report the *leftmost* type-constraint error
@@ -904,4 +914,5 @@ instance Outputable InstOrigin where
     ppr (ImplicOrigin doc)    = doc
     ppr (SigOrigin info)      = pprSkolInfo info
     ppr EqOrigin	      = ptext (sLit "a type equality")
+    ppr InstSigOrigin         = panic "ppr InstSigOrigin"
 \end{code}