content: 
  module DDC.Core.Collect.FreeT
          ( FreeVarConT(..)
          , freeVarsT)
  where
  import DDC.Core.Collect.BindStruct
  import DDC.Type.Exp
  import DDC.Type.Env             (KindEnv)
  import Data.Set                 (Set)
  import qualified DDC.Type.Env   as Env
  import qualified DDC.Type.Sum   as Sum
  import qualified Data.Set       as Set
  
  
  -- | Collect the free type variables in a type.
  freeVarsT
          :: Ord n
          => KindEnv n -> Type n
          -> Set (Bound n)
  freeVarsT kenv tt
   = fst $ freeVarConT kenv tt
  
  
  instance BindStruct (Type n) n where
   slurpBindTree tt
    = case tt of
          TVar u          -> [BindUse BoundSpec u]
          TCon tc         -> slurpBindTree tc
          TAbs b t        -> [bindDefT BindTAbs   [b] [t]]
          TApp t1 t2      -> slurpBindTree t1 ++ slurpBindTree t2
          TForall b t     -> [bindDefT BindForall [b] [t]]
          TSum ts         -> concatMap slurpBindTree $ Sum.toList ts
          TRow r          -> concatMap slurpBindTree $ map snd r
  
  
  instance BindStruct (TyCon n) n where
   slurpBindTree tc
    = case tc of
          TyConBound n    -> [BindCon BoundSpec (UName n) Nothing]
          _               -> []
  
  
  class FreeVarConT (c :: * -> *) where
    -- | Collect the free type variables and constructors used in a thing.
    freeVarConT
          :: Ord n
          => KindEnv n -> c n
          -> (Set (Bound n), Set (Bound n))
  
  
  instance FreeVarConT Type where
   freeVarConT kenv tt
    = case tt of
          TVar u
           -> if Env.member u kenv
                  then (Set.empty, Set.empty)
                  else (Set.singleton u, Set.empty)
  
          TCon tc
           | TyConBound n <- tc   -> (Set.empty, Set.singleton (UName n))
           | otherwise            -> (Set.empty, Set.empty)
  
          TAbs b t
           -> freeVarConT (Env.extend b kenv) t
  
          TApp t1 t2
           -> let (vs1, cs1)      = freeVarConT kenv t1
                  (vs2, cs2)      = freeVarConT kenv t2
              in  ( Set.union vs1 vs2
                  , Set.union cs1 cs2)
  
          TForall b t
           -> freeVarConT (Env.extend b kenv) t
  
          TSum ts
           -> let (vss, css)      = unzip $ map (freeVarConT kenv) $ Sum.toList ts
              in  (Set.unions vss, Set.unions css)
  
          TRow r
           -> let (vss, css)      = unzip $ map (freeVarConT kenv) $ map snd r
              in  (Set.unions vss, Set.unions css)
  
  