ghci: Kill global macros list

Test Plan: Validate

Reviewers: simonmar, thomie, austin

Reviewed By: austin

Subscribers: alanz

Differential Revision: https://phabricator.haskell.org/D1789

2 files changed, 41 insertions, 37 deletions

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 5c4c00ef67..30e70e043e 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -147,8 +147,6 @@ ghciWelcomeMsg :: String
 ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++
                  ": http://www.haskell.org/ghc/  :? for help"
 
-GLOBAL_VAR(macros_ref, [], [Command])
-
 ghciCommands :: [Command]
 ghciCommands = map mkCmd [
   -- Hugs users are accustomed to :e, so make sure it doesn't overlap
@@ -453,6 +451,7 @@ interactiveUI config srcs maybe_exprs = do
                    breaks             = [],
                    tickarrays         = emptyModuleEnv,
                    ghci_commands      = availableCommands config,
+                   ghci_macros        = [],
                    last_command       = Nothing,
                    cmdqueue           = [],
                    remembered_ctx     = [],
@@ -1097,7 +1096,7 @@ lookupCommand str = do
 lookupCommand' :: String -> GHCi (Maybe Command)
 lookupCommand' ":" = return Nothing
 lookupCommand' str' = do
-  macros    <- liftIO $ readIORef macros_ref
+  macros    <- ghci_macros <$> getGHCiState
   ghci_cmds <- ghci_commands <$> getGHCiState
 
   let ghci_cmds_nohide = filter (not . cmdHidden) ghci_cmds
@@ -1342,9 +1341,9 @@ defineMacro _ (':':_) =
   liftIO $ putStrLn "macro name cannot start with a colon"
 defineMacro overwrite s = do
   let (macro_name, definition) = break isSpace s
-  macros <- liftIO (readIORef macros_ref)
+  macros <- ghci_macros <$> getGHCiState
   let defined = map cmdName macros
-  if (null macro_name)
+  if null macro_name
         then if null defined
                 then liftIO $ putStrLn "no macros defined"
                 else liftIO $ putStr ("the following macros are defined:\n" ++
@@ -1355,8 +1354,6 @@ defineMacro overwrite s = do
                 ("macro '" ++ macro_name ++ "' is already defined"))
         else do
 
-  let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ]
-
   -- compile the expression
   handleSourceError GHC.printException $ do
     step <- getGhciStepIO
@@ -1376,7 +1373,9 @@ defineMacro overwrite s = do
                          }
 
     -- later defined macros have precedence
-    liftIO $ writeIORef macros_ref (newCmd : filtered)
+    modifyGHCiState $ \s ->
+        let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ]
+        in s { ghci_macros = newCmd : filtered }
 
 runMacro :: GHC.ForeignHValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
@@ -1392,12 +1391,15 @@ runMacro fun s = do
 undefineMacro :: String -> GHCi ()
 undefineMacro str = mapM_ undef (words str)
  where undef macro_name = do
-        cmds <- liftIO (readIORef macros_ref)
+        cmds <- ghci_macros <$> getGHCiState
         if (macro_name `notElem` map cmdName cmds)
            then throwGhcException (CmdLineError
                 ("macro '" ++ macro_name ++ "' is not defined"))
            else do
-            liftIO (writeIORef macros_ref (filter ((/= macro_name) . cmdName) cmds))
+            -- This is a tad racy but really, it's a shell
+            modifyGHCiState $ \s ->
+                s { ghci_macros = filter ((/= macro_name) . cmdName)
+                                         (ghci_macros s) }
 
 
 -----------------------------------------------------------------------------
@@ -2802,7 +2804,7 @@ ghciCompleteWord line@(left,_) = case firstWord of
             Nothing  -> return completeFilename
 
 completeGhciCommand = wrapCompleter " " $ \w -> do
-  macros <- liftIO $ readIORef macros_ref
+  macros <- ghci_macros <$> getGHCiState
   cmds   <- ghci_commands `fmap` getGHCiState
   let macro_names = map (':':) . map cmdName $ macros
   let command_names = map (':':) . map cmdName $ filter (not . cmdHidden) cmds
