{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

-- | The contents of this module originate from module
--  [HSE.FreeVars](https://github.com/ndmitchell/hlint/blob/master/src/HSE/FreeVars.hs)
--  in Neil Mitchell's HLint.
module Language.Haskell.Exts.FreeVars
  ( FreeVars(..)
  , Vars(..)
  , AllVars(..)
  ) where

import           Control.Monad
import           Data.Data
import           Data.Generics.Uniplate.Data
import           Data.Monoid (Monoid(..))
import           Data.Semigroup (Semigroup(..))
import           Data.Set                      (Set)
import qualified Data.Set                      as Set
import           Language.Haskell.Exts
import           Prelude

(^+) :: (Data s, Ord s) => Set (Name s) -> Set (Name s) -> Set (Name s)
^+ :: Set (Name s) -> Set (Name s) -> Set (Name s)
(^+) = Set (Name s) -> Set (Name s) -> Set (Name s)
forall a. Ord a => Set a -> Set a -> Set a
Set.union
(^-) :: (Data s, Ord s) => Set (Name s) -> Set (Name s) -> Set (Name s)
^- :: Set (Name s) -> Set (Name s) -> Set (Name s)
(^-) = Set (Name s) -> Set (Name s) -> Set (Name s)
forall a. Ord a => Set a -> Set a -> Set a
Set.difference

data Vars = Vars {Vars -> Set (Name ())
bound :: Set (Name ()), Vars -> Set (Name ())
free :: Set (Name ())}

instance Semigroup Vars where
    Vars x1 :: Set (Name ())
x1 x2 :: Set (Name ())
x2 <> :: Vars -> Vars -> Vars
<> Vars y1 :: Set (Name ())
y1 y2 :: Set (Name ())
y2 = Set (Name ()) -> Set (Name ()) -> Vars
Vars (Set (Name ())
x1 Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall s.
(Data s, Ord s) =>
Set (Name s) -> Set (Name s) -> Set (Name s)
^+ Set (Name ())
y1) (Set (Name ())
x2 Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall s.
(Data s, Ord s) =>
Set (Name s) -> Set (Name s) -> Set (Name s)
^+ Set (Name ())
y2)

instance Monoid Vars where
    mempty :: Vars
mempty = Set (Name ()) -> Set (Name ()) -> Vars
Vars Set (Name ())
forall a. Set a
Set.empty Set (Name ())
forall a. Set a
Set.empty
#if !(MIN_VERSION_base(4,11,0))
    mappend = (<>)
#endif
    mconcat :: [Vars] -> Vars
mconcat fvs :: [Vars]
fvs = Set (Name ()) -> Set (Name ()) -> Vars
Vars ([Set (Name ())] -> Set (Name ())
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set (Name ())] -> Set (Name ()))
-> [Set (Name ())] -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ (Vars -> Set (Name ())) -> [Vars] -> [Set (Name ())]
forall a b. (a -> b) -> [a] -> [b]
map Vars -> Set (Name ())
bound [Vars]
fvs) ([Set (Name ())] -> Set (Name ())
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set (Name ())] -> Set (Name ()))
-> [Set (Name ())] -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ (Vars -> Set (Name ())) -> [Vars] -> [Set (Name ())]
forall a b. (a -> b) -> [a] -> [b]
map Vars -> Set (Name ())
free [Vars]
fvs)

class AllVars a where
    -- | Return the variables, erring on the side of more free variables
    allVars :: a -> Vars

class FreeVars a where
    -- | Return the variables, erring on the side of more free variables
    freeVars :: a -> Set (Name ())

freeVars_ :: (FreeVars a) => a -> Vars
freeVars_ :: a -> Vars
freeVars_ = Set (Name ()) -> Set (Name ()) -> Vars
Vars Set (Name ())
forall a. Set a
Set.empty (Set (Name ()) -> Vars) -> (a -> Set (Name ())) -> a -> Vars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars

inFree
  :: (AllVars a, FreeVars b)
  => a -> b -> Set (Name ())
