+defineMacro :: String -> GHCi ()
+defineMacro s = do
+ let (macro_name, definition) = break isSpace s
+ cmds <- io (readIORef commands)
+ if (null macro_name)
+ then throwDyn (OtherError "invalid macro name")
+ else do
+ if (macro_name `elem` map fst cmds)
+ then throwDyn (OtherError
+ ("command `" ++ macro_name ++ "' already defined"))
+ else do
+
+ -- give the expression a type signature, so we can be sure we're getting
+ -- something of the right type.
+ let new_expr = '(' : definition ++ ") :: String -> IO String"
+
+ -- compile the expression
+ st <- getGHCiState
+ dflags <- io (getDynFlags)
+ (new_cmstate, maybe_stuff) <-
+ io (cmGetExpr (cmstate st) dflags False (current_module st) new_expr)
+ setGHCiState st{cmstate = new_cmstate}
+ case maybe_stuff of
+ Nothing -> return ()
+ Just (hv, unqual, ty)
+ -> io (writeIORef commands
+ ((macro_name, keepGoing (runMacro hv)) : cmds))
+
+runMacro :: HValue{-String -> IO String-} -> String -> GHCi ()
+runMacro fun s = do
+ str <- io ((unsafeCoerce# fun :: String -> IO String) s)
+ stringLoop (lines str)
+
+undefineMacro :: String -> GHCi ()
+undefineMacro macro_name = do
+ cmds <- io (readIORef commands)
+ if (macro_name `elem` map fst builtin_commands)
+ then throwDyn (OtherError
+ ("command `" ++ macro_name ++ "' cannot be undefined"))
+ else do
+ if (macro_name `notElem` map fst cmds)
+ then throwDyn (OtherError
+ ("command `" ++ macro_name ++ "' not defined"))
+ else do
+ io (writeIORef commands (filter ((/= macro_name) . fst) cmds))
+