X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcDeriv.lhs;h=34baafb7a65bd19f00d88fc23e1e3407c9c2ab3f;hb=ff843f76541ab39ed30c050ae41c7c07c8980d3a;hp=ffa240dd62c79e91880bdfcd9f109f7b7422dd54;hpb=2a26efb65343e31957b043f63c43caf24d5eeb30;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index ffa240d..34baafb 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -46,7 +46,6 @@ import Var
 import VarSet
 import PrelNames
 import SrcLoc
-import Unique
 import UniqSupply
 import Util
 import ListSetOps
@@ -319,18 +318,20 @@ tcDeriving tycl_decls inst_decls deriv_decls
 
 	; insts2 <- mapM (genInst False overlap_flag) final_specs
 
-		 -- Generate the (old) generic to/from functions from each type declaration
+	-- We no longer generate the old generic to/from functions
+        -- from each type declaration, so this is emptyBag
 	; gen_binds <- return emptyBag -- mkGenericBinds is_boot tycl_decls
 	
-	 -- Generate the generic Representable0/1 instances from each type declaration
-  ; repInstsMeta <- genGenericRepBinds is_boot tycl_decls
+	 -- Generate the generic Representable0 instances
+        -- from each type declaration
+        ; repInstsMeta <- genGenericRepBinds is_boot tycl_decls
 	
-	; let repInsts   = concat (map (\(a,b,c) -> a) repInstsMeta)
-	      repMetaTys = map (\(a,b,c) -> b) repInstsMeta
-	      repTyCons  = map (\(a,b,c) -> c) repInstsMeta
-	-- Should we extendLocalInstEnv with repInsts?
+	; let repInsts   = concat (map (\(a,_,_) -> a) repInstsMeta)
+	      repMetaTys = map (\(_,b,_) -> b) repInstsMeta
+	      repTyCons  = map (\(_,_,c) -> c) repInstsMeta
 
-	; (inst_info, rn_binds, rn_dus) <- renameDeriv is_boot gen_binds (insts1 ++ insts2 ++ repInsts)
+	; (inst_info, rn_binds, rn_dus)
+                <- renameDeriv is_boot gen_binds (insts1 ++ insts2 ++ repInsts)
 
 	; dflags <- getDOpts
 	; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances"
@@ -406,6 +407,7 @@ renameDeriv is_boot gen_binds insts
 	  clas_nm            = className clas
 
 -----------------------------------------
+{- Now unused 
 mkGenericBinds :: Bool -> [LTyClDecl Name] -> TcM (LHsBinds RdrName)
 mkGenericBinds is_boot tycl_decls
   | is_boot 
@@ -418,6 +420,7 @@ mkGenericBinds is_boot tycl_decls
 		-- We are only interested in the data type declarations,
 		-- and then only in the ones whose 'has-generics' flag is on
 		-- The predicate tyConHasGenerics finds both of these
+-}
 \end{code}
 
 Note [Newtype deriving and unused constructors]
@@ -1301,7 +1304,7 @@ inferInstanceContexts oflag infer_specs
     gen_soln (DS { ds_loc = loc, ds_orig = orig, ds_tvs = tyvars 
 		 , ds_cls = clas, ds_tys = inst_tys, ds_theta = deriv_rhs })
       = setSrcSpan loc	$
-	addErrCtxt (derivInstCtxt clas inst_tys) $ 
+	addErrCtxt (derivInstCtxt the_pred) $ 
 	do {      -- Check for a bizarre corner case, when the derived instance decl should
 		  -- have form 	instance C a b => D (T a) where ...
 		  -- Note that 'b' isn't a parameter of T.  This gives rise to all sorts
@@ -1316,7 +1319,7 @@ inferInstanceContexts oflag infer_specs
                                      , not (tyVarsOfPred pred `subVarSet` tv_set)]  
 	   ; mapM_ (addErrTc . badDerivedPred) weird_preds	
 
-           ; theta <- simplifyDeriv orig tyvars deriv_rhs
+           ; theta <- simplifyDeriv orig the_pred tyvars deriv_rhs
 	   	-- checkValidInstance tyvars theta clas inst_tys
 		-- Not necessary; see Note [Exotic derived instance contexts]
 		-- 		  in TcSimplify
@@ -1326,6 +1329,8 @@ inferInstanceContexts oflag infer_specs
 		-- Hence no need to call:
 		--   checkValidInstance tyvars theta clas inst_tys
 	   ; return (sortLe (<=) theta) }	-- Canonicalise before returning the solution
+      where
+        the_pred = mkClassPred clas inst_tys
 
 ------------------------------------------------------------------
 mkInstance :: OverlapFlag -> ThetaType -> DerivSpec -> Instance
@@ -1494,7 +1499,7 @@ genGenericRepBinds isBoot tyclDecls
                                        , isDataDecl d ]
       let tyDecls = filter tyConHasGenerics allTyDecls
       inst1 <- mapM genGenericRepBind tyDecls
-      let (repInsts, metaTyCons, repTys) = unzip3 inst1
+      let (_repInsts, metaTyCons, _repTys) = unzip3 inst1
       metaInsts <- ASSERT (length tyDecls == length metaTyCons)
                      mapM genDtMeta (zip tyDecls metaTyCons)
       return (ASSERT (length inst1 == length metaInsts)
@@ -1657,9 +1662,9 @@ standaloneCtxt :: LHsType Name -> SDoc
 standaloneCtxt ty = hang (ptext (sLit "In the stand-alone deriving instance for")) 
 		       2 (quotes (ppr ty))
 
-derivInstCtxt :: Class -> [Type] -> Message
-derivInstCtxt clas inst_tys
-  = ptext (sLit "When deriving the instance for") <+> parens (pprClassPred clas inst_tys)
+derivInstCtxt :: PredType -> Message
+derivInstCtxt pred
+  = ptext (sLit "When deriving the instance for") <+> parens (ppr pred)
 
 badDerivedPred :: PredType -> Message
 badDerivedPred pred