inFree :: a -> b -> Set (Name ())
inFree a :: a
a b :: b
b = Vars -> Set (Name ())
free Vars
aa Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall s.
(Data s, Ord s) =>
Set (Name s) -> Set (Name s) -> Set (Name s)
^+ (b -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars b
b Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall s.
(Data s, Ord s) =>
Set (Name s) -> Set (Name s) -> Set (Name s)
^- Vars -> Set (Name ())
bound Vars
aa)
    where aa :: Vars
aa = a -> Vars
forall a. AllVars a => a -> Vars
allVars a
a

inVars
  :: (AllVars a, AllVars b)
  => a -> b -> Vars
inVars :: a -> b -> Vars
inVars a :: a
a b :: b
b = Set (Name ()) -> Set (Name ()) -> Vars
Vars (Vars -> Set (Name ())
bound Vars
aa Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall s.
(Data s, Ord s) =>
Set (Name s) -> Set (Name s) -> Set (Name s)
^+ Vars -> Set (Name ())
bound Vars
bb) (Vars -> Set (Name ())
free Vars
aa Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall s.
(Data s, Ord s) =>
Set (Name s) -> Set (Name s) -> Set (Name s)
^+ (Vars -> Set (Name ())
free Vars
bb Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall s.
(Data s, Ord s) =>
Set (Name s) -> Set (Name s) -> Set (Name s)
^- Vars -> Set (Name ())
bound Vars
aa))
    where aa :: Vars
aa = a -> Vars
forall a. AllVars a => a -> Vars
allVars a
a
          bb :: Vars
bb = b -> Vars
forall a. AllVars a => a -> Vars
allVars b
b

unqualNames :: QName s -> [Name ()]
unqualNames :: QName s -> [Name ()]
unqualNames (UnQual _ x :: Name s
x) = [Name s -> Name ()
forall s. Name s -> Name ()
withNoLoc Name s
x]
unqualNames _            = []

unqualOp :: QOp s -> [Name ()]
unqualOp :: QOp s -> [Name ()]
unqualOp (QVarOp _ x :: QName s
x) = QName s -> [Name ()]
forall s. QName s -> [Name ()]
unqualNames QName s
x
unqualOp (QConOp _ x :: QName s
x) = QName s -> [Name ()]
forall s. QName s -> [Name ()]
unqualNames QName s
x

withNoLoc :: Name s -> Name ()
withNoLoc :: Name s -> Name ()
withNoLoc = Name s -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void

instance (Data s, Ord s) => FreeVars (Set (Name s)) where
    freeVars :: Set (Name s) -> Set (Name ())
freeVars = (Name s -> Name ()) -> Set (Name s) -> Set (Name ())
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Name s -> Name ()
forall s. Name s -> Name ()
withNoLoc

instance AllVars Vars where
    allVars :: Vars -> Vars
allVars = Vars -> Vars
forall a. a -> a
id

instance (Data s, Ord s) => FreeVars (Exp s) where -- never has any bound variables
    freeVars :: Exp s -> Set (Name ())
freeVars (Var _ x :: QName s
x) = [Name ()] -> Set (Name ())
forall a. Ord a => [a] -> Set a
Set.fromList ([Name ()] -> Set (Name ())) -> [Name ()] -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ QName s -> [Name ()]
forall s. QName s -> [Name ()]
unqualNames QName s
x
    freeVars (VarQuote l :: s
l x :: QName s
x) = Exp s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars (Exp s -> Set (Name ())) -> Exp s -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ s -> QName s -> Exp s
forall l. l -> QName l -> Exp l
Var s
l QName s
x
    freeVars (SpliceExp _ (IdSplice l :: s
l x :: String
x)) = [Name ()] -> Set (Name ())
forall a. Ord a => [a] -> Set a
Set.fromList [Name s -> Name ()
forall s. Name s -> Name ()
withNoLoc (Name s -> Name ()) -> Name s -> Name ()
forall a b. (a -> b) -> a -> b
$ s -> String -> Name s
forall l. l -> String -> Name l
Ident s
l String
x]
    freeVars (InfixApp _ a :: Exp s
a op :: QOp s
op b :: Exp s
b) =
      Exp s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars Exp s
a Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall s.
(Data s, Ord s) =>
Set (Name s) -> Set (Name s) -> Set (Name s)
^+ [Name ()] -> Set (Name ())
forall a. Ord a => [a] -> Set a
Set.fromList (QOp s -> [Name ()]
forall s. QOp s -> [Name ()]
unqualOp QOp s
op) Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall s.
(Data s, Ord s) =>
Set (Name s) -> Set (Name s) -> Set (Name s)
^+ Exp s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars Exp s
b
    freeVars (LeftSection _ a :: Exp s
a op :: QOp s
op) = Exp s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars Exp s
a Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall s.
(Data s, Ord s) =>
Set (Name s) -> Set (Name s) -> Set (Name s)
^+ [Name ()] -> Set (Name ())
forall a. Ord a => [a] -> Set a
Set.fromList (QOp s -> [Name ()]
forall s. QOp s -> [Name ()]
unqualOp QOp s
op)
    freeVars (RightSection _ op :: QOp s
op b :: Exp s
b) = [Name ()] -> Set (Name ())
forall a. Ord a => [a] -> Set a
Set.fromList (QOp s -> [Name ()]
forall s. QOp s -> [Name ()]
unqualOp QOp s
op) Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall s.
(Data s, Ord s) =>
Set (Name s) -> Set (Name s) -> Set (Name s)
^+ Exp s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars Exp s
b
    freeVars (Lambda _ p :: [Pat s]
p x :: Exp s
x) = [Pat s] -> Exp s -> Set (Name ())
forall a b. (AllVars a, FreeVars b) => a -> b -> Set (Name ())
inFree [Pat s]
p Exp s
x
    freeVars (Let _ bind :: Binds s
bind x :: Exp s
x) = Binds s -> Exp s -> Set (Name ())
forall a b. (AllVars a, FreeVars b) => a -> b -> Set (Name ())
inFree Binds s
bind Exp s
x
    freeVars (Case _ x :: Exp s
x alts :: [Alt s]
alts) = Exp s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars Exp s
x Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall a. Monoid a => a -> a -> a
`mappend` [Alt s] -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars [Alt s]
alts
    freeVars (Do _ xs :: [Stmt s]
xs) = Vars -> Set (Name ())
free (Vars -> Set (Name ())) -> Vars -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ [Stmt s] -> Vars
forall a. AllVars a => a -> Vars
allVars [Stmt s]
xs
    freeVars (MDo l :: s
l xs :: [Stmt s]
xs) = Exp s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars (Exp s -> Set (Name ())) -> Exp s -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ s -> [Stmt s] -> Exp s
forall l. l -> [Stmt l] -> Exp l
Do s
l [Stmt s]
xs
    freeVars (RecConstr _ _ a :: [FieldUpdate s]
a) = [Set (Name ())] -> Set (Name ())
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set (Name ())] -> Set (Name ()))
-> [Set (Name ())] -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ (FieldUpdate s -> Set (Name ()))
-> [FieldUpdate s] -> [Set (Name ())]
forall a b. (a -> b) -> [a] -> [b]
map FieldUpdate s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars [FieldUpdate s]
a
    freeVars (RecUpdate _ a :: Exp s
a b :: [FieldUpdate s]
b) = [Set (Name ())] -> Set (Name ())
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set (Name ())] -> Set (Name ()))
-> [Set (Name ())] -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ Exp s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars Exp s
a Set (Name ()) -> [Set (Name ())] -> [Set (Name ())]
forall a. a -> [a] -> [a]
: (FieldUpdate s -> Set (Name ()))
-> [FieldUpdate s] -> [Set (Name ())]
forall a b. (a -> b) -> [a] -> [b]
map FieldUpdate s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars [FieldUpdate s]
b
    freeVars (ParComp _ x :: Exp s
x xs :: [[QualStmt s]]
xs) = Vars -> Set (Name ())
free Vars
xfv Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall s.
(Data s, Ord s) =>
Set (Name s) -> Set (Name s) -> Set (Name s)
^+ (Exp s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars Exp s
x Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall s.
(Data s, Ord s) =>
Set (Name s) -> Set (Name s) -> Set (Name s)
^- Vars -> Set (Name ())
bound Vars
xfv)
        where xfv :: Vars
xfv = [Vars] -> Vars
forall a. Monoid a => [a] -> a
mconcat ([Vars] -> Vars) -> [Vars] -> Vars
forall a b. (a -> b) -> a -> b
$ ([QualStmt s] -> Vars) -> [[QualStmt s]] -> [Vars]
forall a b. (a -> b) -> [a] -> [b]
map [QualStmt s] -> Vars
forall a. AllVars a => a -> Vars
allVars [[QualStmt s]]
xs
    freeVars (ListComp l :: s
l x :: Exp s
x xs :: [QualStmt s]
xs) = Exp s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars (Exp s -> Set (Name ())) -> Exp s -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ s -> Exp s -> [[QualStmt s]] -> Exp s
forall l. l -> Exp l -> [[QualStmt l]] -> Exp l
ParComp s
l Exp s
x [[QualStmt s]
xs]
    freeVars x :: Exp s
x = [Exp s] -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars ([Exp s] -> Set (Name ())) -> [Exp s] -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ Exp s -> [Exp s]
forall on. Uniplate on => on -> [on]
children Exp s
x

instance (Data s, Ord s) => FreeVars (FieldUpdate s) where
    freeVars :: FieldUpdate s -> Set (Name ())
freeVars (FieldUpdate _ _ x :: Exp s
x) = Exp s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars Exp s
x
    freeVars (FieldPun _ x :: QName s
x) = [Name ()] -> Set (Name ())
forall a. Ord a => [a] -> Set a
Set.fromList ([Name ()] -> Set (Name ())) -> [Name ()] -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ QName s -> [Name ()]
forall s. QName s -> [Name ()]
unqualNames QName s
x
    freeVars (FieldWildcard _) = Set (Name ())
forall a. Set a
Set.empty -- have no idea what's in here

instance (Data s, Ord s) => FreeVars [Exp s] where
    freeVars :: [Exp s] -> Set (Name ())
freeVars = [Set (Name ())] -> Set (Name ())
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set (Name ())] -> Set (Name ()))
-> ([Exp s] -> [Set (Name ())]) -> [Exp s] -> Set (Name ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp s -> Set (Name ())) -> [Exp s] -> [Set (Name ())]
forall a b. (a -> b) -> [a] -> [b]
map Exp s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars

instance (Data s, Ord s) => AllVars (Pat s) where
    allVars :: Pat s -> Vars
allVars (PVar _ x :: Name s
x)       = Set (Name ()) -> Set (Name ()) -> Vars
Vars (Name () -> Set (Name ())
forall a. a -> Set a
Set.singleton (Name () -> Set (Name ())) -> Name () -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ Name s -> Name ()
forall s. Name s -> Name ()
withNoLoc Name s
x) Set (Name ())
forall a. Set a
Set.empty
    allVars (PNPlusK l :: s
l x :: Name s
x _)  = Pat s -> Vars
forall a. AllVars a => a -> Vars
allVars (s -> Name s -> Pat s
forall l. l -> Name l -> Pat l
PVar s
l Name s
x)
    allVars (PAsPat l :: s
l n :: Name s
n x :: Pat s
x)   = Pat s -> Vars
forall a. AllVars a => a -> Vars
allVars (s -> Name s -> Pat s
forall l. l -> Name l -> Pat l
PVar s
l Name s
n) Vars -> Vars -> Vars
forall a. Monoid a => a -> a -> a
`mappend` Pat s -> Vars
forall a. AllVars a => a -> Vars
allVars Pat s
x
    allVars (PRec _ _ x :: [PatField s]
x)     = [PatField s] -> Vars
forall a. AllVars a => a -> Vars
allVars [PatField s]
x
    allVars (PViewPat _ e :: Exp s
e p :: Pat s
p) = Exp s -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ Exp s
e Vars -> Vars -> Vars
forall a. Monoid a => a -> a -> a
`mappend` Pat s -> Vars
forall a. AllVars a => a -> Vars
allVars Pat s
p
    allVars x :: Pat s
