Merged stand-alone deriving with FC stuff.

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index a72b47b..a57be91 100644 (file)
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -456,8 +456,10 @@ topdecl :: { OrdList (LHsDecl RdrName) }
        : cl_decl                       { unitOL (L1 (TyClD (unLoc $1))) }
        | ty_decl                       { unitOL (L1 (TyClD (unLoc $1))) }
        | 'instance' inst_type where
-               { let (binds,sigs) = cvBindsAndSigs (unLoc $3)
-                 in unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs))) }
+               { let (binds, sigs, ats) = cvBindsAndSigs (unLoc $3)
+                 in unitOL (L (comb3 $1 $2 $3) 
+                           (InstD (InstDecl $2 binds sigs ats))) }
+        | stand_alone_deriving                  { unitOL (LL (DerivD (unLoc $1))) }
        | 'default' '(' comma_types0 ')'        { unitOL (LL $ DefD (DefaultDecl $3)) }
        | 'foreign' fdecl                       { unitOL (LL (unLoc $2)) }
        | '{-# DEPRECATED' deprecations '#-}'   { $2 }

diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 033e399..776199f 100644 (file)
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -386,7 +386,11 @@ makeDerivEqns overlap_flag tycl_decls deriv_decls
         mk_eqn_help loc orig gla_exts new_or_data tycon deriv_tvs clas tys
 
     ------------------------------------------------------------------
-    mk_eqn_help gla_exts DataType tycon deriv_tvs clas tys
+    -- data/newtype T a = ... deriving( C t1 t2 )
+    --   leads to a call to mk_eqn_help with
+    --         tycon = T, deriv_tvs = ftv(t1,t2), clas = C, tys = [t1,t2]
+
+    mk_eqn_help loc orig gla_exts DataType tycon deriv_tvs clas tys
       | Just err <- checkSideConditions gla_exts tycon deriv_tvs clas tys
       = bale_out (derivingThingErr clas tys tycon (tyConTyVars tycon) err)
       | otherwise 

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 3236b67..468d9a9 100644 (file)
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -179,16 +179,19 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
                -- (3) Instances from generic class declarations
        ; generic_inst_info <- getGenericInstances clas_decls
 
-       -- (3) Compute instances from "deriving" clauses; 
-       -- This stuff computes a context for the derived instance decl, so it
-       -- needs to know about all the instances possible; hence inst_env4
-    tcDeriving tycl_decls      `thenM` \ (deriv_inst_info, deriv_binds) ->
-    addInsts deriv_inst_info   $
+               -- Next, construct the instance environment so far, consisting
+               -- of 
+               --   a) local instance decls
+               --   b) generic instances
+               --   c) local family instance decls
+       ; addInsts local_info         $ do {
+       ; addInsts generic_inst_info  $ do {
+       ; addFamInsts at_idx_tycon    $ do {
 
                -- (4) Compute instances from "deriving" clauses; 
                -- This stuff computes a context for the derived instance
                -- decl, so it needs to know about all the instances possible
-       ; (deriv_inst_info, deriv_binds) <- tcDeriving tycl_decls
+       ; (deriv_inst_info, deriv_binds) <- tcDeriving tycl_decls deriv_decls
        ; addInsts deriv_inst_info   $ do {
 
        ; gbl_env <- getGblEnv

diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 4c6c0d5..ffd88b8 100644 (file)
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -2162,7 +2162,7 @@ tcSimplifyDeriv orig tc tyvars theta
        -- The main loop may do unification, and that may crash if 
        -- it doesn't see a TcTyVar, so we have to instantiate. Sigh
        -- ToDo: what if two of them do get unified?
-    newDicts DerivOrigin (substTheta tenv theta)       `thenM` \ wanteds ->
+    newDictBndrsO orig (substTheta tenv theta) `thenM` \ wanteds ->
     simpleReduceLoop doc reduceMe wanteds              `thenM` \ (frees, _, irreds) ->
     ASSERT( null frees )                       -- reduceMe never returns Free
 

diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 3f1810f..cd4c4c7 100644 (file)
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -673,6 +673,7 @@ tcSplitPhiTy ty = split ty ty []
        | Just p <- tcSplitPredTy_maybe arg = split res res (p:ts)
   split orig_ty ty             ts = (reverse ts, orig_ty)
 
+tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type)
 tcSplitSigmaTy ty = case tcSplitForAllTys ty of
                        (tvs, rho) -> case tcSplitPhiTy rho of
                                        (theta, tau) -> (tvs, theta, tau)