X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcInstDcls.lhs;h=965db1530df58e03610a4c53398d3c80a1eac1c7;hb=aedb94f5f220b5e442b23ecc445fd38c8d9b6ba0;hp=466cee9d25aa130a121976a046b6d6832ea9313a;hpb=62ee856ca84f409741f472ce3527d6deafa5b62a;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 466cee9..965db15 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -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:
@@ -614,9 +614,10 @@ 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
@@ -625,7 +626,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = NewTypeDerived })
         ; let coerced_rep_dict = wrapId the_coercion (instToId rep_dict)
 
         ; body <- make_body cls_tycon cls_inst_tys sc_dicts coerced_rep_dict
-        ; let dict_bind = noLoc $ VarBind (instToId this_dict) (noLoc body)
+	; let dict_bind = mkVarBind (instToId this_dict) (noLoc body)
 
         ; return (unitBag $ noLoc $
                   AbsBinds inst_tvs' (map instToVar dfun_dicts)
@@ -636,7 +637,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = NewTypeDerived })
       --        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
@@ -743,7 +744,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = VanillaInst monobinds uprags })
     checkSigTyVars inst_tyvars'
 
     -- Deal with 'SPECIALISE instance' pragmas
-    prags <- tcPrags dfun_id (filter isSpecInstLSig uprags)
+    prags <- tcPrags NonRecursive dfun_id (filter isSpecInstLSig uprags)
 
     -- Create the result bindings
     let
@@ -762,7 +763,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = VanillaInst monobinds uprags })
                 --      See Note [Inline dfuns] below
 
         sc_dict_vars  = map instToVar sc_dicts
-        dict_bind     = L loc (VarBind this_dict_id dict_rhs)
+        dict_bind     = mkVarBind this_dict_id dict_rhs
         dict_rhs      = foldl (\ f a -> L loc (HsApp f (L loc a))) inst_constr meth_exprs
  	inst_constr   = L loc $ wrapId (mkWpApps sc_dict_vars <.> mkWpTyApps inst_tys')
 				       (dataConWrapId dict_constr)
@@ -773,7 +774,6 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = VanillaInst monobinds uprags })
                 -- member) are dealt with by the common MkId.mkDataConWrapId code rather
                 -- than needing to be repeated here.
 
-
         main_bind = noLoc $ AbsBinds
                             inst_tyvars'
                             dfun_lam_vars
@@ -824,7 +824,7 @@ tcInstanceMethod loc clas tyvars dfun_dicts theta inst_tys
 		-- then clashes with its friends
 	; uniq1 <- newUnique
 	; let local_meth_name = mkInternalName uniq1 sel_occ loc   -- Same OccName
-	      this_dict_bind  = L loc $ VarBind (instToId cloned_this) $ 
+	      this_dict_bind  = mkVarBind (instToId cloned_this) $ 
 				L loc $ wrapId meth_wrapper dfun_id
 	      mb_this_bind | null tyvars = Nothing
 			   | otherwise   = Just (cloned_this, this_dict_bind)