Skip to content
Snippets Groups Projects
Commit 4a8695c5 authored by bjorn@bringert.net's avatar bjorn@bringert.net
Browse files

Merged stand-alone deriving with FC stuff.

parent 9c5aa098
No related branches found
No related tags found
No related merge requests found
......@@ -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 }
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment