content: module CFreeVars (
                    -- get the variables and value constructors:
                    getFVE,  -- of a CExpr
                    getFVDl, -- of a CDefl
                    getFVD,  -- of a CDef
                    getFVC,  -- of a CClause
                    getFVR,  -- of a CRule
  
                    -- for recursive constructs, allow removing it's own name
                    deleteV,
  
                    -- FVSet to list functions
                    fvSetToFreeVars,
                    fvSetToFreeCons,
  
                    -- get the variables bound by:
                    getPV,       -- a CPat
                    getPVs,      -- a CPat list
                    getStmtBind, -- a CStmt list
                    getLDefs,    -- a CDefl
                    getVQuals,   -- a [CQual]
  
                    -- get type constructors in:
                    getFQTyCons, -- a CQType
                    getFTyCons,  -- a CType
                    getFTCDn,    -- a CDefn
                    getFTCC,     -- a CClause
  
                    -- get type variables:
                    getFQTyVars,  -- returns the unique names
                    getFQTyVarsT, -- returns the unique TyVar (includes kind etc)
                    getCPTyVars,  -- like getFQTyVars but for CPred
  
                    -- get the names of toplevel CDefn
                    getVDefIds
     ) where
  
  import qualified Data.Set as S
  import Util(set_deleteMany)
  
  import Id
  import ErrorUtil(internalError)
  import CSyntax
  import PreIds(idPrimGetName)
  import CType(typeclassId)
  -- import PPrint
  -- import Debug.Trace
  
  
  -- --------------------
  
  -- The "free variable" functions actually return free variables and
  -- value constructors, which are not in the same namespace, so we return
  -- two separate sets.
  
  -- constructor set, variable set
  type FVSet = (S.Set Id, S.Set Id)
  
  fvSetToFreeVars :: FVSet -> [Id]
  fvSetToFreeVars (_, v_set) = S.toList v_set
  
  fvSetToFreeCons :: FVSet -> [Id]
  fvSetToFreeCons (c_set, _) = S.toList c_set
  
  emptyFVS :: FVSet
  emptyFVS = (S.empty, S.empty)
  
  unionFVS :: FVSet -> FVSet -> FVSet
  unionFVS (cs1, vs1) (cs2, vs2) = (cs1 `S.union` cs2, vs1 `S.union` vs2)
  
  unionManyFVS :: [FVSet] -> FVSet
  unionManyFVS cvs =
      let (cs, vs) = unzip cvs
      in  (S.unions cs, S.unions vs)
  
  -- delete a single bound variable
  deleteV :: Id -> FVSet -> FVSet
  deleteV i (cs, vs) = (cs, S.delete i vs)
  
  -- delete many bound variables
  deleteManyV :: [Id] -> FVSet -> FVSet
  deleteManyV is (cs, vs) = (cs, set_deleteMany is vs)
  
  -- delete a set of bound variables
  minusVS :: FVSet -> S.Set Id -> FVSet
  minusVS (cs, vs1) vs2 = (cs, vs1 `S.difference` vs2)
  
  -- add a set of constructors
  plusCS :: FVSet -> S.Set Id -> FVSet
  plusCS (cs1, vs) cs2 = (cs1 `S.union` cs2, vs)
  
  -- add a variable
  addV :: Id -> FVSet -> FVSet
  addV i (cs, vs) = (cs, S.insert i vs)
  
  -- add a constructor
  addC :: Id -> FVSet -> FVSet
  addC i (cs, vs) = (S.insert i cs, vs)
  
  -- singleton variable
  singletonV :: Id -> FVSet
  singletonV i = (S.empty, S.singleton i)
  
  -- singleton variable
  singletonC :: Id -> FVSet
  singletonC i = (S.singleton i, S.empty)
  
  -- --------------------
  
  -- Get free value variables
  getFVE :: CExpr -> FVSet
  getFVE (CLam (Right i) e) = deleteV i (getFVE e)
  getFVE (CLam (Left _) e) = getFVE e
  getFVE (CLamT (Right i) _ e) = deleteV i (getFVE e)
  getFVE (CLamT (Left _) _ e) = getFVE e
  getFVE (Cletseq let_arms expr) =
      let (defs, free_vars_rhs) = getFVSeqDefls let_arms
          free_vars_expr = getFVE expr `minusVS` defs
      in  free_vars_rhs `unionFVS` free_vars_expr
  getFVE (Cletrec defs expr) =
      let defined_vars = concatMap getLDefs defs
          fve_rhs_and_expr = unionManyFVS (getFVE expr : map getFVDl defs)
      in  deleteManyV defined_vars fve_rhs_and_expr
  getFVE (CSelect e i) = getFVE e  ---- XXX WRONG i is field addV i (getFVE e)
  getFVE (CSelectTT _ e i) = getFVE e -- XXX WRONG i is field addV i (getFVE e)
  getFVE (CCon i es) = addC i (unionManyFVS (map getFVE es))
  getFVE (Ccase pos e as) = unionFVS (getFVE e) (unionManyFVS (map getFVArm as))
    where getFVArm arm =
              let -- better to do two minuses than union and one minus
                  pat_bound  = getPV (cca_pattern arm)
                  qual_bound = getVQuals (cca_filters arm)
              in (((getFVQuals (cca_filters arm)) `unionFVS`
                   (getFVE (cca_consequent arm) `minusVS` qual_bound)) `minusVS`
                   pat_bound) `plusCS` (getPC (cca_pattern arm))
  getFVE (CStruct _ i ies) =
      -- XXX doesn't return the fields
      addC i $ unionManyFVS [getFVE e | (i, e) <- ies]
  getFVE (CStructUpd e ies) =
      unionManyFVS (getFVE e : [getFVE e | (i, e) <- ies])
  getFVE (Cwrite pos e v) = unionFVS (getFVE e) (getFVE v)
  getFVE (CAny {}) = emptyFVS
  getFVE (CVar i) = singletonV i
  getFVE (CApply (CVar i) es) | i == idPrimGetName = singletonV idPrimGetName
  getFVE (CApply e es) = unionManyFVS (map getFVE (e:es))
  getFVE (CTaskApply e es) = unionManyFVS (map getFVE (e:es))
  getFVE (CTaskApplyT e t es) = unionManyFVS (map getFVE (e:es))
  getFVE (CLit _) = emptyFVS
  getFVE (CBinOp l i r) =
      -- XXX should we be adding the operator?
      addV i (getFVE l `unionFVS` getFVE r)
  getFVE (CHasType e t) = getFVE e
  getFVE (Cif pos c t e) = getFVE c `unionFVS` getFVE t `unionFVS` getFVE e
  getFVE (CSub pos e1 e2) = getFVE e1 `unionFVS` getFVE e2
  getFVE (CSub2 e1 e2 e3) = getFVE e1 `unionFVS` getFVE e2 `unionFVS` getFVE e3
  getFVE (CSubUpdate _ e_vec (e_h, e_l) e_rhs) = unionManyFVS $ map getFVE $ [e_vec, e_h, e_l, e_rhs]
  getFVE (CCon1 _ i e) = addC i (getFVE e)
  getFVE (Cmodule _ is) = getFVMStmts is
  getFVE (Cinterface pos mi ds) =
      -- XXX mi is both a value constructor and a type constructor
      let defined_vars = concatMap getLDefs ds
          dfvs = deleteManyV defined_vars (unionManyFVS (map getFVDl ds))
      in  case mi of
            Nothing -> dfvs
            Just i -> addC i dfvs
  getFVE (CmoduleVerilog e _ _ _ ses _ _ _) = unionManyFVS (getFVE e : map (getFVE . snd) ses)
  getFVE (CmoduleVerilogT _ e _ _ _ ses _ _ _) = unionManyFVS (getFVE e : map (getFVE . snd) ses)
  getFVE (CForeignFuncC { }) = emptyFVS
  getFVE (CForeignFuncCT { }) = emptyFVS
  getFVE (Cdo _ ss) = getFVStmts ss
  getFVE (Caction _ ss) = getFVStmts ss
  getFVE (Crules _ rs) = unionManyFVS (map getFVR rs)
  getFVE (COper es) = unionManyFVS (map getFVO es)
  getFVE (CTApply e _) = getFVE e
  getFVE (CSelectT _ i) = emptyFVS ---- XXX WRONG i is field singletonV i
  getFVE (CCon0 mi ci) = singletonC ci
  getFVE (CConT _ i es) = addC i (unionManyFVS (map getFVE es))
  getFVE (CStructT t ies) =
      -- XXX doesn't return the fields
      unionManyFVS [getFVE e | (i, e) <- ies]
  getFVE (CLitT _ _) = emptyFVS
  getFVE (CAnyT {}) = emptyFVS
  getFVE (Cattributes _) = emptyFVS
  
  -- Get the vars from a list of defls from letseq (not letrec).
  -- Returns the bound def names (to be removed from the free vars of later
  -- expressions or statements) and the free vars from those defs.
  getFVSeqDefls :: [CDefl] -> (S.Set Id, FVSet)
  getFVSeqDefls let_arms =
      let get_def_fve (defs_above, free_vars_above) let_arm =
              (defs_above `S.union` S.fromList (getLDefs let_arm),
               free_vars_above `unionFVS` (getFVDl let_arm `minusVS` defs_above))
      in  foldl get_def_fve (S.empty, emptyFVS) let_arms
  
  getFVMStmts :: [CMStmt] -> FVSet
  getFVMStmts ss =
      let -- takes the list of free variables from later statements,
          -- removes those bound by this statement, and
          -- adds the free variables of this statement
          getFVMStmt :: CMStmt -> FVSet -> FVSet
          getFVMStmt (CMStmt stmt) fvs = getFVStmt stmt fvs
          -- the rest don't bind any names, so just add free variables
          getFVMStmt (CMrules e) fvs = getFVE e `unionFVS` fvs
          getFVMStmt (CMinterface e) fvs = getFVE e `unionFVS` fvs
          getFVMStmt (CMTupleInterface _ es) fvs =
              unionManyFVS (map getFVE es) `unionFVS` fvs
      in  -- start from the bottom and work up
          foldr getFVMStmt emptyFVS ss
  
  getFVStmts :: [CStmt] -> FVSet
  getFVStmts ss =
      -- start from the bottom and work up
      foldr getFVStmt emptyFVS ss
  
  -- takes the list of free variables from later statements,
  -- removes those bound by this statement, and
  -- adds the free variables of this statement
  getFVStmt :: CStmt -> FVSet -> FVSet
  getFVStmt (CSBindT p me _ _ e) s =
      ((getFVE e `plusCS` getPC p) `unionFVS` getMFVE me)
          `unionFVS` (s `minusVS` getPV p)
  getFVStmt (CSBind p me _ e) s =
      ((getFVE e `plusCS` getPC p) `unionFVS` getMFVE me)
          `unionFVS` (s `minusVS` getPV p)
  getFVStmt (CSletseq ds) s =
      let (defs, free_vars_rhs) = getFVSeqDefls ds
      in  free_vars_rhs `unionFVS` (s `minusVS` defs)
  getFVStmt (CSletrec ds) s =
      unionManyFVS (map getFVDl ds) `unionFVS`
       (deleteManyV (concatMap getLDefs ds) s)
  getFVStmt (CSExpr _ e) s = getFVE e `unionFVS` s
  
  -- Get variables bound by a statement
  getStmtBind :: CStmt -> [Id]
  getStmtBind (CSBindT p _ _ _ _) = S.toList (getPV p)
  getStmtBind (CSBind p _ _ _) = S.toList (getPV p)
  getStmtBind (CSletseq ds) = concatMap getLDefs ds
  getStmtBind (CSletrec ds) = concatMap getLDefs ds
  getStmtBind _ = []
  
  {-
  getMStmtBind (CMStmt s) = getStmtBind s
  getMStmtBind _ = []
  -}
  
  getFVO :: COp -> FVSet
  getFVO (CRand e) = getFVE e
  getFVO (CRator _ i) = singletonV i  -- XXX should we return operators?
  
  -- Get type constructors
  getFTCE :: CExpr -> S.Set Id
  getFTCE (CLam _ e) = getFTCE e
  getFTCE (CLamT _ t e) = getFTCE e `S.union` getFQTyCons t
  getFTCE (Cletseq defs expr) = S.unions (getFTCE expr : map getFTCDl defs)
  getFTCE (Cletrec ds e) = S.unions (getFTCE e : map getFTCDl ds)
  getFTCE (CSelect e i) = getFTCE e
  getFTCE (CSelectTT ti e fi) = S.insert ti (getFTCE e)
  getFTCE (CCon i es) = S.unions (map getFTCE es)
  getFTCE (Ccase pos e as) = S.union (getFTCE e) (S.unions (map getFTCArm as))
    where getFTCArm arm = getPT (cca_pattern arm) `S.union`
                          getFTCQuals (cca_filters arm) `S.union`
                          getFTCE (cca_consequent arm)
  getFTCE (CStruct _ i ies) = S.unions [getFTCE e | (_, e) <- ies]
  getFTCE (CStructUpd e ies) = S.unions (getFTCE e : [getFTCE e | (_, e) <- ies])
  getFTCE (Cwrite pos e v) = S.union (getFTCE e) (getFTCE v)
  getFTCE (CAny {}) = S.empty
  getFTCE (CVar i) = S.empty
  getFTCE (CApply e es) = S.unions (map getFTCE (e:es))
  getFTCE (CTaskApply e es) = S.unions (map getFTCE (e:es))
  getFTCE (CTaskApplyT e t es) =
      S.unions (getFTyCons t : map getFTCE (e:es))
  getFTCE (CLit _) = S.empty
  getFTCE (CBinOp l i r) = getFTCE l `S.union` getFTCE r
  getFTCE (CHasType e t) = getFTCE e `S.union` getFQTyCons t
  getFTCE (Cif pos c t e) = getFTCE c `S.union` getFTCE t `S.union` getFTCE e
  getFTCE (CSub pos e1 e2) = getFTCE e1 `S.union` getFTCE e2
  getFTCE (CSub2 e1 e2 e3) = getFTCE e1 `S.union` getFTCE e2 `S.union` getFTCE e3
  getFTCE (CSubUpdate _ e_vec (e_h, e_l) e_rhs) = S.unions (map getFTCE [e_vec, e_h, e_l, e_rhs])
  getFTCE (CCon1 ti ci e) = S.insert ti (getFTCE e)
  getFTCE (Cmodule _ is) = S.unions (map getFTCMStmt is)
  getFTCE (Cinterface pos mi ds) =
      -- XXX mi is both a value constructor and a type constructor
      let dcs = S.unions (map getFTCDl ds)
      in  case mi of
            Nothing -> dcs
            Just i  -> S.insert i dcs
  getFTCE (CmoduleVerilog e _ _ _ ses _ _ _) =
      S.unions (getFTCE e : map (getFTCE . snd) ses)
  getFTCE (CmoduleVerilogT t e _ _ _ ses _ _ _) =
      S.unions ([getFTyCons t, getFTCE e] ++ map (getFTCE . snd) ses)
  getFTCE (CForeignFuncC _ t) = getFQTyCons t
  getFTCE (CForeignFuncCT _ t) = getFTyCons t
  getFTCE (Cdo _ ss) = S.unions (map getFTCStmt ss)
  getFTCE (Caction _ ss) = S.unions (map getFTCStmt ss)
  getFTCE (Crules _ rs) = S.unions (map getFTCR rs)
  getFTCE (COper es) = S.unions (map getFTCO es)
  getFTCE (CTApply e ts) = S.unions (getFTCE e : map getFTyCons ts)
  getFTCE (CSelectT ti _) = S.singleton ti
  getFTCE (CCon0 mi _) =
      case mi of
        Nothing -> S.empty
        Just i  -> S.singleton i
  getFTCE (CConT ti _ es) = S.insert ti (S.unions (map getFTCE es))
  getFTCE (CStructT t ies) =
      S.unions (getFTyCons t : [getFTCE e | (_, e) <- ies])
  getFTCE (CLitT t _) = getFTyCons t
  getFTCE (CAnyT _ _ t) = getFTyCons t
  getFTCE (Cattributes _) = S.empty
  
  -- since there is no worry about name binding, this can just be mapped over
  -- the statement list (no folding involved)
  getFTCStmt :: CStmt -> S.Set Id
  getFTCStmt (CSBindT p me _ t e) =
      S.unions [getFQTyCons t, getPT p, getFTCE e, getMFTC me]
  getFTCStmt (CSBind p me _ e) =
      S.unions [getPT p, getFTCE e, getMFTC me]
  getFTCStmt (CSletseq ds) = S.unions (map getFTCDl ds)
  getFTCStmt (CSletrec ds) = S.unions (map getFTCDl ds)
  getFTCStmt (CSExpr _ e) = getFTCE e
  
  getFTCMStmt :: CMStmt -> S.Set Id
  getFTCMStmt (CMStmt s) = getFTCStmt s
  getFTCMStmt (CMrules e) = getFTCE e
  getFTCMStmt (CMinterface e) = getFTCE e
  getFTCMStmt (CMTupleInterface _ es) = S.unions (map getFTCE es)
  
  getFTCO :: COp -> S.Set Id
  getFTCO (CRand e) = getFTCE e
  getFTCO (CRator _ _) = S.empty
  
  -- Get variables bound by a CDefl
  getLDefs :: CDefl -> [Id]
  getLDefs (CLValueSign d _) = [getDName d]
  getLDefs (CLValue i _ _) = [i]
  getLDefs (CLMatch p _) = S.toList (getPV p)
  
  {-
  getFVQuals :: [CQual] -> S.Set Id
  getFVQuals qs = trace ("qs: " ++ ppReadable qs) $
                  trace ("result: " ++ ppReadable (S.toList result)) $ result
   where result = getFVQuals' qs
  -}
  
  getFVQuals :: [CQual] -> FVSet
  getFVQuals [] = emptyFVS
  getFVQuals (CQGen _ p e:qs) =
      (getFVE e `unionFVS` ((getFVQuals qs) `minusVS` (getPV p)))
          `plusCS` (getPC p)
  getFVQuals (CQFilter e:qs) = getFVE e  `unionFVS`  getFVQuals qs
  
  getVQuals :: [CQual] -> S.Set Id
  getVQuals [] = S.empty
  getVQuals (CQGen _ p e:qs) = getPV p `S.union` getVQuals qs
  getVQuals (CQFilter e:qs) = getVQuals qs
  
  -- Get variables bound in a pattern
  getPV :: CPat -> S.Set Id
  getPV (CPCon _ ps) = S.unions (map getPV ps)
  getPV (CPstruct _ _ ips) = S.unions (map (getPV . snd) ips)
  getPV (CPVar i) = S.singleton i
  getPV (CPAs i p) = S.insert i (getPV p)
  getPV (CPAny {}) = S.empty
  getPV (CPLit _) = S.empty
  getPV (CPMixedLit {}) = S.empty
  getPV (CPCon1 _ _ p) = getPV p
  getPV (CPConTs _ _ _ ps) = S.unions (map getPV ps)
  getPV (CPOper _) = internalError "CFreeVars.getPV: CPOper"
  
  -- Get (constructor and field) identifiers used in a pattern
  getPC :: CPat -> S.Set Id
  getPC (CPCon i ps) = S.insert i (S.unions (map getPC ps))
  getPC (CPstruct _ i ips) =
      -- XXX we don't return fields
      S.insert i (S.unions [getPC p | (i, p) <- ips])
  getPC (CPVar i) = S.empty
  getPC (CPAs i p) = getPC p
  getPC (CPAny {}) = S.empty
  getPC (CPLit _) = S.empty
  getPC (CPMixedLit {}) = S.empty
  getPC (CPCon1 _ i p) = S.insert i (getPC p)
  getPC (CPConTs _ i _ ps) = S.insert i (S.unions (map getPC ps))
  getPC (CPOper ops) =
      let getPCO (CPRand p) = getPC p
          -- XXX we don't return operators
          getPCO (CPRator n i) = S.empty
      in  S.unions (map getPCO ops)
  
  -- Get type constructors used in a pattern
  getPT :: CPat -> S.Set Id
  getPT (CPCon _ ps) = S.unions (map getPT ps)
  getPT (CPstruct {}) = S.empty
  getPT (CPVar {}) = S.empty
  getPT (CPAs _ p) = getPT p
  getPT (CPAny {}) = S.empty
  getPT (CPLit {}) = S.empty
  getPT (CPMixedLit {}) = S.empty
  getPT (CPOper ops) =
      let getPTO (CPRand p) = getPT p
          getPTO (CPRator n i) = S.empty
      in  S.unions (map getPTO ops)
  getPT (CPCon1 ti _ _) = S.singleton ti
  getPT (CPConTs ti _ ts ps) =
      S.insert ti (S.unions (map getFTyCons ts ++ map getPT ps))
  
  getPTs :: [CPat] -> S.Set Id
  getPTs ps = S.unions (map getPT ps)
  
  getPCs :: [CPat] -> S.Set Id
  getPCs ps = S.unions (map getPC ps)
  
  getPVs :: [CPat] -> S.Set Id
  getPVs ps = S.unions (map getPV ps)
  
  -- Note that the def names themselves are included in the set.
  -- To remove them, use "getLDefs".
  getFVDl :: CDefl -> FVSet
  getFVDl (CLValueSign def qs) =
          -- the "qs" are implicit condition for methods,
          -- so there is no binding there that can affect "def",
          -- thus we don't remove the variables bound there
          getFVQuals qs `unionFVS` getFVD def
  getFVDl (CLValue _ cs qs) =
          -- as above, we don't subtract the vars bound in "qs"
          unionManyFVS (getFVQuals qs : map getFVC cs)
  getFVDl (CLMatch p e) =
          -- here, we do want to remove any vars bound in the pattern
          getFVE e `minusVS` getPV p
  
  -- Note that the def names themselves are included in the set.
  -- To remove them, use "getDName".
  getFVD :: CDef -> FVSet
  getFVD (CDef _ _ cs)    = unionManyFVS (map getFVC cs)
  getFVD (CDefT _ _ _ cs) = unionManyFVS (map getFVC cs)
  
  getFVC :: CClause -> FVSet
  getFVC (CClause ps qs e) =
          let bvs = getVQuals qs `S.union` getPVs ps
          in  ((getFVQuals qs `unionFVS` getFVE e) `minusVS` bvs) `plusCS` getPCs ps
  
  getFVR :: CRule -> FVSet
  getFVR (CRule _ n qs e) =
          let bvs = getVQuals qs
          in  getMFVE n `unionFVS` ((getFVQuals qs `unionFVS` getFVE e) `minusVS` bvs)
  getFVR (CRuleNest _ n qs rs) =
          let bvs = getVQuals qs
          in  getMFVE n `unionFVS` ((getFVQuals qs `unionFVS` unionManyFVS (map getFVR rs)) `minusVS` bvs)
  
  getMFVE :: Maybe CExpr -> FVSet
  getMFVE Nothing = emptyFVS
  getMFVE (Just e) = getFVE e
  
  getFTCDl :: CDefl -> S.Set Id
  getFTCDl (CLValueSign d me) = getFTCD d `S.union` getFTCQuals me
  getFTCDl (CLValue _ cs me) =
      S.unions (map getFTCC cs) `S.union` getFTCQuals me
  getFTCDl (CLMatch p e) = getPT p `S.union` getFTCE e
  
  getFTCD :: CDef -> S.Set Id
  getFTCD (CDef _ t cs) = S.unions (map getFTCC cs) `S.union` getFQTyCons t
  getFTCD (CDefT _ _ t cs) = S.unions (map getFTCC cs) `S.union` getFQTyCons t
  
  getFTCC :: CClause -> S.Set Id
  getFTCC (CClause ps qs e) =
      getPTs ps `S.union` getFTCQuals qs `S.union` getFTCE e
  
  getFTCR :: CRule -> S.Set Id
  getFTCR (CRule _ n qs e) =
          getMFTC n `S.union` (getFTCQuals qs `S.union` getFTCE e)
  getFTCR (CRuleNest _ n qs rs) =
          getMFTC n `S.union` (getFTCQuals qs `S.union` S.unions (map getFTCR rs))
  
  getMFTC :: Maybe CExpr -> S.Set Id
  getMFTC Nothing = S.empty
  getMFTC (Just e) = getFTCE e
  
  getFTCQuals :: [CQual] -> S.Set Id
  getFTCQuals qs =
      -- since we don't worry about name binding, map is OK (instead of fold)
      let getFTCQual (CQGen t p e) =
              S.unions [getFTyCons t, getPT p, getFTCE e]
          getFTCQual (CQFilter e) = getFTCE e
      in  S.unions (map getFTCQual qs)
  
  {-
  getFVQTs :: CQType -> S.Set Id
  getFVQTs t = set_deleteMany (getQTyVars t) (getFVQT t)
  
  getQTyVars :: CQType -> [Id]
  getQTyVars t = [ i | i <- S.toList (getFVQT t), getIdKind i == IKTyVar ]
  
  getFVQT :: CQType -> S.Set Id
  getFVQT (CQType ps t) = S.unions (getFVT t : map (\ (c, ts) -> S.insert c (S.unions (map getFVT ts))) ps)
  
  getFVT :: CType -> S.Set Id
  getFVT (TVar (TyVar i _ _)) = S.singleton i
  getFVT (TCon (TyCon i _ _)) = S.singleton i
  getFVT (TAp t t') = S.union (getFVT t) (getFVT t')
  getFVT (TGen _ _) = S.empty
  -}
  
  getFQTyCons :: CQType -> S.Set Id
  getFQTyCons (CQType ps t) = S.unions (getFTyCons t : map getCPTyCons ps)
  
  getCPTyCons :: CPred -> S.Set Id
  getCPTyCons (CPred (CTypeclass c) ts) = S.insert c (S.unions (map getFTyCons ts))
  
  getFTyCons :: CType -> S.Set Id
  getFTyCons (TVar (TyVar i _ _)) = S.empty
  getFTyCons (TCon (TyCon i _ _)) = S.singleton i
  getFTyCons (TCon (TyNum _ _)) = S.empty
  getFTyCons (TCon (TyStr _ _)) = S.empty
  getFTyCons (TAp t t') = S.union (getFTyCons t) (getFTyCons t')
  getFTyCons (TGen _ _) = S.empty
  getFTyCons (TDefMonad _) = S.empty  -- internalError "getFTyCons: TDefMonad"
  
  getFQTyVars :: CQType -> S.Set Id
  getFQTyVars (CQType ps t) = S.unions (getFTyVars t : map getCPTyVars ps)
  
  getCPTyVars :: CPred -> S.Set Id
  getCPTyVars (CPred c ts) = S.unions (map getFTyVars ts)
  
  getFTyVars :: CType -> S.Set Id
  getFTyVars (TVar (TyVar i _ _)) = S.singleton i
  getFTyVars (TCon (TyCon i _ _)) = S.empty
  getFTyVars (TCon (TyNum _ _)) = S.empty
  getFTyVars (TCon (TyStr _ _)) = S.empty
  getFTyVars (TAp t t') = S.union (getFTyVars t) (getFTyVars t')
  getFTyVars (TGen _ _) = S.empty
  getFTyVars (TDefMonad _) = S.empty  -- internalError "getFTyVars: TDefMonad"
  
  -- I'm not completely sure that Eq over TyVars does the right
  -- thing, that is, whether it is guaranteed that two identical
  -- TyVars get folded (by S. unions) into one (as opposed to
  -- some failing equality due to some different but insignificant
  -- meta information on the TyVar)
  getFQTyVarsT :: CQType -> S.Set TyVar
  getFQTyVarsT (CQType ps t) = S.unions (getFTyVarsT t : map getCPTyVarsT ps)
  
  getCPTyVarsT :: CPred -> S.Set TyVar
  getCPTyVarsT (CPred c ts) = S.unions (map getFTyVarsT ts)
  
  getFTyVarsT :: CType -> S.Set TyVar
  getFTyVarsT (TVar i) = S.singleton i
  getFTyVarsT (TCon (TyCon i _ _)) = S.empty
  getFTyVarsT (TCon (TyNum _ _)) = S.empty
  getFTyVarsT (TCon (TyStr _ _)) = S.empty
  getFTyVarsT (TAp t t') = S.union (getFTyVarsT t) (getFTyVarsT t')
  getFTyVarsT (TGen _ _) = S.empty
  getFTyVarsT (TDefMonad _) = internalError "getFTyVars: TDefMonad"
  
  
  
  -- Get Free TyCons
  getFTCDn :: CDefn -> S.Set Id
  getFTCDn (CValueSign d) = getFTCD d
  getFTCDn (CValue _ cs) = S.unions (map getFTCC cs)
  getFTCDn (Cprimitive _ t) = getFQTyCons t
  getFTCDn (CprimType _) = S.empty
  getFTCDn (CPragma _) = S.empty
  getFTCDn (Cforeign { cforg_type = t } ) = getFQTyCons t
  getFTCDn (Ctype _ _ t) = getFTyCons t
  getFTCDn (Cdata { cd_internal_summands = summands,
                    cd_derivings = derivings }) =
      S.unions (map f summands) `S.union` S.fromList (map typeclassId derivings)
    where f summand = getFTyCons (cis_arg_type summand)
  getFTCDn (Cstruct _ _ _ vs fields ds) =
      S.unions (map (getFQTyCons . cf_type) fields) `S.union` S.fromList (map typeclassId ds)
  getFTCDn (Cclass _ ps _ _ _ fields) =
      S.unions (map getCPTyCons ps ++ map f fields)
    where f field = getFQTyCons (cf_type field) `S.union`
                    S.unions (map getFTCC (cf_default field))
                    -- XXX nothing with cf_orig_type?
  getFTCDn (Cinstance qt ds) =
      S.union (getFQTyCons qt) (S.unions (map getFTCDl ds))
  getFTCDn (CIinstance _ qt) = getFQTyCons qt
  getFTCDn (CIValueSign _ t) = getFQTyCons t
  getFTCDn (CItype i vs useposs) = S.empty
  getFTCDn (CIclass incoh ps i vs fds useposs) = S.unions (map getCPTyCons ps)
  
  getVDefIds :: CDefn -> [Id]
  getVDefIds (CValueSign (CDef i _ _)) = [i]
  getVDefIds (CValueSign (CDefT i _ _ _)) = [i]
  getVDefIds (CValue i _) = [i]
  getVDefIds (Cprimitive i _) = [i]
  getVDefIds (CprimType i) = [iKName i]
  getVDefIds (CPragma _) = []
  getVDefIds (Cforeign { cforg_name = i }) = [i]
  getVDefIds (Ctype i _ _) = [iKName i]
  getVDefIds (Cdata { cd_name = name }) = [iKName name]
  getVDefIds (Cstruct _ _ i _ _ _) = [iKName i]
  getVDefIds (Cclass _ _ i _ _ _) = [iKName i]
  getVDefIds (Cinstance _ _) = []
  getVDefIds (CIinstance _ _) = []
  getVDefIds (CItype i _ useposs) = [iKName i]
  getVDefIds (CIclass _ _ i _ _ useposs) = [iKName i]
  getVDefIds (CIValueSign i _) = [i]
  