x                = [Pat s] -> Vars
forall a. AllVars a => a -> Vars
allVars ([Pat s] -> Vars) -> [Pat s] -> Vars
forall a b. (a -> b) -> a -> b
$ Pat s -> [Pat s]
forall on. Uniplate on => on -> [on]
children Pat s
x

instance (Data s, Ord s) => AllVars [Pat s] where
    allVars :: [Pat s] -> Vars
allVars = [Vars] -> Vars
forall a. Monoid a => [a] -> a
mconcat ([Vars] -> Vars) -> ([Pat s] -> [Vars]) -> [Pat s] -> Vars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat s -> Vars) -> [Pat s] -> [Vars]
forall a b. (a -> b) -> [a] -> [b]
map Pat s -> Vars
forall a. AllVars a => a -> Vars
allVars

instance (Data s, Ord s) => AllVars (PatField s) where
    allVars :: PatField s -> Vars
allVars (PFieldPat _ _ x :: Pat s
x) = Pat s -> Vars
forall a. AllVars a => a -> Vars
allVars Pat s
x
    allVars (PFieldPun _ (UnQual _ x :: Name s
x)) = Set (Name ()) -> Set (Name ()) -> Vars
Vars (Name () -> Set (Name ())
forall a. a -> Set a
Set.singleton (Name () -> Set (Name ())) -> Name () -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ Name s -> Name ()
forall s. Name s -> Name ()
withNoLoc Name s
x) Set (Name ())
forall a. Set a
Set.empty
    allVars (PFieldPun _ (Qual _ _ x :: Name s
x)) = Set (Name ()) -> Set (Name ()) -> Vars
Vars (Name () -> Set (Name ())
forall a. a -> Set a
Set.singleton (Name () -> Set (Name ())) -> Name () -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ Name s -> Name ()
forall s. Name s -> Name ()
withNoLoc Name s
x) Set (Name ())
forall a. Set a
Set.empty
    allVars (PFieldWildcard _) = Vars
forall a. Monoid a => a
mempty -- explicitly cannot guess what might be bound here

instance (Data s, Ord s) => AllVars [PatField s] where
    allVars :: [PatField s] -> Vars
allVars = [Vars] -> Vars
forall a. Monoid a => [a] -> a
mconcat ([Vars] -> Vars)
-> ([PatField s] -> [Vars]) -> [PatField s] -> Vars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatField s -> Vars) -> [PatField s] -> [Vars]
forall a b. (a -> b) -> [a] -> [b]
map PatField s -> Vars
forall a. AllVars a => a -> Vars
allVars

instance (Data s, Ord s) => FreeVars (Alt s) where
    freeVars :: Alt s -> Set (Name ())
freeVars (Language.Haskell.Exts.Alt _ pat :: Pat s
pat alt :: Rhs s
alt bind :: Maybe (Binds s)
bind) = Pat s -> Set (Name ()) -> Set (Name ())
forall a b. (AllVars a, FreeVars b) => a -> b -> Set (Name ())
inFree Pat s
pat (Set (Name ()) -> Set (Name ())) -> Set (Name ()) -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ Maybe (Binds s) -> Rhs s -> Set (Name ())
forall a b. (AllVars a, FreeVars b) => a -> b -> Set (Name ())
inFree Maybe (Binds s)
bind Rhs s
alt

instance (Data s, Ord s) => FreeVars [Alt s] where
    freeVars :: [Alt s] -> Set (Name ())
freeVars = [Set (Name ())] -> Set (Name ())
forall a. Monoid a => [a] -> a
mconcat ([Set (Name ())] -> Set (Name ()))
-> ([Alt s] -> [Set (Name ())]) -> [Alt s] -> Set (Name ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alt s -> Set (Name ())) -> [Alt s] -> [Set (Name ())]
forall a b. (a -> b) -> [a] -> [b]
map Alt s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars

instance (Data s, Ord s) => FreeVars (Rhs s) where
    freeVars :: Rhs s -> Set (Name ())
freeVars (UnGuardedRhs _ x :: Exp s
x) = Exp s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars Exp s
x
    freeVars (GuardedRhss _ xs :: [GuardedRhs s]
xs) = [Set (Name ())] -> Set (Name ())
forall a. Monoid a => [a] -> a
mconcat ([Set (Name ())] -> Set (Name ()))
-> [Set (Name ())] -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ (GuardedRhs s -> Set (Name ()))
-> [GuardedRhs s] -> [Set (Name ())]
forall a b. (a -> b) -> [a] -> [b]
map GuardedRhs s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars [GuardedRhs s]
xs

instance (Data s, Ord s) => FreeVars (GuardedRhs s) where
    freeVars :: GuardedRhs s -> Set (Name ())
freeVars (GuardedRhs _ stmt :: [Stmt s]
stmt exp :: Exp s
exp) = [Stmt s] -> Exp s -> Set (Name ())
forall a b. (AllVars a, FreeVars b) => a -> b -> Set (Name ())
inFree [Stmt s]
stmt Exp s
exp

instance (Data s, Ord s) => AllVars (QualStmt s) where
    allVars :: QualStmt s -> Vars
allVars (QualStmt _ x :: Stmt s
x) = Stmt s -> Vars
forall a. AllVars a => a -> Vars
allVars Stmt s
x
    allVars x :: QualStmt s
x              = [Exp s] -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ (QualStmt s -> [Exp s]
forall from to. Biplate from to => from -> [to]
childrenBi QualStmt s
x :: [Exp s])

instance (Data s, Ord s) => AllVars [QualStmt s] where
    allVars :: [QualStmt s] -> Vars
allVars (x :: QualStmt s
x:xs :: [QualStmt s]
xs) = QualStmt s -> [QualStmt s] -> Vars
forall a b. (AllVars a, AllVars b) => a -> b -> Vars
inVars QualStmt s
x [QualStmt s]
xs
    allVars []     = Vars
forall a. Monoid a => a
mempty

instance (Data s, Ord s) => AllVars [Stmt s] where
    allVars :: [Stmt s] -> Vars
allVars (x :: Stmt s
x:xs :: [Stmt s]
xs) = Stmt s -> [Stmt s] -> Vars
forall a b. (AllVars a, AllVars b) => a -> b -> Vars
inVars Stmt s
x [Stmt s]
xs
    allVars []     = Vars
forall a. Monoid a => a
mempty

instance (Data s, Ord s) => AllVars (Stmt s) where
    allVars :: Stmt s -> Vars
allVars (Generator _ pat :: Pat s
pat exp :: Exp s
exp) = Pat s -> Vars
forall a. AllVars a => a -> Vars
allVars Pat s
pat Vars -> Vars -> Vars
forall a. Monoid a => a -> a -> a
`mappend` Exp s -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ Exp s
exp
    allVars (Qualifier _ exp :: Exp s
exp)     = Exp s -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ Exp s
exp
    allVars (LetStmt _ binds :: Binds s
binds)     = Binds s -> Vars
forall a. AllVars a => a -> Vars
allVars Binds s
binds
    allVars (RecStmt _ stmts :: [Stmt s]
stmts)     = [Stmt s] -> Vars
forall a. AllVars a => a -> Vars
allVars [Stmt s]
stmts

instance (Data s, Ord s) => AllVars (Maybe (Binds s)) where
    allVars :: Maybe (Binds s) -> Vars
allVars = Vars -> (Binds s -> Vars) -> Maybe (Binds s) -> Vars
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Vars
forall a. Monoid a => a
mempty Binds s -> Vars
forall a. AllVars a => a -> Vars
allVars

instance (Data s, Ord s) => AllVars (Binds s) where
    allVars :: Binds s -> Vars
allVars (BDecls _ decls :: [Decl s]
decls)  = [Decl s] -> Vars
forall a. AllVars a => a -> Vars
allVars [Decl s]
decls
    allVars (IPBinds _ binds :: [IPBind s]
binds) = [IPBind s] -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ [IPBind s]
binds

instance (Data s, Ord s) => AllVars [Decl s] where
    allVars :: [Decl s] -> Vars
allVars = [Vars] -> Vars
forall a. Monoid a => [a] -> a
mconcat ([Vars] -> Vars) -> ([Decl s] -> [Vars]) -> [Decl s] -> Vars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decl s -> Vars) -> [Decl s] -> [Vars]
forall a b. (a -> b) -> [a] -> [b]
map Decl s -> Vars
forall a. AllVars a => a -> Vars
allVars

instance (Data s, Ord s) => AllVars (Decl s) where
    allVars :: Decl s -> Vars
allVars (FunBind _ m :: [Match s]
m) = [Match s] -> Vars
forall a. AllVars a => a -> Vars
allVars [Match s]
m
    allVars (PatBind _ pat :: Pat s
pat rhs :: Rhs s
rhs bind :: Maybe (Binds s)
bind) = Pat s -> Vars
forall a. AllVars a => a -> Vars
allVars Pat s
pat Vars -> Vars -> Vars
forall a. Monoid a => a -> a -> a
`mappend` Set (Name ()) -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ (Maybe (Binds s) -> Rhs s -> Set (Name ())
forall a b. (AllVars a, FreeVars b) => a -> b -> Set (Name ())
inFree Maybe (Binds s)
bind Rhs s
rhs)
    allVars _ = Vars
forall a. Monoid a => a
mempty

instance (Data s, Ord s) => AllVars [Match s] where
    allVars :: [Match s] -> Vars
allVars = [Vars] -> Vars
forall a. Monoid a => [a] -> a
mconcat ([Vars] -> Vars) -> ([Match s] -> [Vars]) -> [Match s] -> Vars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Match s -> Vars) -> [Match s] -> [Vars]
forall a b. (a -> b) -> [a] -> [b]
map Match s -> Vars
forall a. AllVars a => a -> Vars
allVars

instance (Data s, Ord s) => AllVars (Match s) where
    allVars :: Match s -> Vars
allVars (Match l :: s
l name :: Name s
name pat :: [Pat s]
pat rhs :: Rhs s
rhs binds :: Maybe (Binds s)
binds) = Pat s -> Vars
forall a. AllVars a => a -> Vars
allVars (s -> Name s -> Pat s
forall l. l -> Name l -> Pat l
PVar s
l Name s
name) Vars -> Vars -> Vars
forall a. Monoid a => a -> a -> a
`mappend` Set (Name ()) -> Vars
forall a. FreeVars a => a -> Vars
freeVars_ ([Pat s] -> Set (Name ()) -> Set (Name ())
forall a b. (AllVars a, FreeVars b) => a -> b -> Set (Name ())
inFree [Pat s]
pat (Maybe (Binds s) -> Rhs s -> Set (Name ())
forall a b. (AllVars a, FreeVars b) => a -> b -> Set (Name ())
inFree Maybe (Binds s)
binds Rhs s
rhs))
    allVars (InfixMatch l :: s
l p1 :: Pat s
p1 name :: Name s
name p2 :: [Pat s]
p2 rhs :: Rhs s
rhs binds :: Maybe (Binds s)
binds) = Match s -> Vars
forall a. AllVars a => a -> Vars
allVars (Match s -> Vars) -> Match s -> Vars
forall a b. (a -> b) -> a -> b
$ s -> Name s -> [Pat s] -> Rhs s -> Maybe (Binds s) -> Match s
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match s
l Name s
name (Pat s
p1Pat s -> [Pat s] -> [Pat s]
forall a. a -> [a] -> [a]
:[Pat s]
p2) Rhs s
rhs Maybe (Binds s)
binds

instance (Data s, Ord s) => FreeVars [IPBind s] where
    freeVars :: [IPBind s] -> Set (Name ())
freeVars = [Set (Name ())] -> Set (Name ())
forall a. Monoid a => [a] -> a
mconcat ([Set (Name ())] -> Set (Name ()))
-> ([IPBind s] -> [Set (Name ())]) -> [IPBind s] -> Set (Name ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IPBind s -> Set (Name ())) -> [IPBind s] -> [Set (Name ())]
forall a b. (a -> b) -> [a] -> [b]
map IPBind s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars

instance (Data s, Ord s) => FreeVars (IPBind s) where
    freeVars :: IPBind s -> Set (Name ())
freeVars (IPBind _ _ exp :: Exp s
exp) = Exp s -> Set (Name ())
forall a. FreeVars a => a -> Set (Name ())
freeVars Exp s
exp