module Language.Haskell.Session.Binding ( getBindings, removeBinding, ) where import Control.Applicative ((<$>)) import qualified Data.List as List import qualified GHC import GhcMonad (GhcMonad) import qualified GhcMonad import qualified HscTypes import qualified Linker import Language.Haskell.Session.GHC.Util (dshow) bindingMatch :: GHC.DynFlags -> String -> HscTypes.TyThing -> Bool bindingMatch dflags name binding = result where result = dropDot bname == name bname = dshow dflags $ HscTypes.tyThingAvailInfo binding dropDot :: String -> String dropDot = reverse . List.takeWhile (/= '.') . reverse -- | Remove bound variable and release memory removeBinding :: GhcMonad m => String -> m () removeBinding name = do dflags <- GHC.getSessionDynFlags matching <- filter (bindingMatch dflags name) <$> getIcTythings GhcMonad.liftIO $ Linker.deleteFromLinkEnv $ map GHC.getName matching removeIcTythings name getIcTythings :: GhcMonad m => m [HscTypes.TyThing] getIcTythings = do hscEnv <- GhcMonad.getSession return $ HscTypes.ic_tythings $ HscTypes.hsc_IC hscEnv -- | Get list of bound variables getBindings :: GhcMonad m => m [String] getBindings = do dflags <- GHC.getSessionDynFlags map (dropDot . dshow dflags . HscTypes.tyThingAvailInfo) <$> getIcTythings removeIcTythings :: GhcMonad m => String -> m () removeIcTythings name = do dflags <- GHC.getSessionDynFlags GhcMonad.modifySession $ \hscEnv -> let hsc_IC = HscTypes.hsc_IC hscEnv ic_tythings = HscTypes.ic_tythings hsc_IC ic_tythings' = filter (not . bindingMatch dflags name) ic_tythings hsc_IC' = hsc_IC {HscTypes.ic_tythings = ic_tythings'} in hscEnv { HscTypes.hsc_IC = hsc_IC'}