[commit: haddock] 2.15, 2.15.0.1, 2.15.0.2, T6018-injective-type-families, adamse-D1033, clean, fix-travis, ghc-head, master, metainfo, v2.15, wip/10268, wip/10313, wip/D538, wip/D538-1, wip/D538-2, wip/D538-3, wip/D538-4, wip/D538-5, wip/D538-6, wip/D548-master, wip/D548-master-2, wip/T10483, wip/T8584, wip/T9840, wip/api-ann-hstylit, wip/api-ann-hstylit-1, wip/api-ann-hstylit-2, wip/api-ann-hstylit-3, wip/api-ann-hstylit-4, wip/api-ann-hstylit-5, wip/api-annot-tweaks-7.10, wip/api-annots-ghc-7.10-3, wip/ast-annotations-separate, wip/ast-prepare-annotations, wip/ast-prepare-annotations-final, wip/ast-prepare-annotations-final2, wip/ast-prepare-annotations-final3, wip/ast-prepare-annotations-final4, wip/ast-prepare-annotations-final5, wip/ast-prepare-annotations-final6, wip/attoparsec-update, wip/landmine-param-family, wip/orf-new, wip/orf-reboot, wip/pattern-synonyms, wip/rae, wip/remove-cabal-dep, wip/trac-9744: Adapt to new definition of HsDecls.TyFamEqn (cb96b4f)

git at git.haskell.org git at git.haskell.org
Wed Jul 8 08:29:20 UTC 2015


Repository : ssh://git@git.haskell.org/haddock

On branches: 2.15,2.15.0.1,2.15.0.2,T6018-injective-type-families,adamse-D1033,clean,fix-travis,ghc-head,master,metainfo,v2.15,wip/10268,wip/10313,wip/D538,wip/D538-1,wip/D538-2,wip/D538-3,wip/D538-4,wip/D538-5,wip/D538-6,wip/D548-master,wip/D548-master-2,wip/T10483,wip/T8584,wip/T9840,wip/api-ann-hstylit,wip/api-ann-hstylit-1,wip/api-ann-hstylit-2,wip/api-ann-hstylit-3,wip/api-ann-hstylit-4,wip/api-ann-hstylit-5,wip/api-annot-tweaks-7.10,wip/api-annots-ghc-7.10-3,wip/ast-annotations-separate,wip/ast-prepare-annotations,wip/ast-prepare-annotations-final,wip/ast-prepare-annotations-final2,wip/ast-prepare-annotations-final3,wip/ast-prepare-annotations-final4,wip/ast-prepare-annotations-final5,wip/ast-prepare-annotations-final6,wip/attoparsec-update,wip/landmine-param-family,wip/orf-new,wip/orf-reboot,wip/pattern-synonyms,wip/rae,wip/remove-cabal-dep,wip/trac-9744
Link       : http://git.haskell.org/haddock.git/commitdiff/cb96b4f1ed0462b4a394b9fda6612c3bea9886bd

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

commit cb96b4f1ed0462b4a394b9fda6612c3bea9886bd
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Jul 14 16:23:15 2014 +0100

    Adapt to new definition of HsDecls.TyFamEqn
    
    This is a knock-on from the refactoring from Trac #9063.
    I'll push the corresponding changes to GHC shortly.


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

cb96b4f1ed0462b4a394b9fda6612c3bea9886bd
 src/Haddock/Backends/Xhtml/Decl.hs |  4 ++--
 src/Haddock/Convert.hs             | 12 ++++++------
 src/Haddock/GhcUtils.hs            |  2 +-
 src/Haddock/Interface/Rename.hs    | 24 +++++++++++++++++-------
 4 files changed, 26 insertions(+), 16 deletions(-)

diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 8884f69..0429580 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -280,8 +280,8 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode
       = ppInstances instances docname unicode qual
 
     -- Individual equation of a closed type family
-    ppTyFamEqn TyFamInstEqn { tfie_tycon = n, tfie_rhs = rhs
-                            , tfie_pats = HsWB { hswb_cts = ts }}
+    ppTyFamEqn TyFamEqn { tfe_tycon = n, tfe_rhs = rhs
+                        , tfe_pats = HsWB { hswb_cts = ts }}
       = ( ppAppNameTypes (unLoc n) [] (map unLoc ts) unicode qual
           <+> equals <+> ppType unicode qual (unLoc rhs)
         , Nothing, [] )
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 405bf20..dfb0f14 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -64,7 +64,7 @@ tyThingToLHsDecl t = noLoc $ case t of
            extractFamilyDecl _           =
              error "tyThingToLHsDecl: impossible associated tycon"
 
-           atTyClDecls = [synifyTyCon Nothing at_tc | (at_tc, _) <- classATItems cl]
+           atTyClDecls = [synifyTyCon Nothing at_tc | ATI at_tc _ <- classATItems cl]
            atFamDecls  = map extractFamilyDecl atTyClDecls in
        TyClD $ ClassDecl
          { tcdCtxt = synifyCtx (classSCTheta cl)
@@ -107,11 +107,11 @@ synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs })
         typats     = map (synifyType WithinType) args
         hs_rhs     = synifyType WithinType rhs
         (kvs, tvs) = partition isKindVar tkvs
-    in TyFamInstEqn { tfie_tycon = name
-                    , tfie_pats  = HsWB { hswb_cts = typats
-                                        , hswb_kvs = map tyVarName kvs
-                                        , hswb_tvs = map tyVarName tvs }
-                    , tfie_rhs   = hs_rhs }
+    in TyFamEqn { tfe_tycon = name
+                , tfe_pats  = HsWB { hswb_cts = typats
+                                    , hswb_kvs = map tyVarName kvs
+                                    , hswb_tvs = map tyVarName tvs }
+                , tfe_rhs   = hs_rhs }
 
 synifyAxiom :: CoAxiom br -> HsDecl Name
 synifyAxiom ax@(CoAxiom { co_ax_tc = tc })
diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index c06b34a..8ea5485 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/src/Haddock/GhcUtils.hs
@@ -102,7 +102,7 @@ getInstLoc (TyFamInstD (TyFamInstDecl
   -- Since CoAxioms' Names refer to the whole line for type family instances
   -- in particular, we need to dig a bit deeper to pull out the entire
   -- equation. This does not happen for data family instances, for some reason.
-  { tfid_eqn = L _ (TyFamInstEqn { tfie_rhs = L l _ })})) = l
+  { tfid_eqn = L _ (TyFamEqn { tfe_rhs = L l _ })})) = l
 
 -- Useful when there is a signature with multiple names, e.g.
 --   foo, bar :: Types..
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 2eb2cc0..a804f4a 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -323,7 +323,7 @@ renameTyClD d = case d of
     lfundeps' <- mapM renameLFunDep lfundeps
     lsigs'    <- mapM renameLSig lsigs
     ats'      <- mapM (renameLThing renameFamilyDecl) ats
-    at_defs'  <- mapM (mapM renameTyFamInstD) at_defs
+    at_defs'  <- mapM renameLTyFamDefltEqn at_defs
     -- we don't need the default methods or the already collected doc entities
     return (ClassDecl { tcdCtxt = lcontext', tcdLName = lname', tcdTyVars = ltyvars'
                       , tcdFDs = lfundeps', tcdSigs = lsigs', tcdMeths= emptyBag
@@ -351,7 +351,7 @@ renameFamilyInfo :: FamilyInfo Name -> RnM (FamilyInfo DocName)
 renameFamilyInfo DataFamily     = return DataFamily
 renameFamilyInfo OpenTypeFamily = return OpenTypeFamily
 renameFamilyInfo (ClosedTypeFamily eqns)
-  = do { eqns' <- mapM (renameLThing renameTyFamInstEqn) eqns
+  = do { eqns' <- mapM renameLTyFamInstEqn eqns
        ; return $ ClosedTypeFamily eqns' }
 
 renameDataDefn :: HsDataDefn Name -> RnM (HsDataDefn DocName)
@@ -456,17 +456,27 @@ renameClsInstD (ClsInstDecl { cid_overlap_mode = omode
 
 renameTyFamInstD :: TyFamInstDecl Name -> RnM (TyFamInstDecl DocName)
 renameTyFamInstD (TyFamInstDecl { tfid_eqn = eqn })
-  = do { eqn' <- renameLThing renameTyFamInstEqn eqn
+  = do { eqn' <- renameLTyFamInstEqn eqn
        ; return (TyFamInstDecl { tfid_eqn = eqn'
                                , tfid_fvs = placeHolderNames }) }
 
-renameTyFamInstEqn :: TyFamInstEqn Name -> RnM (TyFamInstEqn DocName)
-renameTyFamInstEqn (TyFamInstEqn { tfie_tycon = tc, tfie_pats = pats_w_bndrs, tfie_rhs = rhs })
+renameLTyFamInstEqn :: LTyFamInstEqn Name -> RnM (LTyFamInstEqn DocName)
+renameLTyFamInstEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = pats_w_bndrs, tfe_rhs = rhs }))
   = do { tc' <- renameL tc
        ; pats' <- mapM renameLType (hswb_cts pats_w_bndrs)
        ; rhs' <- renameLType rhs
-       ; return (TyFamInstEqn { tfie_tycon = tc', tfie_pats = pats_w_bndrs { hswb_cts = pats' }
-                              , tfie_rhs = rhs' }) }
+       ; return (L loc (TyFamEqn { tfe_tycon = tc'
+                                 , tfe_pats = pats_w_bndrs { hswb_cts = pats' }
+                                 , tfe_rhs = rhs' })) }
+
+renameLTyFamDefltEqn :: LTyFamDefltEqn Name -> RnM (LTyFamDefltEqn DocName)
+renameLTyFamDefltEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = tvs, tfe_rhs = rhs }))
+  = do { tc' <- renameL tc
+       ; tvs'  <- renameLTyVarBndrs tvs
+       ; rhs' <- renameLType rhs
+       ; return (L loc (TyFamEqn { tfe_tycon = tc'
+                                 , tfe_pats = tvs'
+                                 , tfe_rhs = rhs' })) }
 
 renameDataFamInstD :: DataFamInstDecl Name -> RnM (DataFamInstDecl DocName)
 renameDataFamInstD (DataFamInstDecl { dfid_tycon = tc, dfid_pats = pats_w_bndrs, dfid_defn = defn })



More information about the ghc-commits mailing list