X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcInstDcls.lhs;h=14c96aec431b7618756335dbdc951baf033b0d41;hb=04c3bfc687db82659a7fe5a8b0fa4244c52560b7;hp=97db7b37dde96a07fe018c11d29cf4a8b1f0d385;hpb=aaed05e88978688e37dc74177dd4eba51a6ab4d0;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 97db7b3..14c96ae 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -21,7 +21,7 @@ import FamInst
 import FamInstEnv
 import TcDeriv
 import TcEnv
-import RnEnv	( lookupImportedName )
+import RnEnv	( lookupGlobalOccRn )
 import TcHsType
 import TcUnify
 import TcSimplify
@@ -96,9 +96,9 @@ Running example:
 	op1_i = /\a. \(d:C a). 
 	       let this :: C [a]
 		   this = df_i a d
+	             -- Note [Subtle interaction of recursion and overlap]
 
 		   local_op1 :: forall b. Ix b => [a] -> b -> b
-	             -- Note [Subtle interaction of recursion and overlap]
 	           local_op1 = <rhs>
 	       	     -- Source code; run the type checker on this
 		     -- NB: Type variable 'a' (but not 'b') is in scope in <rhs>
@@ -571,7 +571,7 @@ tcInstDecl2 :: InstInfo Name -> TcM (LHsBinds Id)
 --      newtype N a = MkN (Tree [a]) deriving( Foo Int )
 --
 -- The newtype gives an FC axiom looking like
---      axiom CoN a ::  N a :=: Tree [a]
+--      axiom CoN a ::  N a ~ Tree [a]
 --   (see Note [Newtype coercions] in TyCon for this unusual form of axiom)
 --
 -- So all need is to generate a binding looking like:
@@ -588,7 +588,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = NewTypeDerived })
               rigid_info   = InstSkol
               origin       = SigOrigin rigid_info
               inst_ty      = idType dfun_id
-        ; (tvs, theta, inst_head_ty) <- tcSkolSigType rigid_info inst_ty
+        ; (inst_tvs', theta, inst_head_ty) <- tcSkolSigType rigid_info inst_ty
                 -- inst_head_ty is a PredType
 
         ; let (cls, cls_inst_tys) = tcSplitDFunHead inst_head_ty
@@ -614,13 +614,14 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = NewTypeDerived })
 
         -- Figure out bindings for the superclass context from dfun_dicts
         -- Don't include this_dict in the 'givens', else
-        -- sc_dicst get bound by just selecting from this_dict!!
+        -- sc_dicts get bound by just selecting from this_dict!!
         ; sc_binds <- addErrCtxt superClassCtxt $
-                      tcSimplifySuperClasses inst_loc dfun_dicts (rep_dict:sc_dicts)
+                      tcSimplifySuperClasses inst_loc this_dict dfun_dicts 
+					     (rep_dict:sc_dicts)
 
 	-- It's possible that the superclass stuff might unified something
 	-- in the envt with one of the clas_tyvars
-	; checkSigTyVars class_tyvars
+	; checkSigTyVars inst_tvs'
 
         ; let coerced_rep_dict = wrapId the_coercion (instToId rep_dict)
 
@@ -628,15 +629,15 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = NewTypeDerived })
         ; let dict_bind = noLoc $ VarBind (instToId this_dict) (noLoc body)
 
         ; return (unitBag $ noLoc $
-                  AbsBinds  tvs (map instToVar dfun_dicts)
-                            [(tvs, dfun_id, instToId this_dict, [])]
+                  AbsBinds inst_tvs' (map instToVar dfun_dicts)
+                            [(inst_tvs', dfun_id, instToId this_dict, [])]
                             (dict_bind `consBag` sc_binds)) }
   where
       -----------------------
       --        make_coercion
       -- The inst_head looks like (C s1 .. sm (T a1 .. ak))
       -- But we want the coercion (C s1 .. sm (sym (CoT a1 .. ak)))
-      --        with kind (C s1 .. sm (T a1 .. ak)  :=:  C s1 .. sm <rep_ty>)
+      --        with kind (C s1 .. sm (T a1 .. ak)  ~  C s1 .. sm <rep_ty>)
       --        where rep_ty is the (eta-reduced) type rep of T
       -- So we just replace T with CoT, and insert a 'sym'
       -- NB: we know that k will be >= arity of CoT, because the latter fully eta-reduced
@@ -735,7 +736,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = VanillaInst monobinds uprags })
     -- Don't include this_dict in the 'givens', else
     -- sc_dicts get bound by just selecting  from this_dict!!
     sc_binds <- addErrCtxt superClassCtxt $
-                tcSimplifySuperClasses inst_loc dfun_dicts sc_dicts
+                tcSimplifySuperClasses inst_loc this_dict dfun_dicts sc_dicts
 		-- Note [Recursive superclasses]
 
 	-- It's possible that the superclass stuff might unified something
@@ -862,7 +863,7 @@ tcInstanceMethod loc clas tyvars dfun_dicts theta inst_tys
 			{   -- Build the typechecked version directly, 
 			    -- without calling typecheck_method; 
 			    -- see Note [Default methods in instances]
-			  dm_name <- lookupImportedName (mkDefMethRdrName sel_name)
+			  dm_name <- lookupGlobalOccRn (mkDefMethRdrName sel_name)
 					-- Might not be imported, but will be an OrigName
 			; dm_id   <- tcLookupId dm_name
 			; return (wrapId dm_wrapper dm_id, emptyBag) } }
@@ -962,7 +963,7 @@ mustBeVarArgErr ty =
 wrongATArgErr :: Type -> Type -> SDoc
 wrongATArgErr ty instTy =
   sep [ ptext (sLit "Type indexes must match class instance head")
-      , ptext (sLit "Found") <+> ppr ty <+> ptext (sLit "but expected") <+>
-         ppr instTy
+      , ptext (sLit "Found") <+> quotes (ppr ty)
+        <+> ptext (sLit "but expected") <+> quotes (ppr instTy)
       ]
 \end{code}