@@ -2812,7 +2814,7 @@ completeGhciCommand = wrapCompleter " " $ \w -> do
   return $ filter (w `isPrefixOf`) candidates
 
 completeMacro = wrapIdentCompleter $ \w -> do
-  cmds <- liftIO $ readIORef macros_ref
+  cmds <- ghci_macros <$> getGHCiState
   return (filter (w `isPrefixOf`) (map cmdName cmds))
 
 completeIdentifier line@(left, _) =
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index 87b6d27c5d..824bba17a4 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -66,56 +66,58 @@ data GHCiState = GHCiState
      {
         progname       :: String,
         args           :: [String],
-        evalWrapper    :: ForeignHValue, -- IO a -> IO a
+        evalWrapper    :: ForeignHValue, -- ^ of type @IO a -> IO a@
         prompt         :: String,
         prompt2        :: String,
         editor         :: String,
         stop           :: String,
         options        :: [GHCiOption],
-        line_number    :: !Int,         -- input line
+        line_number    :: !Int,         -- ^ input line
         break_ctr      :: !Int,
         breaks         :: ![(Int, BreakLocation)],
         tickarrays     :: ModuleEnv TickArray,
-                -- tickarrays caches the TickArray for loaded modules,
-                -- so that we don't rebuild it each time the user sets
-                -- a breakpoint.
-        -- available ghci commands
+            -- ^ 'tickarrays' caches the 'TickArray' for loaded modules,
+            -- so that we don't rebuild it each time the user sets
+            -- a breakpoint.
         ghci_commands  :: [Command],
-        -- ":" at the GHCi prompt repeats the last command, so we
-        -- remember it here:
+            -- ^ available ghci commands
+        ghci_macros    :: [Command],
+            -- ^ user-defined macros
         last_command   :: Maybe Command,
+            -- ^ @:@ at the GHCi prompt repeats the last command, so we
+            -- remember it here
         cmdqueue       :: [String],
 
         remembered_ctx :: [InteractiveImport],
-             -- the imports that the user has asked for, via import
-             -- declarations and :module commands.  This list is
-             -- persistent over :reloads (but any imports for modules
-             -- that are not loaded are temporarily ignored).  After a
-             -- :load, all the home-package imports are stripped from
-             -- this list.
-
-             -- See bugs #2049, #1873, #1360
+            -- ^ The imports that the user has asked for, via import
+            -- declarations and :module commands.  This list is
+            -- persistent over :reloads (but any imports for modules
+            -- that are not loaded are temporarily ignored).  After a
+            -- :load, all the home-package imports are stripped from
+            -- this list.
+            --
+            -- See bugs #2049, #1873, #1360
 
         transient_ctx  :: [InteractiveImport],
-             -- An import added automatically after a :load, usually of
-             -- the most recently compiled module.  May be empty if
-             -- there are no modules loaded.  This list is replaced by
-             -- :load, :reload, and :add.  In between it may be modified
-             -- by :module.
+            -- ^ An import added automatically after a :load, usually of
+            -- the most recently compiled module.  May be empty if
+            -- there are no modules loaded.  This list is replaced by
+            -- :load, :reload, and :add.  In between it may be modified
+            -- by :module.
 
-        ghc_e :: Bool, -- True if this is 'ghc -e' (or runghc)
+        ghc_e :: Bool, -- ^ True if this is 'ghc -e' (or runghc)
 
-        -- help text to display to a user
         short_help :: String,
+            -- ^ help text to display to a user
         long_help  :: String,
         lastErrorLocations :: IORef [(FastString, Int)],
 
         mod_infos  :: !(Map ModuleName ModInfo),
 
-        -- hFlush stdout; hFlush stderr in the interpreter
         flushStdHandles :: ForeignHValue,
-        -- hSetBuffering NoBuffering for stdin/stdout/stderr
+            -- ^ @hFlush stdout; hFlush stderr@ in the interpreter
         noBuffering :: ForeignHValue
+            -- ^ @hSetBuffering NoBuffering@ for stdin/stdout/stderr
      }
 
 type TickArray = Array Int [(GHC.BreakIndex,RealSrcSpan)]