Commit 878924ac authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Fixed deriving of associated data types

- We forgot to pull the data declarations nested in class instances out of
  the instances when collecting all the predicates that we need derive.
  Thanks to Roman for spotting this.
parent 39876e61
...@@ -205,16 +205,18 @@ And then translate it to: ...@@ -205,16 +205,18 @@ And then translate it to:
%************************************************************************ %************************************************************************
\begin{code} \begin{code}
tcDeriving :: [LTyClDecl Name] -- All type constructors tcDeriving :: [LTyClDecl Name] -- All type constructors
-> [LInstDecl Name] -- All instance declarations
-> [LDerivDecl Name] -- All stand-alone deriving declarations -> [LDerivDecl Name] -- All stand-alone deriving declarations
-> TcM ([InstInfo], -- The generated "instance decls" -> TcM ([InstInfo], -- The generated "instance decls"
HsValBinds Name) -- Extra generated top-level bindings HsValBinds Name) -- Extra generated top-level bindings
tcDeriving tycl_decls deriv_decls tcDeriving tycl_decls inst_decls deriv_decls
= recoverM (returnM ([], emptyValBindsOut)) $ = recoverM (returnM ([], emptyValBindsOut)) $
do { -- Fish the "deriving"-related information out of the TcEnv do { -- Fish the "deriving"-related information out of the TcEnv
-- and make the necessary "equations". -- and make the necessary "equations".
; (ordinary_eqns, newtype_inst_info) <- makeDerivEqns tycl_decls deriv_decls ; (ordinary_eqns, newtype_inst_info)
<- makeDerivEqns tycl_decls inst_decls deriv_decls
; (ordinary_inst_info, deriv_binds) ; (ordinary_inst_info, deriv_binds)
<- extendLocalInstEnv (map iSpec newtype_inst_info) $ <- extendLocalInstEnv (map iSpec newtype_inst_info) $
...@@ -338,17 +340,24 @@ when the dict is constructed in TcInstDcls.tcInstDecl2 ...@@ -338,17 +340,24 @@ when the dict is constructed in TcInstDcls.tcInstDecl2
\begin{code} \begin{code}
makeDerivEqns :: [LTyClDecl Name] makeDerivEqns :: [LTyClDecl Name]
-> [LInstDecl Name]
-> [LDerivDecl Name] -> [LDerivDecl Name]
-> TcM ([DerivEqn], -- Ordinary derivings -> TcM ([DerivEqn], -- Ordinary derivings
[InstInfo]) -- Special newtype derivings [InstInfo]) -- Special newtype derivings
makeDerivEqns tycl_decls deriv_decls makeDerivEqns tycl_decls inst_decls deriv_decls
= do { eqns1 <- mapM deriveTyData $ = do { eqns1 <- mapM deriveTyData $
[ (p,d) | d@(L _ (TyData {tcdDerivs = Just preds})) <- tycl_decls extractTyDataPreds tycl_decls ++
, p <- preds ] [ pd -- traverse assoc data families
| L _ (InstDecl _ _ _ ats) <- inst_decls
, pd <- extractTyDataPreds ats ]
; eqns2 <- mapM deriveStandalone deriv_decls ; eqns2 <- mapM deriveStandalone deriv_decls
; return ([eqn | (Just eqn, _) <- eqns1 ++ eqns2], ; return ([eqn | (Just eqn, _) <- eqns1 ++ eqns2],
[inst | (_, Just inst) <- eqns1 ++ eqns2]) } [inst | (_, Just inst) <- eqns1 ++ eqns2]) }
where
extractTyDataPreds decls =
[(p, d) | d@(L _ (TyData {tcdDerivs = Just preds})) <- decls, p <- preds]
------------------------------------------------------------------ ------------------------------------------------------------------
deriveStandalone :: LDerivDecl Name -> TcM (Maybe DerivEqn, Maybe InstInfo) deriveStandalone :: LDerivDecl Name -> TcM (Maybe DerivEqn, Maybe InstInfo)
......
...@@ -179,7 +179,10 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls ...@@ -179,7 +179,10 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
-- (4) Compute instances from "deriving" clauses; -- (4) Compute instances from "deriving" clauses;
-- This stuff computes a context for the derived instance -- This stuff computes a context for the derived instance
-- decl, so it needs to know about all the instances possible -- decl, so it needs to know about all the instances possible
; (deriv_inst_info, deriv_binds) <- tcDeriving tycl_decls deriv_decls -- NB: class instance declarations can contain derivings as
-- part of associated data type declarations
; (deriv_inst_info, deriv_binds) <- tcDeriving tycl_decls inst_decls
deriv_decls
; addInsts deriv_inst_info $ do { ; addInsts deriv_inst_info $ do {
; gbl_env <- getGblEnv ; gbl_env <- getGblEnv
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment