diff options
author | Ben Gamari <ben@smart-cactus.org> | 2017-11-21 15:50:15 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2017-11-21 15:50:15 -0500 |
commit | be45ddae4e2f7d971f2166d9a8fe45402ddcb3c1 (patch) | |
tree | 26c5f70eb323acac0eb125025fc1f44f0e27e96d | |
parent | c3f8a3b396e0051133120d2381e73af8cf9c8951 (diff) |
Revert "Match Trees That Grow"
This reverts commit 73a26af844ac50b8bec39de11d64452a6286b00c.
-rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 4 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/Specialize.hs | 5 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Types.hs | 3 |
3 files changed, 5 insertions, 7 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 357cd780..c6a67af0 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -520,10 +520,10 @@ ungroup group_ = mkDecls (typesigs . hs_valds) SigD group_ ++ mkDecls (valbinds . hs_valds) ValD group_ where - typesigs (XValBindsLR (NValBinds _ sigs)) = filter isUserLSig sigs + typesigs (ValBindsOut _ sigs) = filter isUserLSig sigs typesigs _ = error "expected ValBindsOut" - valbinds (XValBindsLR (NValBinds binds _)) = concatMap bagToList . snd . unzip $ binds + valbinds (ValBindsOut binds _) = concatMap bagToList . snd . unzip $ binds valbinds _ = error "expected ValBindsOut" diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index f0cf08a1..0cac818d 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -203,11 +203,12 @@ setInternalOccName occ name = -- | Compute set of free variables of given type. -freeVariables :: HsType GhcRn -> Set Name +freeVariables :: forall p. (NamedThing (IdP p), DataId p, Typeable p) + => HsType p -> Set Name freeVariables = everythingWithState Set.empty Set.union query where - query term ctx = case cast term :: Maybe (HsType GhcRn) of + query term ctx = case cast term :: Maybe (HsType p) of Just (HsForAllTy _ bndrs _) -> (Set.empty, Set.union ctx (bndrsNames bndrs)) Just (HsTyVar _ _ (L _ name)) diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index bb8ea9c7..f0f1b2f4 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -697,6 +697,3 @@ type instance XXTyVarBndr DocNameI = PlaceHolder type instance XFieldOcc DocNameI = DocName type instance XXFieldOcc DocNameI = PlaceHolder - -type instance XValBinds DocNameI DocNameI = PlaceHolder -type instance XXValBindsLR DocNameI DocNameI = NHsValBindsLR DocNameI |