+-----------------------------------------------------------------------------
+-- Setting the module context
+
+setContext str
+ | all sensible mods = newContext mods -- default is to set the empty context
+ | all plusminus mods = adjustContext mods
+ | otherwise
+ = throwDyn (CmdLineError "syntax: :module M1 .. Mn | :module [+/-]M1 ... [+/-]Mn")
+ where
+ mods = words str
+
+ sensible (c:cs) = isUpper c && all isAlphaNumEx cs
+ isAlphaNumEx c = isAlphaNum c || c == '_'
+
+ plusminus ('-':mod) = sensible mod
+ plusminus ('+':mod) = sensible mod
+ plusminus _ = False
+
+newContext mods = do
+ state@GHCiState{cmstate=cmstate} <- getGHCiState
+ dflags <- io getDynFlags
+
+ let separate [] as bs = return (as,bs)
+ separate (m:ms) as bs = do
+ b <- io (cmModuleIsInterpreted cmstate m)
+ if b then separate ms (m:as) bs
+ else separate ms as (m:bs)
+
+ (as,bs) <- separate mods [] []
+ let bs' = if null as && prel `notElem` bs then prel:bs else bs
+ cmstate' <- io (cmSetContext cmstate dflags as bs')
+ setGHCiState state{cmstate=cmstate'}
+
+prel = "Prelude"
+
+adjustContext mods = do
+ state@GHCiState{cmstate=cmstate} <- getGHCiState
+ dflags <- io getDynFlags
+
+ let adjust [] as bs = return (as,bs)
+ adjust (('-':m) : ms) as bs
+ | m `elem` as = adjust ms (delete m as) bs
+ | m `elem` bs = adjust ms as (delete m bs)
+ | otherwise = throwDyn (CmdLineError ("module `" ++ m ++ "' is not currently in scope"))
+ adjust (('+':m) : ms) as bs
+ | m `elem` as || m `elem` bs = adjust ms as bs -- continue silently
+ | otherwise = do b <- io (cmModuleIsInterpreted cmstate m)
+ if b then adjust ms (m:as) bs
+ else adjust ms as (m:bs)
+
+ (as,bs) <- io (cmGetContext cmstate)
+ (as,bs) <- adjust mods as bs
+ let bs' = if null as && prel `notElem` bs then prel:bs else bs
+ cmstate' <- io (cmSetContext cmstate dflags as bs')
+ setGHCiState state{cmstate=cmstate'}
+