content: -- | Collecting sets of variables and constructors.
  module DDC.Core.Flow.Exp.Simple.Collect
          ()
  where
  import DDC.Core.Collect.BindStruct
  import DDC.Core.Collect.FreeX
  import DDC.Core.Flow.Exp.Simple.Exp
  
  
  -- Exp ------------------------------------------------------------------------
  instance BindStruct (Exp a n) n where
   slurpBindTree xx
    = case xx of
          XAnnot _ x      -> slurpBindTree x
          XVar u          -> [BindUse BoundExp u]
          XPrim{}         -> []
          XCon{}          -> []
          XApp x1 x2      -> slurpBindTree x1 ++ slurpBindTree x2
          XLAM b x        -> [bindDefT BindLAM [b] [x]]
          XLam b x        -> [bindDefX BindLam [b] [x]]
  
          XLet (LLet b x1) x2
           -> slurpBindTree x1
           ++ [bindDefX BindLet [b] [x2]]
  
          XLet (LRec bxs) x2
           -> [bindDefX BindLetRec
                       (map fst bxs)
                       (map snd bxs ++ [x2])]
  
          XLet (LPrivate bsR mtExtend bs) x2
           -> (case mtExtend of
                  Nothing -> []
                  Just tR -> slurpBindTree tR)
           ++ [ BindDef  BindLetRegions bsR
               [bindDefX BindLetRegionWith bs [x2]] ]
  
          XCase x alts    -> slurpBindTree x ++ concatMap slurpBindTree alts
          XCast c x       -> slurpBindTree c ++ slurpBindTree x
          XType t         -> slurpBindTree t
          XWitness w      -> slurpBindTree w
  
  
  instance BindStruct (Cast a n) n where
   slurpBindTree cc
    = case cc of
          CastWeakenEffect  eff   -> slurpBindTree eff
          CastPurify w            -> slurpBindTree w
          CastBox                 -> []
          CastRun                 -> []
  
  
  instance BindStruct (Alt a n) n where
   slurpBindTree alt
    = case alt of
          AAlt PDefault x
           -> slurpBindTree x
  
          AAlt (PData _ bs) x
           -> [bindDefX BindCasePat bs [x]]
  
  
  instance BindStruct (Witness a n) n where
   slurpBindTree ww
    = case ww of
          WVar u          -> [BindUse BoundWit u]
          WCon{}          -> []
          WApp  w1 w2     -> slurpBindTree w1 ++ slurpBindTree w2
          WType t         -> slurpBindTree t
          WAnnot _ w      -> slurpBindTree w
  
  