diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2017-11-08 11:05:36 +0200 |
---|---|---|
committer | Alan Zimmerman <alan.zimm@gmail.com> | 2017-11-08 17:21:58 +0200 |
commit | 73a26af844ac50b8bec39de11d64452a6286b00c (patch) | |
tree | c426cb4bc0c5ba9f474096f8d1a54f26be155cbf /haddock-api/src/Haddock/Interface | |
parent | 01eeeb048acd2dd05ff6471ae148a97cf0720547 (diff) |
Match Trees That Grow
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 4 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/Specialize.hs | 5 |
2 files changed, 4 insertions, 5 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index c6a67af0..357cd780 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 (ValBindsOut _ sigs) = filter isUserLSig sigs + typesigs (XValBindsLR (NValBinds _ sigs)) = filter isUserLSig sigs typesigs _ = error "expected ValBindsOut" - valbinds (ValBindsOut binds _) = concatMap bagToList . snd . unzip $ binds + valbinds (XValBindsLR (NValBinds 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 0cac818d..f0cf08a1 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -203,12 +203,11 @@ setInternalOccName occ name = -- | Compute set of free variables of given type. -freeVariables :: forall p. (NamedThing (IdP p), DataId p, Typeable p) - => HsType p -> Set Name +freeVariables :: HsType GhcRn -> Set Name freeVariables = everythingWithState Set.empty Set.union query where - query term ctx = case cast term :: Maybe (HsType p) of + query term ctx = case cast term :: Maybe (HsType GhcRn) of Just (HsForAllTy _ bndrs _) -> (Set.empty, Set.union ctx (bndrsNames bndrs)) Just (HsTyVar _ _ (L _ name)) |