{-# LANGUAGE CPP #-}
module Language.Haskell.TH.Desugar.FV
( fvDType
, extractBoundNamesDPat
) where
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable (foldMap)
#endif
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid ((<>))
#endif
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Desugar.AST
import qualified Language.Haskell.TH.Desugar.OSet as OS
import Language.Haskell.TH.Desugar.OSet (OSet)
fvDType :: DType -> OSet Name
fvDType = go
where
go :: DType -> OSet Name
go (DForallT tvbs ctxt ty) = fv_dtvbs tvbs (foldMap fvDType ctxt <> go ty)
go (DAppT t1 t2) = go t1 <> go t2
go (DAppKindT t k) = go t <> go k
go (DSigT ty ki) = go ty <> go ki
go (DVarT n) = OS.singleton n
go (DConT {}) = OS.empty
go DArrowT = OS.empty
go (DLitT {}) = OS.empty
go DWildCardT = OS.empty
extractBoundNamesDPat :: DPat -> OSet Name
extractBoundNamesDPat = go
where
go :: DPat -> OSet Name
go (DLitP _) = OS.empty
go (DVarP n) = OS.singleton n
go (DConP _ pats) = foldMap go pats
go (DTildeP p) = go p
go (DBangP p) = go p
go (DSigP p _) = go p
go DWildP = OS.empty
fv_dtvbs :: [DTyVarBndr] -> OSet Name -> OSet Name
fv_dtvbs tvbs fvs = foldr fv_dtvb fvs tvbs
fv_dtvb :: DTyVarBndr -> OSet Name -> OSet Name
fv_dtvb (DPlainTV n) fvs = OS.delete n fvs
fv_dtvb (DKindedTV n k) fvs = OS.delete n fvs <> fvDType k