[commit: ghc] ghc-generics1: we have to guard our tcLookupClass of Functor since it is in a library (a5a02df)

[José Pedro Magalhães]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : ghc-generics1

http://hackage.haskell.org/trac/ghc/changeset/a5a02df3f1fa3a7609ffc9b8e517558d626d936c

>---------------------------------------------------------------

commit a5a02df3f1fa3a7609ffc9b8e517558d626d936c
Author: Nicolas Frisby <nicolas.frisby at gmail.com>
Date:   Mon Apr 9 16:17:49 2012 -0500

    we have to guard our tcLookupClass of Functor since it is in a library
    
    Signed-off-by: Jose Pedro Magalhaes <jpm at cs.uu.nl>

>---------------------------------------------------------------

 compiler/typecheck/TcDeriv.lhs |   17 ++++++++++-------
 1 files changed, 10 insertions(+), 7 deletions(-)

diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 8e7f90e..52c1608 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -709,9 +709,11 @@ mk_data_eqn :: CtOrigin -> [TyVar] -> Class
 mk_data_eqn orig tvs cls tycon tc_args rep_tc rep_tc_args mtheta
   = do	{ dfun_name <- new_dfun_name cls tycon
   	; loc <- getSrcSpanM
-        ; functorClass <- tcLookupClass functorClassName
+        -- TODO NSF 9 April 2012: only recover from a
+        -- "base:Data.Functor.Functor could not be found" error
+        ; functorClass_maybe <- recoverM (return Nothing) $ Just `fmap` tcLookupClass functorClassName
 	; let inst_tys = [mkTyConApp tycon tc_args]
-	      inferred_constraints = inferConstraints functorClass tvs cls inst_tys rep_tc rep_tc_args
+	      inferred_constraints = inferConstraints functorClass_maybe tvs cls inst_tys rep_tc rep_tc_args
 	      spec = DS { ds_loc = loc, ds_orig = orig
 			, ds_name = dfun_name, ds_tvs = tvs
 			, ds_cls = cls, ds_tys = inst_tys
@@ -755,27 +757,28 @@ mk_typeable_eqn orig tvs cls tycon tc_args mtheta
 		     , ds_theta = mtheta `orElse` [], ds_newtype = False })  }
 
 ----------------------
-inferConstraints :: Class -> -- the Functor class
+inferConstraints :: Maybe Class -> -- the base:Functor class, if in scope
                     [TyVar] -> Class -> [TcType] -> TyCon -> [TcType] -> ThetaType
 -- Generate a sufficiently large set of constraints that typechecking the
 -- generated method definitions should succeed.   This set will be simplified
 -- before being used in the instance declaration
-inferConstraints functorClass _ cls inst_tys rep_tc rep_tc_args
+inferConstraints functorClass_maybe _ cls inst_tys rep_tc rep_tc_args
   -- Generic constraints are easy
   | cls `hasKey` genClassKey
   = []
   | cls `hasKey` gen1ClassKey
   = ASSERT (length rep_tc_tvs > 0)
-    con_arg_constraints functorClass (get_gen1_constrained_tys last_tv) 
+    con_arg_constraints functorClass_maybe (get_gen1_constrained_tys last_tv) 
   -- The others are a bit more complicated
   | otherwise
   = ASSERT2( equalLength rep_tc_tvs all_rep_tc_args, ppr cls <+> ppr rep_tc )
     stupid_constraints ++ extra_constraints
     ++ sc_constraints
-    ++ con_arg_constraints cls get_std_constrained_tys
+    ++ con_arg_constraints (Just cls) get_std_constrained_tys
   where
        -- Constraints arising from the arguments of each constructor
-    con_arg_constraints cls' get_constrained_tys
+    con_arg_constraints Nothing _ = []
+    con_arg_constraints (Just cls') get_constrained_tys
       = [ mkClassPred cls' [arg_ty]
         | data_con <- tyConDataCons rep_tc,
           arg_ty   <- ASSERT( isVanillaDataCon data_con )