diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,9 @@
 # Changelog for the [`clash-ghc`](http://hackage.haskell.org/package/clash-ghc) package
 
+## 0.7 *January 16th 2017*
+* New features:
+  * Support for `clash-prelude` 0.11
+
 ## 0.6.24 *October 17th 20168
 * Call generatePrimMap after loadModules [#175](https://github.com/clash-lang/clash-compiler/pull/175)
 * Fixes bugs:
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,5 @@
-Copyright (c) 2012-2015, University of Twente
+Copyright (c) 2012-2016, University of Twente,
+              2017, QBayLogic
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without
diff --git a/clash-ghc.cabal b/clash-ghc.cabal
--- a/clash-ghc.cabal
+++ b/clash-ghc.cabal
@@ -1,5 +1,5 @@
 Name:                 clash-ghc
-Version:              0.6.24
+Version:              0.7
 Synopsis:             CAES Language for Synchronous Hardware
 Description:
   CλaSH (pronounced ‘clash’) is a functional hardware description language that
@@ -9,9 +9,8 @@
   .
   Features of CλaSH:
   .
-  * Strongly typed (like VHDL), yet with a very high degree of type inference,
-    enabling both safe and fast prototying using consise descriptions (like
-    Verilog).
+  * Strongly typed, but with a very high degree of type inference, enabling both
+    safe and fast prototyping using concise descriptions.
   .
   * Interactive REPL: load your designs in an interpreter and easily test all
     your component without needing to setup a test bench.
@@ -37,14 +36,13 @@
 License-file:         LICENSE
 Author:               Christiaan Baaij
 Maintainer:           Christiaan Baaij <christiaan.baaij@gmail.com>
-Copyright:            Copyright © 2012-2016 University of Twente
+Copyright:            Copyright © 2012-2016, University of Twente, 2017 QBayLogic
 Category:             Hardware
 Build-type:           Simple
 
 Extra-source-files:   README.md,
                       CHANGELOG.md,
                       LICENSE_GHC,
-                      src-bin/HsVersions.h,
                       src-bin/PosixSource.h
 
 Cabal-version:        >=1.10
@@ -81,9 +79,9 @@
                       bifunctors                >= 4.1.1    && < 5.5,
                       bytestring                >= 0.9      && < 0.11,
                       containers                >= 0.5.4.0  && < 0.6,
-                      directory                 >= 1.2      && < 1.3,
+                      directory                 >= 1.2      && < 1.4,
                       filepath                  >= 1.3      && < 1.5,
-                      ghc                       >= 7.10.1   && < 7.12,
+                      ghc                       >= 8.0.1    && < 8.2,
                       process                   >= 1.2      && < 1.5,
                       hashable                  >= 1.1.2.3  && < 1.3,
                       haskeline                 >= 0.7.0.3  && < 0.8,
@@ -94,26 +92,31 @@
                       unbound-generics          >= 0.1      && < 0.4,
                       unordered-containers      >= 0.2.1.0  && < 0.3,
 
-                      clash-lib                 >= 0.6.21   && < 0.7,
-                      clash-systemverilog       >= 0.6.10   && < 0.7,
-                      clash-vhdl                >= 0.6.16   && < 0.7,
-                      clash-verilog             >= 0.6.10   && < 0.7,
-                      clash-prelude             >= 0.10.13  && < 0.11,
-                      ghc-typelits-extra        >= 0.1.3    && < 0.2,
+                      clash-lib                 >= 0.7      && < 0.8,
+                      clash-systemverilog       >= 0.7      && < 0.8,
+                      clash-vhdl                >= 0.7      && < 0.8,
+                      clash-verilog             >= 0.7      && < 0.8,
+                      clash-prelude             >= 0.11     && < 0.12,
+                      ghc-typelits-extra        >= 0.1.3    && < 0.3,
+                      ghc-typelits-knownnat     >= 0.1.2    && < 0.3,
                       ghc-typelits-natnormalise >= 0.4.3    && < 0.6,
                       deepseq                   >= 1.3.0.2  && < 1.5,
-                      time                      >= 1.4.0.1  && < 1.7
+                      time                      >= 1.4.0.1  && < 1.8,
+                      ghc-boot                  >= 8.0.1    && < 8.2,
+                      ghci                      >= 8.0.1    && < 8.2,
+                      uniplate                  >= 1.6.12   && < 1.8
 
   if os(windows)
-    Build-Depends:    Win32                     >= 2.3.1    && < 2.4
+    Build-Depends:    Win32                     >= 2.3.1    && < 2.6
   else
     Build-Depends:    unix                      >= 2.7.1    && < 2.8
 
   C-Sources:          src-bin/hschooks.c
 
-  Other-Modules:      InteractiveUI
-                      GhciMonad
-                      GhciTags
+  Other-Modules:      GHCi.UI
+                      GHCi.UI.Info
+                      GHCi.UI.Monad
+                      GHCi.UI.Tags
 
                       CLaSH.GHC.CLaSHFlags
                       CLaSH.GHC.Evaluator
diff --git a/src-bin/GHCi/UI.hs b/src-bin/GHCi/UI.hs
new file mode 100644
--- /dev/null
+++ b/src-bin/GHCi/UI.hs
@@ -0,0 +1,3648 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NondecreasingIndentation #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ViewPatterns #-}
+
+{-# OPTIONS -fno-cse #-}
+-- -fno-cse is needed for GLOBAL_VAR's to behave properly
+
+-----------------------------------------------------------------------------
+--
+-- GHC Interactive User Interface
+--
+-- (c) The GHC Team 2005-2006
+--
+-----------------------------------------------------------------------------
+
+module GHCi.UI (
+        interactiveUI,
+        GhciSettings(..),
+        defaultGhciSettings,
+        ghciCommands,
+        ghciWelcomeMsg,
+        makeHDL
+    ) where
+
+#include "HsVersions.h"
+
+-- GHCi
+import qualified GHCi.UI.Monad as GhciMonad ( args, runStmt, runDecls )
+import GHCi.UI.Monad hiding ( args, runStmt, runDecls )
+import GHCi.UI.Tags
+import GHCi.UI.Info
+import Debugger
+
+-- The GHC interface
+import GHCi
+import GHCi.RemoteTypes
+import GHCi.BreakArray
+import DynFlags
+import ErrUtils
+import GhcMonad ( modifySession )
+import qualified GHC
+import GHC ( LoadHowMuch(..), Target(..),  TargetId(..), InteractiveImport(..),
+             TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc,
+             getModuleGraph, handleSourceError )
+import HsImpExp
+import HsSyn
+import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC,
+                  setInteractivePrintName, hsc_dflags, msObjFilePath )
+import Module
+import Name
+import Packages ( trusted, getPackageDetails, listVisibleModuleNames, pprFlag )
+import PprTyThing
+import PrelNames
+import RdrName ( RdrName, getGRE_NameQualifier_maybes, getRdrName )
+import SrcLoc
+import qualified Lexer
+
+import StringBuffer
+import Outputable hiding ( printForUser, printForUserPartWay, bold )
+
+-- Other random utilities
+import BasicTypes hiding ( isTopLevel )
+import Config
+import Digraph
+import Encoding
+import FastString
+import Linker
+import Maybes ( orElse, expectJust )
+import NameSet
+import Panic hiding ( showException )
+import Util
+import qualified GHC.LanguageExtensions as LangExt
+
+-- Haskell Libraries
+import System.Console.Haskeline as Haskeline
+
+import Control.Applicative hiding (empty)
+import Control.DeepSeq (deepseq)
+import Control.Monad as Monad
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except
+
+import Data.Array
+import qualified Data.ByteString.Char8 as BS
+import Data.Char
+import Data.Function
+import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
+import Data.List ( find, group, intercalate, intersperse, isPrefixOf, nub,
+                   partition, sort, sortBy )
+import Data.Maybe
+import qualified Data.Map as M
+
+import Exception hiding (catch)
+import Foreign
+import GHC.Stack hiding (SrcLoc(..))
+
+import System.Directory
+import System.Environment
+import System.Exit ( exitWith, ExitCode(..) )
+import System.FilePath
+import System.IO
+import System.IO.Error
+import System.IO.Unsafe ( unsafePerformIO )
+import System.Process
+import Text.Printf
+import Text.Read ( readMaybe )
+import Text.Read.Lex (isSymbolChar)
+
+#ifndef mingw32_HOST_OS
+import System.Posix hiding ( getEnv )
+#else
+import qualified System.Win32
+#endif
+
+import GHC.IO.Exception ( IOErrorType(InvalidArgument) )
+import GHC.IO.Handle ( hFlushAll )
+import GHC.TopHandler ( topHandler )
+
+import qualified CLaSH.Backend
+import           CLaSH.Backend.SystemVerilog (SystemVerilogState)
+import           CLaSH.Backend.VHDL (VHDLState)
+import           CLaSH.Backend.Verilog (VerilogState)
+import qualified CLaSH.Driver
+import           CLaSH.Driver.Types (CLaSHOpts(..))
+import           CLaSH.GHC.Evaluator
+import           CLaSH.GHC.GenerateBindings
+import           CLaSH.GHC.NetlistTypes
+import           CLaSH.Netlist.BlackBox.Types (HdlSyn)
+import           CLaSH.Util (clashLibVersion)
+import           Control.DeepSeq
+import qualified Data.Time.Clock as Clock
+import qualified Data.Version as Data.Version
+import qualified Paths_clash_ghc
+
+-----------------------------------------------------------------------------
+
+data GhciSettings = GhciSettings {
+        availableCommands :: [Command],
+        shortHelpText     :: String,
+        fullHelpText      :: String,
+        defPrompt         :: String,
+        defPrompt2        :: String
+    }
+
+defaultGhciSettings :: IORef CLaSHOpts -> GhciSettings
+defaultGhciSettings opts =
+    GhciSettings {
+        availableCommands = ghciCommands opts,
+        shortHelpText     = defShortHelpText,
+        defPrompt         = default_prompt,
+        defPrompt2        = default_prompt2,
+        fullHelpText      = defFullHelpText
+    }
+
+ghciWelcomeMsg :: String
+ghciWelcomeMsg = "CLaSHi, version " ++ Data.Version.showVersion Paths_clash_ghc.version ++
+                 " (using clash-lib, version " ++ Data.Version.showVersion clashLibVersion ++
+                 "):\nhttp://www.clash-lang.org/  :? for help"
+
+ghciCommands :: IORef CLaSHOpts -> [Command]
+ghciCommands opts = map mkCmd [
+  -- Hugs users are accustomed to :e, so make sure it doesn't overlap
+  ("?",         keepGoing help,                 noCompletion),
+  ("add",       keepGoingPaths addModule,       completeFilename),
+  ("abandon",   keepGoing abandonCmd,           noCompletion),
+  ("break",     keepGoing breakCmd,             completeIdentifier),
+  ("back",      keepGoing backCmd,              noCompletion),
+  ("browse",    keepGoing' (browseCmd False),   completeModule),
+  ("browse!",   keepGoing' (browseCmd True),    completeModule),
+  ("cd",        keepGoing' changeDirectory,     completeFilename),
+  ("check",     keepGoing' checkModule,         completeHomeModule),
+  ("continue",  keepGoing continueCmd,          noCompletion),
+  ("cmd",       keepGoing cmdCmd,               completeExpression),
+  ("ctags",     keepGoing createCTagsWithLineNumbersCmd, completeFilename),
+  ("ctags!",    keepGoing createCTagsWithRegExesCmd, completeFilename),
+  ("def",       keepGoing (defineMacro False),  completeExpression),
+  ("def!",      keepGoing (defineMacro True),   completeExpression),
+  ("delete",    keepGoing deleteCmd,            noCompletion),
+  ("edit",      keepGoing' editFile,            completeFilename),
+  ("etags",     keepGoing createETagsFileCmd,   completeFilename),
+  ("force",     keepGoing forceCmd,             completeExpression),
+  ("forward",   keepGoing forwardCmd,           noCompletion),
+  ("help",      keepGoing help,                 noCompletion),
+  ("history",   keepGoing historyCmd,           noCompletion),
+  ("info",      keepGoing' (info False),        completeIdentifier),
+  ("info!",     keepGoing' (info True),         completeIdentifier),
+  ("issafe",    keepGoing' isSafeCmd,           completeModule),
+  ("kind",      keepGoing' (kindOfType False),  completeIdentifier),
+  ("kind!",     keepGoing' (kindOfType True),   completeIdentifier),
+  ("load",      keepGoingPaths (loadModule_ False), completeHomeModuleOrFile),
+  ("load!",     keepGoingPaths (loadModule_ True), completeHomeModuleOrFile),
+  ("list",      keepGoing' listCmd,             noCompletion),
+  ("module",    keepGoing moduleCmd,            completeSetModule),
+  ("main",      keepGoing runMain,              completeFilename),
+  ("print",     keepGoing printCmd,             completeExpression),
+  ("quit",      quit,                           noCompletion),
+  ("reload",    keepGoing' (reloadModule False), noCompletion),
+  ("reload!",   keepGoing' (reloadModule True), noCompletion),
+  ("run",       keepGoing runRun,               completeFilename),
+  ("script",    keepGoing' scriptCmd,           completeFilename),
+  ("set",       keepGoing setCmd,               completeSetOptions),
+  ("seti",      keepGoing setiCmd,              completeSeti),
+  ("show",      keepGoing showCmd,              completeShowOptions),
+  ("showi",     keepGoing showiCmd,             completeShowiOptions),
+  ("sprint",    keepGoing sprintCmd,            completeExpression),
+  ("step",      keepGoing stepCmd,              completeIdentifier),
+  ("steplocal", keepGoing stepLocalCmd,         completeIdentifier),
+  ("stepmodule",keepGoing stepModuleCmd,        completeIdentifier),
+  ("type",      keepGoing' typeOfExpr,          completeExpression),
+  ("trace",     keepGoing traceCmd,             completeExpression),
+  ("undef",     keepGoing undefineMacro,        completeMacro),
+  ("unset",     keepGoing unsetOptions,         completeSetOptions),
+  ("where",     keepGoing whereCmd,             noCompletion),
+  ("vhdl",      keepGoingPaths (makeVHDL opts),        completeHomeModuleOrFile),
+  ("verilog",   keepGoingPaths (makeVerilog opts),     completeHomeModuleOrFile),
+  ("systemverilog",   keepGoingPaths (makeSystemVerilog opts),     completeHomeModuleOrFile)
+  ] ++ map mkCmdHidden [ -- hidden commands
+  ("all-types", keepGoing' allTypesCmd),
+  ("complete",  keepGoing completeCmd),
+  ("loc-at",    keepGoing' locAtCmd),
+  ("type-at",   keepGoing' typeAtCmd),
+  ("uses",      keepGoing' usesCmd)
+  ]
+ where
+  mkCmd (n,a,c) = Command { cmdName = n
+                          , cmdAction = a
+                          , cmdHidden = False
+                          , cmdCompletionFunc = c
+                          }
+
+  mkCmdHidden (n,a) = Command { cmdName = n
+                              , cmdAction = a
+                              , cmdHidden = True
+                              , cmdCompletionFunc = noCompletion
+                              }
+
+-- We initialize readline (in the interactiveUI function) to use
+-- word_break_chars as the default set of completion word break characters.
+-- This can be overridden for a particular command (for example, filename
+-- expansion shouldn't consider '/' to be a word break) by setting the third
+-- entry in the Command tuple above.
+--
+-- NOTE: in order for us to override the default correctly, any custom entry
+-- must be a SUBSET of word_break_chars.
+word_break_chars :: String
+word_break_chars = spaces ++ specials ++ symbols
+
+symbols, specials, spaces :: String
+symbols = "!#$%&*+/<=>?@\\^|-~"
+specials = "(),;[]`{}"
+spaces = " \t\n"
+
+flagWordBreakChars :: String
+flagWordBreakChars = " \t\n"
+
+
+keepGoing :: (String -> GHCi ()) -> (String -> InputT GHCi Bool)
+keepGoing a str = keepGoing' (lift . a) str
+
+keepGoing' :: Monad m => (String -> m ()) -> String -> m Bool
+keepGoing' a str = a str >> return False
+
+keepGoingPaths :: ([FilePath] -> InputT GHCi ()) -> (String -> InputT GHCi Bool)
+keepGoingPaths a str
+ = do case toArgs str of
+          Left err -> liftIO $ hPutStrLn stderr err
+          Right args -> a args
+      return False
+
+defShortHelpText :: String
+defShortHelpText = "use :? for help.\n"
+
+defFullHelpText :: String
+defFullHelpText =
+  " Commands available from the prompt:\n" ++
+  "\n" ++
+  "   <statement>                 evaluate/run <statement>\n" ++
+  "   :                           repeat last command\n" ++
+  "   :{\\n ..lines.. \\n:}\\n       multiline command\n" ++
+  "   :add [*]<module> ...        add module(s) to the current target set\n" ++
+  "   :browse[!] [[*]<mod>]       display the names defined by module <mod>\n" ++
+  "                               (!: more details; *: all top-level names)\n" ++
+  "   :cd <dir>                   change directory to <dir>\n" ++
+  "   :cmd <expr>                 run the commands returned by <expr>::IO String\n" ++
+  "   :complete <dom> [<rng>] <s> list completions for partial input string\n" ++
+  "   :ctags[!] [<file>]          create tags file <file> for Vi (default: \"tags\")\n" ++
+  "                               (!: use regex instead of line number)\n" ++
+  "   :def <cmd> <expr>           define command :<cmd> (later defined command has\n" ++
+  "                               precedence, ::<cmd> is always a builtin command)\n" ++
+  "   :edit <file>                edit file\n" ++
+  "   :edit                       edit last module\n" ++
+  "   :etags [<file>]             create tags file <file> for Emacs (default: \"TAGS\")\n" ++
+  "   :help, :?                   display this list of commands\n" ++
+  "   :info[!] [<name> ...]       display information about the given names\n" ++
+  "                               (!: do not filter instances)\n" ++
+  "   :issafe [<mod>]             display safe haskell information of module <mod>\n" ++
+  "   :kind[!] <type>             show the kind of <type>\n" ++
+  "                               (!: also print the normalised type)\n" ++
+  "   :load[!] [*]<module> ...    load module(s) and their dependents\n" ++
+  "                               (!: defer type errors)\n" ++
+  "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
+  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
+  "   :quit                       exit GHCi\n" ++
+  "   :reload[!]                  reload the current module set\n" ++
+  "                               (!: defer type errors)\n" ++
+  "   :run function [<arguments> ...] run the function with the given arguments\n" ++
+  "   :script <file>              run the script <file>\n" ++
+  "   :type <expr>                show the type of <expr>\n" ++
+  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
+  "   :!<command>                 run the shell command <command>\n" ++
+  "   :vhdl                       synthesize currently loaded module to vhdl\n" ++
+  "   :vhdl [<module>]            synthesize specified modules/files to vhdl\n" ++
+  "   :verilog                    synthesize currently loaded module to verilog\n" ++
+  "   :verilog [<module>]         synthesize specified modules/files to verilog\n" ++
+  "   :systemverilog              synthesize currently loaded module to systemverilog\n" ++
+  "   :systemverilog [<module>]   synthesize specified modules/files to systemverilog\n" ++
+  "\n" ++
+  " -- Commands for debugging:\n" ++
+  "\n" ++
+  "   :abandon                    at a breakpoint, abandon current computation\n" ++
+  "   :back [<n>]                 go back in the history N steps (after :trace)\n" ++
+  "   :break [<mod>] <l> [<col>]  set a breakpoint at the specified location\n" ++
+  "   :break <name>               set a breakpoint on the specified function\n" ++
+  "   :continue                   resume after a breakpoint\n" ++
+  "   :delete <number>            delete the specified breakpoint\n" ++
+  "   :delete *                   delete all breakpoints\n" ++
+  "   :force <expr>               print <expr>, forcing unevaluated parts\n" ++
+  "   :forward [<n>]              go forward in the history N step s(after :back)\n" ++
+  "   :history [<n>]              after :trace, show the execution history\n" ++
+  "   :list                       show the source code around current breakpoint\n" ++
+  "   :list <identifier>          show the source code for <identifier>\n" ++
+  "   :list [<module>] <line>     show the source code around line number <line>\n" ++
+  "   :print [<name> ...]         show a value without forcing its computation\n" ++
+  "   :sprint [<name> ...]        simplified version of :print\n" ++
+  "   :step                       single-step after stopping at a breakpoint\n"++
+  "   :step <expr>                single-step into <expr>\n"++
+  "   :steplocal                  single-step within the current top-level binding\n"++
+  "   :stepmodule                 single-step restricted to the current module\n"++
+  "   :trace                      trace after stopping at a breakpoint\n"++
+  "   :trace <expr>               evaluate <expr> with tracing on (see :history)\n"++
+
+  "\n" ++
+  " -- Commands for changing settings:\n" ++
+  "\n" ++
+  "   :set <option> ...           set options\n" ++
+  "   :seti <option> ...          set options for interactive evaluation only\n" ++
+  "   :set args <arg> ...         set the arguments returned by System.getArgs\n" ++
+  "   :set prog <progname>        set the value returned by System.getProgName\n" ++
+  "   :set prompt <prompt>        set the prompt used in GHCi\n" ++
+  "   :set prompt2 <prompt>       set the continuation prompt used in GHCi\n" ++
+  "   :set editor <cmd>           set the command used for :edit\n" ++
+  "   :set stop [<n>] <cmd>       set the command to run when a breakpoint is hit\n" ++
+  "   :unset <option> ...         unset options\n" ++
+  "\n" ++
+  "  Options for ':set' and ':unset':\n" ++
+  "\n" ++
+  "    +m            allow multiline commands\n" ++
+  "    +r            revert top-level expressions after each evaluation\n" ++
+  "    +s            print timing/memory stats after each evaluation\n" ++
+  "    +t            print type after evaluation\n" ++
+  "    +c            collect type/location info after loading modules\n" ++
+  "    -<flags>      most GHC command line flags can also be set here\n" ++
+  "                         (eg. -v2, -XFlexibleInstances, etc.)\n" ++
+  "                    for GHCi-specific flags, see User's Guide,\n"++
+  "                    Flag reference, Interactive-mode options\n" ++
+  "\n" ++
+  " -- Commands for displaying information:\n" ++
+  "\n" ++
+  "   :show bindings              show the current bindings made at the prompt\n" ++
+  "   :show breaks                show the active breakpoints\n" ++
+  "   :show context               show the breakpoint context\n" ++
+  "   :show imports               show the current imports\n" ++
+  "   :show linker                show current linker state\n" ++
+  "   :show modules               show the currently loaded modules\n" ++
+  "   :show packages              show the currently active package flags\n" ++
+  "   :show paths                 show the currently active search paths\n" ++
+  "   :show language              show the currently active language flags\n" ++
+  "   :show <setting>             show value of <setting>, which is one of\n" ++
+  "                                  [args, prog, prompt, editor, stop]\n" ++
+  "   :showi language             show language flags for interactive evaluation\n" ++
+  "\n"
+
+findEditor :: IO String
+findEditor = do
+  getEnv "EDITOR"
+    `catchIO` \_ -> do
+#if mingw32_HOST_OS
+        win <- System.Win32.getWindowsDirectory
+        return (win </> "notepad.exe")
+#else
+        return ""
+#endif
+
+default_progname, default_prompt, default_prompt2, default_stop :: String
+default_progname = "<interactive>"
+default_prompt = "%s> "
+default_prompt2 = "%s| "
+default_stop = ""
+
+default_args :: [String]
+default_args = []
+
+interactiveUI :: GhciSettings -> [(FilePath, Maybe Phase)] -> Maybe [String]
+              -> Ghc ()
+interactiveUI config srcs maybe_exprs = do
+   -- HACK! If we happen to get into an infinite loop (eg the user
+   -- types 'let x=x in x' at the prompt), then the thread will block
+   -- on a blackhole, and become unreachable during GC.  The GC will
+   -- detect that it is unreachable and send it the NonTermination
+   -- exception.  However, since the thread is unreachable, everything
+   -- it refers to might be finalized, including the standard Handles.
+   -- This sounds like a bug, but we don't have a good solution right
+   -- now.
+   _ <- liftIO $ newStablePtr stdin
+   _ <- liftIO $ newStablePtr stdout
+   _ <- liftIO $ newStablePtr stderr
+
+    -- Initialise buffering for the *interpreted* I/O system
+   (nobuffering, flush) <- initInterpBuffering
+
+   -- The initial set of DynFlags used for interactive evaluation is the same
+   -- as the global DynFlags, plus -XExtendedDefaultRules and
+   -- -XNoMonomorphismRestriction.
+   dflags <- getDynFlags
+   let dflags' = (`xopt_set` LangExt.ExtendedDefaultRules)
+               . (`xopt_unset` LangExt.MonomorphismRestriction)
+               $ dflags
+   GHC.setInteractiveDynFlags dflags'
+
+   lastErrLocationsRef <- liftIO $ newIORef []
+   progDynFlags <- GHC.getProgramDynFlags
+   _ <- GHC.setProgramDynFlags $
+      progDynFlags { log_action = ghciLogAction lastErrLocationsRef }
+
+   when (isNothing maybe_exprs) $ do
+        -- Only for GHCi (not runghc and ghc -e):
+
+        -- Turn buffering off for the compiled program's stdout/stderr
+        turnOffBuffering_ nobuffering
+        -- Turn buffering off for GHCi's stdout
+        liftIO $ hFlush stdout
+        liftIO $ hSetBuffering stdout NoBuffering
+        -- We don't want the cmd line to buffer any input that might be
+        -- intended for the program, so unbuffer stdin.
+        liftIO $ hSetBuffering stdin NoBuffering
+        liftIO $ hSetBuffering stderr NoBuffering
+#if defined(mingw32_HOST_OS)
+        -- On Unix, stdin will use the locale encoding.  The IO library
+        -- doesn't do this on Windows (yet), so for now we use UTF-8,
+        -- for consistency with GHC 6.10 and to make the tests work.
+        liftIO $ hSetEncoding stdin utf8
+#endif
+
+   default_editor <- liftIO $ findEditor
+   eval_wrapper <- mkEvalWrapper default_progname default_args
+   startGHCi (runGHCi srcs maybe_exprs)
+        GHCiState{ progname           = default_progname,
+                   args               = default_args,
+                   evalWrapper        = eval_wrapper,
+                   prompt             = defPrompt config,
+                   prompt2            = defPrompt2 config,
+                   stop               = default_stop,
+                   editor             = default_editor,
+                   options            = [],
+                   -- We initialize line number as 0, not 1, because we use
+                   -- current line number while reporting errors which is
+                   -- incremented after reading a line.
+                   line_number        = 0,
+                   break_ctr          = 0,
+                   breaks             = [],
+                   tickarrays         = emptyModuleEnv,
+                   ghci_commands      = availableCommands config,
+                   ghci_macros        = [],
+                   last_command       = Nothing,
+                   cmdqueue           = [],
+                   remembered_ctx     = [],
+                   transient_ctx      = [],
+                   ghc_e              = isJust maybe_exprs,
+                   short_help         = shortHelpText config,
+                   long_help          = fullHelpText config,
+                   lastErrorLocations = lastErrLocationsRef,
+                   mod_infos          = M.empty,
+                   flushStdHandles    = flush,
+                   noBuffering        = nobuffering
+                 }
+
+   return ()
+
+resetLastErrorLocations :: GHCi ()
+resetLastErrorLocations = do
+    st <- getGHCiState
+    liftIO $ writeIORef (lastErrorLocations st) []
+
+ghciLogAction :: IORef [(FastString, Int)] ->  LogAction
+ghciLogAction lastErrLocations dflags flag severity srcSpan style msg = do
+    defaultLogAction dflags flag severity srcSpan style msg
+    case severity of
+        SevError -> case srcSpan of
+            RealSrcSpan rsp -> modifyIORef lastErrLocations
+                (++ [(srcLocFile (realSrcSpanStart rsp), srcLocLine (realSrcSpanStart rsp))])
+            _ -> return ()
+        _ -> return ()
+
+withGhcAppData :: (FilePath -> IO a) -> IO a -> IO a
+withGhcAppData right left = do
+    either_dir <- tryIO (getAppUserDataDirectory "clash")
+    case either_dir of
+        Right dir ->
+            do createDirectoryIfMissing False dir `catchIO` \_ -> return ()
+               right dir
+        _ -> left
+
+runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
+runGHCi paths maybe_exprs = do
+  dflags <- getDynFlags
+  let
+   ignore_dot_ghci = gopt Opt_IgnoreDotGhci dflags
+
+   current_dir = return (Just ".clashi")
+
+   app_user_dir = liftIO $ withGhcAppData
+                    (\dir -> return (Just (dir </> "clashi.conf")))
+                    (return Nothing)
+
+   home_dir = do
+    either_dir <- liftIO $ tryIO (getEnv "HOME")
+    case either_dir of
+      Right home -> return (Just (home </> ".clashi"))
+      _ -> return Nothing
+
+   canonicalizePath' :: FilePath -> IO (Maybe FilePath)
+   canonicalizePath' fp = liftM Just (canonicalizePath fp)
+                `catchIO` \_ -> return Nothing
+
+   sourceConfigFile :: FilePath -> GHCi ()
+   sourceConfigFile file = do
+     exists <- liftIO $ doesFileExist file
+     when exists $ do
+       either_hdl <- liftIO $ tryIO (openFile file ReadMode)
+       case either_hdl of
+         Left _e   -> return ()
+         -- NOTE: this assumes that runInputT won't affect the terminal;
+         -- can we assume this will always be the case?
+         -- This would be a good place for runFileInputT.
+         Right hdl ->
+             do runInputTWithPrefs defaultPrefs defaultSettings $
+                          runCommands $ fileLoop hdl
+                liftIO (hClose hdl `catchIO` \_ -> return ())
+                -- Don't print a message if this is really ghc -e (#11478).
+                -- Also, let the user silence the message with -v0
+                -- (the default verbosity in GHCi is 1).
+                when (isNothing maybe_exprs && verbosity dflags > 0) $
+                  liftIO $ putStrLn ("Loaded CLaSHi configuration from " ++ file)
+
+  --
+
+  setGHCContextFromGHCiState
+
+  dot_cfgs <- if ignore_dot_ghci then return [] else do
+    dot_files <- catMaybes <$> sequence [ current_dir, app_user_dir, home_dir ]
+    liftIO $ filterM checkFileAndDirPerms dot_files
+  mdot_cfgs <- liftIO $ mapM canonicalizePath' dot_cfgs
+
+  let arg_cfgs = reverse $ ghciScripts dflags
+    -- -ghci-script are collected in reverse order
+    -- We don't require that a script explicitly added by -ghci-script
+    -- is owned by the current user. (#6017)
+  mapM_ sourceConfigFile $ nub $ (catMaybes mdot_cfgs) ++ arg_cfgs
+    -- nub, because we don't want to read .ghci twice if the CWD is $HOME.
+
+  -- Perform a :load for files given on the GHCi command line
+  -- When in -e mode, if the load fails then we want to stop
+  -- immediately rather than going on to evaluate the expression.
+  when (not (null paths)) $ do
+     ok <- ghciHandle (\e -> do showException e; return Failed) $
+                -- TODO: this is a hack.
+                runInputTWithPrefs defaultPrefs defaultSettings $
+                    loadModule paths
+     when (isJust maybe_exprs && failed ok) $
+        liftIO (exitWith (ExitFailure 1))
+
+  installInteractivePrint (interactivePrint dflags) (isJust maybe_exprs)
+
+  -- if verbosity is greater than 0, or we are connected to a
+  -- terminal, display the prompt in the interactive loop.
+  is_tty <- liftIO (hIsTerminalDevice stdin)
+  let show_prompt = verbosity dflags > 0 || is_tty
+
+  -- reset line number
+  modifyGHCiState $ \st -> st{line_number=0}
+
+  case maybe_exprs of
+        Nothing ->
+          do
+            -- enter the interactive loop
+            runGHCiInput $ runCommands $ nextInputLine show_prompt is_tty
+        Just exprs -> do
+            -- just evaluate the expression we were given
+            enqueueCommands exprs
+            let hdle e = do st <- getGHCiState
+                            -- flush the interpreter's stdout/stderr on exit (#3890)
+                            flushInterpBuffers
+                            -- Jump through some hoops to get the
+                            -- current progname in the exception text:
+                            -- <progname>: <exception>
+                            liftIO $ withProgName (progname st)
+                                   $ topHandler e
+                                   -- this used to be topHandlerFastExit, see #2228
+            runInputTWithPrefs defaultPrefs defaultSettings $ do
+                -- make `ghc -e` exit nonzero on invalid input, see Trac #7962
+                _ <- runCommands' hdle
+                     (Just $ hdle (toException $ ExitFailure 1) >> return ())
+                     (return Nothing)
+                return ()
+
+  -- and finally, exit
+  liftIO $ when (verbosity dflags > 0) $ putStrLn "Leaving CLaSHi."
+
+runGHCiInput :: InputT GHCi a -> GHCi a
+runGHCiInput f = do
+    dflags <- getDynFlags
+    histFile <- if gopt Opt_GhciHistory dflags
+                then liftIO $ withGhcAppData (\dir -> return (Just (dir </> "clashi_history")))
+                                             (return Nothing)
+                else return Nothing
+    runInputT
+        (setComplete ghciCompleteWord $ defaultSettings {historyFile = histFile})
+        f
+
+-- | How to get the next input line from the user
+nextInputLine :: Bool -> Bool -> InputT GHCi (Maybe String)
+nextInputLine show_prompt is_tty
+  | is_tty = do
+    prmpt <- if show_prompt then lift mkPrompt else return ""
+    r <- getInputLine prmpt
+    incrementLineNo
+    return r
+  | otherwise = do
+    when show_prompt $ lift mkPrompt >>= liftIO . putStr
+    fileLoop stdin
+
+-- NOTE: We only read .ghci files if they are owned by the current user,
+-- and aren't world writable (files owned by root are ok, see #9324).
+-- Otherwise, we could be accidentally running code planted by
+-- a malicious third party.
+
+-- Furthermore, We only read ./.ghci if . is owned by the current user
+-- and isn't writable by anyone else.  I think this is sufficient: we
+-- don't need to check .. and ../.. etc. because "."  always refers to
+-- the same directory while a process is running.
+
+checkFileAndDirPerms :: FilePath -> IO Bool
+checkFileAndDirPerms file = do
+  file_ok <- checkPerms file
+  -- Do not check dir perms when .ghci doesn't exist, otherwise GHCi will
+  -- print some confusing and useless warnings in some cases (e.g. in
+  -- travis). Note that we can't add a test for this, as all ghci tests should
+  -- run with -ignore-dot-ghci, which means we never get here.
+  if file_ok then checkPerms (getDirectory file) else return False
+  where
+  getDirectory f = case takeDirectory f of
+    "" -> "."
+    d -> d
+
+checkPerms :: FilePath -> IO Bool
+#ifdef mingw32_HOST_OS
+checkPerms _ = return True
+#else
+checkPerms file =
+  handleIO (\_ -> return False) $ do
+    st <- getFileStatus file
+    me <- getRealUserID
+    let mode = System.Posix.fileMode st
+        ok = (fileOwner st == me || fileOwner st == 0) &&
+             groupWriteMode /= mode `intersectFileModes` groupWriteMode &&
+             otherWriteMode /= mode `intersectFileModes` otherWriteMode
+    unless ok $
+      -- #8248: Improving warning to include a possible fix.
+      putStrLn $ "*** WARNING: " ++ file ++
+                 " is writable by someone else, IGNORING!" ++
+                 "\nSuggested fix: execute 'chmod go-w " ++ file ++ "'"
+    return ok
+#endif
+
+incrementLineNo :: InputT GHCi ()
+incrementLineNo = modifyGHCiState incLineNo
+  where
+    incLineNo st = st { line_number = line_number st + 1 }
+
+fileLoop :: Handle -> InputT GHCi (Maybe String)
+fileLoop hdl = do
+   l <- liftIO $ tryIO $ hGetLine hdl
+   case l of
+        Left e | isEOFError e              -> return Nothing
+               | -- as we share stdin with the program, the program
+                 -- might have already closed it, so we might get a
+                 -- handle-closed exception. We therefore catch that
+                 -- too.
+                 isIllegalOperation e      -> return Nothing
+               | InvalidArgument <- etype  -> return Nothing
+               | otherwise                 -> liftIO $ ioError e
+                where etype = ioeGetErrorType e
+                -- treat InvalidArgument in the same way as EOF:
+                -- this can happen if the user closed stdin, or
+                -- perhaps did getContents which closes stdin at
+                -- EOF.
+        Right l' -> do
+           incrementLineNo
+           return (Just l')
+
+mkPrompt :: GHCi String
+mkPrompt = do
+  st <- getGHCiState
+  imports <- GHC.getContext
+  resumes <- GHC.getResumeContext
+
+  context_bit <-
+        case resumes of
+            [] -> return empty
+            r:_ -> do
+                let ix = GHC.resumeHistoryIx r
+                if ix == 0
+                   then return (brackets (ppr (GHC.resumeSpan r)) <> space)
+                   else do
+                        let hist = GHC.resumeHistory r !! (ix-1)
+                        pan <- GHC.getHistorySpan hist
+                        return (brackets (ppr (negate ix) <> char ':'
+                                          <+> ppr pan) <> space)
+  let
+        dots | _:rs <- resumes, not (null rs) = text "... "
+             | otherwise = empty
+
+        rev_imports = reverse imports -- rightmost are the most recent
+        modules_bit =
+             hsep [ char '*' <> ppr m | IIModule m <- rev_imports ] <+>
+             hsep (map ppr [ myIdeclName d | IIDecl d <- rev_imports ])
+
+         --  use the 'as' name if there is one
+        myIdeclName d | Just m <- ideclAs d = m
+                      | otherwise           = unLoc (ideclName d)
+
+        deflt_prompt = dots <> context_bit <> modules_bit
+
+        f ('%':'l':xs) = ppr (1 + line_number st) <> f xs
+        f ('%':'s':xs) = deflt_prompt <> f xs
+        f ('%':'%':xs) = char '%' <> f xs
+        f (x:xs) = char x <> f xs
+        f [] = empty
+
+  dflags <- getDynFlags
+  return (showSDoc dflags (f (prompt st)))
+
+
+queryQueue :: GHCi (Maybe String)
+queryQueue = do
+  st <- getGHCiState
+  case cmdqueue st of
+    []   -> return Nothing
+    c:cs -> do setGHCiState st{ cmdqueue = cs }
+               return (Just c)
+
+-- Reconfigurable pretty-printing Ticket #5461
+installInteractivePrint :: Maybe String -> Bool -> GHCi ()
+installInteractivePrint Nothing _  = return ()
+installInteractivePrint (Just ipFun) exprmode = do
+  ok <- trySuccess $ do
+                (name:_) <- GHC.parseName ipFun
+                modifySession (\he -> let new_ic = setInteractivePrintName (hsc_IC he) name
+                                      in he{hsc_IC = new_ic})
+                return Succeeded
+
+  when (failed ok && exprmode) $ liftIO (exitWith (ExitFailure 1))
+
+-- | The main read-eval-print loop
+runCommands :: InputT GHCi (Maybe String) -> InputT GHCi ()
+runCommands gCmd = runCommands' handler Nothing gCmd >> return ()
+
+runCommands' :: (SomeException -> GHCi Bool) -- ^ Exception handler
+             -> Maybe (GHCi ()) -- ^ Source error handler
+             -> InputT GHCi (Maybe String)
+             -> InputT GHCi (Maybe Bool)
+         -- We want to return () here, but have to return (Maybe Bool)
+         -- because gmask is not polymorphic enough: we want to use
+         -- unmask at two different types.
+runCommands' eh sourceErrorHandler gCmd = gmask $ \unmask -> do
+    b <- ghandle (\e -> case fromException e of
+                          Just UserInterrupt -> return $ Just False
+                          _ -> case fromException e of
+                                 Just ghce ->
+                                   do liftIO (print (ghce :: GhcException))
+                                      return Nothing
+                                 _other ->
+                                   liftIO (Exception.throwIO e))
+            (unmask $ runOneCommand eh gCmd)
+    case b of
+      Nothing -> return Nothing
+      Just success -> do
+        unless success $ maybe (return ()) lift sourceErrorHandler
+        unmask $ runCommands' eh sourceErrorHandler gCmd
+
+-- | Evaluate a single line of user input (either :<command> or Haskell code).
+-- A result of Nothing means there was no more input to process.
+-- Otherwise the result is Just b where b is True if the command succeeded;
+-- this is relevant only to ghc -e, which will exit with status 1
+-- if the commmand was unsuccessful. GHCi will continue in either case.
+runOneCommand :: (SomeException -> GHCi Bool) -> InputT GHCi (Maybe String)
+            -> InputT GHCi (Maybe Bool)
+runOneCommand eh gCmd = do
+  -- run a previously queued command if there is one, otherwise get new
+  -- input from user
+  mb_cmd0 <- noSpace (lift queryQueue)
+  mb_cmd1 <- maybe (noSpace gCmd) (return . Just) mb_cmd0
+  case mb_cmd1 of
+    Nothing -> return Nothing
+    Just c  -> ghciHandle (\e -> lift $ eh e >>= return . Just) $
+             handleSourceError printErrorAndFail
+               (doCommand c)
+               -- source error's are handled by runStmt
+               -- is the handler necessary here?
+  where
+    printErrorAndFail err = do
+        GHC.printException err
+        return $ Just False     -- Exit ghc -e, but not GHCi
+
+    noSpace q = q >>= maybe (return Nothing)
+                            (\c -> case removeSpaces c of
+                                     ""   -> noSpace q
+                                     ":{" -> multiLineCmd q
+                                     _    -> return (Just c) )
+    multiLineCmd q = do
+      st <- getGHCiState
+      let p = prompt st
+      setGHCiState st{ prompt = prompt2 st }
+      mb_cmd <- collectCommand q "" `GHC.gfinally`
+                modifyGHCiState (\st' -> st' { prompt = p })
+      return mb_cmd
+    -- we can't use removeSpaces for the sublines here, so
+    -- multiline commands are somewhat more brittle against
+    -- fileformat errors (such as \r in dos input on unix),
+    -- we get rid of any extra spaces for the ":}" test;
+    -- we also avoid silent failure if ":}" is not found;
+    -- and since there is no (?) valid occurrence of \r (as
+    -- opposed to its String representation, "\r") inside a
+    -- ghci command, we replace any such with ' ' (argh:-(
+    collectCommand q c = q >>=
+      maybe (liftIO (ioError collectError))
+            (\l->if removeSpaces l == ":}"
+                 then return (Just c)
+                 else collectCommand q (c ++ "\n" ++ map normSpace l))
+      where normSpace '\r' = ' '
+            normSpace   x  = x
+    -- SDM (2007-11-07): is userError the one to use here?
+    collectError = userError "unterminated multiline command :{ .. :}"
+
+    -- | Handle a line of input
+    doCommand :: String -> InputT GHCi (Maybe Bool)
+
+    -- command
+    doCommand stmt | (':' : cmd) <- removeSpaces stmt = do
+      result <- specialCommand cmd
+      case result of
+        True -> return Nothing
+        _    -> return $ Just True
+
+    -- haskell
+    doCommand stmt = do
+      -- if 'stmt' was entered via ':{' it will contain '\n's
+      let stmt_nl_cnt = length [ () | '\n' <- stmt ]
+      ml <- lift $ isOptionSet Multiline
+      if ml && stmt_nl_cnt == 0 -- don't trigger automatic multi-line mode for ':{'-multiline input
+        then do
+          fst_line_num <- line_number <$> getGHCiState
+          mb_stmt <- checkInputForLayout stmt gCmd
+          case mb_stmt of
+            Nothing      -> return $ Just True
+            Just ml_stmt -> do
+              -- temporarily compensate line-number for multi-line input
+              result <- timeIt runAllocs $ lift $
+                runStmtWithLineNum fst_line_num ml_stmt GHC.RunToCompletion
+              return $ Just (runSuccess result)
+        else do -- single line input and :{ - multiline input
+          last_line_num <- line_number <$> getGHCiState
+          -- reconstruct first line num from last line num and stmt
+          let fst_line_num | stmt_nl_cnt > 0 = last_line_num - (stmt_nl_cnt2 + 1)
+                           | otherwise = last_line_num -- single line input
+              stmt_nl_cnt2 = length [ () | '\n' <- stmt' ]
+              stmt' = dropLeadingWhiteLines stmt -- runStmt doesn't like leading empty lines
+          -- temporarily compensate line-number for multi-line input
+          result <- timeIt runAllocs $ lift $
+            runStmtWithLineNum fst_line_num stmt' GHC.RunToCompletion
+          return $ Just (runSuccess result)
+
+    -- runStmt wrapper for temporarily overridden line-number
+    runStmtWithLineNum :: Int -> String -> SingleStep
+                       -> GHCi (Maybe GHC.ExecResult)
+    runStmtWithLineNum lnum stmt step = do
+        st0 <- getGHCiState
+        setGHCiState st0 { line_number = lnum }
+        result <- runStmt stmt step
+        -- restore original line_number
+        getGHCiState >>= \st -> setGHCiState st { line_number = line_number st0 }
+        return result
+
+    -- note: this is subtly different from 'unlines . dropWhile (all isSpace) . lines'
+    dropLeadingWhiteLines s | (l0,'\n':r) <- break (=='\n') s
+                            , all isSpace l0 = dropLeadingWhiteLines r
+                            | otherwise = s
+
+
+-- #4316
+-- lex the input.  If there is an unclosed layout context, request input
+checkInputForLayout :: String -> InputT GHCi (Maybe String)
+                    -> InputT GHCi (Maybe String)
+checkInputForLayout stmt getStmt = do
+   dflags' <- getDynFlags
+   let dflags = xopt_set dflags' LangExt.AlternativeLayoutRule
+   st0 <- getGHCiState
+   let buf'   =  stringToStringBuffer stmt
+       loc    = mkRealSrcLoc (fsLit (progname st0)) (line_number st0) 1
+       pstate = Lexer.mkPState dflags buf' loc
+   case Lexer.unP goToEnd pstate of
+     (Lexer.POk _ False) -> return $ Just stmt
+     _other              -> do
+       st1 <- getGHCiState
+       let p = prompt st1
+       setGHCiState st1{ prompt = prompt2 st1 }
+       mb_stmt <- ghciHandle (\ex -> case fromException ex of
+                            Just UserInterrupt -> return Nothing
+                            _ -> case fromException ex of
+                                 Just ghce ->
+                                   do liftIO (print (ghce :: GhcException))
+                                      return Nothing
+                                 _other -> liftIO (Exception.throwIO ex))
+                     getStmt
+       modifyGHCiState (\st' -> st' { prompt = p })
+       -- the recursive call does not recycle parser state
+       -- as we use a new string buffer
+       case mb_stmt of
+         Nothing  -> return Nothing
+         Just str -> if str == ""
+           then return $ Just stmt
+           else do
+             checkInputForLayout (stmt++"\n"++str) getStmt
+     where goToEnd = do
+             eof <- Lexer.nextIsEOF
+             if eof
+               then Lexer.activeContext
+               else Lexer.lexer False return >> goToEnd
+
+enqueueCommands :: [String] -> GHCi ()
+enqueueCommands cmds = do
+  -- make sure we force any exceptions in the commands while we're
+  -- still inside the exception handler, otherwise bad things will
+  -- happen (see #10501)
+  cmds `deepseq` return ()
+  modifyGHCiState $ \st -> st{ cmdqueue = cmds ++ cmdqueue st }
+
+-- | Entry point to execute some haskell code from user.
+-- The return value True indicates success, as in `runOneCommand`.
+runStmt :: String -> SingleStep -> GHCi (Maybe GHC.ExecResult)
+runStmt stmt step = do
+  dflags <- GHC.getInteractiveDynFlags
+  if | GHC.isStmt dflags stmt    -> run_stmt
+     | GHC.isImport dflags stmt  -> run_import
+     -- Every import declaration should be handled by `run_import`. As GHCi
+     -- in general only accepts one command at a time, we simply throw an
+     -- exception when the input contains multiple commands of which at least
+     -- one is an import command (see #10663).
+     | GHC.hasImport dflags stmt -> throwGhcException
+       (CmdLineError "error: expecting a single import declaration")
+     -- Note: `GHC.isDecl` returns False on input like
+     -- `data Infix a b = a :@: b; infixl 4 :@:`
+     -- and should therefore not be used here.
+     | otherwise                 -> run_decl
+
+  where
+    run_import = do
+      addImportToContext stmt
+      return (Just (GHC.ExecComplete (Right []) 0))
+
+    run_decl =
+        do _ <- liftIO $ tryIO $ hFlushAll stdin
+           m_result <- GhciMonad.runDecls stmt
+           case m_result of
+               Nothing     -> return Nothing
+               Just result ->
+                 Just <$> afterRunStmt (const True)
+                            (GHC.ExecComplete (Right result) 0)
+
+    run_stmt =
+        do -- In the new IO library, read handles buffer data even if the Handle
+           -- is set to NoBuffering.  This causes problems for GHCi where there
+           -- are really two stdin Handles.  So we flush any bufferred data in
+           -- GHCi's stdin Handle here (only relevant if stdin is attached to
+           -- a file, otherwise the read buffer can't be flushed).
+           _ <- liftIO $ tryIO $ hFlushAll stdin
+           m_result <- GhciMonad.runStmt stmt step
+           case m_result of
+               Nothing     -> return Nothing
+               Just result -> Just <$> afterRunStmt (const True) result
+
+-- | Clean up the GHCi environment after a statement has run
+afterRunStmt :: (SrcSpan -> Bool) -> GHC.ExecResult -> GHCi GHC.ExecResult
+afterRunStmt step_here run_result = do
+  resumes <- GHC.getResumeContext
+  case run_result of
+     GHC.ExecComplete{..} ->
+       case execResult of
+          Left ex -> liftIO $ Exception.throwIO ex
+          Right names -> do
+            show_types <- isOptionSet ShowType
+            when show_types $ printTypeOfNames names
+     GHC.ExecBreak names mb_info
+         | isNothing  mb_info ||
+           step_here (GHC.resumeSpan $ head resumes) -> do
+               mb_id_loc <- toBreakIdAndLocation mb_info
+               let bCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc
+               if (null bCmd)
+                 then printStoppedAtBreakInfo (head resumes) names
+                 else enqueueCommands [bCmd]
+               -- run the command set with ":set stop <cmd>"
+               st <- getGHCiState
+               enqueueCommands [stop st]
+               return ()
+         | otherwise -> resume step_here GHC.SingleStep >>=
+                        afterRunStmt step_here >> return ()
+
+  flushInterpBuffers
+  liftIO installSignalHandlers
+  b <- isOptionSet RevertCAFs
+  when b revertCAFs
+
+  return run_result
+
+runSuccess :: Maybe GHC.ExecResult -> Bool
+runSuccess run_result
+  | Just (GHC.ExecComplete { execResult = Right _ }) <- run_result = True
+  | otherwise = False
+
+runAllocs :: Maybe GHC.ExecResult -> Maybe Integer
+runAllocs m = do
+  res <- m
+  case res of
+    GHC.ExecComplete{..} -> Just (fromIntegral execAllocation)
+    _ -> Nothing
+
+toBreakIdAndLocation ::
+  Maybe GHC.BreakInfo -> GHCi (Maybe (Int, BreakLocation))
+toBreakIdAndLocation Nothing = return Nothing
+toBreakIdAndLocation (Just inf) = do
+  let md = GHC.breakInfo_module inf
+      nm = GHC.breakInfo_number inf
+  st <- getGHCiState
+  return $ listToMaybe [ id_loc | id_loc@(_,loc) <- breaks st,
+                                  breakModule loc == md,
+                                  breakTick loc == nm ]
+
+printStoppedAtBreakInfo :: Resume -> [Name] -> GHCi ()
+printStoppedAtBreakInfo res names = do
+  printForUser $ pprStopped res
+  --  printTypeOfNames session names
+  let namesSorted = sortBy compareNames names
+  tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted
+  docs <- mapM pprTypeAndContents [i | AnId i <- tythings]
+  printForUserPartWay $ vcat docs
+
+printTypeOfNames :: [Name] -> GHCi ()
+printTypeOfNames names
+ = mapM_ (printTypeOfName ) $ sortBy compareNames names
+
+compareNames :: Name -> Name -> Ordering
+n1 `compareNames` n2 = compareWith n1 `compare` compareWith n2
+    where compareWith n = (getOccString n, getSrcSpan n)
+
+printTypeOfName :: Name -> GHCi ()
+printTypeOfName n
+   = do maybe_tything <- GHC.lookupName n
+        case maybe_tything of
+            Nothing    -> return ()
+            Just thing -> printTyThing thing
+
+
+data MaybeCommand = GotCommand Command | BadCommand | NoLastCommand
+
+-- | Entry point for execution a ':<command>' input from user
+specialCommand :: String -> InputT GHCi Bool
+specialCommand ('!':str) = lift $ shellEscape (dropWhile isSpace str)
+specialCommand str = do
+  let (cmd,rest) = break isSpace str
+  maybe_cmd <- lift $ lookupCommand cmd
+  htxt <- short_help <$> getGHCiState
+  case maybe_cmd of
+    GotCommand cmd -> (cmdAction cmd) (dropWhile isSpace rest)
+    BadCommand ->
+      do liftIO $ hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
+                           ++ htxt)
+         return False
+    NoLastCommand ->
+      do liftIO $ hPutStr stdout ("there is no last command to perform\n"
+                           ++ htxt)
+         return False
+
+shellEscape :: String -> GHCi Bool
+shellEscape str = liftIO (system str >> return False)
+
+lookupCommand :: String -> GHCi (MaybeCommand)
+lookupCommand "" = do
+  st <- getGHCiState
+  case last_command st of
+      Just c -> return $ GotCommand c
+      Nothing -> return NoLastCommand
+lookupCommand str = do
+  mc <- lookupCommand' str
+  modifyGHCiState (\st -> st { last_command = mc })
+  return $ case mc of
+           Just c -> GotCommand c
+           Nothing -> BadCommand
+
+lookupCommand' :: String -> GHCi (Maybe Command)
+lookupCommand' ":" = return Nothing
+lookupCommand' str' = do
+  macros    <- ghci_macros <$> getGHCiState
+  ghci_cmds <- ghci_commands <$> getGHCiState
+
+  let ghci_cmds_nohide = filter (not . cmdHidden) ghci_cmds
+
+  let (str, xcmds) = case str' of
+          ':' : rest -> (rest, [])     -- "::" selects a builtin command
+          _          -> (str', macros) -- otherwise include macros in lookup
+
+      lookupExact  s = find $ (s ==)           . cmdName
+      lookupPrefix s = find $ (s `isPrefixOf`) . cmdName
+
+      -- hidden commands can only be matched exact
+      builtinPfxMatch = lookupPrefix str ghci_cmds_nohide
+
+  -- first, look for exact match (while preferring macros); then, look
+  -- for first prefix match (preferring builtins), *unless* a macro
+  -- overrides the builtin; see #8305 for motivation
+  return $ lookupExact str xcmds <|>
+           lookupExact str ghci_cmds <|>
+           (builtinPfxMatch >>= \c -> lookupExact (cmdName c) xcmds) <|>
+           builtinPfxMatch <|>
+           lookupPrefix str xcmds
+
+getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
+getCurrentBreakSpan = do
+  resumes <- GHC.getResumeContext
+  case resumes of
+    [] -> return Nothing
+    (r:_) -> do
+        let ix = GHC.resumeHistoryIx r
+        if ix == 0
+           then return (Just (GHC.resumeSpan r))
+           else do
+                let hist = GHC.resumeHistory r !! (ix-1)
+                pan <- GHC.getHistorySpan hist
+                return (Just pan)
+
+getCallStackAtCurrentBreakpoint :: GHCi (Maybe [String])
+getCallStackAtCurrentBreakpoint = do
+  resumes <- GHC.getResumeContext
+  case resumes of
+    [] -> return Nothing
+    (r:_) -> do
+       hsc_env <- GHC.getSession
+       Just <$> liftIO (costCentreStackInfo hsc_env (GHC.resumeCCS r))
+
+getCurrentBreakModule :: GHCi (Maybe Module)
+getCurrentBreakModule = do
+  resumes <- GHC.getResumeContext
+  case resumes of
+    [] -> return Nothing
+    (r:_) -> do
+        let ix = GHC.resumeHistoryIx r
+        if ix == 0
+           then return (GHC.breakInfo_module `liftM` GHC.resumeBreakInfo r)
+           else do
+                let hist = GHC.resumeHistory r !! (ix-1)
+                return $ Just $ GHC.getHistoryModule  hist
+
+-----------------------------------------------------------------------------
+--
+-- Commands
+--
+-----------------------------------------------------------------------------
+
+noArgs :: GHCi () -> String -> GHCi ()
+noArgs m "" = m
+noArgs _ _  = liftIO $ putStrLn "This command takes no arguments"
+
+withSandboxOnly :: String -> GHCi () -> GHCi ()
+withSandboxOnly cmd this = do
+   dflags <- getDynFlags
+   if not (gopt Opt_GhciSandbox dflags)
+      then printForUser (text cmd <+>
+                         ptext (sLit "is not supported with -fno-ghci-sandbox"))
+      else this
+
+-----------------------------------------------------------------------------
+-- :help
+
+help :: String -> GHCi ()
+help _ = do
+    txt <- long_help `fmap` getGHCiState
+    liftIO $ putStr txt
+
+-----------------------------------------------------------------------------
+-- :info
+
+info :: Bool -> String -> InputT GHCi ()
+info _ "" = throwGhcException (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
+info allInfo s  = handleSourceError GHC.printException $ do
+    unqual <- GHC.getPrintUnqual
+    dflags <- getDynFlags
+    sdocs  <- mapM (infoThing allInfo) (words s)
+    mapM_ (liftIO . putStrLn . showSDocForUser dflags unqual) sdocs
+
+infoThing :: GHC.GhcMonad m => Bool -> String -> m SDoc
+infoThing allInfo str = do
+    names     <- GHC.parseName str
+    mb_stuffs <- mapM (GHC.getInfo allInfo) names
+    let filtered = filterOutChildren (\(t,_f,_ci,_fi) -> t) (catMaybes mb_stuffs)
+    return $ vcat (intersperse (text "") $ map pprInfo filtered)
+
+  -- Filter out names whose parent is also there Good
+  -- example is '[]', which is both a type and data
+  -- constructor in the same type
+filterOutChildren :: (a -> TyThing) -> [a] -> [a]
+filterOutChildren get_thing xs
+  = filterOut has_parent xs
+  where
+    all_names = mkNameSet (map (getName . get_thing) xs)
+    has_parent x = case tyThingParent_maybe (get_thing x) of
+                     Just p  -> getName p `elemNameSet` all_names
+                     Nothing -> False
+
+pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst]) -> SDoc
+pprInfo (thing, fixity, cls_insts, fam_insts)
+  =  pprTyThingInContextLoc thing
+  $$ show_fixity
+  $$ vcat (map GHC.pprInstance cls_insts)
+  $$ vcat (map GHC.pprFamInst  fam_insts)
+  where
+    show_fixity
+        | fixity == GHC.defaultFixity = empty
+        | otherwise                   = ppr fixity <+> pprInfixName (GHC.getName thing)
+
+-----------------------------------------------------------------------------
+-- :main
+
+runMain :: String -> GHCi ()
+runMain s = case toArgs s of
+            Left err   -> liftIO (hPutStrLn stderr err)
+            Right args ->
+                do dflags <- getDynFlags
+                   let main = fromMaybe "main" (mainFunIs dflags)
+                   -- Wrap the main function in 'void' to discard its value instead
+                   -- of printing it (#9086). See Haskell 2010 report Chapter 5.
+                   doWithArgs args $ "Control.Monad.void (" ++ main ++ ")"
+
+-----------------------------------------------------------------------------
+-- :run
+
+runRun :: String -> GHCi ()
+runRun s = case toCmdArgs s of
+           Left err          -> liftIO (hPutStrLn stderr err)
+           Right (cmd, args) -> doWithArgs args cmd
+
+doWithArgs :: [String] -> String -> GHCi ()
+doWithArgs args cmd = enqueueCommands ["System.Environment.withArgs " ++
+                                       show args ++ " (" ++ cmd ++ ")"]
+
+-----------------------------------------------------------------------------
+-- :cd
+
+changeDirectory :: String -> InputT GHCi ()
+changeDirectory "" = do
+  -- :cd on its own changes to the user's home directory
+  either_dir <- liftIO $ tryIO getHomeDirectory
+  case either_dir of
+     Left _e -> return ()
+     Right dir -> changeDirectory dir
+changeDirectory dir = do
+  graph <- GHC.getModuleGraph
+  when (not (null graph)) $
+        liftIO $ putStrLn "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed."
+  GHC.setTargets []
+  _ <- GHC.load LoadAllTargets
+  lift $ setContextAfterLoad False []
+  GHC.workingDirectoryChanged
+  dir' <- expandPath dir
+  liftIO $ setCurrentDirectory dir'
+
+trySuccess :: GHC.GhcMonad m => m SuccessFlag -> m SuccessFlag
+trySuccess act =
+    handleSourceError (\e -> do GHC.printException e
+                                return Failed) $ do
+      act
+
+-----------------------------------------------------------------------------
+-- :edit
+
+editFile :: String -> InputT GHCi ()
+editFile str =
+  do file <- if null str then lift chooseEditFile else expandPath str
+     st <- getGHCiState
+     errs <- liftIO $ readIORef $ lastErrorLocations st
+     let cmd = editor st
+     when (null cmd)
+       $ throwGhcException (CmdLineError "editor not set, use :set editor")
+     lineOpt <- liftIO $ do
+         let sameFile p1 p2 = liftA2 (==) (canonicalizePath p1) (canonicalizePath p2)
+              `catchIO` (\_ -> return False)
+
+         curFileErrs <- filterM (\(f, _) -> unpackFS f `sameFile` file) errs
+         return $ case curFileErrs of
+             (_, line):_ -> " +" ++ show line
+             _ -> ""
+     let cmdArgs = ' ':(file ++ lineOpt)
+     code <- liftIO $ system (cmd ++ cmdArgs)
+
+     when (code == ExitSuccess)
+       $ reloadModule False ""
+
+-- The user didn't specify a file so we pick one for them.
+-- Our strategy is to pick the first module that failed to load,
+-- or otherwise the first target.
+--
+-- XXX: Can we figure out what happened if the depndecy analysis fails
+--      (e.g., because the porgrammeer mistyped the name of a module)?
+-- XXX: Can we figure out the location of an error to pass to the editor?
+-- XXX: if we could figure out the list of errors that occured during the
+-- last load/reaload, then we could start the editor focused on the first
+-- of those.
+chooseEditFile :: GHCi String
+chooseEditFile =
+  do let hasFailed x = fmap not $ GHC.isLoaded $ GHC.ms_mod_name x
+
+     graph <- GHC.getModuleGraph
+     failed_graph <- filterM hasFailed graph
+     let order g  = flattenSCCs $ GHC.topSortModuleGraph True g Nothing
+         pick xs  = case xs of
+                      x : _ -> GHC.ml_hs_file (GHC.ms_location x)
+                      _     -> Nothing
+
+     case pick (order failed_graph) of
+       Just file -> return file
+       Nothing   ->
+         do targets <- GHC.getTargets
+            case msum (map fromTarget targets) of
+              Just file -> return file
+              Nothing   -> throwGhcException (CmdLineError "No files to edit.")
+
+  where fromTarget (GHC.Target (GHC.TargetFile f _) _ _) = Just f
+        fromTarget _ = Nothing -- when would we get a module target?
+
+
+-----------------------------------------------------------------------------
+-- :def
+
+defineMacro :: Bool{-overwrite-} -> String -> GHCi ()
+defineMacro _ (':':_) =
+  liftIO $ putStrLn "macro name cannot start with a colon"
+defineMacro overwrite s = do
+  let (macro_name, definition) = break isSpace s
+  macros <- ghci_macros <$> getGHCiState
+  let defined = map cmdName macros
+  if null macro_name
+        then if null defined
+                then liftIO $ putStrLn "no macros defined"
+                else liftIO $ putStr ("the following macros are defined:\n" ++
+                                      unlines defined)
+        else do
+  if (not overwrite && macro_name `elem` defined)
+        then throwGhcException (CmdLineError
+                ("macro '" ++ macro_name ++ "' is already defined"))
+        else do
+
+  -- compile the expression
+  handleSourceError GHC.printException $ do
+    step <- getGhciStepIO
+    expr <- GHC.parseExpr definition
+    -- > ghciStepIO . definition :: String -> IO String
+    let stringTy = nlHsTyVar stringTy_RDR
+        ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
+        body = nlHsVar compose_RDR `mkHsApp` step `mkHsApp` expr
+        tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM)
+        new_expr = L (getLoc expr) $ ExprWithTySig body tySig
+    hv <- GHC.compileParsedExprRemote new_expr
+
+    let newCmd = Command { cmdName = macro_name
+                         , cmdAction = lift . runMacro hv
+                         , cmdHidden = False
+                         , cmdCompletionFunc = noCompletion
+                         }
+
+    -- later defined macros have precedence
+    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
+  hsc_env <- GHC.getSession
+  str <- liftIO $ evalStringToIOString hsc_env fun s
+  enqueueCommands (lines str)
+  return False
+
+
+-----------------------------------------------------------------------------
+-- :undef
+
+undefineMacro :: String -> GHCi ()
+undefineMacro str = mapM_ undef (words str)
+ where undef macro_name = do
+        cmds <- ghci_macros <$> getGHCiState
+        if (macro_name `notElem` map cmdName cmds)
+           then throwGhcException (CmdLineError
+                ("macro '" ++ macro_name ++ "' is not defined"))
+           else do
+            -- This is a tad racy but really, it's a shell
+            modifyGHCiState $ \s ->
+                s { ghci_macros = filter ((/= macro_name) . cmdName)
+                                         (ghci_macros s) }
+
+
+-----------------------------------------------------------------------------
+-- :cmd
+
+cmdCmd :: String -> GHCi ()
+cmdCmd str = handleSourceError GHC.printException $ do
+    step <- getGhciStepIO
+    expr <- GHC.parseExpr str
+    -- > ghciStepIO str :: IO String
+    let new_expr = step `mkHsApp` expr
+    hv <- GHC.compileParsedExprRemote new_expr
+
+    hsc_env <- GHC.getSession
+    cmds <- liftIO $ evalString hsc_env hv
+    enqueueCommands (lines cmds)
+
+-- | Generate a typed ghciStepIO expression
+-- @ghciStepIO :: Ty String -> IO String@.
+getGhciStepIO :: GHCi (LHsExpr RdrName)
+getGhciStepIO = do
+  ghciTyConName <- GHC.getGHCiMonad
+  let stringTy = nlHsTyVar stringTy_RDR
+      ghciM = nlHsTyVar (getRdrName ghciTyConName) `nlHsAppTy` stringTy
+      ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
+      body = nlHsVar (getRdrName ghciStepIoMName)
+      tySig = mkLHsSigWcType (ghciM `nlHsFunTy` ioM)
+  return $ noLoc $ ExprWithTySig body tySig
+
+-----------------------------------------------------------------------------
+-- :check
+
+checkModule :: String -> InputT GHCi ()
+checkModule m = do
+  let modl = GHC.mkModuleName m
+  ok <- handleSourceError (\e -> GHC.printException e >> return False) $ do
+          r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl
+          dflags <- getDynFlags
+          liftIO $ putStrLn $ showSDoc dflags $
+           case GHC.moduleInfo r of
+             cm | Just scope <- GHC.modInfoTopLevelScope cm ->
+                let
+                    (loc, glob) = ASSERT( all isExternalName scope )
+                                  partition ((== modl) . GHC.moduleName . GHC.nameModule) scope
+                in
+                        (text "global names: " <+> ppr glob) $$
+                        (text "local  names: " <+> ppr loc)
+             _ -> empty
+          return True
+  afterLoad (successIf ok) False
+
+
+-----------------------------------------------------------------------------
+-- :load, :add, :reload
+
+-- | Sets '-fdefer-type-errors' if 'defer' is true, executes 'load' and unsets
+-- '-fdefer-type-errors' again if it has not been set before.
+deferredLoad :: Bool -> InputT GHCi SuccessFlag -> InputT GHCi ()
+deferredLoad defer load = do
+  -- Force originalFlags to avoid leaking the associated HscEnv
+  !originalFlags <- getDynFlags
+  when defer $ Monad.void $
+    GHC.setProgramDynFlags $ setGeneralFlag' Opt_DeferTypeErrors originalFlags
+  Monad.void $ load
+  Monad.void $ GHC.setProgramDynFlags $ originalFlags
+
+loadModule :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag
+loadModule fs = timeIt (const Nothing) (loadModule' fs)
+
+-- | @:load@ command
+loadModule_ :: Bool -> [FilePath] -> InputT GHCi ()
+loadModule_ defer fs = deferredLoad defer (loadModule (zip fs (repeat Nothing)))
+
+loadModule' :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag
+loadModule' files = do
+  let (filenames, phases) = unzip files
+  exp_filenames <- mapM expandPath filenames
+  let files' = zip exp_filenames phases
+  targets <- mapM (uncurry GHC.guessTarget) files'
+
+  -- NOTE: we used to do the dependency anal first, so that if it
+  -- fails we didn't throw away the current set of modules.  This would
+  -- require some re-working of the GHC interface, so we'll leave it
+  -- as a ToDo for now.
+
+  -- unload first
+  _ <- GHC.abandonAll
+  lift discardActiveBreakPoints
+  GHC.setTargets []
+  _ <- GHC.load LoadAllTargets
+
+  GHC.setTargets targets
+  doLoadAndCollectInfo False LoadAllTargets
+
+-- | @:add@ command
+addModule :: [FilePath] -> InputT GHCi ()
+addModule files = do
+  lift revertCAFs -- always revert CAFs on load/add.
+  files' <- mapM expandPath files
+  targets <- mapM (\m -> GHC.guessTarget m Nothing) files'
+  -- remove old targets with the same id; e.g. for :add *M
+  mapM_ GHC.removeTarget [ tid | Target tid _ _ <- targets ]
+  mapM_ GHC.addTarget targets
+  _ <- doLoadAndCollectInfo False LoadAllTargets
+  return ()
+
+-- | @:reload@ command
+reloadModule :: Bool -> String -> InputT GHCi ()
+reloadModule defer m = deferredLoad defer $
+                       doLoadAndCollectInfo True loadTargets
+  where
+    loadTargets | null m    = LoadAllTargets
+                | otherwise = LoadUpTo (GHC.mkModuleName m)
+
+-- | Load/compile targets and (optionally) collect module-info
+--
+-- This collects the necessary SrcSpan annotated type information (via
+-- 'collectInfo') required by the @:all-types@, @:loc-at@, @:type-at@,
+-- and @:uses@ commands.
+--
+-- Meta-info collection is not enabled by default and needs to be
+-- enabled explicitly via @:set +c@.  The reason is that collecting
+-- the type-information for all sub-spans can be quite expensive, and
+-- since those commands are designed to be used by editors and
+-- tooling, it's useless to collect this data for normal GHCi
+-- sessions.
+doLoadAndCollectInfo :: Bool -> LoadHowMuch -> InputT GHCi SuccessFlag
+doLoadAndCollectInfo retain_context howmuch = do
+  doCollectInfo <- lift (isOptionSet CollectInfo)
+
+  doLoad retain_context howmuch >>= \case
+    Succeeded | doCollectInfo -> do
+      loaded <- getModuleGraph >>= filterM GHC.isLoaded . map GHC.ms_mod_name
+      v <- mod_infos <$> getGHCiState
+      !newInfos <- collectInfo v loaded
+      modifyGHCiState (\st -> st { mod_infos = newInfos })
+      return Succeeded
+    flag -> return flag
+
+doLoad :: Bool -> LoadHowMuch -> InputT GHCi SuccessFlag
+doLoad retain_context howmuch = do
+  -- turn off breakpoints before we load: we can't turn them off later, because
+  -- the ModBreaks will have gone away.
+  lift discardActiveBreakPoints
+
+  lift resetLastErrorLocations
+  -- Enable buffering stdout and stderr as we're compiling. Keeping these
+  -- handles unbuffered will just slow the compilation down, especially when
+  -- compiling in parallel.
+  gbracket (liftIO $ do hSetBuffering stdout LineBuffering
+                        hSetBuffering stderr LineBuffering)
+           (\_ ->
+            liftIO $ do hSetBuffering stdout NoBuffering
+                        hSetBuffering stderr NoBuffering) $ \_ -> do
+      ok <- trySuccess $ GHC.load howmuch
+      afterLoad ok retain_context
+      return ok
+
+
+afterLoad :: SuccessFlag
+          -> Bool   -- keep the remembered_ctx, as far as possible (:reload)
+          -> InputT GHCi ()
+afterLoad ok retain_context = do
+  lift revertCAFs  -- always revert CAFs on load.
+  lift discardTickArrays
+  loaded_mods <- getLoadedModules
+  modulesLoadedMsg ok loaded_mods
+  lift $ setContextAfterLoad retain_context loaded_mods
+
+setContextAfterLoad :: Bool -> [GHC.ModSummary] -> GHCi ()
+setContextAfterLoad keep_ctxt [] = do
+  setContextKeepingPackageModules keep_ctxt []
+setContextAfterLoad keep_ctxt ms = do
+  -- load a target if one is available, otherwise load the topmost module.
+  targets <- GHC.getTargets
+  case [ m | Just m <- map (findTarget ms) targets ] of
+        []    ->
+          let graph' = flattenSCCs (GHC.topSortModuleGraph True ms Nothing) in
+          load_this (last graph')
+        (m:_) ->
+          load_this m
+ where
+   findTarget mds t
+    = case filter (`matches` t) mds of
+        []    -> Nothing
+        (m:_) -> Just m
+
+   summary `matches` Target (TargetModule m) _ _
+        = GHC.ms_mod_name summary == m
+   summary `matches` Target (TargetFile f _) _ _
+        | Just f' <- GHC.ml_hs_file (GHC.ms_location summary)   = f == f'
+   _ `matches` _
+        = False
+
+   load_this summary | m <- GHC.ms_mod summary = do
+        is_interp <- GHC.moduleIsInterpreted m
+        dflags <- getDynFlags
+        let star_ok = is_interp && not (safeLanguageOn dflags)
+              -- We import the module with a * iff
+              --   - it is interpreted, and
+              --   - -XSafe is off (it doesn't allow *-imports)
+        let new_ctx | star_ok   = [mkIIModule (GHC.moduleName m)]
+                    | otherwise = [mkIIDecl   (GHC.moduleName m)]
+        setContextKeepingPackageModules keep_ctxt new_ctx
+
+
+-- | Keep any package modules (except Prelude) when changing the context.
+setContextKeepingPackageModules
+        :: Bool                 -- True  <=> keep all of remembered_ctx
+                                -- False <=> just keep package imports
+        -> [InteractiveImport]  -- new context
+        -> GHCi ()
+
+setContextKeepingPackageModules keep_ctx trans_ctx = do
+
+  st <- getGHCiState
+  let rem_ctx = remembered_ctx st
+  new_rem_ctx <- if keep_ctx then return rem_ctx
+                             else keepPackageImports rem_ctx
+  setGHCiState st{ remembered_ctx = new_rem_ctx,
+                   transient_ctx  = filterSubsumed new_rem_ctx trans_ctx }
+  setGHCContextFromGHCiState
+
+-- | Filters a list of 'InteractiveImport', clearing out any home package
+-- imports so only imports from external packages are preserved.  ('IIModule'
+-- counts as a home package import, because we are only able to bring a
+-- full top-level into scope when the source is available.)
+keepPackageImports :: [InteractiveImport] -> GHCi [InteractiveImport]
+keepPackageImports = filterM is_pkg_import
+  where
+     is_pkg_import :: InteractiveImport -> GHCi Bool
+     is_pkg_import (IIModule _) = return False
+     is_pkg_import (IIDecl d)
+         = do e <- gtry $ GHC.findModule mod_name (fmap sl_fs $ ideclPkgQual d)
+              case e :: Either SomeException Module of
+                Left _  -> return False
+                Right m -> return (not (isHomeModule m))
+        where
+          mod_name = unLoc (ideclName d)
+
+
+modulesLoadedMsg :: SuccessFlag -> [GHC.ModSummary] -> InputT GHCi ()
+modulesLoadedMsg ok mods = do
+  dflags <- getDynFlags
+  unqual <- GHC.getPrintUnqual
+  let mod_name mod = do
+        is_interpreted <- GHC.isModuleInterpreted mod
+        return $ if is_interpreted
+                  then ppr (GHC.ms_mod mod)
+                  else ppr (GHC.ms_mod mod)
+                       <> text " ("
+                       <> text (normalise $ msObjFilePath mod)
+                       <> text ")" -- fix #9887
+  mod_names <- mapM mod_name mods
+  let mod_commas
+        | null mods = text "none."
+        | otherwise = hsep (punctuate comma mod_names) <> text "."
+      status = case ok of
+                   Failed    -> text "Failed"
+                   Succeeded -> text "Ok"
+
+      msg = status <> text ", modules loaded:" <+> mod_commas
+
+  when (verbosity dflags > 0) $
+     liftIO $ putStrLn $ showSDocForUser dflags unqual msg
+
+
+-- | Run an 'ExceptT' wrapped 'GhcMonad' while handling source errors
+-- and printing 'throwE' strings to 'stderr'
+runExceptGhcMonad :: GHC.GhcMonad m => ExceptT SDoc m () -> m ()
+runExceptGhcMonad act = handleSourceError GHC.printException $
+                        either handleErr pure =<<
+                        runExceptT act
+  where
+    handleErr sdoc = do
+        dflags <- getDynFlags
+        liftIO . hPutStrLn stderr . showSDocForUser dflags alwaysQualify $ sdoc
+
+-- | Inverse of 'runExceptT' for \"pure\" computations
+-- (c.f. 'except' for 'Except')
+exceptT :: Applicative m => Either e a -> ExceptT e m a
+exceptT = ExceptT . pure
+
+makeHDL' :: CLaSH.Backend.Backend backend
+         => (Int -> HdlSyn -> backend)
+         -> IORef CLaSHOpts
+         -> [FilePath]
+         -> InputT GHCi ()
+makeHDL' backend opts lst = makeHDL backend opts =<< case lst of
+  srcs@(_:_) -> return srcs
+  []         -> do
+    modGraph <- GHC.getModuleGraph
+    let sortedGraph = GHC.topSortModuleGraph False modGraph Nothing
+    return $ case (reverse sortedGraph) of
+      ((AcyclicSCC top) : _) -> maybeToList $ (GHC.ml_hs_file . GHC.ms_location) top
+      _                      -> []
+
+makeHDL :: GHC.GhcMonad m
+        => CLaSH.Backend.Backend backend
+        => (Int -> HdlSyn -> backend)
+        -> IORef CLaSHOpts
+        -> [FilePath]
+        -> m ()
+makeHDL backend optsRef srcs = do
+  dflags <- GHC.getSessionDynFlags
+  liftIO $ do startTime <- Clock.getCurrentTime
+              opts  <- readIORef optsRef
+              let iw = opt_intWidth opts
+                  fp = opt_floatSupport opts
+                  syn = opt_hdlSyn opts
+                  -- determine whether `-outputdir` was used
+                  outputDir = do odir <- objectDir dflags
+                                 hidir <- hiDir dflags
+                                 sdir <- stubDir dflags
+                                 ddir <- dumpDir dflags
+                                 if all (== odir) [hidir,sdir,ddir]
+                                    then Just odir
+                                    else Nothing
+                  opts' = opts {opt_hdlDir = maybe outputDir Just (opt_hdlDir opts)}
+              primDir <- CLaSH.Backend.primDir (backend iw syn)
+              forM_ srcs $ \src -> do
+                (bindingsMap,tcm,tupTcm,topEnt,testInpM,expOutM,primMap) <- generateBindings primDir src (Just dflags)
+                prepTime <- startTime `deepseq` bindingsMap `deepseq` tcm `deepseq` Clock.getCurrentTime
+                let prepStartDiff = Clock.diffUTCTime prepTime startTime
+                putStrLn $ "Loading dependencies took " ++ show prepStartDiff
+                CLaSH.Driver.generateHDL bindingsMap (Just (backend iw syn)) primMap tcm
+                  tupTcm (ghcTypeToHWType iw fp) reduceConstant topEnt testInpM expOutM opts' (startTime,prepTime)
+
+makeVHDL :: IORef CLaSHOpts -> [FilePath] -> InputT GHCi ()
+makeVHDL = makeHDL' (CLaSH.Backend.initBackend :: Int -> HdlSyn -> VHDLState)
+
+makeVerilog :: IORef CLaSHOpts -> [FilePath] -> InputT GHCi ()
+makeVerilog = makeHDL' (CLaSH.Backend.initBackend :: Int -> HdlSyn -> VerilogState)
+
+makeSystemVerilog :: IORef CLaSHOpts -> [FilePath] -> InputT GHCi ()
+makeSystemVerilog = makeHDL' (CLaSH.Backend.initBackend :: Int -> HdlSyn -> SystemVerilogState)
+
+-----------------------------------------------------------------------------
+-- | @:type@ command
+
+typeOfExpr :: String -> InputT GHCi ()
+typeOfExpr str = handleSourceError GHC.printException $ do
+    ty <- GHC.exprType str
+    printForUser $ sep [text str, nest 2 (dcolon <+> pprTypeForUser ty)]
+
+-----------------------------------------------------------------------------
+-- | @:type-at@ command
+
+typeAtCmd :: String -> InputT GHCi ()
+typeAtCmd str = runExceptGhcMonad $ do
+    (span',sample) <- exceptT $ parseSpanArg str
+    infos      <- mod_infos <$> getGHCiState
+    (info, ty) <- findType infos span' sample
+    lift $ printForUserModInfo (modinfoInfo info)
+                               (sep [text sample,nest 2 (dcolon <+> ppr ty)])
+
+-----------------------------------------------------------------------------
+-- | @:uses@ command
+
+usesCmd :: String -> InputT GHCi ()
+usesCmd str = runExceptGhcMonad $ do
+    (span',sample) <- exceptT $ parseSpanArg str
+    infos  <- mod_infos <$> getGHCiState
+    uses   <- findNameUses infos span' sample
+    forM_ uses (liftIO . putStrLn . showSrcSpan)
+
+-----------------------------------------------------------------------------
+-- | @:loc-at@ command
+
+locAtCmd :: String -> InputT GHCi ()
+locAtCmd str = runExceptGhcMonad $ do
+    (span',sample) <- exceptT $ parseSpanArg str
+    infos    <- mod_infos <$> getGHCiState
+    (_,_,sp) <- findLoc infos span' sample
+    liftIO . putStrLn . showSrcSpan $ sp
+
+-----------------------------------------------------------------------------
+-- | @:all-types@ command
+
+allTypesCmd :: String -> InputT GHCi ()
+allTypesCmd _ = runExceptGhcMonad $ do
+    infos <- mod_infos <$> getGHCiState
+    forM_ (M.elems infos) $ \mi ->
+        forM_ (modinfoSpans mi) (lift . printSpan)
+  where
+    printSpan span'
+      | Just ty <- spaninfoType span' = do
+        df <- getDynFlags
+        let tyInfo = unwords . words $
+                     showSDocForUser df alwaysQualify (pprTypeForUser ty)
+        liftIO . putStrLn $
+            showRealSrcSpan (spaninfoSrcSpan span') ++ ": " ++ tyInfo
+      | otherwise = return ()
+
+-----------------------------------------------------------------------------
+-- Helpers for locAtCmd/typeAtCmd/usesCmd
+
+-- | Parse a span: <module-name/filepath> <sl> <sc> <el> <ec> <string>
+parseSpanArg :: String -> Either SDoc (RealSrcSpan,String)
+parseSpanArg s = do
+    (fp,s0) <- readAsString (skipWs s)
+    s0'     <- skipWs1 s0
+    (sl,s1) <- readAsInt s0'
+    s1'     <- skipWs1 s1
+    (sc,s2) <- readAsInt s1'
+    s2'     <- skipWs1 s2
+    (el,s3) <- readAsInt s2'
+    s3'     <- skipWs1 s3
+    (ec,s4) <- readAsInt s3'
+
+    trailer <- case s4 of
+        [] -> Right ""
+        _  -> skipWs1 s4
+
+    let fs    = mkFastString fp
+        span' = mkRealSrcSpan (mkRealSrcLoc fs sl sc)
+                              (mkRealSrcLoc fs el ec)
+
+    return (span',trailer)
+  where
+    readAsInt :: String -> Either SDoc (Int,String)
+    readAsInt "" = Left "Premature end of string while expecting Int"
+    readAsInt s0 = case reads s0 of
+        [s_rest] -> Right s_rest
+        _        -> Left ("Couldn't read" <+> text (show s0) <+> "as Int")
+
+    readAsString :: String -> Either SDoc (String,String)
+    readAsString s0
+      | '"':_ <- s0 = case reads s0 of
+          [s_rest] -> Right s_rest
+          _        -> leftRes
+      | s_rest@(_:_,_) <- breakWs s0 = Right s_rest
+      | otherwise = leftRes
+      where
+        leftRes = Left ("Couldn't read" <+> text (show s0) <+> "as String")
+
+    skipWs1 :: String -> Either SDoc String
+    skipWs1 (c:cs) | isWs c = Right (skipWs cs)
+    skipWs1 s0 = Left ("Expected whitespace in" <+> text (show s0))
+
+    isWs    = (`elem` [' ','\t'])
+    skipWs  = dropWhile isWs
+    breakWs = break isWs
+
+
+-- | Pretty-print \"real\" 'SrcSpan's as
+-- @<filename>:(<line>,<col>)-(<line-end>,<col-end>)@
+-- while simply unpacking 'UnhelpfulSpan's
+showSrcSpan :: SrcSpan -> String
+showSrcSpan (UnhelpfulSpan s)  = unpackFS s
+showSrcSpan (RealSrcSpan spn)  = showRealSrcSpan spn
+
+-- | Variant of 'showSrcSpan' for 'RealSrcSpan's
+showRealSrcSpan :: RealSrcSpan -> String
+showRealSrcSpan spn = concat [ fp, ":(", show sl, ",", show sc
+                             , ")-(", show el, ",", show ec, ")"
+                             ]
+  where
+    fp = unpackFS (srcSpanFile spn)
+    sl = srcSpanStartLine spn
+    sc = srcSpanStartCol  spn
+    el = srcSpanEndLine   spn
+    ec = srcSpanEndCol    spn
+
+-----------------------------------------------------------------------------
+-- | @:kind@ command
+
+kindOfType :: Bool -> String -> InputT GHCi ()
+kindOfType norm str = handleSourceError GHC.printException $ do
+    (ty, kind) <- GHC.typeKind norm str
+    printForUser $ vcat [ text str <+> dcolon <+> pprTypeForUser kind
+                        , ppWhen norm $ equals <+> pprTypeForUser ty ]
+
+-----------------------------------------------------------------------------
+-- :quit
+
+quit :: String -> InputT GHCi Bool
+quit _ = return True
+
+
+-----------------------------------------------------------------------------
+-- :script
+
+-- running a script file #1363
+
+scriptCmd :: String -> InputT GHCi ()
+scriptCmd ws = do
+  case words ws of
+    [s]    -> runScript s
+    _      -> throwGhcException (CmdLineError "syntax:  :script <filename>")
+
+runScript :: String    -- ^ filename
+           -> InputT GHCi ()
+runScript filename = do
+  filename' <- expandPath filename
+  either_script <- liftIO $ tryIO (openFile filename' ReadMode)
+  case either_script of
+    Left _err    -> throwGhcException (CmdLineError $ "IO error:  \""++filename++"\" "
+                      ++(ioeGetErrorString _err))
+    Right script -> do
+      st <- getGHCiState
+      let prog = progname st
+          line = line_number st
+      setGHCiState st{progname=filename',line_number=0}
+      scriptLoop script
+      liftIO $ hClose script
+      new_st <- getGHCiState
+      setGHCiState new_st{progname=prog,line_number=line}
+  where scriptLoop script = do
+          res <- runOneCommand handler $ fileLoop script
+          case res of
+            Nothing -> return ()
+            Just s  -> if s
+              then scriptLoop script
+              else return ()
+
+-----------------------------------------------------------------------------
+-- :issafe
+
+-- Displaying Safe Haskell properties of a module
+
+isSafeCmd :: String -> InputT GHCi ()
+isSafeCmd m =
+    case words m of
+        [s] | looksLikeModuleName s -> do
+            md <- lift $ lookupModule s
+            isSafeModule md
+        [] -> do md <- guessCurrentModule "issafe"
+                 isSafeModule md
+        _ -> throwGhcException (CmdLineError "syntax:  :issafe <module>")
+
+isSafeModule :: Module -> InputT GHCi ()
+isSafeModule m = do
+    mb_mod_info <- GHC.getModuleInfo m
+    when (isNothing mb_mod_info)
+         (throwGhcException $ CmdLineError $ "unknown module: " ++ mname)
+
+    dflags <- getDynFlags
+    let iface = GHC.modInfoIface $ fromJust mb_mod_info
+    when (isNothing iface)
+         (throwGhcException $ CmdLineError $ "can't load interface file for module: " ++
+                                    (GHC.moduleNameString $ GHC.moduleName m))
+
+    (msafe, pkgs) <- GHC.moduleTrustReqs m
+    let trust  = showPpr dflags $ getSafeMode $ GHC.mi_trust $ fromJust iface
+        pkg    = if packageTrusted dflags m then "trusted" else "untrusted"
+        (good, bad) = tallyPkgs dflags pkgs
+
+    -- print info to user...
+    liftIO $ putStrLn $ "Trust type is (Module: " ++ trust ++ ", Package: " ++ pkg ++ ")"
+    liftIO $ putStrLn $ "Package Trust: " ++ (if packageTrustOn dflags then "On" else "Off")
+    when (not $ null good)
+         (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++
+                        (intercalate ", " $ map (showPpr dflags) good))
+    case msafe && null bad of
+        True -> liftIO $ putStrLn $ mname ++ " is trusted!"
+        False -> do
+            when (not $ null bad)
+                 (liftIO $ putStrLn $ "Trusted package dependencies (untrusted): "
+                            ++ (intercalate ", " $ map (showPpr dflags) bad))
+            liftIO $ putStrLn $ mname ++ " is NOT trusted!"
+
+  where
+    mname = GHC.moduleNameString $ GHC.moduleName m
+
+    packageTrusted dflags md
+        | thisPackage dflags == moduleUnitId md = True
+        | otherwise = trusted $ getPackageDetails dflags (moduleUnitId md)
+
+    tallyPkgs dflags deps | not (packageTrustOn dflags) = ([], [])
+                          | otherwise = partition part deps
+        where part pkg = trusted $ getPackageDetails dflags pkg
+
+-----------------------------------------------------------------------------
+-- :browse
+
+-- Browsing a module's contents
+
+browseCmd :: Bool -> String -> InputT GHCi ()
+browseCmd bang m =
+  case words m of
+    ['*':s] | looksLikeModuleName s -> do
+        md <- lift $ wantInterpretedModule s
+        browseModule bang md False
+    [s] | looksLikeModuleName s -> do
+        md <- lift $ lookupModule s
+        browseModule bang md True
+    [] -> do md <- guessCurrentModule ("browse" ++ if bang then "!" else "")
+             browseModule bang md True
+    _ -> throwGhcException (CmdLineError "syntax:  :browse <module>")
+
+guessCurrentModule :: String -> InputT GHCi Module
+-- Guess which module the user wants to browse.  Pick
+-- modules that are interpreted first.  The most
+-- recently-added module occurs last, it seems.
+guessCurrentModule cmd
+  = do imports <- GHC.getContext
+       when (null imports) $ throwGhcException $
+          CmdLineError (':' : cmd ++ ": no current module")
+       case (head imports) of
+          IIModule m -> GHC.findModule m Nothing
+          IIDecl d   -> GHC.findModule (unLoc (ideclName d))
+                                       (fmap sl_fs $ ideclPkgQual d)
+
+-- without bang, show items in context of their parents and omit children
+-- with bang, show class methods and data constructors separately, and
+--            indicate import modules, to aid qualifying unqualified names
+-- with sorted, sort items alphabetically
+browseModule :: Bool -> Module -> Bool -> InputT GHCi ()
+browseModule bang modl exports_only = do
+  -- :browse reports qualifiers wrt current context
+  unqual <- GHC.getPrintUnqual
+
+  mb_mod_info <- GHC.getModuleInfo modl
+  case mb_mod_info of
+    Nothing -> throwGhcException (CmdLineError ("unknown module: " ++
+                                GHC.moduleNameString (GHC.moduleName modl)))
+    Just mod_info -> do
+        dflags <- getDynFlags
+        let names
+               | exports_only = GHC.modInfoExports mod_info
+               | otherwise    = GHC.modInfoTopLevelScope mod_info
+                                `orElse` []
+
+                -- sort alphabetically name, but putting locally-defined
+                -- identifiers first. We would like to improve this; see #1799.
+            sorted_names = loc_sort local ++ occ_sort external
+                where
+                (local,external) = ASSERT( all isExternalName names )
+                                   partition ((==modl) . nameModule) names
+                occ_sort = sortBy (compare `on` nameOccName)
+                -- try to sort by src location. If the first name in our list
+                -- has a good source location, then they all should.
+                loc_sort ns
+                      | n:_ <- ns, isGoodSrcSpan (nameSrcSpan n)
+                      = sortBy (compare `on` nameSrcSpan) ns
+                      | otherwise
+                      = occ_sort ns
+
+        mb_things <- mapM GHC.lookupName sorted_names
+        let filtered_things = filterOutChildren (\t -> t) (catMaybes mb_things)
+
+        rdr_env <- GHC.getGRE
+
+        let things | bang      = catMaybes mb_things
+                   | otherwise = filtered_things
+            pretty | bang      = pprTyThing
+                   | otherwise = pprTyThingInContext
+
+            labels  [] = text "-- not currently imported"
+            labels  l  = text $ intercalate "\n" $ map qualifier l
+
+            qualifier :: Maybe [ModuleName] -> String
+            qualifier  = maybe "-- defined locally"
+                             (("-- imported via "++) . intercalate ", "
+                               . map GHC.moduleNameString)
+            importInfo = RdrName.getGRE_NameQualifier_maybes rdr_env
+
+            modNames :: [[Maybe [ModuleName]]]
+            modNames   = map (importInfo . GHC.getName) things
+
+            -- annotate groups of imports with their import modules
+            -- the default ordering is somewhat arbitrary, so we group
+            -- by header and sort groups; the names themselves should
+            -- really come in order of source appearance.. (trac #1799)
+            annotate mts = concatMap (\(m,ts)->labels m:ts)
+                         $ sortBy cmpQualifiers $ grp mts
+              where cmpQualifiers =
+                      compare `on` (map (fmap (map moduleNameFS)) . fst)
+            grp []            = []
+            grp mts@((m,_):_) = (m,map snd g) : grp ng
+              where (g,ng) = partition ((==m).fst) mts
+
+        let prettyThings, prettyThings' :: [SDoc]
+            prettyThings = map pretty things
+            prettyThings' | bang      = annotate $ zip modNames prettyThings
+                          | otherwise = prettyThings
+        liftIO $ putStrLn $ showSDocForUser dflags unqual (vcat prettyThings')
+        -- ToDo: modInfoInstances currently throws an exception for
+        -- package modules.  When it works, we can do this:
+        --        $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
+
+
+-----------------------------------------------------------------------------
+-- :module
+
+-- Setting the module context.  For details on context handling see
+-- "remembered_ctx" and "transient_ctx" in GhciMonad.
+
+moduleCmd :: String -> GHCi ()
+moduleCmd str
+  | all sensible strs = cmd
+  | otherwise = throwGhcException (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
+  where
+    (cmd, strs) =
+        case str of
+          '+':stuff -> rest addModulesToContext   stuff
+          '-':stuff -> rest remModulesFromContext stuff
+          stuff     -> rest setContext            stuff
+
+    rest op stuff = (op as bs, stuffs)
+       where (as,bs) = partitionWith starred stuffs
+             stuffs  = words stuff
+
+    sensible ('*':m) = looksLikeModuleName m
+    sensible m       = looksLikeModuleName m
+
+    starred ('*':m) = Left  (GHC.mkModuleName m)
+    starred m       = Right (GHC.mkModuleName m)
+
+
+-- -----------------------------------------------------------------------------
+-- Four ways to manipulate the context:
+--   (a) :module +<stuff>:     addModulesToContext
+--   (b) :module -<stuff>:     remModulesFromContext
+--   (c) :module <stuff>:      setContext
+--   (d) import <module>...:   addImportToContext
+
+addModulesToContext :: [ModuleName] -> [ModuleName] -> GHCi ()
+addModulesToContext starred unstarred = restoreContextOnFailure $ do
+   addModulesToContext_ starred unstarred
+
+addModulesToContext_ :: [ModuleName] -> [ModuleName] -> GHCi ()
+addModulesToContext_ starred unstarred = do
+   mapM_ addII (map mkIIModule starred ++ map mkIIDecl unstarred)
+   setGHCContextFromGHCiState
+
+remModulesFromContext :: [ModuleName] -> [ModuleName] -> GHCi ()
+remModulesFromContext  starred unstarred = do
+   -- we do *not* call restoreContextOnFailure here.  If the user
+   -- is trying to fix up a context that contains errors by removing
+   -- modules, we don't want GHC to silently put them back in again.
+   mapM_ rm (starred ++ unstarred)
+   setGHCContextFromGHCiState
+ where
+   rm :: ModuleName -> GHCi ()
+   rm str = do
+     m <- moduleName <$> lookupModuleName str
+     let filt = filter ((/=) m . iiModuleName)
+     modifyGHCiState $ \st ->
+        st { remembered_ctx = filt (remembered_ctx st)
+           , transient_ctx  = filt (transient_ctx st) }
+
+setContext :: [ModuleName] -> [ModuleName] -> GHCi ()
+setContext starred unstarred = restoreContextOnFailure $ do
+  modifyGHCiState $ \st -> st { remembered_ctx = [], transient_ctx = [] }
+                                -- delete the transient context
+  addModulesToContext_ starred unstarred
+
+addImportToContext :: String -> GHCi ()
+addImportToContext str = restoreContextOnFailure $ do
+  idecl <- GHC.parseImportDecl str
+  addII (IIDecl idecl)   -- #5836
+  setGHCContextFromGHCiState
+
+-- Util used by addImportToContext and addModulesToContext
+addII :: InteractiveImport -> GHCi ()
+addII iidecl = do
+  checkAdd iidecl
+  modifyGHCiState $ \st ->
+     st { remembered_ctx = addNotSubsumed iidecl (remembered_ctx st)
+        , transient_ctx = filter (not . (iidecl `iiSubsumes`))
+                                 (transient_ctx st)
+        }
+
+-- Sometimes we can't tell whether an import is valid or not until
+-- we finally call 'GHC.setContext'.  e.g.
+--
+--   import System.IO (foo)
+--
+-- will fail because System.IO does not export foo.  In this case we
+-- don't want to store the import in the context permanently, so we
+-- catch the failure from 'setGHCContextFromGHCiState' and set the
+-- context back to what it was.
+--
+-- See #6007
+--
+restoreContextOnFailure :: GHCi a -> GHCi a
+restoreContextOnFailure do_this = do
+  st <- getGHCiState
+  let rc = remembered_ctx st; tc = transient_ctx st
+  do_this `gonException` (modifyGHCiState $ \st' ->
+     st' { remembered_ctx = rc, transient_ctx = tc })
+
+-- -----------------------------------------------------------------------------
+-- Validate a module that we want to add to the context
+
+checkAdd :: InteractiveImport -> GHCi ()
+checkAdd ii = do
+  dflags <- getDynFlags
+  let safe = safeLanguageOn dflags
+  case ii of
+    IIModule modname
+       | safe -> throwGhcException $ CmdLineError "can't use * imports with Safe Haskell"
+       | otherwise -> wantInterpretedModuleName modname >> return ()
+
+    IIDecl d -> do
+       let modname = unLoc (ideclName d)
+           pkgqual = ideclPkgQual d
+       m <- GHC.lookupModule modname (fmap sl_fs pkgqual)
+       when safe $ do
+           t <- GHC.isModuleTrusted m
+           when (not t) $ throwGhcException $ ProgramError $ ""
+
+-- -----------------------------------------------------------------------------
+-- Update the GHC API's view of the context
+
+-- | Sets the GHC context from the GHCi state.  The GHC context is
+-- always set this way, we never modify it incrementally.
+--
+-- We ignore any imports for which the ModuleName does not currently
+-- exist.  This is so that the remembered_ctx can contain imports for
+-- modules that are not currently loaded, perhaps because we just did
+-- a :reload and encountered errors.
+--
+-- Prelude is added if not already present in the list.  Therefore to
+-- override the implicit Prelude import you can say 'import Prelude ()'
+-- at the prompt, just as in Haskell source.
+--
+setGHCContextFromGHCiState :: GHCi ()
+setGHCContextFromGHCiState = do
+  st <- getGHCiState
+      -- re-use checkAdd to check whether the module is valid.  If the
+      -- module does not exist, we do *not* want to print an error
+      -- here, we just want to silently keep the module in the context
+      -- until such time as the module reappears again.  So we ignore
+      -- the actual exception thrown by checkAdd, using tryBool to
+      -- turn it into a Bool.
+  iidecls <- filterM (tryBool.checkAdd) (transient_ctx st ++ remembered_ctx st)
+  GHC.setContext $
+     if not (any isPreludeImport iidecls)
+        then iidecls ++ [implicitPreludeImport]
+        else iidecls
+    -- XXX put prel at the end, so that guessCurrentModule doesn't pick it up.
+
+
+-- -----------------------------------------------------------------------------
+-- Utils on InteractiveImport
+
+mkIIModule :: ModuleName -> InteractiveImport
+mkIIModule = IIModule
+
+mkIIDecl :: ModuleName -> InteractiveImport
+mkIIDecl = IIDecl . simpleImportDecl
+
+iiModules :: [InteractiveImport] -> [ModuleName]
+iiModules is = [m | IIModule m <- is]
+
+iiModuleName :: InteractiveImport -> ModuleName
+iiModuleName (IIModule m) = m
+iiModuleName (IIDecl d)   = unLoc (ideclName d)
+
+preludeModuleName :: ModuleName
+preludeModuleName = GHC.mkModuleName "CLaSH.Prelude"
+
+implicitPreludeImport :: InteractiveImport
+implicitPreludeImport = IIDecl (simpleImportDecl preludeModuleName)
+
+isPreludeImport :: InteractiveImport -> Bool
+isPreludeImport (IIModule {}) = True
+isPreludeImport (IIDecl d)    = unLoc (ideclName d) == preludeModuleName
+
+addNotSubsumed :: InteractiveImport
+               -> [InteractiveImport] -> [InteractiveImport]
+addNotSubsumed i is
+  | any (`iiSubsumes` i) is = is
+  | otherwise               = i : filter (not . (i `iiSubsumes`)) is
+
+-- | @filterSubsumed is js@ returns the elements of @js@ not subsumed
+-- by any of @is@.
+filterSubsumed :: [InteractiveImport] -> [InteractiveImport]
+               -> [InteractiveImport]
+filterSubsumed is js = filter (\j -> not (any (`iiSubsumes` j) is)) js
+
+-- | Returns True if the left import subsumes the right one.  Doesn't
+-- need to be 100% accurate, conservatively returning False is fine.
+-- (EXCEPT: (IIModule m) *must* subsume itself, otherwise a panic in
+-- plusProv will ensue (#5904))
+--
+-- Note that an IIModule does not necessarily subsume an IIDecl,
+-- because e.g. a module might export a name that is only available
+-- qualified within the module itself.
+--
+-- Note that 'import M' does not necessarily subsume 'import M(foo)',
+-- because M might not export foo and we want an error to be produced
+-- in that case.
+--
+iiSubsumes :: InteractiveImport -> InteractiveImport -> Bool
+iiSubsumes (IIModule m1) (IIModule m2) = m1==m2
+iiSubsumes (IIDecl d1) (IIDecl d2)      -- A bit crude
+  =  unLoc (ideclName d1) == unLoc (ideclName d2)
+     && ideclAs d1 == ideclAs d2
+     && (not (ideclQualified d1) || ideclQualified d2)
+     && (ideclHiding d1 `hidingSubsumes` ideclHiding d2)
+  where
+     _                    `hidingSubsumes` Just (False,L _ []) = True
+     Just (False, L _ xs) `hidingSubsumes` Just (False,L _ ys)
+                                                           = all (`elem` xs) ys
+     h1                   `hidingSubsumes` h2              = h1 == h2
+iiSubsumes _ _ = False
+
+
+----------------------------------------------------------------------------
+-- :set
+
+-- set options in the interpreter.  Syntax is exactly the same as the
+-- ghc command line, except that certain options aren't available (-C,
+-- -E etc.)
+--
+-- This is pretty fragile: most options won't work as expected.  ToDo:
+-- figure out which ones & disallow them.
+
+setCmd :: String -> GHCi ()
+setCmd ""   = showOptions False
+setCmd "-a" = showOptions True
+setCmd str
+  = case getCmd str of
+    Right ("args",    rest) ->
+        case toArgs rest of
+            Left err -> liftIO (hPutStrLn stderr err)
+            Right args -> setArgs args
+    Right ("prog",    rest) ->
+        case toArgs rest of
+            Right [prog] -> setProg prog
+            _ -> liftIO (hPutStrLn stderr "syntax: :set prog <progname>")
+    Right ("prompt",  rest) -> setPrompt  $ dropWhile isSpace rest
+    Right ("prompt2", rest) -> setPrompt2 $ dropWhile isSpace rest
+    Right ("editor",  rest) -> setEditor  $ dropWhile isSpace rest
+    Right ("stop",    rest) -> setStop    $ dropWhile isSpace rest
+    _ -> case toArgs str of
+         Left err -> liftIO (hPutStrLn stderr err)
+         Right wds -> setOptions wds
+
+setiCmd :: String -> GHCi ()
+setiCmd ""   = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags False
+setiCmd "-a" = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags True
+setiCmd str  =
+  case toArgs str of
+    Left err -> liftIO (hPutStrLn stderr err)
+    Right wds -> newDynFlags True wds
+
+showOptions :: Bool -> GHCi ()
+showOptions show_all
+  = do st <- getGHCiState
+       dflags <- getDynFlags
+       let opts = options st
+       liftIO $ putStrLn (showSDoc dflags (
+              text "options currently set: " <>
+              if null opts
+                   then text "none."
+                   else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
+           ))
+       getDynFlags >>= liftIO . showDynFlags show_all
+
+
+showDynFlags :: Bool -> DynFlags -> IO ()
+showDynFlags show_all dflags = do
+  showLanguages' show_all dflags
+  putStrLn $ showSDoc dflags $
+     text "GHCi-specific dynamic flag settings:" $$
+         nest 2 (vcat (map (setting "-f" "-fno-" gopt) ghciFlags))
+  putStrLn $ showSDoc dflags $
+     text "other dynamic, non-language, flag settings:" $$
+         nest 2 (vcat (map (setting "-f" "-fno-" gopt) others))
+  putStrLn $ showSDoc dflags $
+     text "warning settings:" $$
+         nest 2 (vcat (map (setting "-W" "-Wno-" wopt) DynFlags.wWarningFlags))
+  where
+        setting prefix noPrefix test flag
+          | quiet     = empty
+          | is_on     = text prefix <> text name
+          | otherwise = text noPrefix <> text name
+          where name = flagSpecName flag
+                f = flagSpecFlag flag
+                is_on = test f dflags
+                quiet = not show_all && test f default_dflags == is_on
+
+        default_dflags = defaultDynFlags (settings dflags)
+
+        (ghciFlags,others)  = partition (\f -> flagSpecFlag f `elem` flgs)
+                                        DynFlags.fFlags
+        flgs = [ Opt_PrintExplicitForalls
+               , Opt_PrintExplicitKinds
+               , Opt_PrintUnicodeSyntax
+               , Opt_PrintBindResult
+               , Opt_BreakOnException
+               , Opt_BreakOnError
+               , Opt_PrintEvldWithShow
+               ]
+
+setArgs, setOptions :: [String] -> GHCi ()
+setProg, setEditor, setStop :: String -> GHCi ()
+
+setArgs args = do
+  st <- getGHCiState
+  wrapper <- mkEvalWrapper (progname st) args
+  setGHCiState st { GhciMonad.args = args, evalWrapper = wrapper }
+
+setProg prog = do
+  st <- getGHCiState
+  wrapper <- mkEvalWrapper prog (GhciMonad.args st)
+  setGHCiState st { progname = prog, evalWrapper = wrapper }
+
+setEditor cmd = modifyGHCiState (\st -> st { editor = cmd })
+
+setStop str@(c:_) | isDigit c
+  = do let (nm_str,rest) = break (not.isDigit) str
+           nm = read nm_str
+       st <- getGHCiState
+       let old_breaks = breaks st
+       if all ((/= nm) . fst) old_breaks
+              then printForUser (text "Breakpoint" <+> ppr nm <+>
+                                 text "does not exist")
+              else do
+       let new_breaks = map fn old_breaks
+           fn (i,loc) | i == nm   = (i,loc { onBreakCmd = dropWhile isSpace rest })
+                      | otherwise = (i,loc)
+       setGHCiState st{ breaks = new_breaks }
+setStop cmd = modifyGHCiState (\st -> st { stop = cmd })
+
+setPrompt :: String -> GHCi ()
+setPrompt = setPrompt_ f err
+  where
+    f v st = st { prompt = v }
+    err st = "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
+
+setPrompt2 :: String -> GHCi ()
+setPrompt2 = setPrompt_ f err
+  where
+    f v st = st { prompt2 = v }
+    err st = "syntax: :set prompt2 <prompt>, currently \"" ++ prompt2 st ++ "\""
+
+setPrompt_ :: (String -> GHCiState -> GHCiState) -> (GHCiState -> String) -> String -> GHCi ()
+setPrompt_ f err value = do
+  st <- getGHCiState
+  if null value
+      then liftIO $ hPutStrLn stderr $ err st
+      else case value of
+           '\"' : _ -> case reads value of
+                       [(value', xs)] | all isSpace xs ->
+                           setGHCiState $ f value' st
+                       _ ->
+                           liftIO $ hPutStrLn stderr "Can't parse prompt string. Use Haskell syntax."
+           _ -> setGHCiState $ f value st
+
+setOptions wds =
+   do -- first, deal with the GHCi opts (+s, +t, etc.)
+      let (plus_opts, minus_opts)  = partitionWith isPlus wds
+      mapM_ setOpt plus_opts
+      -- then, dynamic flags
+      newDynFlags False minus_opts
+
+packageFlagsChanged :: DynFlags -> DynFlags -> Bool
+packageFlagsChanged idflags1 idflags0 =
+    packageFlags idflags1 /= packageFlags idflags0 ||
+    ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 ||
+    pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 ||
+    trustFlags idflags1 /= trustFlags idflags0
+
+newDynFlags :: Bool -> [String] -> GHCi ()
+newDynFlags interactive_only minus_opts = do
+      let lopts = map noLoc minus_opts
+
+      idflags0 <- GHC.getInteractiveDynFlags
+      (idflags1, leftovers, warns) <- GHC.parseDynamicFlags idflags0 lopts
+
+      liftIO $ handleFlagWarnings idflags1 warns
+      when (not $ null leftovers)
+           (throwGhcException . CmdLineError
+            $ "Some flags have not been recognized: "
+            ++ (concat . intersperse ", " $ map unLoc leftovers))
+
+      when (interactive_only && packageFlagsChanged idflags1 idflags0) $ do
+          liftIO $ hPutStrLn stderr "cannot set package flags with :seti; use :set"
+      GHC.setInteractiveDynFlags idflags1
+      installInteractivePrint (interactivePrint idflags1) False
+
+      dflags0 <- getDynFlags
+      when (not interactive_only) $ do
+        (dflags1, _, _) <- liftIO $ GHC.parseDynamicFlags dflags0 lopts
+        new_pkgs <- GHC.setProgramDynFlags dflags1
+
+        -- if the package flags changed, reset the context and link
+        -- the new packages.
+        hsc_env <- GHC.getSession
+        let dflags2 = hsc_dflags hsc_env
+        when (packageFlagsChanged dflags2 dflags0) $ do
+          when (verbosity dflags2 > 0) $
+            liftIO . putStrLn $
+              "package flags have changed, resetting and loading new packages..."
+          GHC.setTargets []
+          _ <- GHC.load LoadAllTargets
+          liftIO $ linkPackages hsc_env new_pkgs
+          -- package flags changed, we can't re-use any of the old context
+          setContextAfterLoad False []
+          -- and copy the package state to the interactive DynFlags
+          idflags <- GHC.getInteractiveDynFlags
+          GHC.setInteractiveDynFlags
+              idflags{ pkgState = pkgState dflags2
+                     , pkgDatabase = pkgDatabase dflags2
+                     , packageFlags = packageFlags dflags2 }
+
+        let ld0length   = length $ ldInputs dflags0
+            fmrk0length = length $ cmdlineFrameworks dflags0
+
+            newLdInputs     = drop ld0length (ldInputs dflags2)
+            newCLFrameworks = drop fmrk0length (cmdlineFrameworks dflags2)
+
+            hsc_env' = hsc_env { hsc_dflags =
+                         dflags2 { ldInputs = newLdInputs
+                                 , cmdlineFrameworks = newCLFrameworks } }
+
+        when (not (null newLdInputs && null newCLFrameworks)) $
+          liftIO $ linkCmdLineLibs hsc_env'
+
+      return ()
+
+
+unsetOptions :: String -> GHCi ()
+unsetOptions str
+  =   -- first, deal with the GHCi opts (+s, +t, etc.)
+     let opts = words str
+         (minus_opts, rest1) = partition isMinus opts
+         (plus_opts, rest2)  = partitionWith isPlus rest1
+         (other_opts, rest3) = partition (`elem` map fst defaulters) rest2
+
+         defaulters =
+           [ ("args"   , setArgs default_args)
+           , ("prog"   , setProg default_progname)
+           , ("prompt" , setPrompt default_prompt)
+           , ("prompt2", setPrompt2 default_prompt2)
+           , ("editor" , liftIO findEditor >>= setEditor)
+           , ("stop"   , setStop default_stop)
+           ]
+
+         no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
+         no_flag ('-':'X':rest) = return ("-XNo" ++ rest)
+         no_flag f = throwGhcException (ProgramError ("don't know how to reverse " ++ f))
+
+     in if (not (null rest3))
+           then liftIO (putStrLn ("unknown option: '" ++ head rest3 ++ "'"))
+           else do
+             mapM_ (fromJust.flip lookup defaulters) other_opts
+
+             mapM_ unsetOpt plus_opts
+
+             no_flags <- mapM no_flag minus_opts
+             newDynFlags False no_flags
+
+isMinus :: String -> Bool
+isMinus ('-':_) = True
+isMinus _ = False
+
+isPlus :: String -> Either String String
+isPlus ('+':opt) = Left opt
+isPlus other     = Right other
+
+setOpt, unsetOpt :: String -> GHCi ()
+
+setOpt str
+  = case strToGHCiOpt str of
+        Nothing -> liftIO (putStrLn ("unknown option: '" ++ str ++ "'"))
+        Just o  -> setOption o
+
+unsetOpt str
+  = case strToGHCiOpt str of
+        Nothing -> liftIO (putStrLn ("unknown option: '" ++ str ++ "'"))
+        Just o  -> unsetOption o
+
+strToGHCiOpt :: String -> (Maybe GHCiOption)
+strToGHCiOpt "m" = Just Multiline
+strToGHCiOpt "s" = Just ShowTiming
+strToGHCiOpt "t" = Just ShowType
+strToGHCiOpt "r" = Just RevertCAFs
+strToGHCiOpt "c" = Just CollectInfo
+strToGHCiOpt _   = Nothing
+
+optToStr :: GHCiOption -> String
+optToStr Multiline  = "m"
+optToStr ShowTiming = "s"
+optToStr ShowType   = "t"
+optToStr RevertCAFs = "r"
+optToStr CollectInfo = "c"
+
+
+-- ---------------------------------------------------------------------------
+-- :show
+
+showCmd :: String -> GHCi ()
+showCmd ""   = showOptions False
+showCmd "-a" = showOptions True
+showCmd str = do
+    st <- getGHCiState
+    dflags <- getDynFlags
+
+    let lookupCmd :: String -> Maybe (GHCi ())
+        lookupCmd name = lookup name $ map (\(_,b,c) -> (b,c)) cmds
+
+        -- (show in help?, command name, action)
+        action :: String -> GHCi () -> (Bool, String, GHCi ())
+        action name m = (True, name, m)
+
+        hidden :: String -> GHCi () -> (Bool, String, GHCi ())
+        hidden name m = (False, name, m)
+
+        cmds =
+            [ action "args"       $ liftIO $ putStrLn (show (GhciMonad.args st))
+            , action "prog"       $ liftIO $ putStrLn (show (progname st))
+            , action "prompt"     $ liftIO $ putStrLn (show (prompt st))
+            , action "prompt2"    $ liftIO $ putStrLn (show (prompt2 st))
+            , action "editor"     $ liftIO $ putStrLn (show (editor st))
+            , action "stop"       $ liftIO $ putStrLn (show (stop st))
+            , action "imports"    $ showImports
+            , action "modules"    $ showModules
+            , action "bindings"   $ showBindings
+            , action "linker"     $ getDynFlags >>= liftIO . showLinkerState
+            , action "breaks"     $ showBkptTable
+            , action "context"    $ showContext
+            , action "packages"   $ showPackages
+            , action "paths"      $ showPaths
+            , action "language"   $ showLanguages
+            , hidden "languages"  $ showLanguages -- backwards compat
+            , hidden "lang"       $ showLanguages -- useful abbreviation
+            ]
+
+    case words str of
+      [w] | Just action <- lookupCmd w -> action
+
+      _ -> let helpCmds = [ text name | (True, name, _) <- cmds ]
+           in throwGhcException $ CmdLineError $ showSDoc dflags
+              $ hang (text "syntax:") 4
+              $ hang (text ":show") 6
+              $ brackets (fsep $ punctuate (text " |") helpCmds)
+
+showiCmd :: String -> GHCi ()
+showiCmd str = do
+  case words str of
+        ["languages"]  -> showiLanguages -- backwards compat
+        ["language"]   -> showiLanguages
+        ["lang"]       -> showiLanguages -- useful abbreviation
+        _ -> throwGhcException (CmdLineError ("syntax:  :showi language"))
+
+showImports :: GHCi ()
+showImports = do
+  st <- getGHCiState
+  dflags <- getDynFlags
+  let rem_ctx   = reverse (remembered_ctx st)
+      trans_ctx = transient_ctx st
+
+      show_one (IIModule star_m)
+          = ":module +*" ++ moduleNameString star_m
+      show_one (IIDecl imp) = showPpr dflags imp
+
+      prel_imp
+        | any isPreludeImport (rem_ctx ++ trans_ctx) = []
+        | otherwise = ["import CLaSH.Prelude -- implicit"]
+
+      trans_comment s = s ++ " -- added automatically" :: String
+  --
+  liftIO $ mapM_ putStrLn (prel_imp ++ map show_one rem_ctx
+                                    ++ map (trans_comment . show_one) trans_ctx)
+
+showModules :: GHCi ()
+showModules = do
+  loaded_mods <- getLoadedModules
+        -- we want *loaded* modules only, see #1734
+  let show_one ms = do m <- GHC.showModule ms; liftIO (putStrLn m)
+  mapM_ show_one loaded_mods
+
+getLoadedModules :: GHC.GhcMonad m => m [GHC.ModSummary]
+getLoadedModules = do
+  graph <- GHC.getModuleGraph
+  filterM (GHC.isLoaded . GHC.ms_mod_name) graph
+
+showBindings :: GHCi ()
+showBindings = do
+    bindings <- GHC.getBindings
+    (insts, finsts) <- GHC.getInsts
+    docs     <- mapM makeDoc (reverse bindings)
+                  -- reverse so the new ones come last
+    let idocs  = map GHC.pprInstanceHdr insts
+        fidocs = map GHC.pprFamInst finsts
+    mapM_ printForUserPartWay (docs ++ idocs ++ fidocs)
+  where
+    makeDoc (AnId i) = pprTypeAndContents i
+    makeDoc tt = do
+        mb_stuff <- GHC.getInfo False (getName tt)
+        return $ maybe (text "") pprTT mb_stuff
+
+    pprTT :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst]) -> SDoc
+    pprTT (thing, fixity, _cls_insts, _fam_insts)
+      = pprTyThing thing
+        $$ show_fixity
+      where
+        show_fixity
+            | fixity == GHC.defaultFixity  = empty
+            | otherwise                    = ppr fixity <+> ppr (GHC.getName thing)
+
+
+printTyThing :: TyThing -> GHCi ()
+printTyThing tyth = printForUser (pprTyThing tyth)
+
+showBkptTable :: GHCi ()
+showBkptTable = do
+  st <- getGHCiState
+  printForUser $ prettyLocations (breaks st)
+
+showContext :: GHCi ()
+showContext = do
+   resumes <- GHC.getResumeContext
+   printForUser $ vcat (map pp_resume (reverse resumes))
+  where
+   pp_resume res =
+        ptext (sLit "--> ") <> text (GHC.resumeStmt res)
+        $$ nest 2 (pprStopped res)
+
+pprStopped :: GHC.Resume -> SDoc
+pprStopped res =
+  ptext (sLit "Stopped in")
+    <+> ((case mb_mod_name of
+           Nothing -> empty
+           Just mod_name -> text (moduleNameString mod_name) <> char '.')
+         <> text (GHC.resumeDecl res))
+    <> char ',' <+> ppr (GHC.resumeSpan res)
+ where
+  mb_mod_name = moduleName <$> GHC.breakInfo_module <$> GHC.resumeBreakInfo res
+
+showPackages :: GHCi ()
+showPackages = do
+  dflags <- getDynFlags
+  let pkg_flags = packageFlags dflags
+  liftIO $ putStrLn $ showSDoc dflags $
+    text ("active package flags:"++if null pkg_flags then " none" else "") $$
+      nest 2 (vcat (map pprFlag pkg_flags))
+
+showPaths :: GHCi ()
+showPaths = do
+  dflags <- getDynFlags
+  liftIO $ do
+    cwd <- getCurrentDirectory
+    putStrLn $ showSDoc dflags $
+      text "current working directory: " $$
+        nest 2 (text cwd)
+    let ipaths = importPaths dflags
+    putStrLn $ showSDoc dflags $
+      text ("module import search paths:"++if null ipaths then " none" else "") $$
+        nest 2 (vcat (map text ipaths))
+
+showLanguages :: GHCi ()
+showLanguages = getDynFlags >>= liftIO . showLanguages' False
+
+showiLanguages :: GHCi ()
+showiLanguages = GHC.getInteractiveDynFlags >>= liftIO . showLanguages' False
+
+showLanguages' :: Bool -> DynFlags -> IO ()
+showLanguages' show_all dflags =
+  putStrLn $ showSDoc dflags $ vcat
+     [ text "base language is: " <>
+         case language dflags of
+           Nothing          -> text "Haskell2010"
+           Just Haskell98   -> text "Haskell98"
+           Just Haskell2010 -> text "Haskell2010"
+     , (if show_all then text "all active language options:"
+                    else text "with the following modifiers:") $$
+          nest 2 (vcat (map (setting xopt) DynFlags.xFlags))
+     ]
+  where
+   setting test flag
+          | quiet     = empty
+          | is_on     = text "-X" <> text name
+          | otherwise = text "-XNo" <> text name
+          where name = flagSpecName flag
+                f = flagSpecFlag flag
+                is_on = test f dflags
+                quiet = not show_all && test f default_dflags == is_on
+
+   default_dflags =
+       defaultDynFlags (settings dflags) `lang_set`
+         case language dflags of
+           Nothing -> Just Haskell2010
+           other   -> other
+
+-- -----------------------------------------------------------------------------
+-- Completion
+
+completeCmd :: String -> GHCi ()
+completeCmd argLine0 = case parseLine argLine0 of
+    Just ("repl", resultRange, left) -> do
+        (unusedLine,compls) <- ghciCompleteWord (reverse left,"")
+        let compls' = takeRange resultRange compls
+        liftIO . putStrLn $ unwords [ show (length compls'), show (length compls), show (reverse unusedLine) ]
+        forM_ (takeRange resultRange compls) $ \(Completion r _ _) -> do
+            liftIO $ print r
+    _ -> throwGhcException (CmdLineError "Syntax: :complete repl [<range>] <quoted-string-to-complete>")
+  where
+    parseLine argLine
+        | null argLine = Nothing
+        | null rest1   = Nothing
+        | otherwise    = (,,) dom <$> resRange <*> s
+      where
+        (dom, rest1) = breakSpace argLine
+        (rng, rest2) = breakSpace rest1
+        resRange | head rest1 == '"' = parseRange ""
+                 | otherwise         = parseRange rng
+        s | head rest1 == '"' = readMaybe rest1 :: Maybe String
+          | otherwise         = readMaybe rest2
+        breakSpace = fmap (dropWhile isSpace) . break isSpace
+
+    takeRange (lb,ub) = maybe id (drop . pred) lb . maybe id take ub
+
+    -- syntax: [n-][m] with semantics "drop (n-1) . take m"
+    parseRange :: String -> Maybe (Maybe Int,Maybe Int)
+    parseRange s = case span isDigit s of
+                   (_, "") ->
+                       -- upper limit only
+                       Just (Nothing, bndRead s)
+                   (s1, '-' : s2)
+                    | all isDigit s2 ->
+                       Just (bndRead s1, bndRead s2)
+                   _ ->
+                       Nothing
+      where
+        bndRead x = if null x then Nothing else Just (read x)
+
+
+
+completeGhciCommand, completeMacro, completeIdentifier, completeModule,
+    completeSetModule, completeSeti, completeShowiOptions,
+    completeHomeModule, completeSetOptions, completeShowOptions,
+    completeHomeModuleOrFile, completeExpression
+    :: CompletionFunc GHCi
+
+-- | Provide completions for last word in a given string.
+--
+-- Takes a tuple of two strings.  First string is a reversed line to be
+-- completed.  Second string is likely unused, 'completeCmd' always passes an
+-- empty string as second item in tuple.
+ghciCompleteWord :: CompletionFunc GHCi
+ghciCompleteWord line@(left,_) = case firstWord of
+    -- If given string starts with `:` colon, and there is only one following
+    -- word then provide REPL command completions.  If there is more than one
+    -- word complete either filename or builtin ghci commands or macros.
+    ':':cmd     | null rest     -> completeGhciCommand line
+                | otherwise     -> do
+                        completion <- lookupCompletion cmd
+                        completion line
+    -- If given string starts with `import` keyword provide module name
+    -- completions
+    "import"    -> completeModule line
+    -- otherwise provide identifier completions
+    _           -> completeExpression line
+  where
+    (firstWord,rest) = break isSpace $ dropWhile isSpace $ reverse left
+    lookupCompletion ('!':_) = return completeFilename
+    lookupCompletion c = do
+        maybe_cmd <- lookupCommand' c
+        case maybe_cmd of
+            Just cmd -> return (cmdCompletionFunc cmd)
+            Nothing  -> return completeFilename
+
+completeGhciCommand = wrapCompleter " " $ \w -> do
+  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
+  let{ candidates = case w of
+      ':' : ':' : _ -> map (':':) command_names
+      _ -> nub $ macro_names ++ command_names }
+  return $ filter (w `isPrefixOf`) candidates
+
+completeMacro = wrapIdentCompleter $ \w -> do
+  cmds <- ghci_macros <$> getGHCiState
+  return (filter (w `isPrefixOf`) (map cmdName cmds))
+
+completeIdentifier line@(left, _) =
+  -- Note: `left` is a reversed input
+  case left of
+    (x:_) | isSymbolChar x -> wrapCompleter (specials ++ spaces) complete line
+    _                      -> wrapIdentCompleter complete line
+  where
+    complete w = do
+      rdrs <- GHC.getRdrNamesInScope
+      dflags <- GHC.getSessionDynFlags
+      return (filter (w `isPrefixOf`) (map (showPpr dflags) rdrs))
+
+completeModule = wrapIdentCompleter $ \w -> do
+  dflags <- GHC.getSessionDynFlags
+  let pkg_mods = allVisibleModules dflags
+  loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
+  return $ filter (w `isPrefixOf`)
+        $ map (showPpr dflags) $ loaded_mods ++ pkg_mods
+
+completeSetModule = wrapIdentCompleterWithModifier "+-" $ \m w -> do
+  dflags <- GHC.getSessionDynFlags
+  modules <- case m of
+    Just '-' -> do
+      imports <- GHC.getContext
+      return $ map iiModuleName imports
+    _ -> do
+      let pkg_mods = allVisibleModules dflags
+      loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
+      return $ loaded_mods ++ pkg_mods
+  return $ filter (w `isPrefixOf`) $ map (showPpr dflags) modules
+
+completeHomeModule = wrapIdentCompleter listHomeModules
+
+listHomeModules :: String -> GHCi [String]
+listHomeModules w = do
+    g <- GHC.getModuleGraph
+    let home_mods = map GHC.ms_mod_name g
+    dflags <- getDynFlags
+    return $ sort $ filter (w `isPrefixOf`)
+            $ map (showPpr dflags) home_mods
+
+completeSetOptions = wrapCompleter flagWordBreakChars $ \w -> do
+  return (filter (w `isPrefixOf`) opts)
+    where opts = "args":"prog":"prompt":"prompt2":"editor":"stop":flagList
+          flagList = map head $ group $ sort allNonDeprecatedFlags
+
+completeSeti = wrapCompleter flagWordBreakChars $ \w -> do
+  return (filter (w `isPrefixOf`) flagList)
+    where flagList = map head $ group $ sort allNonDeprecatedFlags
+
+completeShowOptions = wrapCompleter flagWordBreakChars $ \w -> do
+  return (filter (w `isPrefixOf`) opts)
+    where opts = ["args", "prog", "prompt", "prompt2", "editor", "stop",
+                     "modules", "bindings", "linker", "breaks",
+                     "context", "packages", "paths", "language", "imports"]
+
+completeShowiOptions = wrapCompleter flagWordBreakChars $ \w -> do
+  return (filter (w `isPrefixOf`) ["language"])
+
+completeHomeModuleOrFile = completeWord Nothing filenameWordBreakChars
+                $ unionComplete (fmap (map simpleCompletion) . listHomeModules)
+                            listFiles
+
+unionComplete :: Monad m => (a -> m [b]) -> (a -> m [b]) -> a -> m [b]
+unionComplete f1 f2 line = do
+  cs1 <- f1 line
+  cs2 <- f2 line
+  return (cs1 ++ cs2)
+
+wrapCompleter :: String -> (String -> GHCi [String]) -> CompletionFunc GHCi
+wrapCompleter breakChars fun = completeWord Nothing breakChars
+    $ fmap (map simpleCompletion . nubSort) . fun
+
+wrapIdentCompleter :: (String -> GHCi [String]) -> CompletionFunc GHCi
+wrapIdentCompleter = wrapCompleter word_break_chars
+
+wrapIdentCompleterWithModifier :: String -> (Maybe Char -> String -> GHCi [String]) -> CompletionFunc GHCi
+wrapIdentCompleterWithModifier modifChars fun = completeWordWithPrev Nothing word_break_chars
+    $ \rest -> fmap (map simpleCompletion . nubSort) . fun (getModifier rest)
+ where
+  getModifier = find (`elem` modifChars)
+
+-- | Return a list of visible module names for autocompletion.
+-- (NB: exposed != visible)
+allVisibleModules :: DynFlags -> [ModuleName]
+allVisibleModules dflags = listVisibleModuleNames dflags
+
+completeExpression = completeQuotedWord (Just '\\') "\"" listFiles
+                        completeIdentifier
+
+
+-- -----------------------------------------------------------------------------
+-- commands for debugger
+
+sprintCmd, printCmd, forceCmd :: String -> GHCi ()
+sprintCmd = pprintCommand False False
+printCmd  = pprintCommand True False
+forceCmd  = pprintCommand False True
+
+pprintCommand :: Bool -> Bool -> String -> GHCi ()
+pprintCommand bind force str = do
+  pprintClosureCommand bind force str
+
+stepCmd :: String -> GHCi ()
+stepCmd arg = withSandboxOnly ":step" $ step arg
+  where
+  step []         = doContinue (const True) GHC.SingleStep
+  step expression = runStmt expression GHC.SingleStep >> return ()
+
+stepLocalCmd :: String -> GHCi ()
+stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg
+  where
+  step expr
+   | not (null expr) = stepCmd expr
+   | otherwise = do
+      mb_span <- getCurrentBreakSpan
+      case mb_span of
+        Nothing  -> stepCmd []
+        Just loc -> do
+           Just md <- getCurrentBreakModule
+           current_toplevel_decl <- enclosingTickSpan md loc
+           doContinue (`isSubspanOf` RealSrcSpan current_toplevel_decl) GHC.SingleStep
+
+stepModuleCmd :: String -> GHCi ()
+stepModuleCmd arg = withSandboxOnly ":stepmodule" $ step arg
+  where
+  step expr
+   | not (null expr) = stepCmd expr
+   | otherwise = do
+      mb_span <- getCurrentBreakSpan
+      case mb_span of
+        Nothing  -> stepCmd []
+        Just pan -> do
+           let f some_span = srcSpanFileName_maybe pan == srcSpanFileName_maybe some_span
+           doContinue f GHC.SingleStep
+
+-- | Returns the span of the largest tick containing the srcspan given
+enclosingTickSpan :: Module -> SrcSpan -> GHCi RealSrcSpan
+enclosingTickSpan _ (UnhelpfulSpan _) = panic "enclosingTickSpan UnhelpfulSpan"
+enclosingTickSpan md (RealSrcSpan src) = do
+  ticks <- getTickArray md
+  let line = srcSpanStartLine src
+  ASSERT(inRange (bounds ticks) line) do
+  let enclosing_spans = [ pan | (_,pan) <- ticks ! line
+                               , realSrcSpanEnd pan >= realSrcSpanEnd src]
+  return . head . sortBy leftmostLargestRealSrcSpan $ enclosing_spans
+ where
+
+leftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering
+leftmostLargestRealSrcSpan a b =
+  (realSrcSpanStart a `compare` realSrcSpanStart b)
+     `thenCmp`
+  (realSrcSpanEnd b `compare` realSrcSpanEnd a)
+
+traceCmd :: String -> GHCi ()
+traceCmd arg
+  = withSandboxOnly ":trace" $ tr arg
+  where
+  tr []         = doContinue (const True) GHC.RunAndLogSteps
+  tr expression = runStmt expression GHC.RunAndLogSteps >> return ()
+
+continueCmd :: String -> GHCi ()
+continueCmd = noArgs $ withSandboxOnly ":continue" $ doContinue (const True) GHC.RunToCompletion
+
+-- doContinue :: SingleStep -> GHCi ()
+doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
+doContinue pre step = do
+  runResult <- resume pre step
+  _ <- afterRunStmt pre runResult
+  return ()
+
+abandonCmd :: String -> GHCi ()
+abandonCmd = noArgs $ withSandboxOnly ":abandon" $ do
+  b <- GHC.abandon -- the prompt will change to indicate the new context
+  when (not b) $ liftIO $ putStrLn "There is no computation running."
+
+deleteCmd :: String -> GHCi ()
+deleteCmd argLine = withSandboxOnly ":delete" $ do
+   deleteSwitch $ words argLine
+   where
+   deleteSwitch :: [String] -> GHCi ()
+   deleteSwitch [] =
+      liftIO $ putStrLn "The delete command requires at least one argument."
+   -- delete all break points
+   deleteSwitch ("*":_rest) = discardActiveBreakPoints
+   deleteSwitch idents = do
+      mapM_ deleteOneBreak idents
+      where
+      deleteOneBreak :: String -> GHCi ()
+      deleteOneBreak str
+         | all isDigit str = deleteBreak (read str)
+         | otherwise = return ()
+
+historyCmd :: String -> GHCi ()
+historyCmd arg
+  | null arg        = history 20
+  | all isDigit arg = history (read arg)
+  | otherwise       = liftIO $ putStrLn "Syntax:  :history [num]"
+  where
+  history num = do
+    resumes <- GHC.getResumeContext
+    case resumes of
+      [] -> liftIO $ putStrLn "Not stopped at a breakpoint"
+      (r:_) -> do
+        let hist = GHC.resumeHistory r
+            (took,rest) = splitAt num hist
+        case hist of
+          [] -> liftIO $ putStrLn $
+                   "Empty history. Perhaps you forgot to use :trace?"
+          _  -> do
+                 pans <- mapM GHC.getHistorySpan took
+                 let nums  = map (printf "-%-3d:") [(1::Int)..]
+                     names = map GHC.historyEnclosingDecls took
+                 printForUser (vcat(zipWith3
+                                 (\x y z -> x <+> y <+> z)
+                                 (map text nums)
+                                 (map (bold . hcat . punctuate colon . map text) names)
+                                 (map (parens . ppr) pans)))
+                 liftIO $ putStrLn $ if null rest then "<end of history>" else "..."
+
+bold :: SDoc -> SDoc
+bold c | do_bold   = text start_bold <> c <> text end_bold
+       | otherwise = c
+
+backCmd :: String -> GHCi ()
+backCmd arg
+  | null arg        = back 1
+  | all isDigit arg = back (read arg)
+  | otherwise       = liftIO $ putStrLn "Syntax:  :back [num]"
+  where
+  back num = withSandboxOnly ":back" $ do
+      (names, _, pan, _) <- GHC.back num
+      printForUser $ ptext (sLit "Logged breakpoint at") <+> ppr pan
+      printTypeOfNames names
+       -- run the command set with ":set stop <cmd>"
+      st <- getGHCiState
+      enqueueCommands [stop st]
+
+forwardCmd :: String -> GHCi ()
+forwardCmd arg
+  | null arg        = forward 1
+  | all isDigit arg = forward (read arg)
+  | otherwise       = liftIO $ putStrLn "Syntax:  :back [num]"
+  where
+  forward num = withSandboxOnly ":forward" $ do
+      (names, ix, pan, _) <- GHC.forward num
+      printForUser $ (if (ix == 0)
+                        then ptext (sLit "Stopped at")
+                        else ptext (sLit "Logged breakpoint at")) <+> ppr pan
+      printTypeOfNames names
+       -- run the command set with ":set stop <cmd>"
+      st <- getGHCiState
+      enqueueCommands [stop st]
+
+-- handle the "break" command
+breakCmd :: String -> GHCi ()
+breakCmd argLine = withSandboxOnly ":break" $ breakSwitch $ words argLine
+
+breakSwitch :: [String] -> GHCi ()
+breakSwitch [] = do
+   liftIO $ putStrLn "The break command requires at least one argument."
+breakSwitch (arg1:rest)
+   | looksLikeModuleName arg1 && not (null rest) = do
+        md <- wantInterpretedModule arg1
+        breakByModule md rest
+   | all isDigit arg1 = do
+        imports <- GHC.getContext
+        case iiModules imports of
+           (mn : _) -> do
+              md <- lookupModuleName mn
+              breakByModuleLine md (read arg1) rest
+           [] -> do
+              liftIO $ putStrLn "No modules are loaded with debugging support."
+   | otherwise = do -- try parsing it as an identifier
+        wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
+        maybe_info <- GHC.getModuleInfo (GHC.nameModule name)
+        case maybe_info of
+          Nothing -> noCanDo name (ptext (sLit "cannot get module info"))
+          Just minf ->
+               ASSERT( isExternalName name )
+                    findBreakAndSet (GHC.nameModule name) $
+                       findBreakForBind name (GHC.modInfoModBreaks minf)
+       where
+          noCanDo n why = printForUser $
+                text "cannot set breakpoint on " <> ppr n <> text ": " <> why
+
+breakByModule :: Module -> [String] -> GHCi ()
+breakByModule md (arg1:rest)
+   | all isDigit arg1 = do  -- looks like a line number
+        breakByModuleLine md (read arg1) rest
+breakByModule _ _
+   = breakSyntax
+
+breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
+breakByModuleLine md line args
+   | [] <- args = findBreakAndSet md $ maybeToList . findBreakByLine line
+   | [col] <- args, all isDigit col =
+        findBreakAndSet md $ maybeToList . findBreakByCoord Nothing (line, read col)
+   | otherwise = breakSyntax
+
+breakSyntax :: a
+breakSyntax = throwGhcException (CmdLineError "Syntax: :break [<mod>] <line> [<column>]")
+
+findBreakAndSet :: Module -> (TickArray -> [(Int, RealSrcSpan)]) -> GHCi ()
+findBreakAndSet md lookupTickTree = do
+   tickArray <- getTickArray md
+   (breakArray, _) <- getModBreak md
+   case lookupTickTree tickArray of
+      []  -> liftIO $ putStrLn $ "No breakpoints found at that location."
+      some -> mapM_ (breakAt breakArray) some
+ where
+   breakAt breakArray (tick, pan) = do
+         setBreakFlag True breakArray tick
+         (alreadySet, nm) <-
+               recordBreak $ BreakLocation
+                       { breakModule = md
+                       , breakLoc = RealSrcSpan pan
+                       , breakTick = tick
+                       , onBreakCmd = ""
+                       }
+         printForUser $
+            text "Breakpoint " <> ppr nm <>
+            if alreadySet
+               then text " was already set at " <> ppr pan
+               else text " activated at " <> ppr pan
+
+-- When a line number is specified, the current policy for choosing
+-- the best breakpoint is this:
+--    - the leftmost complete subexpression on the specified line, or
+--    - the leftmost subexpression starting on the specified line, or
+--    - the rightmost subexpression enclosing the specified line
+--
+findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,RealSrcSpan)
+findBreakByLine line arr
+  | not (inRange (bounds arr) line) = Nothing
+  | otherwise =
+    listToMaybe (sortBy (leftmostLargestRealSrcSpan `on` snd)  comp)   `mplus`
+    listToMaybe (sortBy (compare `on` snd) incomp) `mplus`
+    listToMaybe (sortBy (flip compare `on` snd) ticks)
+  where
+        ticks = arr ! line
+
+        starts_here = [ (ix,pan) | (ix, pan) <- ticks,
+                        GHC.srcSpanStartLine pan == line ]
+
+        (comp, incomp) = partition ends_here starts_here
+            where ends_here (_,pan) = GHC.srcSpanEndLine pan == line
+
+-- The aim is to find the breakpionts for all the RHSs of the
+-- equations corresponding to a binding.  So we find all breakpoints
+-- for
+--   (a) this binder only (not a nested declaration)
+--   (b) that do not have an enclosing breakpoint
+findBreakForBind :: Name -> GHC.ModBreaks -> TickArray
+                 -> [(BreakIndex,RealSrcSpan)]
+findBreakForBind name modbreaks _ = filter (not . enclosed) ticks
+  where
+    ticks = [ (index, span)
+            | (index, [n]) <- assocs (GHC.modBreaks_decls modbreaks),
+              n == occNameString (nameOccName name),
+              RealSrcSpan span <- [GHC.modBreaks_locs modbreaks ! index] ]
+    enclosed (_,sp0) = any subspan ticks
+      where subspan (_,sp) = sp /= sp0 &&
+                         realSrcSpanStart sp <= realSrcSpanStart sp0 &&
+                         realSrcSpanEnd sp0 <= realSrcSpanEnd sp
+
+findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
+                 -> Maybe (BreakIndex,RealSrcSpan)
+findBreakByCoord mb_file (line, col) arr
+  | not (inRange (bounds arr) line) = Nothing
+  | otherwise =
+    listToMaybe (sortBy (flip compare `on` snd) contains ++
+                 sortBy (compare `on` snd) after_here)
+  where
+        ticks = arr ! line
+
+        -- the ticks that span this coordinate
+        contains = [ tick | tick@(_,pan) <- ticks, RealSrcSpan pan `spans` (line,col),
+                            is_correct_file pan ]
+
+        is_correct_file pan
+                 | Just f <- mb_file = GHC.srcSpanFile pan == f
+                 | otherwise         = True
+
+        after_here = [ tick | tick@(_,pan) <- ticks,
+                              GHC.srcSpanStartLine pan == line,
+                              GHC.srcSpanStartCol pan >= col ]
+
+-- For now, use ANSI bold on terminals that we know support it.
+-- Otherwise, we add a line of carets under the active expression instead.
+-- In particular, on Windows and when running the testsuite (which sets
+-- TERM to vt100 for other reasons) we get carets.
+-- We really ought to use a proper termcap/terminfo library.
+do_bold :: Bool
+do_bold = (`isPrefixOf` unsafePerformIO mTerm) `any` ["xterm", "linux"]
+    where mTerm = System.Environment.getEnv "TERM"
+                  `catchIO` \_ -> return "TERM not set"
+
+start_bold :: String
+start_bold = "\ESC[1m"
+end_bold :: String
+end_bold   = "\ESC[0m"
+
+-----------------------------------------------------------------------------
+-- :where
+
+whereCmd :: String -> GHCi ()
+whereCmd = noArgs $ do
+  mstrs <- getCallStackAtCurrentBreakpoint
+  case mstrs of
+    Nothing -> return ()
+    Just strs -> liftIO $ putStrLn (renderStack strs)
+
+-----------------------------------------------------------------------------
+-- :list
+
+listCmd :: String -> InputT GHCi ()
+listCmd c = listCmd' c
+
+listCmd' :: String -> InputT GHCi ()
+listCmd' "" = do
+   mb_span <- lift getCurrentBreakSpan
+   case mb_span of
+      Nothing ->
+          printForUser $ text "Not stopped at a breakpoint; nothing to list"
+      Just (RealSrcSpan pan) ->
+          listAround pan True
+      Just pan@(UnhelpfulSpan _) ->
+          do resumes <- GHC.getResumeContext
+             case resumes of
+                 [] -> panic "No resumes"
+                 (r:_) ->
+                     do let traceIt = case GHC.resumeHistory r of
+                                      [] -> text "rerunning with :trace,"
+                                      _ -> empty
+                            doWhat = traceIt <+> text ":back then :list"
+                        printForUser (text "Unable to list source for" <+>
+                                      ppr pan
+                                   $$ text "Try" <+> doWhat)
+listCmd' str = list2 (words str)
+
+list2 :: [String] -> InputT GHCi ()
+list2 [arg] | all isDigit arg = do
+    imports <- GHC.getContext
+    case iiModules imports of
+        [] -> liftIO $ putStrLn "No module to list"
+        (mn : _) -> do
+          md <- lift $ lookupModuleName mn
+          listModuleLine md (read arg)
+list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
+        md <- wantInterpretedModule arg1
+        listModuleLine md (read arg2)
+list2 [arg] = do
+        wantNameFromInterpretedModule noCanDo arg $ \name -> do
+        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
+        case loc of
+            RealSrcLoc l ->
+               do tickArray <- ASSERT( isExternalName name )
+                               lift $ getTickArray (GHC.nameModule name)
+                  let mb_span = findBreakByCoord (Just (GHC.srcLocFile l))
+                                        (GHC.srcLocLine l, GHC.srcLocCol l)
+                                        tickArray
+                  case mb_span of
+                    Nothing       -> listAround (realSrcLocSpan l) False
+                    Just (_, pan) -> listAround pan False
+            UnhelpfulLoc _ ->
+                  noCanDo name $ text "can't find its location: " <>
+                                 ppr loc
+    where
+        noCanDo n why = printForUser $
+            text "cannot list source code for " <> ppr n <> text ": " <> why
+list2  _other =
+        liftIO $ putStrLn "syntax:  :list [<line> | <module> <line> | <identifier>]"
+
+listModuleLine :: Module -> Int -> InputT GHCi ()
+listModuleLine modl line = do
+   graph <- GHC.getModuleGraph
+   let this = filter ((== modl) . GHC.ms_mod) graph
+   case this of
+     [] -> panic "listModuleLine"
+     summ:_ -> do
+           let filename = expectJust "listModuleLine" (ml_hs_file (GHC.ms_location summ))
+               loc = mkRealSrcLoc (mkFastString (filename)) line 0
+           listAround (realSrcLocSpan loc) False
+
+-- | list a section of a source file around a particular SrcSpan.
+-- If the highlight flag is True, also highlight the span using
+-- start_bold\/end_bold.
+
+-- GHC files are UTF-8, so we can implement this by:
+-- 1) read the file in as a BS and syntax highlight it as before
+-- 2) convert the BS to String using utf-string, and write it out.
+-- It would be better if we could convert directly between UTF-8 and the
+-- console encoding, of course.
+listAround :: MonadIO m => RealSrcSpan -> Bool -> InputT m ()
+listAround pan do_highlight = do
+      contents <- liftIO $ BS.readFile (unpackFS file)
+      -- Drop carriage returns to avoid duplicates, see #9367.
+      let ls  = BS.split '\n' $ BS.filter (/= '\r') contents
+          ls' = take (line2 - line1 + 1 + pad_before + pad_after) $
+                        drop (line1 - 1 - pad_before) $ ls
+          fst_line = max 1 (line1 - pad_before)
+          line_nos = [ fst_line .. ]
+
+          highlighted | do_highlight = zipWith highlight line_nos ls'
+                      | otherwise    = [\p -> BS.concat[p,l] | l <- ls']
+
+          bs_line_nos = [ BS.pack (show l ++ "  ") | l <- line_nos ]
+          prefixed = zipWith ($) highlighted bs_line_nos
+          output   = BS.intercalate (BS.pack "\n") prefixed
+
+      utf8Decoded <- liftIO $ BS.useAsCStringLen output
+                        $ \(p,n) -> utf8DecodeString (castPtr p) n
+      liftIO $ putStrLn utf8Decoded
+  where
+        file  = GHC.srcSpanFile pan
+        line1 = GHC.srcSpanStartLine pan
+        col1  = GHC.srcSpanStartCol pan - 1
+        line2 = GHC.srcSpanEndLine pan
+        col2  = GHC.srcSpanEndCol pan - 1
+
+        pad_before | line1 == 1 = 0
+                   | otherwise  = 1
+        pad_after = 1
+
+        highlight | do_bold   = highlight_bold
+                  | otherwise = highlight_carets
+
+        highlight_bold no line prefix
+          | no == line1 && no == line2
+          = let (a,r) = BS.splitAt col1 line
+                (b,c) = BS.splitAt (col2-col1) r
+            in
+            BS.concat [prefix, a,BS.pack start_bold,b,BS.pack end_bold,c]
+          | no == line1
+          = let (a,b) = BS.splitAt col1 line in
+            BS.concat [prefix, a, BS.pack start_bold, b]
+          | no == line2
+          = let (a,b) = BS.splitAt col2 line in
+            BS.concat [prefix, a, BS.pack end_bold, b]
+          | otherwise   = BS.concat [prefix, line]
+
+        highlight_carets no line prefix
+          | no == line1 && no == line2
+          = BS.concat [prefix, line, nl, indent, BS.replicate col1 ' ',
+                                         BS.replicate (col2-col1) '^']
+          | no == line1
+          = BS.concat [indent, BS.replicate (col1 - 2) ' ', BS.pack "vv", nl,
+                                         prefix, line]
+          | no == line2
+          = BS.concat [prefix, line, nl, indent, BS.replicate col2 ' ',
+                                         BS.pack "^^"]
+          | otherwise   = BS.concat [prefix, line]
+         where
+           indent = BS.pack ("  " ++ replicate (length (show no)) ' ')
+           nl = BS.singleton '\n'
+
+
+-- --------------------------------------------------------------------------
+-- Tick arrays
+
+getTickArray :: Module -> GHCi TickArray
+getTickArray modl = do
+   st <- getGHCiState
+   let arrmap = tickarrays st
+   case lookupModuleEnv arrmap modl of
+      Just arr -> return arr
+      Nothing  -> do
+        (_breakArray, ticks) <- getModBreak modl
+        let arr = mkTickArray (assocs ticks)
+        setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}
+        return arr
+
+discardTickArrays :: GHCi ()
+discardTickArrays = modifyGHCiState (\st -> st {tickarrays = emptyModuleEnv})
+
+mkTickArray :: [(BreakIndex,SrcSpan)] -> TickArray
+mkTickArray ticks
+  = accumArray (flip (:)) [] (1, max_line)
+        [ (line, (nm,pan)) | (nm,RealSrcSpan pan) <- ticks, line <- srcSpanLines pan ]
+    where
+        max_line = foldr max 0 [ GHC.srcSpanEndLine sp | (_, RealSrcSpan sp) <- ticks ]
+        srcSpanLines pan = [ GHC.srcSpanStartLine pan ..  GHC.srcSpanEndLine pan ]
+
+-- don't reset the counter back to zero?
+discardActiveBreakPoints :: GHCi ()
+discardActiveBreakPoints = do
+   st <- getGHCiState
+   mapM_ (turnOffBreak.snd) (breaks st)
+   setGHCiState $ st { breaks = [] }
+
+deleteBreak :: Int -> GHCi ()
+deleteBreak identity = do
+   st <- getGHCiState
+   let oldLocations    = breaks st
+       (this,rest)     = partition (\loc -> fst loc == identity) oldLocations
+   if null this
+      then printForUser (text "Breakpoint" <+> ppr identity <+>
+                         text "does not exist")
+      else do
+           mapM_ (turnOffBreak.snd) this
+           setGHCiState $ st { breaks = rest }
+
+turnOffBreak :: BreakLocation -> GHCi ()
+turnOffBreak loc = do
+  (arr, _) <- getModBreak (breakModule loc)
+  hsc_env <- GHC.getSession
+  liftIO $ enableBreakpoint hsc_env arr (breakTick loc) False
+
+getModBreak :: Module -> GHCi (ForeignRef BreakArray, Array Int SrcSpan)
+getModBreak m = do
+   Just mod_info <- GHC.getModuleInfo m
+   let modBreaks  = GHC.modInfoModBreaks mod_info
+   let arr        = GHC.modBreaks_flags modBreaks
+   let ticks      = GHC.modBreaks_locs  modBreaks
+   return (arr, ticks)
+
+setBreakFlag :: Bool -> ForeignRef BreakArray -> Int -> GHCi ()
+setBreakFlag toggle arr i = do
+  hsc_env <- GHC.getSession
+  liftIO $ enableBreakpoint hsc_env arr i toggle
+
+-- ---------------------------------------------------------------------------
+-- User code exception handling
+
+-- This is the exception handler for exceptions generated by the
+-- user's code and exceptions coming from children sessions;
+-- it normally just prints out the exception.  The
+-- handler must be recursive, in case showing the exception causes
+-- more exceptions to be raised.
+--
+-- Bugfix: if the user closed stdout or stderr, the flushing will fail,
+-- raising another exception.  We therefore don't put the recursive
+-- handler arond the flushing operation, so if stderr is closed
+-- GHCi will just die gracefully rather than going into an infinite loop.
+handler :: SomeException -> GHCi Bool
+
+handler exception = do
+  flushInterpBuffers
+  liftIO installSignalHandlers
+  ghciHandle handler (showException exception >> return False)
+
+showException :: SomeException -> GHCi ()
+showException se =
+  liftIO $ case fromException se of
+           -- omit the location for CmdLineError:
+           Just (CmdLineError s)    -> putException s
+           -- ditto:
+           Just other_ghc_ex        -> putException (show other_ghc_ex)
+           Nothing                  ->
+               case fromException se of
+               Just UserInterrupt -> putException "Interrupted."
+               _                  -> putException ("*** Exception: " ++ show se)
+  where
+    putException = hPutStrLn stderr
+
+
+-----------------------------------------------------------------------------
+-- recursive exception handlers
+
+-- Don't forget to unblock async exceptions in the handler, or if we're
+-- in an exception loop (eg. let a = error a in a) the ^C exception
+-- may never be delivered.  Thanks to Marcin for pointing out the bug.
+
+ghciHandle :: (HasDynFlags m, ExceptionMonad m) => (SomeException -> m a) -> m a -> m a
+ghciHandle h m = gmask $ \restore -> do
+                 -- Force dflags to avoid leaking the associated HscEnv
+                 !dflags <- getDynFlags
+                 gcatch (restore (GHC.prettyPrintGhcErrors dflags m)) $ \e -> restore (h e)
+
+ghciTry :: GHCi a -> GHCi (Either SomeException a)
+ghciTry (GHCi m) = GHCi $ \s -> gtry (m s)
+
+tryBool :: GHCi a -> GHCi Bool
+tryBool m = do
+    r <- ghciTry m
+    case r of
+      Left _  -> return False
+      Right _ -> return True
+
+-- ----------------------------------------------------------------------------
+-- Utils
+
+lookupModule :: GHC.GhcMonad m => String -> m Module
+lookupModule mName = lookupModuleName (GHC.mkModuleName mName)
+
+lookupModuleName :: GHC.GhcMonad m => ModuleName -> m Module
+lookupModuleName mName = GHC.lookupModule mName Nothing
+
+isHomeModule :: Module -> Bool
+isHomeModule m = GHC.moduleUnitId m == mainUnitId
+
+-- TODO: won't work if home dir is encoded.
+-- (changeDirectory may not work either in that case.)
+expandPath :: MonadIO m => String -> InputT m String
+expandPath = liftIO . expandPathIO
+
+expandPathIO :: String -> IO String
+expandPathIO p =
+  case dropWhile isSpace p of
+   ('~':d) -> do
+        tilde <- getHomeDirectory -- will fail if HOME not defined
+        return (tilde ++ '/':d)
+   other ->
+        return other
+
+wantInterpretedModule :: GHC.GhcMonad m => String -> m Module
+wantInterpretedModule str = wantInterpretedModuleName (GHC.mkModuleName str)
+
+wantInterpretedModuleName :: GHC.GhcMonad m => ModuleName -> m Module
+wantInterpretedModuleName modname = do
+   modl <- lookupModuleName modname
+   let str = moduleNameString modname
+   dflags <- getDynFlags
+   when (GHC.moduleUnitId modl /= thisPackage dflags) $
+      throwGhcException (CmdLineError ("module '" ++ str ++ "' is from another package;\nthis command requires an interpreted module"))
+   is_interpreted <- GHC.moduleIsInterpreted modl
+   when (not is_interpreted) $
+       throwGhcException (CmdLineError ("module '" ++ str ++ "' is not interpreted; try \':add *" ++ str ++ "' first"))
+   return modl
+
+wantNameFromInterpretedModule :: GHC.GhcMonad m
+                              => (Name -> SDoc -> m ())
+                              -> String
+                              -> (Name -> m ())
+                              -> m ()
+wantNameFromInterpretedModule noCanDo str and_then =
+  handleSourceError GHC.printException $ do
+   names <- GHC.parseName str
+   case names of
+      []    -> return ()
+      (n:_) -> do
+            let modl = ASSERT( isExternalName n ) GHC.nameModule n
+            if not (GHC.isExternalName n)
+               then noCanDo n $ ppr n <>
+                                text " is not defined in an interpreted module"
+               else do
+            is_interpreted <- GHC.moduleIsInterpreted modl
+            if not is_interpreted
+               then noCanDo n $ text "module " <> ppr modl <>
+                                text " is not interpreted"
+               else and_then n
diff --git a/src-bin/GHCi/UI/Info.hs b/src-bin/GHCi/UI/Info.hs
new file mode 100644
--- /dev/null
+++ b/src-bin/GHCi/UI/Info.hs
@@ -0,0 +1,366 @@
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | Get information on modules, expreesions, and identifiers
+module GHCi.UI.Info
+    ( ModInfo(..)
+    , SpanInfo(..)
+    , spanInfoFromRealSrcSpan
+    , collectInfo
+    , findLoc
+    , findNameUses
+    , findType
+    , getModInfo
+    ) where
+
+import           Control.Exception
+import           Control.Monad
+import           Control.Monad.Trans.Class
+import           Control.Monad.Trans.Except
+import           Control.Monad.Trans.Maybe
+import           Data.Data
+import           Data.Function
+import           Data.List
+import           Data.Map.Strict   (Map)
+import qualified Data.Map.Strict   as M
+import           Data.Maybe
+import           Data.Time
+import           Prelude           hiding (mod)
+import           System.Directory
+
+import qualified CoreUtils
+import           Desugar
+import           DynFlags (HasDynFlags(..))
+import           FastString
+import           GHC
+import           GhcMonad
+import           Name
+import           NameSet
+import           Outputable
+import           SrcLoc
+import           TcHsSyn
+import           Var
+
+-- | Info about a module. This information is generated every time a
+-- module is loaded.
+data ModInfo = ModInfo
+    { modinfoSummary    :: !ModSummary
+      -- ^ Summary generated by GHC. Can be used to access more
+      -- information about the module.
+    , modinfoSpans      :: [SpanInfo]
+      -- ^ Generated set of information about all spans in the
+      -- module that correspond to some kind of identifier for
+      -- which there will be type info and/or location info.
+    , modinfoInfo       :: !ModuleInfo
+      -- ^ Again, useful from GHC for accessing information
+      -- (exports, instances, scope) from a module.
+    , modinfoLastUpdate :: !UTCTime
+    }
+
+-- | Type of some span of source code. Most of these fields are
+-- unboxed but Haddock doesn't show that.
+data SpanInfo = SpanInfo
+    { spaninfoSrcSpan   :: {-# UNPACK #-} !RealSrcSpan
+      -- ^ The span we associate information with
+    , spaninfoType      :: !(Maybe Type)
+      -- ^ The 'Type' associated with the span
+    , spaninfoVar       :: !(Maybe Id)
+      -- ^ The actual 'Var' associated with the span, if
+      -- any. This can be useful for accessing a variety of
+      -- information about the identifier such as module,
+      -- locality, definition location, etc.
+    }
+
+-- | Test whether second span is contained in (or equal to) first span.
+-- This is basically 'containsSpan' for 'SpanInfo'
+containsSpanInfo :: SpanInfo -> SpanInfo -> Bool
+containsSpanInfo = containsSpan `on` spaninfoSrcSpan
+
+-- | Filter all 'SpanInfo' which are contained in 'SpanInfo'
+spaninfosWithin :: [SpanInfo] -> SpanInfo -> [SpanInfo]
+spaninfosWithin spans' si = filter (si `containsSpanInfo`) spans'
+
+-- | Construct a 'SpanInfo' from a 'RealSrcSpan' and optionally a
+-- 'Type' and an 'Id' (for 'spaninfoType' and 'spaninfoVar'
+-- respectively)
+spanInfoFromRealSrcSpan :: RealSrcSpan -> Maybe Type -> Maybe Id -> SpanInfo
+spanInfoFromRealSrcSpan spn mty mvar =
+    SpanInfo spn mty mvar
+
+-- | Convenience wrapper around 'spanInfoFromRealSrcSpan' which needs
+-- only a 'RealSrcSpan'
+spanInfoFromRealSrcSpan' :: RealSrcSpan -> SpanInfo
+spanInfoFromRealSrcSpan' s = spanInfoFromRealSrcSpan s Nothing Nothing
+
+-- | Convenience wrapper around 'srcSpanFile' which results in a 'FilePath'
+srcSpanFilePath :: RealSrcSpan -> FilePath
+srcSpanFilePath = unpackFS . srcSpanFile
+
+-- | Try to find the location of the given identifier at the given
+-- position in the module.
+findLoc :: GhcMonad m
+        => Map ModuleName ModInfo
+        -> RealSrcSpan
+        -> String
+        -> ExceptT SDoc m (ModInfo,Name,SrcSpan)
+findLoc infos span0 string = do
+    name  <- maybeToExceptT "Couldn't guess that module name. Does it exist?" $
+             guessModule infos (srcSpanFilePath span0)
+
+    info  <- maybeToExceptT "No module info for current file! Try loading it?" $
+             MaybeT $ pure $ M.lookup name infos
+
+    name' <- findName infos span0 info string
+
+    case getSrcSpan name' of
+        UnhelpfulSpan{} -> do
+            throwE ("Found a name, but no location information." <+>
+                    "The module is:" <+>
+                    maybe "<unknown>" (ppr . moduleName)
+                          (nameModule_maybe name'))
+
+        span' -> return (info,name',span')
+
+-- | Find any uses of the given identifier in the codebase.
+findNameUses :: (GhcMonad m)
+             => Map ModuleName ModInfo
+             -> RealSrcSpan
+             -> String
+             -> ExceptT SDoc m [SrcSpan]
+findNameUses infos span0 string =
+    locToSpans <$> findLoc infos span0 string
+  where
+    locToSpans (modinfo,name',span') =
+        stripSurrounding (span' : map toSrcSpan spans)
+      where
+        toSrcSpan = RealSrcSpan . spaninfoSrcSpan
+        spans = filter ((== Just name') . fmap getName . spaninfoVar)
+                       (modinfoSpans modinfo)
+
+-- | Filter out redundant spans which surround/contain other spans.
+stripSurrounding :: [SrcSpan] -> [SrcSpan]
+stripSurrounding xs = filter (not . isRedundant) xs
+  where
+    isRedundant x = any (x `strictlyContains`) xs
+
+    (RealSrcSpan s1) `strictlyContains` (RealSrcSpan s2)
+         = s1 /= s2 && s1 `containsSpan` s2
+    _                `strictlyContains` _ = False
+
+-- | Try to resolve the name located at the given position, or
+-- otherwise resolve based on the current module's scope.
+findName :: GhcMonad m
+         => Map ModuleName ModInfo
+         -> RealSrcSpan
+         -> ModInfo
+         -> String
+         -> ExceptT SDoc m Name
+findName infos span0 mi string =
+    case resolveName (modinfoSpans mi) (spanInfoFromRealSrcSpan' span0) of
+      Nothing -> tryExternalModuleResolution
+      Just name ->
+        case getSrcSpan name of
+          UnhelpfulSpan {} -> tryExternalModuleResolution
+          RealSrcSpan   {} -> return (getName name)
+  where
+    tryExternalModuleResolution =
+      case find (matchName $ mkFastString string)
+                (fromMaybe [] (modInfoTopLevelScope (modinfoInfo mi))) of
+        Nothing -> throwE "Couldn't resolve to any modules."
+        Just imported -> resolveNameFromModule infos imported
+
+    matchName :: FastString -> Name -> Bool
+    matchName str name =
+      str ==
+      occNameFS (getOccName name)
+
+-- | Try to resolve the name from another (loaded) module's exports.
+resolveNameFromModule :: GhcMonad m
+                      => Map ModuleName ModInfo
+                      -> Name
+                      -> ExceptT SDoc m Name
+resolveNameFromModule infos name = do
+     modL <- maybe (throwE $ "No module for" <+> ppr name) return $
+             nameModule_maybe name
+
+     info <- maybe (throwE (ppr (moduleUnitId modL) <> ":" <>
+                            ppr modL)) return $
+             M.lookup (moduleName modL) infos
+
+     maybe (throwE "No matching export in any local modules.") return $
+         find (matchName name) (modInfoExports (modinfoInfo info))
+  where
+    matchName :: Name -> Name -> Bool
+    matchName x y = occNameFS (getOccName x) ==
+                    occNameFS (getOccName y)
+
+-- | Try to resolve the type display from the given span.
+resolveName :: [SpanInfo] -> SpanInfo -> Maybe Var
+resolveName spans' si = listToMaybe $ mapMaybe spaninfoVar $
+                        reverse spans' `spaninfosWithin` si
+
+-- | Try to find the type of the given span.
+findType :: GhcMonad m
+         => Map ModuleName ModInfo
+         -> RealSrcSpan
+         -> String
+         -> ExceptT SDoc m (ModInfo, Type)
+findType infos span0 string = do
+    name  <- maybeToExceptT "Couldn't guess that module name. Does it exist?" $
+             guessModule infos (srcSpanFilePath span0)
+
+    info  <- maybeToExceptT "No module info for current file! Try loading it?" $
+             MaybeT $ pure $ M.lookup name infos
+
+    case resolveType (modinfoSpans info) (spanInfoFromRealSrcSpan' span0) of
+        Nothing -> (,) info <$> lift (exprType string)
+        Just ty -> return (info, ty)
+  where
+    -- | Try to resolve the type display from the given span.
+    resolveType :: [SpanInfo] -> SpanInfo -> Maybe Type
+    resolveType spans' si = listToMaybe $ mapMaybe spaninfoType $
+                            reverse spans' `spaninfosWithin` si
+
+-- | Guess a module name from a file path.
+guessModule :: GhcMonad m
+            => Map ModuleName ModInfo -> FilePath -> MaybeT m ModuleName
+guessModule infos fp = do
+    target <- lift $ guessTarget fp Nothing
+    case targetId target of
+        TargetModule mn  -> return mn
+        TargetFile fp' _ -> guessModule' fp'
+  where
+    guessModule' :: GhcMonad m => FilePath -> MaybeT m ModuleName
+    guessModule' fp' = case findModByFp fp' of
+        Just mn -> return mn
+        Nothing -> do
+            fp'' <- liftIO (makeRelativeToCurrentDirectory fp')
+
+            target' <- lift $ guessTarget fp'' Nothing
+            case targetId target' of
+                TargetModule mn -> return mn
+                _               -> MaybeT . pure $ findModByFp fp''
+
+    findModByFp :: FilePath -> Maybe ModuleName
+    findModByFp fp' = fst <$> find ((Just fp' ==) . mifp) (M.toList infos)
+      where
+        mifp :: (ModuleName, ModInfo) -> Maybe FilePath
+        mifp = ml_hs_file . ms_location . modinfoSummary . snd
+
+
+-- | Collect type info data for the loaded modules.
+collectInfo :: (GhcMonad m) => Map ModuleName ModInfo -> [ModuleName]
+               -> m (Map ModuleName ModInfo)
+collectInfo ms loaded = do
+    df <- getDynFlags
+    liftIO (filterM cacheInvalid loaded) >>= \case
+        [] -> return ms
+        invalidated -> do
+            liftIO (putStrLn ("Collecting type info for " ++
+                              show (length invalidated) ++
+                              " module(s) ... "))
+
+            foldM (go df) ms invalidated
+  where
+    go df m name = do { info <- getModInfo name; return (M.insert name info m) }
+                   `gcatch`
+                   (\(e :: SomeException) -> do
+                         liftIO $ putStrLn
+                                $ showSDocForUser df alwaysQualify
+                                $ "Error while getting type info from" <+>
+                                  ppr name <> ":" <+> text (show e)
+                         return m)
+
+    cacheInvalid name = case M.lookup name ms of
+        Nothing -> return True
+        Just mi -> do
+            let fp = ml_obj_file (ms_location (modinfoSummary mi))
+                last' = modinfoLastUpdate mi
+            exists <- doesFileExist fp
+            if exists
+                then (> last') <$> getModificationTime fp
+                else return True
+
+-- | Get info about the module: summary, types, etc.
+getModInfo :: (GhcMonad m) => ModuleName -> m ModInfo
+getModInfo name = do
+    m <- getModSummary name
+    p <- parseModule m
+    typechecked <- typecheckModule p
+    allTypes <- processAllTypeCheckedModule typechecked
+    let i = tm_checked_module_info typechecked
+    now <- liftIO getCurrentTime
+    return (ModInfo m allTypes i now)
+
+-- | Get ALL source spans in the module.
+processAllTypeCheckedModule :: forall m . GhcMonad m => TypecheckedModule
+                            -> m [SpanInfo]
+processAllTypeCheckedModule tcm = do
+    bts <- mapM getTypeLHsBind $ listifyAllSpans tcs
+    ets <- mapM getTypeLHsExpr $ listifyAllSpans tcs
+    pts <- mapM getTypeLPat    $ listifyAllSpans tcs
+    return $ mapMaybe toSpanInfo
+           $ sortBy cmpSpan
+           $ catMaybes (bts ++ ets ++ pts)
+  where
+    tcs = tm_typechecked_source tcm
+
+    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsBind's
+    getTypeLHsBind :: LHsBind Id -> m (Maybe (Maybe Id,SrcSpan,Type))
+    getTypeLHsBind (L _spn FunBind{fun_id = pid,fun_matches = MG _ _ _typ _})
+        = pure $ Just (Just (unLoc pid),getLoc pid,varType (unLoc pid))
+    getTypeLHsBind _ = pure Nothing
+
+    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsExpr's
+    getTypeLHsExpr :: LHsExpr Id -> m (Maybe (Maybe Id,SrcSpan,Type))
+    getTypeLHsExpr e = do
+        hs_env  <- getSession
+        (_,mbe) <- liftIO $ deSugarExpr hs_env e
+        return $ fmap (\expr -> (mid, getLoc e, CoreUtils.exprType expr)) mbe
+      where
+        mid :: Maybe Id
+        mid | HsVar (L _ i) <- unwrapVar (unLoc e) = Just i
+            | otherwise                            = Nothing
+
+        unwrapVar (HsWrap _ var) = var
+        unwrapVar e'             = e'
+
+    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LPats's
+    getTypeLPat :: LPat Id -> m (Maybe (Maybe Id,SrcSpan,Type))
+    getTypeLPat (L spn pat) =
+        pure (Just (getMaybeId pat,spn,hsPatType pat))
+      where
+        getMaybeId (VarPat (L _ vid)) = Just vid
+        getMaybeId _                  = Nothing
+
+    -- | Get ALL source spans in the source.
+    listifyAllSpans :: Typeable a => TypecheckedSource -> [Located a]
+    listifyAllSpans = everythingAllSpans (++) [] ([] `mkQ` (\x -> [x | p x]))
+      where
+        p (L spn _) = isGoodSrcSpan spn
+
+    -- | Variant of @syb@'s @everything@ (which summarises all nodes
+    -- in top-down, left-to-right order) with a stop-condition on 'NameSet's
+    everythingAllSpans :: (r -> r -> r) -> r -> GenericQ r -> GenericQ r
+    everythingAllSpans k z f x
+      | (False `mkQ` (const True :: NameSet -> Bool)) x = z
+      | otherwise = foldl k (f x) (gmapQ (everythingAllSpans k z f) x)
+
+    cmpSpan (_,a,_) (_,b,_)
+      | a `isSubspanOf` b = LT
+      | b `isSubspanOf` a = GT
+      | otherwise         = EQ
+
+    -- | Pretty print the types into a 'SpanInfo'.
+    toSpanInfo :: (Maybe Id,SrcSpan,Type) -> Maybe SpanInfo
+    toSpanInfo (n,RealSrcSpan spn,typ)
+        = Just $ spanInfoFromRealSrcSpan spn (Just typ) n
+    toSpanInfo _ = Nothing
+
+-- helper stolen from @syb@ package
+type GenericQ r = forall a. Data a => a -> r
+
+mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
+(r `mkQ` br) a = maybe r br (cast a)
diff --git a/src-bin/GHCi/UI/Monad.hs b/src-bin/GHCi/UI/Monad.hs
new file mode 100644
--- /dev/null
+++ b/src-bin/GHCi/UI/Monad.hs
@@ -0,0 +1,427 @@
+{-# LANGUAGE CPP, FlexibleInstances, UnboxedTuples, MagicHash #-}
+{-# OPTIONS_GHC -fno-cse -fno-warn-orphans #-}
+-- -fno-cse is needed for GLOBAL_VAR's to behave properly
+
+-----------------------------------------------------------------------------
+--
+-- Monadery code used in InteractiveUI
+--
+-- (c) The GHC Team 2005-2006
+--
+-----------------------------------------------------------------------------
+
+module GHCi.UI.Monad (
+        GHCi(..), startGHCi,
+        GHCiState(..), setGHCiState, getGHCiState, modifyGHCiState,
+        GHCiOption(..), isOptionSet, setOption, unsetOption,
+        Command(..),
+        BreakLocation(..),
+        TickArray,
+        getDynFlags,
+
+        runStmt, runDecls, resume, timeIt, recordBreak, revertCAFs,
+
+        printForUserNeverQualify, printForUserModInfo,
+        printForUser, printForUserPartWay, prettyLocations,
+        initInterpBuffering,
+        turnOffBuffering, turnOffBuffering_,
+        flushInterpBuffers,
+        mkEvalWrapper
+    ) where
+
+#include "../HsVersions.h"
+
+import GHCi.UI.Info (ModInfo)
+import qualified GHC
+import GhcMonad         hiding (liftIO)
+import Outputable       hiding (printForUser, printForUserPartWay)
+import qualified Outputable
+import DynFlags
+import FastString
+import HscTypes
+import SrcLoc
+import Module
+import GHCi
+import GHCi.RemoteTypes
+
+import Exception
+import Numeric
+import Data.Array
+import Data.IORef
+import System.CPUTime
+import System.Environment
+import System.IO
+import Control.Monad
+
+import System.Console.Haskeline (CompletionFunc, InputT)
+import qualified System.Console.Haskeline as Haskeline
+import Control.Monad.Trans.Class
+import Control.Monad.IO.Class
+import Data.Map.Strict (Map)
+
+-----------------------------------------------------------------------------
+-- GHCi monad
+
+data GHCiState = GHCiState
+     {
+        progname       :: String,
+        args           :: [String],
+        evalWrapper    :: ForeignHValue, -- ^ of type @IO a -> IO a@
+        prompt         :: String,
+        prompt2        :: String,
+        editor         :: String,
+        stop           :: String,
+        options        :: [GHCiOption],
+        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.
+        ghci_commands  :: [Command],
+            -- ^ 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
+
+        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.
+
+        ghc_e :: Bool, -- ^ True if this is 'ghc -e' (or runghc)
+
+        short_help :: String,
+            -- ^ help text to display to a user
+        long_help  :: String,
+        lastErrorLocations :: IORef [(FastString, Int)],
+
+        mod_infos  :: !(Map ModuleName ModInfo),
+
+        flushStdHandles :: ForeignHValue,
+            -- ^ @hFlush stdout; hFlush stderr@ in the interpreter
+        noBuffering :: ForeignHValue
+            -- ^ @hSetBuffering NoBuffering@ for stdin/stdout/stderr
+     }
+
+type TickArray = Array Int [(GHC.BreakIndex,RealSrcSpan)]
+
+-- | A GHCi command
+data Command
+   = Command
+   { cmdName           :: String
+     -- ^ Name of GHCi command (e.g. "exit")
+   , cmdAction         :: String -> InputT GHCi Bool
+     -- ^ The 'Bool' value denotes whether to exit GHCi
+   , cmdHidden         :: Bool
+     -- ^ Commands which are excluded from default completion
+     -- and @:help@ summary. This is usually set for commands not
+     -- useful for interactive use but rather for IDEs.
+   , cmdCompletionFunc :: CompletionFunc GHCi
+     -- ^ 'CompletionFunc' for arguments
+   }
+
+data GHCiOption
+        = ShowTiming            -- show time/allocs after evaluation
+        | ShowType              -- show the type of expressions
+        | RevertCAFs            -- revert CAFs after every evaluation
+        | Multiline             -- use multiline commands
+        | CollectInfo           -- collect and cache information about
+                                -- modules after load
+        deriving Eq
+
+data BreakLocation
+   = BreakLocation
+   { breakModule :: !GHC.Module
+   , breakLoc    :: !SrcSpan
+   , breakTick   :: {-# UNPACK #-} !Int
+   , onBreakCmd  :: String
+   }
+
+instance Eq BreakLocation where
+  loc1 == loc2 = breakModule loc1 == breakModule loc2 &&
+                 breakTick loc1   == breakTick loc2
+
+prettyLocations :: [(Int, BreakLocation)] -> SDoc
+prettyLocations []   = text "No active breakpoints."
+prettyLocations locs = vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ reverse $ locs
+
+instance Outputable BreakLocation where
+   ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+>
+                if null (onBreakCmd loc)
+                   then Outputable.empty
+                   else doubleQuotes (text (onBreakCmd loc))
+
+recordBreak :: BreakLocation -> GHCi (Bool{- was already present -}, Int)
+recordBreak brkLoc = do
+   st <- getGHCiState
+   let oldActiveBreaks = breaks st
+   -- don't store the same break point twice
+   case [ nm | (nm, loc) <- oldActiveBreaks, loc == brkLoc ] of
+     (nm:_) -> return (True, nm)
+     [] -> do
+      let oldCounter = break_ctr st
+          newCounter = oldCounter + 1
+      setGHCiState $ st { break_ctr = newCounter,
+                          breaks = (oldCounter, brkLoc) : oldActiveBreaks
+                        }
+      return (False, oldCounter)
+
+newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> Ghc a }
+
+reflectGHCi :: (Session, IORef GHCiState) -> GHCi a -> IO a
+reflectGHCi (s, gs) m = unGhc (unGHCi m gs) s
+
+reifyGHCi :: ((Session, IORef GHCiState) -> IO a) -> GHCi a
+reifyGHCi f = GHCi f'
+  where
+    -- f' :: IORef GHCiState -> Ghc a
+    f' gs = reifyGhc (f'' gs)
+    -- f'' :: IORef GHCiState -> Session -> IO a
+    f'' gs s = f (s, gs)
+
+startGHCi :: GHCi a -> GHCiState -> Ghc a
+startGHCi g state = do ref <- liftIO $ newIORef state; unGHCi g ref
+
+instance Functor GHCi where
+    fmap = liftM
+
+instance Applicative GHCi where
+    pure a = GHCi $ \_ -> pure a
+    (<*>) = ap
+
+instance Monad GHCi where
+  (GHCi m) >>= k  =  GHCi $ \s -> m s >>= \a -> unGHCi (k a) s
+
+class HasGhciState m where
+    getGHCiState    :: m GHCiState
+    setGHCiState    :: GHCiState -> m ()
+    modifyGHCiState :: (GHCiState -> GHCiState) -> m ()
+
+instance HasGhciState GHCi where
+    getGHCiState      = GHCi $ \r -> liftIO $ readIORef r
+    setGHCiState s    = GHCi $ \r -> liftIO $ writeIORef r s
+    modifyGHCiState f = GHCi $ \r -> liftIO $ modifyIORef r f
+
+instance (MonadTrans t, Monad m, HasGhciState m) => HasGhciState (t m) where
+    getGHCiState    = lift getGHCiState
+    setGHCiState    = lift . setGHCiState
+    modifyGHCiState = lift . modifyGHCiState
+
+liftGhc :: Ghc a -> GHCi a
+liftGhc m = GHCi $ \_ -> m
+
+instance MonadIO GHCi where
+  liftIO = liftGhc . liftIO
+
+instance HasDynFlags GHCi where
+  getDynFlags = getSessionDynFlags
+
+instance GhcMonad GHCi where
+  setSession s' = liftGhc $ setSession s'
+  getSession    = liftGhc $ getSession
+
+instance HasDynFlags (InputT GHCi) where
+  getDynFlags = lift getDynFlags
+
+instance GhcMonad (InputT GHCi) where
+  setSession = lift . setSession
+  getSession = lift getSession
+
+instance ExceptionMonad GHCi where
+  gcatch m h = GHCi $ \r -> unGHCi m r `gcatch` (\e -> unGHCi (h e) r)
+  gmask f =
+      GHCi $ \s -> gmask $ \io_restore ->
+                             let
+                                g_restore (GHCi m) = GHCi $ \s' -> io_restore (m s')
+                             in
+                                unGHCi (f g_restore) s
+
+instance Haskeline.MonadException Ghc where
+  controlIO f = Ghc $ \s -> Haskeline.controlIO $ \(Haskeline.RunIO run) -> let
+                    run' = Haskeline.RunIO (fmap (Ghc . const) . run . flip unGhc s)
+                    in fmap (flip unGhc s) $ f run'
+
+instance Haskeline.MonadException GHCi where
+  controlIO f = GHCi $ \s -> Haskeline.controlIO $ \(Haskeline.RunIO run) -> let
+                    run' = Haskeline.RunIO (fmap (GHCi . const) . run . flip unGHCi s)
+                    in fmap (flip unGHCi s) $ f run'
+
+instance ExceptionMonad (InputT GHCi) where
+  gcatch = Haskeline.catch
+  gmask f = Haskeline.liftIOOp gmask (f . Haskeline.liftIOOp_)
+
+isOptionSet :: GHCiOption -> GHCi Bool
+isOptionSet opt
+ = do st <- getGHCiState
+      return (opt `elem` options st)
+
+setOption :: GHCiOption -> GHCi ()
+setOption opt
+ = do st <- getGHCiState
+      setGHCiState (st{ options = opt : filter (/= opt) (options st) })
+
+unsetOption :: GHCiOption -> GHCi ()
+unsetOption opt
+ = do st <- getGHCiState
+      setGHCiState (st{ options = filter (/= opt) (options st) })
+
+printForUserNeverQualify :: GhcMonad m => SDoc -> m ()
+printForUserNeverQualify doc = do
+  dflags <- getDynFlags
+  liftIO $ Outputable.printForUser dflags stdout neverQualify doc
+
+printForUserModInfo :: GhcMonad m => GHC.ModuleInfo -> SDoc -> m ()
+printForUserModInfo info doc = do
+  dflags <- getDynFlags
+  mUnqual <- GHC.mkPrintUnqualifiedForModule info
+  unqual <- maybe GHC.getPrintUnqual return mUnqual
+  liftIO $ Outputable.printForUser dflags stdout unqual doc
+
+printForUser :: GhcMonad m => SDoc -> m ()
+printForUser doc = do
+  unqual <- GHC.getPrintUnqual
+  dflags <- getDynFlags
+  liftIO $ Outputable.printForUser dflags stdout unqual doc
+
+printForUserPartWay :: SDoc -> GHCi ()
+printForUserPartWay doc = do
+  unqual <- GHC.getPrintUnqual
+  dflags <- getDynFlags
+  liftIO $ Outputable.printForUserPartWay dflags stdout (pprUserLength dflags) unqual doc
+
+-- | Run a single Haskell expression
+runStmt :: String -> GHC.SingleStep -> GHCi (Maybe GHC.ExecResult)
+runStmt expr step = do
+  st <- getGHCiState
+  GHC.handleSourceError (\e -> do GHC.printException e; return Nothing) $ do
+    let opts = GHC.execOptions
+                  { GHC.execSourceFile = progname st
+                  , GHC.execLineNumber = line_number st
+                  , GHC.execSingleStep = step
+                  , GHC.execWrap = \fhv -> EvalApp (EvalThis (evalWrapper st))
+                                                   (EvalThis fhv) }
+    Just <$> GHC.execStmt expr opts
+
+runDecls :: String -> GHCi (Maybe [GHC.Name])
+runDecls decls = do
+  st <- getGHCiState
+  reifyGHCi $ \x ->
+    withProgName (progname st) $
+    withArgs (args st) $
+      reflectGHCi x $ do
+        GHC.handleSourceError (\e -> do GHC.printException e;
+                                        return Nothing) $ do
+          r <- GHC.runDeclsWithLocation (progname st) (line_number st) decls
+          return (Just r)
+
+resume :: (SrcSpan -> Bool) -> GHC.SingleStep -> GHCi GHC.ExecResult
+resume canLogSpan step = do
+  st <- getGHCiState
+  reifyGHCi $ \x ->
+    withProgName (progname st) $
+    withArgs (args st) $
+      reflectGHCi x $ do
+        GHC.resumeExec canLogSpan step
+
+-- --------------------------------------------------------------------------
+-- timing & statistics
+
+timeIt :: (a -> Maybe Integer) -> InputT GHCi a -> InputT GHCi a
+timeIt getAllocs action
+  = do b <- lift $ isOptionSet ShowTiming
+       if not b
+          then action
+          else do time1   <- liftIO $ getCPUTime
+                  a <- action
+                  let allocs = getAllocs a
+                  time2   <- liftIO $ getCPUTime
+                  dflags  <- getDynFlags
+                  liftIO $ printTimes dflags allocs (time2 - time1)
+                  return a
+
+printTimes :: DynFlags -> Maybe Integer -> Integer -> IO ()
+printTimes dflags mallocs psecs
+   = do let secs = (fromIntegral psecs / (10^(12::Integer))) :: Float
+            secs_str = showFFloat (Just 2) secs
+        putStrLn (showSDoc dflags (
+                 parens (text (secs_str "") <+> text "secs" <> comma <+>
+                         case mallocs of
+                           Nothing -> empty
+                           Just allocs ->
+                             text (separateThousands allocs) <+> text "bytes")))
+  where
+    separateThousands n = reverse . sep . reverse . show $ n
+      where sep n'
+              | length n' <= 3 = n'
+              | otherwise = take 3 n' ++ "," ++ sep (drop 3 n')
+
+-----------------------------------------------------------------------------
+-- reverting CAFs
+
+revertCAFs :: GHCi ()
+revertCAFs = do
+  liftIO rts_revertCAFs
+  s <- getGHCiState
+  when (not (ghc_e s)) turnOffBuffering
+     -- Have to turn off buffering again, because we just
+     -- reverted stdout, stderr & stdin to their defaults.
+
+foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()
+        -- Make it "safe", just in case
+
+-----------------------------------------------------------------------------
+-- To flush buffers for the *interpreted* computation we need
+-- to refer to *its* stdout/stderr handles
+
+-- | Compile "hFlush stdout; hFlush stderr" once, so we can use it repeatedly
+initInterpBuffering :: Ghc (ForeignHValue, ForeignHValue)
+initInterpBuffering = do
+  nobuf <- GHC.compileExprRemote $
+   "do { System.IO.hSetBuffering System.IO.stdin System.IO.NoBuffering; " ++
+       " System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering; " ++
+       " System.IO.hSetBuffering System.IO.stderr System.IO.NoBuffering }"
+  flush <- GHC.compileExprRemote $
+   "do { System.IO.hFlush System.IO.stdout; " ++
+       " System.IO.hFlush System.IO.stderr }"
+  return (nobuf, flush)
+
+-- | Invoke "hFlush stdout; hFlush stderr" in the interpreter
+flushInterpBuffers :: GHCi ()
+flushInterpBuffers = do
+  st <- getGHCiState
+  hsc_env <- GHC.getSession
+  liftIO $ evalIO hsc_env (flushStdHandles st)
+
+-- | Turn off buffering for stdin, stdout, and stderr in the interpreter
+turnOffBuffering :: GHCi ()
+turnOffBuffering = do
+  st <- getGHCiState
+  turnOffBuffering_ (noBuffering st)
+
+turnOffBuffering_ :: GhcMonad m => ForeignHValue -> m ()
+turnOffBuffering_ fhv = do
+  hsc_env <- getSession
+  liftIO $ evalIO hsc_env fhv
+
+mkEvalWrapper :: GhcMonad m => String -> [String] ->  m ForeignHValue
+mkEvalWrapper progname args =
+  GHC.compileExprRemote $
+    "\\m -> System.Environment.withProgName " ++ show progname ++
+    "(System.Environment.withArgs " ++ show args ++ " m)"
diff --git a/src-bin/GHCi/UI/Tags.hs b/src-bin/GHCi/UI/Tags.hs
new file mode 100644
--- /dev/null
+++ b/src-bin/GHCi/UI/Tags.hs
@@ -0,0 +1,215 @@
+-----------------------------------------------------------------------------
+--
+-- GHCi's :ctags and :etags commands
+--
+-- (c) The GHC Team 2005-2007
+--
+-----------------------------------------------------------------------------
+
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+module GHCi.UI.Tags (
+  createCTagsWithLineNumbersCmd,
+  createCTagsWithRegExesCmd,
+  createETagsFileCmd
+) where
+
+import Exception
+import GHC
+import GHCi.UI.Monad
+import Outputable
+
+-- ToDo: figure out whether we need these, and put something appropriate
+-- into the GHC API instead
+import Name (nameOccName)
+import OccName (pprOccName)
+import ConLike
+import MonadUtils
+
+import Data.Function
+import Data.Maybe
+import Data.Ord
+import DriverPhases
+import Panic
+import Data.List
+import Control.Monad
+import System.Directory
+import System.IO
+import System.IO.Error
+
+-----------------------------------------------------------------------------
+-- create tags file for currently loaded modules.
+
+createCTagsWithLineNumbersCmd, createCTagsWithRegExesCmd,
+  createETagsFileCmd :: String -> GHCi ()
+
+createCTagsWithLineNumbersCmd ""   =
+  ghciCreateTagsFile CTagsWithLineNumbers "tags"
+createCTagsWithLineNumbersCmd file =
+  ghciCreateTagsFile CTagsWithLineNumbers file
+
+createCTagsWithRegExesCmd ""   =
+  ghciCreateTagsFile CTagsWithRegExes "tags"
+createCTagsWithRegExesCmd file =
+  ghciCreateTagsFile CTagsWithRegExes file
+
+createETagsFileCmd ""    = ghciCreateTagsFile ETags "TAGS"
+createETagsFileCmd file  = ghciCreateTagsFile ETags file
+
+data TagsKind = ETags | CTagsWithLineNumbers | CTagsWithRegExes
+
+ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
+ghciCreateTagsFile kind file = do
+  createTagsFile kind file
+
+-- ToDo:
+--      - remove restriction that all modules must be interpreted
+--        (problem: we don't know source locations for entities unless
+--        we compiled the module.
+--
+--      - extract createTagsFile so it can be used from the command-line
+--        (probably need to fix first problem before this is useful).
+--
+createTagsFile :: TagsKind -> FilePath -> GHCi ()
+createTagsFile tagskind tagsFile = do
+  graph <- GHC.getModuleGraph
+  mtags <- mapM listModuleTags (map GHC.ms_mod graph)
+  either_res <- liftIO $ collateAndWriteTags tagskind tagsFile $ concat mtags
+  case either_res of
+    Left e  -> liftIO $ hPutStrLn stderr $ ioeGetErrorString e
+    Right _ -> return ()
+
+
+listModuleTags :: GHC.Module -> GHCi [TagInfo]
+listModuleTags m = do
+  is_interpreted <- GHC.moduleIsInterpreted m
+  -- should we just skip these?
+  when (not is_interpreted) $
+    let mName = GHC.moduleNameString (GHC.moduleName m) in
+    throwGhcException (CmdLineError ("module '" ++ mName ++ "' is not interpreted"))
+  mbModInfo <- GHC.getModuleInfo m
+  case mbModInfo of
+    Nothing -> return []
+    Just mInfo -> do
+       dflags <- getDynFlags
+       mb_print_unqual <- GHC.mkPrintUnqualifiedForModule mInfo
+       let unqual = fromMaybe GHC.alwaysQualify mb_print_unqual
+       let names = fromMaybe [] $GHC.modInfoTopLevelScope mInfo
+       let localNames = filter ((m==) . nameModule) names
+       mbTyThings <- mapM GHC.lookupName localNames
+       return $! [ tagInfo dflags unqual exported kind name realLoc
+                     | tyThing <- catMaybes mbTyThings
+                     , let name = getName tyThing
+                     , let exported = GHC.modInfoIsExportedName mInfo name
+                     , let kind = tyThing2TagKind tyThing
+                     , let loc = srcSpanStart (nameSrcSpan name)
+                     , RealSrcLoc realLoc <- [loc]
+                     ]
+
+  where
+    tyThing2TagKind (AnId _)                 = 'v'
+    tyThing2TagKind (AConLike RealDataCon{}) = 'd'
+    tyThing2TagKind (AConLike PatSynCon{})   = 'p'
+    tyThing2TagKind (ATyCon _)               = 't'
+    tyThing2TagKind (ACoAxiom _)             = 'x'
+
+
+data TagInfo = TagInfo
+  { tagExported :: Bool -- is tag exported
+  , tagKind :: Char   -- tag kind
+  , tagName :: String -- tag name
+  , tagFile :: String -- file name
+  , tagLine :: Int    -- line number
+  , tagCol :: Int     -- column number
+  , tagSrcInfo :: Maybe (String,Integer)  -- source code line and char offset
+  }
+
+
+-- get tag info, for later translation into Vim or Emacs style
+tagInfo :: DynFlags -> PrintUnqualified -> Bool -> Char -> Name -> RealSrcLoc
+        -> TagInfo
+tagInfo dflags unqual exported kind name loc
+    = TagInfo exported kind
+        (showSDocForUser dflags unqual $ pprOccName (nameOccName name))
+        (showSDocForUser dflags unqual $ ftext (srcLocFile loc))
+        (srcLocLine loc) (srcLocCol loc) Nothing
+
+-- throw an exception when someone tries to overwrite existing source file (fix for #10989)
+writeTagsSafely :: FilePath -> String -> IO ()
+writeTagsSafely file str = do
+    dfe <- doesFileExist file
+    if dfe && isSourceFilename file
+        then throwGhcException (CmdLineError (file ++ " is existing source file. " ++
+             "Please specify another file name to store tags data"))
+        else writeFile file str
+
+collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
+-- ctags style with the Ex exresion being just the line number, Vim et al
+collateAndWriteTags CTagsWithLineNumbers file tagInfos = do
+  let tags = unlines $ sort $ map showCTag tagInfos
+  tryIO (writeTagsSafely file tags)
+
+-- ctags style with the Ex exresion being a regex searching the line, Vim et al
+collateAndWriteTags CTagsWithRegExes file tagInfos = do -- ctags style, Vim et al
+  tagInfoGroups <- makeTagGroupsWithSrcInfo tagInfos
+  let tags = unlines $ sort $ map showCTag $concat tagInfoGroups
+  tryIO (writeTagsSafely file tags)
+
+collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
+  tagInfoGroups <- makeTagGroupsWithSrcInfo $filter tagExported tagInfos
+  let tagGroups = map processGroup tagInfoGroups
+  tryIO (writeTagsSafely file $ concat tagGroups)
+
+  where
+    processGroup [] = throwGhcException (CmdLineError "empty tag file group??")
+    processGroup group@(tagInfo:_) =
+      let tags = unlines $ map showETag group in
+      "\x0c\n" ++ tagFile tagInfo ++ "," ++ show (length tags) ++ "\n" ++ tags
+
+
+makeTagGroupsWithSrcInfo :: [TagInfo] -> IO [[TagInfo]]
+makeTagGroupsWithSrcInfo tagInfos = do
+  let groups = groupBy ((==) `on` tagFile) $ sortBy (comparing tagFile) tagInfos
+  mapM addTagSrcInfo groups
+
+  where
+    addTagSrcInfo [] = throwGhcException (CmdLineError "empty tag file group??")
+    addTagSrcInfo group@(tagInfo:_) = do
+      file <- readFile $tagFile tagInfo
+      let sortedGroup = sortBy (comparing tagLine) group
+      return $ perFile sortedGroup 1 0 $ lines file
+
+    perFile allTags@(tag:tags) cnt pos allLs@(l:ls)
+     | tagLine tag > cnt =
+         perFile allTags (cnt+1) (pos+fromIntegral(length l)) ls
+     | tagLine tag == cnt =
+         tag{ tagSrcInfo = Just(l,pos) } : perFile tags cnt pos allLs
+    perFile _ _ _ _ = []
+
+
+-- ctags format, for Vim et al
+showCTag :: TagInfo -> String
+showCTag ti =
+  tagName ti ++ "\t" ++ tagFile ti ++ "\t" ++ tagCmd ++ ";\"\t" ++
+    tagKind ti : ( if tagExported ti then "" else "\tfile:" )
+
+  where
+    tagCmd =
+      case tagSrcInfo ti of
+        Nothing -> show $tagLine ti
+        Just (srcLine,_) -> "/^"++ foldr escapeSlashes [] srcLine ++"$/"
+
+      where
+        escapeSlashes '/' r = '\\' : '/' : r
+        escapeSlashes '\\' r = '\\' : '\\' : r
+        escapeSlashes c r = c : r
+
+
+-- etags format, for Emacs/XEmacs
+showETag :: TagInfo -> String
+showETag TagInfo{ tagName = tag, tagLine = lineNo, tagCol = colNo,
+                  tagSrcInfo = Just (srcLine,charPos) }
+    =  take (colNo - 1) srcLine ++ tag
+    ++ "\x7f" ++ tag
+    ++ "\x01" ++ show lineNo
+    ++ "," ++ show charPos
+showETag _ = throwGhcException (CmdLineError "missing source file info in showETag")
diff --git a/src-bin/GhciMonad.hs b/src-bin/GhciMonad.hs
deleted file mode 100644
--- a/src-bin/GhciMonad.hs
+++ /dev/null
@@ -1,397 +0,0 @@
-{-# LANGUAGE CPP, FlexibleInstances, UnboxedTuples, MagicHash #-}
-{-# OPTIONS_GHC -fno-cse -fno-warn-orphans #-}
--- -fno-cse is needed for GLOBAL_VAR's to behave properly
-
------------------------------------------------------------------------------
---
--- Monadery code used in InteractiveUI
---
--- (c) The GHC Team 2005-2006
---
------------------------------------------------------------------------------
-
-module GhciMonad (
-        GHCi(..), startGHCi,
-        GHCiState(..), setGHCiState, getGHCiState, modifyGHCiState,
-        GHCiOption(..), isOptionSet, setOption, unsetOption,
-        Command,
-        BreakLocation(..),
-        TickArray,
-        getDynFlags,
-
-        runStmt, runDecls, resume, timeIt, recordBreak, revertCAFs,
-
-        printForUser, printForUserPartWay, prettyLocations,
-        initInterpBuffering, turnOffBuffering, flushInterpBuffers,
-    ) where
-
-#include "HsVersions.h"
-
-import qualified GHC
-import GhcMonad         hiding (liftIO)
-import Outputable       hiding (printForUser, printForUserPartWay)
-import qualified Outputable
-import Util
-import DynFlags
-import FastString
-import HscTypes
-import SrcLoc
-import Module
-import ObjLink
-import Linker
-
-import Exception
-import Numeric
-import Data.Array
-import Data.Int         ( Int64 )
-import Data.IORef
-import System.CPUTime
-import System.Environment
-import System.IO
-import Control.Monad
-import GHC.Exts
-
-import System.Console.Haskeline (CompletionFunc, InputT)
-import qualified System.Console.Haskeline as Haskeline
-import Control.Monad.Trans.Class
-import Control.Monad.IO.Class
-
------------------------------------------------------------------------------
--- GHCi monad
-
--- the Bool means: True = we should exit GHCi (:quit)
-type Command = (String, String -> InputT GHCi Bool, CompletionFunc GHCi)
-
-data GHCiState = GHCiState
-     {
-        progname       :: String,
-        args           :: [String],
-        prompt         :: String,
-        prompt2        :: String,
-        editor         :: String,
-        stop           :: String,
-        options        :: [GHCiOption],
-        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
-        ghci_commands  :: [Command],
-        -- ":" at the GHCi prompt repeats the last command, so we
-        -- remember is here:
-        last_command   :: Maybe Command,
-        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
-
-        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.
-
-        ghc_e :: Bool, -- True if this is 'ghc -e' (or runghc)
-
-        -- help text to display to a user
-        short_help :: String,
-        long_help  :: String,
-        lastErrorLocations :: IORef [(FastString, Int)]
-     }
-
-type TickArray = Array Int [(BreakIndex,SrcSpan)]
-
-data GHCiOption
-        = ShowTiming            -- show time/allocs after evaluation
-        | ShowType              -- show the type of expressions
-        | RevertCAFs            -- revert CAFs after every evaluation
-        | Multiline             -- use multiline commands
-        deriving Eq
-
-data BreakLocation
-   = BreakLocation
-   { breakModule :: !GHC.Module
-   , breakLoc    :: !SrcSpan
-   , breakTick   :: {-# UNPACK #-} !Int
-   , onBreakCmd  :: String
-   }
-
-instance Eq BreakLocation where
-  loc1 == loc2 = breakModule loc1 == breakModule loc2 &&
-                 breakTick loc1   == breakTick loc2
-
-prettyLocations :: [(Int, BreakLocation)] -> SDoc
-prettyLocations []   = text "No active breakpoints."
-prettyLocations locs = vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ reverse $ locs
-
-instance Outputable BreakLocation where
-   ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+>
-                if null (onBreakCmd loc)
-                   then Outputable.empty
-                   else doubleQuotes (text (onBreakCmd loc))
-
-recordBreak :: BreakLocation -> GHCi (Bool{- was already present -}, Int)
-recordBreak brkLoc = do
-   st <- getGHCiState
-   let oldActiveBreaks = breaks st
-   -- don't store the same break point twice
-   case [ nm | (nm, loc) <- oldActiveBreaks, loc == brkLoc ] of
-     (nm:_) -> return (True, nm)
-     [] -> do
-      let oldCounter = break_ctr st
-          newCounter = oldCounter + 1
-      setGHCiState $ st { break_ctr = newCounter,
-                          breaks = (oldCounter, brkLoc) : oldActiveBreaks
-                        }
-      return (False, oldCounter)
-
-newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> Ghc a }
-
-reflectGHCi :: (Session, IORef GHCiState) -> GHCi a -> IO a
-reflectGHCi (s, gs) m = unGhc (unGHCi m gs) s
-
-reifyGHCi :: ((Session, IORef GHCiState) -> IO a) -> GHCi a
-reifyGHCi f = GHCi f'
-  where
-    -- f' :: IORef GHCiState -> Ghc a
-    f' gs = reifyGhc (f'' gs)
-    -- f'' :: IORef GHCiState -> Session -> IO a
-    f'' gs s = f (s, gs)
-
-startGHCi :: GHCi a -> GHCiState -> Ghc a
-startGHCi g state = do ref <- liftIO $ newIORef state; unGHCi g ref
-
-instance Functor GHCi where
-    fmap = liftM
-
-instance Applicative GHCi where
-    pure = return
-    (<*>) = ap
-
-instance Monad GHCi where
-  (GHCi m) >>= k  =  GHCi $ \s -> m s >>= \a -> unGHCi (k a) s
-  return a  = GHCi $ \_ -> return a
-
-getGHCiState :: GHCi GHCiState
-getGHCiState   = GHCi $ \r -> liftIO $ readIORef r
-setGHCiState :: GHCiState -> GHCi ()
-setGHCiState s = GHCi $ \r -> liftIO $ writeIORef r s
-modifyGHCiState :: (GHCiState -> GHCiState) -> GHCi ()
-modifyGHCiState f = GHCi $ \r -> liftIO $ readIORef r >>= writeIORef r . f
-
-liftGhc :: Ghc a -> GHCi a
-liftGhc m = GHCi $ \_ -> m
-
-instance MonadIO GHCi where
-  liftIO = liftGhc . liftIO
-
-instance HasDynFlags GHCi where
-  getDynFlags = getSessionDynFlags
-
-instance GhcMonad GHCi where
-  setSession s' = liftGhc $ setSession s'
-  getSession    = liftGhc $ getSession
-
-instance HasDynFlags (InputT GHCi) where
-  getDynFlags = lift getDynFlags
-
-instance GhcMonad (InputT GHCi) where
-  setSession = lift . setSession
-  getSession = lift getSession
-
-instance ExceptionMonad GHCi where
-  gcatch m h = GHCi $ \r -> unGHCi m r `gcatch` (\e -> unGHCi (h e) r)
-  gmask f =
-      GHCi $ \s -> gmask $ \io_restore ->
-                             let
-                                g_restore (GHCi m) = GHCi $ \s' -> io_restore (m s')
-                             in
-                                unGHCi (f g_restore) s
-
-instance Haskeline.MonadException Ghc where
-  controlIO f = Ghc $ \s -> Haskeline.controlIO $ \(Haskeline.RunIO run) -> let
-                    run' = Haskeline.RunIO (fmap (Ghc . const) . run . flip unGhc s)
-                    in fmap (flip unGhc s) $ f run'
-
-instance Haskeline.MonadException GHCi where
-  controlIO f = GHCi $ \s -> Haskeline.controlIO $ \(Haskeline.RunIO run) -> let
-                    run' = Haskeline.RunIO (fmap (GHCi . const) . run . flip unGHCi s)
-                    in fmap (flip unGHCi s) $ f run'
-
-instance ExceptionMonad (InputT GHCi) where
-  gcatch = Haskeline.catch
-  gmask f = Haskeline.liftIOOp gmask (f . Haskeline.liftIOOp_)
-
-isOptionSet :: GHCiOption -> GHCi Bool
-isOptionSet opt
- = do st <- getGHCiState
-      return (opt `elem` options st)
-
-setOption :: GHCiOption -> GHCi ()
-setOption opt
- = do st <- getGHCiState
-      setGHCiState (st{ options = opt : filter (/= opt) (options st) })
-
-unsetOption :: GHCiOption -> GHCi ()
-unsetOption opt
- = do st <- getGHCiState
-      setGHCiState (st{ options = filter (/= opt) (options st) })
-
-printForUser :: GhcMonad m => SDoc -> m ()
-printForUser doc = do
-  unqual <- GHC.getPrintUnqual
-  dflags <- getDynFlags
-  liftIO $ Outputable.printForUser dflags stdout unqual doc
-
-printForUserPartWay :: SDoc -> GHCi ()
-printForUserPartWay doc = do
-  unqual <- GHC.getPrintUnqual
-  dflags <- getDynFlags
-  liftIO $ Outputable.printForUserPartWay dflags stdout (pprUserLength dflags) unqual doc
-
--- | Run a single Haskell expression
-runStmt :: String -> GHC.SingleStep -> GHCi (Maybe GHC.RunResult)
-runStmt expr step = do
-  st <- getGHCiState
-  reifyGHCi $ \x ->
-    withProgName (progname st) $
-    withArgs (args st) $
-      reflectGHCi x $ do
-        GHC.handleSourceError (\e -> do GHC.printException e;
-                                        return Nothing) $ do
-          r <- GHC.runStmtWithLocation (progname st) (line_number st) expr step
-          return (Just r)
-
-runDecls :: String -> GHCi [GHC.Name]
-runDecls decls = do
-  st <- getGHCiState
-  reifyGHCi $ \x ->
-    withProgName (progname st) $
-    withArgs (args st) $
-      reflectGHCi x $ do
-        GHC.handleSourceError (\e -> do GHC.printException e; return []) $ do
-          GHC.runDeclsWithLocation (progname st) (line_number st) decls
-
-resume :: (SrcSpan -> Bool) -> GHC.SingleStep -> GHCi GHC.RunResult
-resume canLogSpan step = do
-  st <- getGHCiState
-  reifyGHCi $ \x ->
-    withProgName (progname st) $
-    withArgs (args st) $
-      reflectGHCi x $ do
-        GHC.resume canLogSpan step
-
--- --------------------------------------------------------------------------
--- timing & statistics
-
-timeIt :: InputT GHCi a -> InputT GHCi a
-timeIt action
-  = do b <- lift $ isOptionSet ShowTiming
-       if not b
-          then action
-          else do allocs1 <- liftIO $ getAllocations
-                  time1   <- liftIO $ getCPUTime
-                  a <- action
-                  allocs2 <- liftIO $ getAllocations
-                  time2   <- liftIO $ getCPUTime
-                  dflags  <- getDynFlags
-                  liftIO $ printTimes dflags (fromIntegral (allocs2 - allocs1))
-                                  (time2 - time1)
-                  return a
-
-foreign import ccall unsafe "getAllocations" getAllocations :: IO Int64
-        -- defined in ghc/rts/Stats.c
-
-printTimes :: DynFlags -> Integer -> Integer -> IO ()
-printTimes dflags allocs psecs
-   = do let secs = (fromIntegral psecs / (10^(12::Integer))) :: Float
-            secs_str = showFFloat (Just 2) secs
-        putStrLn (showSDoc dflags (
-                 parens (text (secs_str "") <+> text "secs" <> comma <+>
-                         text (separateThousands allocs) <+> text "bytes")))
-  where
-    separateThousands n = reverse . sep . reverse . show $ n
-      where sep n'
-              | length n' <= 3 = n'
-              | otherwise = take 3 n' ++ "," ++ sep (drop 3 n')
-
------------------------------------------------------------------------------
--- reverting CAFs
-
-revertCAFs :: GHCi ()
-revertCAFs = do
-  liftIO rts_revertCAFs
-  s <- getGHCiState
-  when (not (ghc_e s)) $ liftIO turnOffBuffering
-        -- Have to turn off buffering again, because we just
-        -- reverted stdout, stderr & stdin to their defaults.
-
-foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()
-        -- Make it "safe", just in case
-
------------------------------------------------------------------------------
--- To flush buffers for the *interpreted* computation we need
--- to refer to *its* stdout/stderr handles
-
-GLOBAL_VAR(stdin_ptr,  error "no stdin_ptr",  Ptr ())
-GLOBAL_VAR(stdout_ptr, error "no stdout_ptr", Ptr ())
-GLOBAL_VAR(stderr_ptr, error "no stderr_ptr", Ptr ())
-
--- After various attempts, I believe this is the least bad way to do
--- what we want.  We know look up the address of the static stdin,
--- stdout, and stderr closures in the loaded base package, and each
--- time we need to refer to them we cast the pointer to a Handle.
--- This avoids any problems with the CAF having been reverted, because
--- we'll always get the current value.
---
--- The previous attempt that didn't work was to compile an expression
--- like "hSetBuffering stdout NoBuffering" into an expression of type
--- IO () and run this expression each time we needed it, but the
--- problem is that evaluating the expression might cache the contents
--- of the Handle rather than referring to it from its static address
--- each time.  There's no safe workaround for this.
-
-initInterpBuffering :: Ghc ()
-initInterpBuffering = do -- make sure these are linked
-    dflags <- GHC.getSessionDynFlags
-    liftIO $ do
-      initDynLinker dflags
-
-        -- ToDo: we should really look up these names properly, but
-        -- it's a fiddle and not all the bits are exposed via the GHC
-        -- interface.
-      mb_stdin_ptr  <- ObjLink.lookupSymbol "base_GHCziIOziHandleziFD_stdin_closure"
-      mb_stdout_ptr <- ObjLink.lookupSymbol "base_GHCziIOziHandleziFD_stdout_closure"
-      mb_stderr_ptr <- ObjLink.lookupSymbol "base_GHCziIOziHandleziFD_stderr_closure"
-
-      let f ref (Just ptr) = writeIORef ref ptr
-          f _   Nothing    = panic "interactiveUI:setBuffering2"
-      zipWithM_ f [stdin_ptr,stdout_ptr,stderr_ptr]
-                  [mb_stdin_ptr,mb_stdout_ptr,mb_stderr_ptr]
-
-flushInterpBuffers :: GHCi ()
-flushInterpBuffers
- = liftIO $ do getHandle stdout_ptr >>= hFlush
-               getHandle stderr_ptr >>= hFlush
-
-turnOffBuffering :: IO ()
-turnOffBuffering
- = do hdls <- mapM getHandle [stdin_ptr,stdout_ptr,stderr_ptr]
-      mapM_ (\h -> hSetBuffering h NoBuffering) hdls
-
-getHandle :: IORef (Ptr ()) -> IO Handle
-getHandle ref = do
-  (Ptr addr) <- readIORef ref
-  case addrToAny# addr of (# hval #) -> return (unsafeCoerce# hval)
-
diff --git a/src-bin/GhciTags.hs b/src-bin/GhciTags.hs
deleted file mode 100644
--- a/src-bin/GhciTags.hs
+++ /dev/null
@@ -1,206 +0,0 @@
------------------------------------------------------------------------------
---
--- GHCi's :ctags and :etags commands
---
--- (c) The GHC Team 2005-2007
---
------------------------------------------------------------------------------
-
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-module GhciTags (
-  createCTagsWithLineNumbersCmd,
-  createCTagsWithRegExesCmd,
-  createETagsFileCmd
-) where
-
-import Exception
-import GHC
-import GhciMonad
-import Outputable
-
--- ToDo: figure out whether we need these, and put something appropriate
--- into the GHC API instead
-import Name (nameOccName)
-import OccName (pprOccName)
-import ConLike
-import MonadUtils
-
-import Data.Function
-import Data.Maybe
-import Data.Ord
-import Panic
-import Data.List
-import Control.Monad
-import System.IO
-import System.IO.Error
-
------------------------------------------------------------------------------
--- create tags file for currently loaded modules.
-
-createCTagsWithLineNumbersCmd, createCTagsWithRegExesCmd,
-  createETagsFileCmd :: String -> GHCi ()
-
-createCTagsWithLineNumbersCmd ""   =
-  ghciCreateTagsFile CTagsWithLineNumbers "tags"
-createCTagsWithLineNumbersCmd file =
-  ghciCreateTagsFile CTagsWithLineNumbers file
-
-createCTagsWithRegExesCmd ""   =
-  ghciCreateTagsFile CTagsWithRegExes "tags"
-createCTagsWithRegExesCmd file =
-  ghciCreateTagsFile CTagsWithRegExes file
-
-createETagsFileCmd ""    = ghciCreateTagsFile ETags "TAGS"
-createETagsFileCmd file  = ghciCreateTagsFile ETags file
-
-data TagsKind = ETags | CTagsWithLineNumbers | CTagsWithRegExes
-
-ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
-ghciCreateTagsFile kind file = do
-  createTagsFile kind file
-
--- ToDo: 
---      - remove restriction that all modules must be interpreted
---        (problem: we don't know source locations for entities unless
---        we compiled the module.
---
---      - extract createTagsFile so it can be used from the command-line
---        (probably need to fix first problem before this is useful).
---
-createTagsFile :: TagsKind -> FilePath -> GHCi ()
-createTagsFile tagskind tagsFile = do
-  graph <- GHC.getModuleGraph
-  mtags <- mapM listModuleTags (map GHC.ms_mod graph)
-  either_res <- liftIO $ collateAndWriteTags tagskind tagsFile $ concat mtags
-  case either_res of
-    Left e  -> liftIO $ hPutStrLn stderr $ ioeGetErrorString e
-    Right _ -> return ()
-
-
-listModuleTags :: GHC.Module -> GHCi [TagInfo]
-listModuleTags m = do
-  is_interpreted <- GHC.moduleIsInterpreted m
-  -- should we just skip these?
-  when (not is_interpreted) $
-    let mName = GHC.moduleNameString (GHC.moduleName m) in
-    throwGhcException (CmdLineError ("module '" ++ mName ++ "' is not interpreted"))
-  mbModInfo <- GHC.getModuleInfo m
-  case mbModInfo of
-    Nothing -> return []
-    Just mInfo -> do
-       dflags <- getDynFlags
-       mb_print_unqual <- GHC.mkPrintUnqualifiedForModule mInfo
-       let unqual = fromMaybe GHC.alwaysQualify mb_print_unqual
-       let names = fromMaybe [] $GHC.modInfoTopLevelScope mInfo
-       let localNames = filter ((m==) . nameModule) names
-       mbTyThings <- mapM GHC.lookupName localNames
-       return $! [ tagInfo dflags unqual exported kind name realLoc
-                     | tyThing <- catMaybes mbTyThings
-                     , let name = getName tyThing
-                     , let exported = GHC.modInfoIsExportedName mInfo name
-                     , let kind = tyThing2TagKind tyThing
-                     , let loc = srcSpanStart (nameSrcSpan name)
-                     , RealSrcLoc realLoc <- [loc]
-                     ]
-
-  where
-    tyThing2TagKind (AnId _)                 = 'v'
-    tyThing2TagKind (AConLike RealDataCon{}) = 'd'
-    tyThing2TagKind (AConLike PatSynCon{})   = 'p'
-    tyThing2TagKind (ATyCon _)               = 't'
-    tyThing2TagKind (ACoAxiom _)             = 'x'
-
-
-data TagInfo = TagInfo
-  { tagExported :: Bool -- is tag exported
-  , tagKind :: Char   -- tag kind
-  , tagName :: String -- tag name
-  , tagFile :: String -- file name
-  , tagLine :: Int    -- line number
-  , tagCol :: Int     -- column number
-  , tagSrcInfo :: Maybe (String,Integer)  -- source code line and char offset
-  }
-
-
--- get tag info, for later translation into Vim or Emacs style
-tagInfo :: DynFlags -> PrintUnqualified -> Bool -> Char -> Name -> RealSrcLoc
-        -> TagInfo
-tagInfo dflags unqual exported kind name loc
-    = TagInfo exported kind
-        (showSDocForUser dflags unqual $ pprOccName (nameOccName name))
-        (showSDocForUser dflags unqual $ ftext (srcLocFile loc))
-        (srcLocLine loc) (srcLocCol loc) Nothing
-
-
-collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
--- ctags style with the Ex exresion being just the line number, Vim et al
-collateAndWriteTags CTagsWithLineNumbers file tagInfos = do
-  let tags = unlines $ sort $ map showCTag tagInfos
-  tryIO (writeFile file tags)
-
--- ctags style with the Ex exresion being a regex searching the line, Vim et al
-collateAndWriteTags CTagsWithRegExes file tagInfos = do -- ctags style, Vim et al
-  tagInfoGroups <- makeTagGroupsWithSrcInfo tagInfos
-  let tags = unlines $ sort $ map showCTag $concat tagInfoGroups
-  tryIO (writeFile file tags)
-
-collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
-  tagInfoGroups <- makeTagGroupsWithSrcInfo $filter tagExported tagInfos
-  let tagGroups = map processGroup tagInfoGroups
-  tryIO (writeFile file $ concat tagGroups)
-
-  where
-    processGroup [] = throwGhcException (CmdLineError "empty tag file group??")
-    processGroup group@(tagInfo:_) =
-      let tags = unlines $ map showETag group in
-      "\x0c\n" ++ tagFile tagInfo ++ "," ++ show (length tags) ++ "\n" ++ tags
-
-
-makeTagGroupsWithSrcInfo :: [TagInfo] -> IO [[TagInfo]]
-makeTagGroupsWithSrcInfo tagInfos = do
-  let groups = groupBy ((==) `on` tagFile) $ sortBy (comparing tagFile) tagInfos
-  mapM addTagSrcInfo groups
-
-  where
-    addTagSrcInfo [] = throwGhcException (CmdLineError "empty tag file group??")
-    addTagSrcInfo group@(tagInfo:_) = do
-      file <- readFile $tagFile tagInfo
-      let sortedGroup = sortBy (comparing tagLine) group
-      return $ perFile sortedGroup 1 0 $ lines file
-
-    perFile allTags@(tag:tags) cnt pos allLs@(l:ls)
-     | tagLine tag > cnt =
-         perFile allTags (cnt+1) (pos+fromIntegral(length l)) ls
-     | tagLine tag == cnt =
-         tag{ tagSrcInfo = Just(l,pos) } : perFile tags cnt pos allLs
-    perFile _ _ _ _ = []
-
-
--- ctags format, for Vim et al
-showCTag :: TagInfo -> String
-showCTag ti =
-  tagName ti ++ "\t" ++ tagFile ti ++ "\t" ++ tagCmd ++ ";\"\t" ++
-    tagKind ti : ( if tagExported ti then "" else "\tfile:" )
-
-  where
-    tagCmd =
-      case tagSrcInfo ti of
-        Nothing -> show $tagLine ti
-        Just (srcLine,_) -> "/^"++ foldr escapeSlashes [] srcLine ++"$/"
-
-      where
-        escapeSlashes '/' r = '\\' : '/' : r
-        escapeSlashes '\\' r = '\\' : '\\' : r
-        escapeSlashes c r = c : r
-
-
--- etags format, for Emacs/XEmacs
-showETag :: TagInfo -> String
-showETag TagInfo{ tagName = tag, tagLine = lineNo, tagCol = colNo,
-                  tagSrcInfo = Just (srcLine,charPos) }
-    =  take (colNo - 1) srcLine ++ tag
-    ++ "\x7f" ++ tag
-    ++ "\x01" ++ show lineNo
-    ++ "," ++ show charPos
-showETag _ = throwGhcException (CmdLineError "missing source file info in showETag")
-
diff --git a/src-bin/HsVersions.h b/src-bin/HsVersions.h
deleted file mode 100644
--- a/src-bin/HsVersions.h
+++ /dev/null
@@ -1,44 +0,0 @@
-#ifndef HSVERSIONS_H
-#define HSVERSIONS_H
-
-/* Global variables may not work in other Haskell implementations,
- * but we need them currently! so the conditional on GLASGOW won't do. */
-#if defined(__GLASGOW_HASKELL__) || !defined(__GLASGOW_HASKELL__)
-#define GLOBAL_VAR(name,value,ty)  \
-{-# NOINLINE name #-};             \
-name :: IORef (ty);                \
-name = Util.global (value);
-
-#define GLOBAL_VAR_M(name,value,ty) \
-{-# NOINLINE name #-};              \
-name :: IORef (ty);                 \
-name = Util.globalM (value);
-#endif
-
-#define ASSERT(e)      if debugIsOn && not (e) then (assertPanic __FILE__ __LINE__) else
-#define ASSERT2(e,msg) if debugIsOn && not (e) then (assertPprPanic __FILE__ __LINE__ (msg)) else
-#define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) $
-
--- Examples:   Assuming   flagSet :: String -> m Bool
---
---    do { c   <- getChar; MASSERT( isUpper c ); ... }
---    do { c   <- getChar; MASSERT2( isUpper c, text "Bad" ); ... }
---    do { str <- getStr;  ASSERTM( flagSet str ); .. }
---    do { str <- getStr;  ASSERTM2( flagSet str, text "Bad" ); .. }
---    do { str <- getStr;  WARNM2( flagSet str, text "Flag is set" ); .. }
-#define MASSERT(e)      ASSERT(e) return ()
-#define MASSERT2(e,msg) ASSERT2(e,msg) return ()
-#define ASSERTM(e)      do { bool <- e; MASSERT(bool) }
-#define ASSERTM2(e,msg) do { bool <- e; MASSERT2(bool,msg) }
-#define WARNM2(e,msg)   do { bool <- e; WARN(bool, msg) return () }
-
--- Useful for declaring arguments to be strict
-#define STRICT1(f) f a | a `seq` False = undefined
-#define STRICT2(f) f a b | a `seq` b `seq` False = undefined
-#define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined
-#define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined
-#define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined
-#define STRICT6(f) f a b c d e f | a `seq` b `seq` c `seq` d `seq` e `seq` f `seq` False = undefined
-
-#endif /* HsVersions.h */
-
diff --git a/src-bin/InteractiveUI.hs b/src-bin/InteractiveUI.hs
deleted file mode 100644
--- a/src-bin/InteractiveUI.hs
+++ /dev/null
@@ -1,3306 +0,0 @@
-{-# LANGUAGE CPP, MagicHash, NondecreasingIndentation, TupleSections #-}
-{-# OPTIONS -fno-cse #-}
--- -fno-cse is needed for GLOBAL_VAR's to behave properly
-
------------------------------------------------------------------------------
---
--- GHC Interactive User Interface
---
--- (c) The GHC Team 2005-2006
---
------------------------------------------------------------------------------
-
-module InteractiveUI (
-        interactiveUI,
-        GhciSettings(..),
-        defaultGhciSettings,
-        ghciCommands,
-        ghciWelcomeMsg,
-        makeHDL
-    ) where
-
-#include "HsVersions.h"
-
--- GHCi
-import qualified GhciMonad ( args, runStmt )
-import GhciMonad hiding ( args, runStmt )
-import GhciTags
-import Debugger
-
--- The GHC interface
-import DynFlags
-import ErrUtils
-import GhcMonad ( modifySession )
-import qualified GHC
-import GHC ( LoadHowMuch(..), Target(..),  TargetId(..), InteractiveImport(..),
-             TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc,
-             handleSourceError )
-import HsImpExp
-import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC,
-                  setInteractivePrintName )
-import Module
-import Name
-import Packages ( trusted, getPackageDetails, listVisibleModuleNames, pprFlag )
-import PprTyThing
-import RdrName ( getGRE_NameQualifier_maybes )
-import SrcLoc
-import qualified Lexer
-
-import StringBuffer
-import Outputable hiding ( printForUser, printForUserPartWay, bold )
-
--- Other random utilities
-import BasicTypes hiding ( isTopLevel )
-import Digraph
-import Encoding
-import FastString
-import Linker
-import Maybes ( orElse, expectJust )
-import NameSet
-import Panic hiding ( showException )
-import Util
-
--- Haskell Libraries
-import System.Console.Haskeline as Haskeline
-
-import Control.Monad as Monad
-
-import Control.Applicative hiding (empty)
-import Control.Monad.Trans.Class
-import Control.Monad.IO.Class
-
-import Data.Array
-import qualified Data.ByteString.Char8 as BS
-import Data.Char
-import Data.Function
-import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
-import Data.List ( find, group, intercalate, intersperse, isPrefixOf, nub,
-                   partition, sort, sortBy )
-import Data.Maybe
-
-import Exception hiding (catch)
-
-import Foreign.C
-import Foreign
-
-import System.Directory
-import System.Environment
-import System.Exit ( exitWith, ExitCode(..) )
-import System.FilePath
-import System.IO
-import System.IO.Error
-import System.IO.Unsafe ( unsafePerformIO )
-import System.Process
-import Text.Printf
-import Text.Read ( readMaybe )
-
-#ifndef mingw32_HOST_OS
-import System.Posix hiding ( getEnv )
-#else
-import qualified System.Win32
-#endif
-
-import GHC.Exts ( unsafeCoerce# )
-import GHC.IO.Exception ( IOErrorType(InvalidArgument) )
-import GHC.IO.Handle ( hFlushAll )
-import GHC.TopHandler ( topHandler )
-
-import qualified CLaSH.Backend
-import           CLaSH.Backend.SystemVerilog (SystemVerilogState)
-import           CLaSH.Backend.VHDL (VHDLState)
-import           CLaSH.Backend.Verilog (VerilogState)
-import qualified CLaSH.Driver
-import           CLaSH.Driver.Types (CLaSHOpts(..))
-import           CLaSH.GHC.Evaluator
-import           CLaSH.GHC.GenerateBindings
-import           CLaSH.GHC.NetlistTypes
-import           CLaSH.Netlist.BlackBox.Types (HdlSyn)
-import           CLaSH.Util (clashLibVersion)
-import           Control.DeepSeq
-import qualified Data.Time.Clock as Clock
-import qualified Data.Version as Data.Version
-import qualified Paths_clash_ghc
-
------------------------------------------------------------------------------
-
-data GhciSettings = GhciSettings {
-        availableCommands :: [Command],
-        shortHelpText     :: String,
-        fullHelpText      :: String,
-        defPrompt         :: String,
-        defPrompt2        :: String
-    }
-
-defaultGhciSettings :: IORef CLaSHOpts -> GhciSettings
-defaultGhciSettings opts =
-    GhciSettings {
-        availableCommands = ghciCommands opts,
-        shortHelpText     = defShortHelpText,
-        fullHelpText      = defFullHelpText,
-        defPrompt         = default_prompt,
-        defPrompt2        = default_prompt2
-    }
-
-ghciWelcomeMsg :: String
-ghciWelcomeMsg = "CLaSHi, version " ++ Data.Version.showVersion Paths_clash_ghc.version ++
-                 " (using clash-lib, version " ++ Data.Version.showVersion clashLibVersion ++
-                 "):\nhttp://www.clash-lang.org/  :? for help"
-
-cmdName :: Command -> String
-cmdName (n,_,_) = n
-
-GLOBAL_VAR(macros_ref, [], [Command])
-
-ghciCommands :: IORef CLaSHOpts -> [Command]
-ghciCommands opts = [
-  -- Hugs users are accustomed to :e, so make sure it doesn't overlap
-  ("?",         keepGoing help,                 noCompletion),
-  ("add",       keepGoingPaths addModule,       completeFilename),
-  ("abandon",   keepGoing abandonCmd,           noCompletion),
-  ("break",     keepGoing breakCmd,             completeIdentifier),
-  ("back",      keepGoing backCmd,              noCompletion),
-  ("browse",    keepGoing' (browseCmd False),   completeModule),
-  ("browse!",   keepGoing' (browseCmd True),    completeModule),
-  ("cd",        keepGoing' changeDirectory,     completeFilename),
-  ("check",     keepGoing' checkModule,         completeHomeModule),
-  ("continue",  keepGoing continueCmd,          noCompletion),
-  ("complete",  keepGoing completeCmd,          noCompletion),
-  ("cmd",       keepGoing cmdCmd,               completeExpression),
-  ("ctags",     keepGoing createCTagsWithLineNumbersCmd, completeFilename),
-  ("ctags!",    keepGoing createCTagsWithRegExesCmd, completeFilename),
-  ("def",       keepGoing (defineMacro False),  completeExpression),
-  ("def!",      keepGoing (defineMacro True),   completeExpression),
-  ("delete",    keepGoing deleteCmd,            noCompletion),
-  ("edit",      keepGoing' editFile,            completeFilename),
-  ("etags",     keepGoing createETagsFileCmd,   completeFilename),
-  ("force",     keepGoing forceCmd,             completeExpression),
-  ("forward",   keepGoing forwardCmd,           noCompletion),
-  ("help",      keepGoing help,                 noCompletion),
-  ("history",   keepGoing historyCmd,           noCompletion),
-  ("info",      keepGoing' (info False),        completeIdentifier),
-  ("info!",     keepGoing' (info True),         completeIdentifier),
-  ("issafe",    keepGoing' isSafeCmd,           completeModule),
-  ("kind",      keepGoing' (kindOfType False),  completeIdentifier),
-  ("kind!",     keepGoing' (kindOfType True),   completeIdentifier),
-  ("load",      keepGoingPaths loadModule_,     completeHomeModuleOrFile),
-  ("list",      keepGoing' listCmd,             noCompletion),
-  ("module",    keepGoing moduleCmd,            completeSetModule),
-  ("main",      keepGoing runMain,              completeFilename),
-  ("print",     keepGoing printCmd,             completeExpression),
-  ("quit",      quit,                           noCompletion),
-  ("reload",    keepGoing' reloadModule,        noCompletion),
-  ("run",       keepGoing runRun,               completeFilename),
-  ("script",    keepGoing' scriptCmd,           completeFilename),
-  ("set",       keepGoing setCmd,               completeSetOptions),
-  ("seti",      keepGoing setiCmd,              completeSeti),
-  ("show",      keepGoing showCmd,              completeShowOptions),
-  ("showi",     keepGoing showiCmd,             completeShowiOptions),
-  ("sprint",    keepGoing sprintCmd,            completeExpression),
-  ("step",      keepGoing stepCmd,              completeIdentifier),
-  ("steplocal", keepGoing stepLocalCmd,         completeIdentifier),
-  ("stepmodule",keepGoing stepModuleCmd,        completeIdentifier),
-  ("type",      keepGoing' typeOfExpr,          completeExpression),
-  ("trace",     keepGoing traceCmd,             completeExpression),
-  ("undef",     keepGoing undefineMacro,        completeMacro),
-  ("unset",     keepGoing unsetOptions,         completeSetOptions),
-  ("vhdl",      keepGoingPaths (makeVHDL opts),        completeHomeModuleOrFile),
-  ("verilog",   keepGoingPaths (makeVerilog opts),     completeHomeModuleOrFile),
-  ("systemverilog",   keepGoingPaths (makeSystemVerilog opts),     completeHomeModuleOrFile)
-  ]
-
-
--- We initialize readline (in the interactiveUI function) to use
--- word_break_chars as the default set of completion word break characters.
--- This can be overridden for a particular command (for example, filename
--- expansion shouldn't consider '/' to be a word break) by setting the third
--- entry in the Command tuple above.
---
--- NOTE: in order for us to override the default correctly, any custom entry
--- must be a SUBSET of word_break_chars.
-word_break_chars :: String
-word_break_chars = let symbols = "!#$%&*+/<=>?@\\^|-~"
-                       specials = "(),;[]`{}"
-                       spaces = " \t\n"
-                   in spaces ++ specials ++ symbols
-
-flagWordBreakChars :: String
-flagWordBreakChars = " \t\n"
-
-
-keepGoing :: (String -> GHCi ()) -> (String -> InputT GHCi Bool)
-keepGoing a str = keepGoing' (lift . a) str
-
-keepGoing' :: Monad m => (String -> m ()) -> String -> m Bool
-keepGoing' a str = a str >> return False
-
-keepGoingPaths :: ([FilePath] -> InputT GHCi ()) -> (String -> InputT GHCi Bool)
-keepGoingPaths a str
- = do case toArgs str of
-          Left err -> liftIO $ hPutStrLn stderr err
-          Right args -> a args
-      return False
-
-defShortHelpText :: String
-defShortHelpText = "use :? for help.\n"
-
-defFullHelpText :: String
-defFullHelpText =
-  " Commands available from the prompt:\n" ++
-  "\n" ++
-  "   <statement>                 evaluate/run <statement>\n" ++
-  "   :                           repeat last command\n" ++
-  "   :{\\n ..lines.. \\n:}\\n       multiline command\n" ++
-  "   :add [*]<module> ...        add module(s) to the current target set\n" ++
-  "   :browse[!] [[*]<mod>]       display the names defined by module <mod>\n" ++
-  "                               (!: more details; *: all top-level names)\n" ++
-  "   :cd <dir>                   change directory to <dir>\n" ++
-  "   :cmd <expr>                 run the commands returned by <expr>::IO String\n" ++
-  "   :complete <dom> [<rng>] <s> list completions for partial input string\n" ++
-  "   :ctags[!] [<file>]          create tags file for Vi (default: \"tags\")\n" ++
-  "                               (!: use regex instead of line number)\n" ++
-  "   :def <cmd> <expr>           define command :<cmd> (later defined command has\n" ++
-  "                               precedence, ::<cmd> is always a builtin command)\n" ++
-  "   :edit <file>                edit file\n" ++
-  "   :edit                       edit last module\n" ++
-  "   :etags [<file>]             create tags file for Emacs (default: \"TAGS\")\n" ++
-  "   :help, :?                   display this list of commands\n" ++
-  "   :info[!] [<name> ...]       display information about the given names\n" ++
-  "                               (!: do not filter instances)\n" ++
-  "   :issafe [<mod>]             display safe haskell information of module <mod>\n" ++
-  "   :kind[!] <type>             show the kind of <type>\n" ++
-  "                               (!: also print the normalised type)\n" ++
-  "   :load [*]<module> ...       load module(s) and their dependents\n" ++
-  "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
-  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
-  "   :quit                       exit GHCi\n" ++
-  "   :reload                     reload the current module set\n" ++
-  "   :run function [<arguments> ...] run the function with the given arguments\n" ++
-  "   :script <filename>          run the script <filename>\n" ++
-  "   :type <expr>                show the type of <expr>\n" ++
-  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
-  "   :!<command>                 run the shell command <command>\n" ++
-  "   :vhdl                       synthesize currently loaded module to vhdl\n" ++
-  "   :vhdl [<module>]            synthesize specified modules/files to vhdl\n" ++
-  "   :verilog                    synthesize currently loaded module to verilog\n" ++
-  "   :verilog [<module>]         synthesize specified modules/files to verilog\n" ++
-  "   :systemverilog              synthesize currently loaded module to systemverilog\n" ++
-  "   :systemverilog [<module>]   synthesize specified modules/files to systemverilog\n" ++
-  "\n" ++
-  " -- Commands for debugging:\n" ++
-  "\n" ++
-  "   :abandon                    at a breakpoint, abandon current computation\n" ++
-  "   :back                       go back in the history (after :trace)\n" ++
-  "   :break [<mod>] <l> [<col>]  set a breakpoint at the specified location\n" ++
-  "   :break <name>               set a breakpoint on the specified function\n" ++
-  "   :continue                   resume after a breakpoint\n" ++
-  "   :delete <number>            delete the specified breakpoint\n" ++
-  "   :delete *                   delete all breakpoints\n" ++
-  "   :force <expr>               print <expr>, forcing unevaluated parts\n" ++
-  "   :forward                    go forward in the history (after :back)\n" ++
-  "   :history [<n>]              after :trace, show the execution history\n" ++
-  "   :list                       show the source code around current breakpoint\n" ++
-  "   :list <identifier>          show the source code for <identifier>\n" ++
-  "   :list [<module>] <line>     show the source code around line number <line>\n" ++
-  "   :print [<name> ...]         show a value without forcing its computation\n" ++
-  "   :sprint [<name> ...]        simplified version of :print\n" ++
-  "   :step                       single-step after stopping at a breakpoint\n"++
-  "   :step <expr>                single-step into <expr>\n"++
-  "   :steplocal                  single-step within the current top-level binding\n"++
-  "   :stepmodule                 single-step restricted to the current module\n"++
-  "   :trace                      trace after stopping at a breakpoint\n"++
-  "   :trace <expr>               evaluate <expr> with tracing on (see :history)\n"++
-
-  "\n" ++
-  " -- Commands for changing settings:\n" ++
-  "\n" ++
-  "   :set <option> ...           set options\n" ++
-  "   :seti <option> ...          set options for interactive evaluation only\n" ++
-  "   :set args <arg> ...         set the arguments returned by System.getArgs\n" ++
-  "   :set prog <progname>        set the value returned by System.getProgName\n" ++
-  "   :set prompt <prompt>        set the prompt used in GHCi\n" ++
-  "   :set prompt2 <prompt>       set the continuation prompt used in GHCi\n" ++
-  "   :set editor <cmd>           set the command used for :edit\n" ++
-  "   :set stop [<n>] <cmd>       set the command to run when a breakpoint is hit\n" ++
-  "   :unset <option> ...         unset options\n" ++
-  "\n" ++
-  "  Options for ':set' and ':unset':\n" ++
-  "\n" ++
-  "    +m            allow multiline commands\n" ++
-  "    +r            revert top-level expressions after each evaluation\n" ++
-  "    +s            print timing/memory stats after each evaluation\n" ++
-  "    +t            print type after evaluation\n" ++
-  "    -<flags>      most GHC command line flags can also be set here\n" ++
-  "                         (eg. -v2, -XFlexibleInstances, etc.)\n" ++
-  "                    for GHCi-specific flags, see User's Guide,\n"++
-  "                    Flag reference, Interactive-mode options\n" ++
-  "\n" ++
-  " -- Commands for displaying information:\n" ++
-  "\n" ++
-  "   :show bindings              show the current bindings made at the prompt\n" ++
-  "   :show breaks                show the active breakpoints\n" ++
-  "   :show context               show the breakpoint context\n" ++
-  "   :show imports               show the current imports\n" ++
-  "   :show linker                show current linker state\n" ++
-  "   :show modules               show the currently loaded modules\n" ++
-  "   :show packages              show the currently active package flags\n" ++
-  "   :show paths                 show the currently active search paths\n" ++
-  "   :show language              show the currently active language flags\n" ++
-  "   :show <setting>             show value of <setting>, which is one of\n" ++
-  "                                  [args, prog, prompt, editor, stop]\n" ++
-  "   :showi language             show language flags for interactive evaluation\n" ++
-  "\n"
-
-findEditor :: IO String
-findEditor = do
-  getEnv "EDITOR"
-    `catchIO` \_ -> do
-#if mingw32_HOST_OS
-        win <- System.Win32.getWindowsDirectory
-        return (win </> "notepad.exe")
-#else
-        return ""
-#endif
-
-foreign import ccall unsafe "rts_isProfiled" isProfiled :: IO CInt
-
-default_progname, default_prompt, default_prompt2, default_stop :: String
-default_progname = "<interactive>"
-default_prompt = "%s> "
-default_prompt2 = "%s| "
-default_stop = ""
-
-default_args :: [String]
-default_args = []
-
-interactiveUI :: GhciSettings -> [(FilePath, Maybe Phase)] -> Maybe [String]
-              -> Ghc ()
-interactiveUI config srcs maybe_exprs = do
-   -- although GHCi compiles with -prof, it is not usable: the byte-code
-   -- compiler and interpreter don't work with profiling.  So we check for
-   -- this up front and emit a helpful error message (#2197)
-   i <- liftIO $ isProfiled
-   when (i /= 0) $
-     throwGhcException (InstallationError "GHCi cannot be used when compiled with -prof")
-
-   -- HACK! If we happen to get into an infinite loop (eg the user
-   -- types 'let x=x in x' at the prompt), then the thread will block
-   -- on a blackhole, and become unreachable during GC.  The GC will
-   -- detect that it is unreachable and send it the NonTermination
-   -- exception.  However, since the thread is unreachable, everything
-   -- it refers to might be finalized, including the standard Handles.
-   -- This sounds like a bug, but we don't have a good solution right
-   -- now.
-   _ <- liftIO $ newStablePtr stdin
-   _ <- liftIO $ newStablePtr stdout
-   _ <- liftIO $ newStablePtr stderr
-
-    -- Initialise buffering for the *interpreted* I/O system
-   initInterpBuffering
-
-   -- The initial set of DynFlags used for interactive evaluation is the same
-   -- as the global DynFlags, plus -XExtendedDefaultRules and
-   -- -XNoMonomorphismRestriction.
-   dflags <- getDynFlags
-   let dflags' = (`xopt_set` Opt_ExtendedDefaultRules)
-               . (`xopt_unset` Opt_MonomorphismRestriction)
-               $ dflags
-   GHC.setInteractiveDynFlags dflags'
-
-   lastErrLocationsRef <- liftIO $ newIORef []
-   progDynFlags <- GHC.getProgramDynFlags
-   _ <- GHC.setProgramDynFlags $
-      progDynFlags { log_action = ghciLogAction lastErrLocationsRef }
-
-   liftIO $ when (isNothing maybe_exprs) $ do
-        -- Only for GHCi (not runghc and ghc -e):
-
-        -- Turn buffering off for the compiled program's stdout/stderr
-        turnOffBuffering
-        -- Turn buffering off for GHCi's stdout
-        hFlush stdout
-        hSetBuffering stdout NoBuffering
-        -- We don't want the cmd line to buffer any input that might be
-        -- intended for the program, so unbuffer stdin.
-        hSetBuffering stdin NoBuffering
-        hSetBuffering stderr NoBuffering
-#if defined(mingw32_HOST_OS)
-        -- On Unix, stdin will use the locale encoding.  The IO library
-        -- doesn't do this on Windows (yet), so for now we use UTF-8,
-        -- for consistency with GHC 6.10 and to make the tests work.
-        hSetEncoding stdin utf8
-#endif
-
-   default_editor <- liftIO $ findEditor
-   startGHCi (runGHCi srcs maybe_exprs)
-        GHCiState{ progname           = default_progname,
-                   GhciMonad.args     = default_args,
-                   prompt             = defPrompt config,
-                   prompt2            = defPrompt2 config,
-                   stop               = default_stop,
-                   editor             = default_editor,
-                   options            = [],
-                   line_number        = 1,
-                   break_ctr          = 0,
-                   breaks             = [],
-                   tickarrays         = emptyModuleEnv,
-                   ghci_commands      = availableCommands config,
-                   last_command       = Nothing,
-                   cmdqueue           = [],
-                   remembered_ctx     = [],
-                   transient_ctx      = [],
-                   ghc_e              = isJust maybe_exprs,
-                   short_help         = shortHelpText config,
-                   long_help          = fullHelpText config,
-                   lastErrorLocations = lastErrLocationsRef
-                 }
-
-   return ()
-
-resetLastErrorLocations :: GHCi ()
-resetLastErrorLocations = do
-    st <- getGHCiState
-    liftIO $ writeIORef (lastErrorLocations st) []
-
-ghciLogAction :: IORef [(FastString, Int)] ->  LogAction
-ghciLogAction lastErrLocations dflags severity srcSpan style msg = do
-    defaultLogAction dflags severity srcSpan style msg
-    case severity of
-        SevError -> case srcSpan of
-            RealSrcSpan rsp -> modifyIORef lastErrLocations
-                (++ [(srcLocFile (realSrcSpanStart rsp), srcLocLine (realSrcSpanStart rsp))])
-            _ -> return ()
-        _ -> return ()
-
-withGhcAppData :: (FilePath -> IO a) -> IO a -> IO a
-withGhcAppData right left = do
-    either_dir <- tryIO (getAppUserDataDirectory "clash")
-    case either_dir of
-        Right dir ->
-            do createDirectoryIfMissing False dir `catchIO` \_ -> return ()
-               right dir
-        _ -> left
-
-runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
-runGHCi paths maybe_exprs = do
-  dflags <- getDynFlags
-  let
-   read_dot_files = not (gopt Opt_IgnoreDotGhci dflags)
-
-   current_dir = return (Just ".clashi")
-
-   app_user_dir = liftIO $ withGhcAppData
-                    (\dir -> return (Just (dir </> "clashi.conf")))
-                    (return Nothing)
-
-   home_dir = do
-    either_dir <- liftIO $ tryIO (getEnv "HOME")
-    case either_dir of
-      Right home -> return (Just (home </> ".clashi"))
-      _ -> return Nothing
-
-   canonicalizePath' :: FilePath -> IO (Maybe FilePath)
-   canonicalizePath' fp = liftM Just (canonicalizePath fp)
-                `catchIO` \_ -> return Nothing
-
-   sourceConfigFile :: (FilePath, Bool) -> GHCi ()
-   sourceConfigFile (file, check_perms) = do
-     exists <- liftIO $ doesFileExist file
-     when exists $ do
-       perms_ok <-
-         if not check_perms
-            then return True
-            else do
-              dir_ok  <- liftIO $ checkPerms (getDirectory file)
-              file_ok <- liftIO $ checkPerms file
-              return (dir_ok && file_ok)
-       when perms_ok $ do
-         either_hdl <- liftIO $ tryIO (openFile file ReadMode)
-         case either_hdl of
-           Left _e   -> return ()
-           -- NOTE: this assumes that runInputT won't affect the terminal;
-           -- can we assume this will always be the case?
-           -- This would be a good place for runFileInputT.
-           Right hdl ->
-               do runInputTWithPrefs defaultPrefs defaultSettings $
-                            runCommands $ fileLoop hdl
-                  liftIO (hClose hdl `catchIO` \_ -> return ())
-     where
-      getDirectory f = case takeDirectory f of "" -> "."; d -> d
-  --
-
-  setGHCContextFromGHCiState
-
-  when (read_dot_files) $ do
-    mcfgs0 <- catMaybes <$> sequence [ current_dir, app_user_dir, home_dir ]
-    let mcfgs1 = zip mcfgs0 (repeat True)
-              ++ zip (ghciScripts dflags) (repeat False)
-         -- False says "don't check permissions".  We don't
-         -- require that a script explicitly added by
-         -- -ghci-script is owned by the current user. (#6017)
-    mcfgs <- liftIO $ mapM (\(f, b) -> (,b) <$> canonicalizePath' f) mcfgs1
-    mapM_ sourceConfigFile $ nub $ [ (f,b) | (Just f, b) <- mcfgs ]
-        -- nub, because we don't want to read .ghci twice if the
-        -- CWD is $HOME.
-
-  -- Perform a :load for files given on the GHCi command line
-  -- When in -e mode, if the load fails then we want to stop
-  -- immediately rather than going on to evaluate the expression.
-  when (not (null paths)) $ do
-     ok <- ghciHandle (\e -> do showException e; return Failed) $
-                -- TODO: this is a hack.
-                runInputTWithPrefs defaultPrefs defaultSettings $
-                    loadModule paths
-     when (isJust maybe_exprs && failed ok) $
-        liftIO (exitWith (ExitFailure 1))
-
-  installInteractivePrint (interactivePrint dflags) (isJust maybe_exprs)
-
-  -- if verbosity is greater than 0, or we are connected to a
-  -- terminal, display the prompt in the interactive loop.
-  is_tty <- liftIO (hIsTerminalDevice stdin)
-  let show_prompt = verbosity dflags > 0 || is_tty
-
-  -- reset line number
-  getGHCiState >>= \st -> setGHCiState st{line_number=1}
-
-  case maybe_exprs of
-        Nothing ->
-          do
-            -- enter the interactive loop
-            runGHCiInput $ runCommands $ nextInputLine show_prompt is_tty
-        Just exprs -> do
-            -- just evaluate the expression we were given
-            enqueueCommands exprs
-            let hdle e = do st <- getGHCiState
-                            -- flush the interpreter's stdout/stderr on exit (#3890)
-                            flushInterpBuffers
-                            -- Jump through some hoops to get the
-                            -- current progname in the exception text:
-                            -- <progname>: <exception>
-                            liftIO $ withProgName (progname st)
-                                   $ topHandler e
-                                   -- this used to be topHandlerFastExit, see #2228
-            runInputTWithPrefs defaultPrefs defaultSettings $ do
-                -- make `ghc -e` exit nonzero on invalid input, see Trac #7962
-                runCommands' hdle (Just $ hdle (toException $ ExitFailure 1) >> return ()) (return Nothing)
-
-  -- and finally, exit
-  liftIO $ when (verbosity dflags > 0) $ putStrLn "Leaving CLaSHi."
-
-runGHCiInput :: InputT GHCi a -> GHCi a
-runGHCiInput f = do
-    dflags <- getDynFlags
-    histFile <- if gopt Opt_GhciHistory dflags
-                then liftIO $ withGhcAppData (\dir -> return (Just (dir </> "clashi_history")))
-                                             (return Nothing)
-                else return Nothing
-    runInputT
-        (setComplete ghciCompleteWord $ defaultSettings {historyFile = histFile})
-        f
-
--- | How to get the next input line from the user
-nextInputLine :: Bool -> Bool -> InputT GHCi (Maybe String)
-nextInputLine show_prompt is_tty
-  | is_tty = do
-    prmpt <- if show_prompt then lift mkPrompt else return ""
-    r <- getInputLine prmpt
-    incrementLineNo
-    return r
-  | otherwise = do
-    when show_prompt $ lift mkPrompt >>= liftIO . putStr
-    fileLoop stdin
-
--- NOTE: We only read .ghci files if they are owned by the current user,
--- and aren't world writable (files owned by root are ok, see #9324).
--- Otherwise, we could be accidentally running code planted by
--- a malicious third party.
-
--- Furthermore, We only read ./.ghci if . is owned by the current user
--- and isn't writable by anyone else.  I think this is sufficient: we
--- don't need to check .. and ../.. etc. because "."  always refers to
--- the same directory while a process is running.
-
-checkPerms :: String -> IO Bool
-#ifdef mingw32_HOST_OS
-checkPerms _ = return True
-#else
-checkPerms name =
-  handleIO (\_ -> return False) $ do
-    st <- getFileStatus name
-    me <- getRealUserID
-    let mode = System.Posix.fileMode st
-        ok = (fileOwner st == me || fileOwner st == 0) &&
-             groupWriteMode /= mode `intersectFileModes` groupWriteMode &&
-             otherWriteMode /= mode `intersectFileModes` otherWriteMode
-    unless ok $
-      putStrLn $ "*** WARNING: " ++ name ++
-                 " is writable by someone else, IGNORING!"
-    return ok
-#endif
-
-incrementLineNo :: InputT GHCi ()
-incrementLineNo = do
-   st <- lift $ getGHCiState
-   let ln = 1+(line_number st)
-   lift $ setGHCiState st{line_number=ln}
-
-fileLoop :: Handle -> InputT GHCi (Maybe String)
-fileLoop hdl = do
-   l <- liftIO $ tryIO $ hGetLine hdl
-   case l of
-        Left e | isEOFError e              -> return Nothing
-               | -- as we share stdin with the program, the program
-                 -- might have already closed it, so we might get a
-                 -- handle-closed exception. We therefore catch that
-                 -- too.
-                 isIllegalOperation e      -> return Nothing
-               | InvalidArgument <- etype  -> return Nothing
-               | otherwise                 -> liftIO $ ioError e
-                where etype = ioeGetErrorType e
-                -- treat InvalidArgument in the same way as EOF:
-                -- this can happen if the user closed stdin, or
-                -- perhaps did getContents which closes stdin at
-                -- EOF.
-        Right l' -> do
-           incrementLineNo
-           return (Just l')
-
-mkPrompt :: GHCi String
-mkPrompt = do
-  st <- getGHCiState
-  imports <- GHC.getContext
-  resumes <- GHC.getResumeContext
-
-  context_bit <-
-        case resumes of
-            [] -> return empty
-            r:_ -> do
-                let ix = GHC.resumeHistoryIx r
-                if ix == 0
-                   then return (brackets (ppr (GHC.resumeSpan r)) <> space)
-                   else do
-                        let hist = GHC.resumeHistory r !! (ix-1)
-                        pan <- GHC.getHistorySpan hist
-                        return (brackets (ppr (negate ix) <> char ':'
-                                          <+> ppr pan) <> space)
-  let
-        dots | _:rs <- resumes, not (null rs) = text "... "
-             | otherwise = empty
-
-        rev_imports = reverse imports -- rightmost are the most recent
-        modules_bit =
-             hsep [ char '*' <> ppr m | IIModule m <- rev_imports ] <+>
-             hsep (map ppr [ myIdeclName d | IIDecl d <- rev_imports ])
-
-         --  use the 'as' name if there is one
-        myIdeclName d | Just m <- ideclAs d = m
-                      | otherwise           = unLoc (ideclName d)
-
-        deflt_prompt = dots <> context_bit <> modules_bit
-
-        f ('%':'l':xs) = ppr (1 + line_number st) <> f xs
-        f ('%':'s':xs) = deflt_prompt <> f xs
-        f ('%':'%':xs) = char '%' <> f xs
-        f (x:xs) = char x <> f xs
-        f [] = empty
-
-  dflags <- getDynFlags
-  return (showSDoc dflags (f (prompt st)))
-
-
-queryQueue :: GHCi (Maybe String)
-queryQueue = do
-  st <- getGHCiState
-  case cmdqueue st of
-    []   -> return Nothing
-    c:cs -> do setGHCiState st{ cmdqueue = cs }
-               return (Just c)
-
--- Reconfigurable pretty-printing Ticket #5461
-installInteractivePrint :: Maybe String -> Bool -> GHCi ()
-installInteractivePrint Nothing _  = return ()
-installInteractivePrint (Just ipFun) exprmode = do
-  ok <- trySuccess $ do
-                (name:_) <- GHC.parseName ipFun
-                modifySession (\he -> let new_ic = setInteractivePrintName (hsc_IC he) name
-                                      in he{hsc_IC = new_ic})
-                return Succeeded
-
-  when (failed ok && exprmode) $ liftIO (exitWith (ExitFailure 1))
-
--- | The main read-eval-print loop
-runCommands :: InputT GHCi (Maybe String) -> InputT GHCi ()
-runCommands = runCommands' handler Nothing
-
-runCommands' :: (SomeException -> GHCi Bool) -- ^ Exception handler
-             -> Maybe (GHCi ()) -- ^ Source error handler
-             -> InputT GHCi (Maybe String) -> InputT GHCi ()
-runCommands' eh sourceErrorHandler gCmd = do
-    b <- ghandle (\e -> case fromException e of
-                          Just UserInterrupt -> return $ Just False
-                          _ -> case fromException e of
-                                 Just ghce ->
-                                   do liftIO (print (ghce :: GhcException))
-                                      return Nothing
-                                 _other ->
-                                   liftIO (Exception.throwIO e))
-            (runOneCommand eh gCmd)
-    case b of
-      Nothing -> return ()
-      Just success -> do
-        when (not success) $ maybe (return ()) lift sourceErrorHandler
-        runCommands' eh sourceErrorHandler gCmd
-
--- | Evaluate a single line of user input (either :<command> or Haskell code).
--- A result of Nothing means there was no more input to process.
--- Otherwise the result is Just b where b is True if the command succeeded;
--- this is relevant only to ghc -e, which will exit with status 1
--- if the commmand was unsuccessful. GHCi will continue in either case.
-runOneCommand :: (SomeException -> GHCi Bool) -> InputT GHCi (Maybe String)
-            -> InputT GHCi (Maybe Bool)
-runOneCommand eh gCmd = do
-  -- run a previously queued command if there is one, otherwise get new
-  -- input from user
-  mb_cmd0 <- noSpace (lift queryQueue)
-  mb_cmd1 <- maybe (noSpace gCmd) (return . Just) mb_cmd0
-  case mb_cmd1 of
-    Nothing -> return Nothing
-    Just c  -> ghciHandle (\e -> lift $ eh e >>= return . Just) $
-             handleSourceError printErrorAndFail
-               (doCommand c)
-               -- source error's are handled by runStmt
-               -- is the handler necessary here?
-  where
-    printErrorAndFail err = do
-        GHC.printException err
-        return $ Just False     -- Exit ghc -e, but not GHCi
-
-    noSpace q = q >>= maybe (return Nothing)
-                            (\c -> case removeSpaces c of
-                                     ""   -> noSpace q
-                                     ":{" -> multiLineCmd q
-                                     _    -> return (Just c) )
-    multiLineCmd q = do
-      st <- lift getGHCiState
-      let p = prompt st
-      lift $ setGHCiState st{ prompt = prompt2 st }
-      mb_cmd <- collectCommand q "" `GHC.gfinally` lift (getGHCiState >>= \st' -> setGHCiState st' { prompt = p })
-      return mb_cmd
-    -- we can't use removeSpaces for the sublines here, so
-    -- multiline commands are somewhat more brittle against
-    -- fileformat errors (such as \r in dos input on unix),
-    -- we get rid of any extra spaces for the ":}" test;
-    -- we also avoid silent failure if ":}" is not found;
-    -- and since there is no (?) valid occurrence of \r (as
-    -- opposed to its String representation, "\r") inside a
-    -- ghci command, we replace any such with ' ' (argh:-(
-    collectCommand q c = q >>=
-      maybe (liftIO (ioError collectError))
-            (\l->if removeSpaces l == ":}"
-                 then return (Just c)
-                 else collectCommand q (c ++ "\n" ++ map normSpace l))
-      where normSpace '\r' = ' '
-            normSpace   x  = x
-    -- SDM (2007-11-07): is userError the one to use here?
-    collectError = userError "unterminated multiline command :{ .. :}"
-
-    -- | Handle a line of input
-    doCommand :: String -> InputT GHCi (Maybe Bool)
-
-    -- command
-    doCommand stmt | (':' : cmd) <- removeSpaces stmt = do
-      result <- specialCommand cmd
-      case result of
-        True -> return Nothing
-        _    -> return $ Just True
-
-    -- haskell
-    doCommand stmt = do
-      -- if 'stmt' was entered via ':{' it will contain '\n's
-      let stmt_nl_cnt = length [ () | '\n' <- stmt ]
-      ml <- lift $ isOptionSet Multiline
-      if ml && stmt_nl_cnt == 0 -- don't trigger automatic multi-line mode for ':{'-multiline input
-        then do
-          fst_line_num <- lift (line_number <$> getGHCiState)
-          mb_stmt <- checkInputForLayout stmt gCmd
-          case mb_stmt of
-            Nothing      -> return $ Just True
-            Just ml_stmt -> do
-              -- temporarily compensate line-number for multi-line input
-              result <- timeIt $ lift $ runStmtWithLineNum fst_line_num ml_stmt GHC.RunToCompletion
-              return $ Just result
-        else do -- single line input and :{-multiline input
-          last_line_num <- lift (line_number <$> getGHCiState)
-          -- reconstruct first line num from last line num and stmt
-          let fst_line_num | stmt_nl_cnt > 0 = last_line_num - (stmt_nl_cnt2 + 1)
-                           | otherwise = last_line_num -- single line input
-              stmt_nl_cnt2 = length [ () | '\n' <- stmt' ]
-              stmt' = dropLeadingWhiteLines stmt -- runStmt doesn't like leading empty lines
-          -- temporarily compensate line-number for multi-line input
-          result <- timeIt $ lift $ runStmtWithLineNum fst_line_num stmt' GHC.RunToCompletion
-          return $ Just result
-
-    -- runStmt wrapper for temporarily overridden line-number
-    runStmtWithLineNum :: Int -> String -> SingleStep -> GHCi Bool
-    runStmtWithLineNum lnum stmt step = do
-        st0 <- getGHCiState
-        setGHCiState st0 { line_number = lnum }
-        result <- runStmt stmt step
-        -- restore original line_number
-        getGHCiState >>= \st -> setGHCiState st { line_number = line_number st0 }
-        return result
-
-    -- note: this is subtly different from 'unlines . dropWhile (all isSpace) . lines'
-    dropLeadingWhiteLines s | (l0,'\n':r) <- break (=='\n') s
-                            , all isSpace l0 = dropLeadingWhiteLines r
-                            | otherwise = s
-
-
--- #4316
--- lex the input.  If there is an unclosed layout context, request input
-checkInputForLayout :: String -> InputT GHCi (Maybe String)
-                    -> InputT GHCi (Maybe String)
-checkInputForLayout stmt getStmt = do
-   dflags' <- lift $ getDynFlags
-   let dflags = xopt_set dflags' Opt_AlternativeLayoutRule
-   st0 <- lift $ getGHCiState
-   let buf'   =  stringToStringBuffer stmt
-       loc    = mkRealSrcLoc (fsLit (progname st0)) (line_number st0) 1
-       pstate = Lexer.mkPState dflags buf' loc
-   case Lexer.unP goToEnd pstate of
-     (Lexer.POk _ False) -> return $ Just stmt
-     _other              -> do
-       st1 <- lift getGHCiState
-       let p = prompt st1
-       lift $ setGHCiState st1{ prompt = prompt2 st1 }
-       mb_stmt <- ghciHandle (\ex -> case fromException ex of
-                            Just UserInterrupt -> return Nothing
-                            _ -> case fromException ex of
-                                 Just ghce ->
-                                   do liftIO (print (ghce :: GhcException))
-                                      return Nothing
-                                 _other -> liftIO (Exception.throwIO ex))
-                     getStmt
-       lift $ getGHCiState >>= \st' -> setGHCiState st'{ prompt = p }
-       -- the recursive call does not recycle parser state
-       -- as we use a new string buffer
-       case mb_stmt of
-         Nothing  -> return Nothing
-         Just str -> if str == ""
-           then return $ Just stmt
-           else do
-             checkInputForLayout (stmt++"\n"++str) getStmt
-     where goToEnd = do
-             eof <- Lexer.nextIsEOF
-             if eof
-               then Lexer.activeContext
-               else Lexer.lexer False return >> goToEnd
-
-enqueueCommands :: [String] -> GHCi ()
-enqueueCommands cmds = do
-  st <- getGHCiState
-  setGHCiState st{ cmdqueue = cmds ++ cmdqueue st }
-
--- | If we one of these strings prefixes a command, then we treat it as a decl
--- rather than a stmt. NB that the appropriate decl prefixes depends on the
--- flag settings (Trac #9915)
-declPrefixes :: DynFlags -> [String]
-declPrefixes dflags = keywords ++ concat opt_keywords
-  where
-    keywords = [ "class ", "instance "
-               , "data ", "newtype ", "type "
-               , "default ", "default("
-               ]
-
-    opt_keywords = [ ["foreign "  | xopt Opt_ForeignFunctionInterface dflags]
-                   , ["deriving " | xopt Opt_StandaloneDeriving dflags]
-                   , ["pattern "  | xopt Opt_PatternSynonyms dflags]
-                   ]
-
--- | Entry point to execute some haskell code from user.
--- The return value True indicates success, as in `runOneCommand`.
-runStmt :: String -> SingleStep -> GHCi Bool
-runStmt stmt step
- -- empty; this should be impossible anyways since we filtered out
- -- whitespace-only input in runOneCommand's noSpace
- | null (filter (not.isSpace) stmt)
- = return True
-
- -- import
- | stmt `looks_like` "import "
- = do addImportToContext stmt; return True
-
- | otherwise
- = do dflags <- getDynFlags
-      if any (stmt `looks_like`) (declPrefixes dflags)
-        then run_decl
-        else run_stmt
-  where
-    run_decl =
-        do _ <- liftIO $ tryIO $ hFlushAll stdin
-           result <- GhciMonad.runDecls stmt
-           afterRunStmt (const True) (GHC.RunOk result)
-
-    run_stmt =
-        do -- In the new IO library, read handles buffer data even if the Handle
-           -- is set to NoBuffering.  This causes problems for GHCi where there
-           -- are really two stdin Handles.  So we flush any bufferred data in
-           -- GHCi's stdin Handle here (only relevant if stdin is attached to
-           -- a file, otherwise the read buffer can't be flushed).
-           _ <- liftIO $ tryIO $ hFlushAll stdin
-           m_result <- GhciMonad.runStmt stmt step
-           case m_result of
-               Nothing     -> return False
-               Just result -> afterRunStmt (const True) result
-
-    s `looks_like` prefix = prefix `isPrefixOf` dropWhile isSpace s
-       -- Ignore leading spaces (see Trac #9914), so that
-       --    ghci>   data T = T
-       -- (note leading spaces) works properly
-
--- | Clean up the GHCi environment after a statement has run
-afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool
-afterRunStmt _ (GHC.RunException e) = liftIO $ Exception.throwIO e
-afterRunStmt step_here run_result = do
-  resumes <- GHC.getResumeContext
-  case run_result of
-     GHC.RunOk names -> do
-        show_types <- isOptionSet ShowType
-        when show_types $ printTypeOfNames names
-     GHC.RunBreak _ names mb_info
-         | isNothing  mb_info ||
-           step_here (GHC.resumeSpan $ head resumes) -> do
-               mb_id_loc <- toBreakIdAndLocation mb_info
-               let bCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc
-               if (null bCmd)
-                 then printStoppedAtBreakInfo (head resumes) names
-                 else enqueueCommands [bCmd]
-               -- run the command set with ":set stop <cmd>"
-               st <- getGHCiState
-               enqueueCommands [stop st]
-               return ()
-         | otherwise -> resume step_here GHC.SingleStep >>=
-                        afterRunStmt step_here >> return ()
-     _ -> return ()
-
-  flushInterpBuffers
-  liftIO installSignalHandlers
-  b <- isOptionSet RevertCAFs
-  when b revertCAFs
-
-  return (case run_result of GHC.RunOk _ -> True; _ -> False)
-
-toBreakIdAndLocation ::
-  Maybe GHC.BreakInfo -> GHCi (Maybe (Int, BreakLocation))
-toBreakIdAndLocation Nothing = return Nothing
-toBreakIdAndLocation (Just inf) = do
-  let md = GHC.breakInfo_module inf
-      nm = GHC.breakInfo_number inf
-  st <- getGHCiState
-  return $ listToMaybe [ id_loc | id_loc@(_,loc) <- breaks st,
-                                  breakModule loc == md,
-                                  breakTick loc == nm ]
-
-printStoppedAtBreakInfo :: Resume -> [Name] -> GHCi ()
-printStoppedAtBreakInfo res names = do
-  printForUser $ ptext (sLit "Stopped at") <+>
-    ppr (GHC.resumeSpan res)
-  --  printTypeOfNames session names
-  let namesSorted = sortBy compareNames names
-  tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted
-  docs <- mapM pprTypeAndContents [i | AnId i <- tythings]
-  printForUserPartWay $ vcat docs
-
-printTypeOfNames :: [Name] -> GHCi ()
-printTypeOfNames names
- = mapM_ (printTypeOfName ) $ sortBy compareNames names
-
-compareNames :: Name -> Name -> Ordering
-n1 `compareNames` n2 = compareWith n1 `compare` compareWith n2
-    where compareWith n = (getOccString n, getSrcSpan n)
-
-printTypeOfName :: Name -> GHCi ()
-printTypeOfName n
-   = do maybe_tything <- GHC.lookupName n
-        case maybe_tything of
-            Nothing    -> return ()
-            Just thing -> printTyThing thing
-
-
-data MaybeCommand = GotCommand Command | BadCommand | NoLastCommand
-
--- | Entry point for execution a ':<command>' input from user
-specialCommand :: String -> InputT GHCi Bool
-specialCommand ('!':str) = lift $ shellEscape (dropWhile isSpace str)
-specialCommand str = do
-  let (cmd,rest) = break isSpace str
-  maybe_cmd <- lift $ lookupCommand cmd
-  htxt <- lift $ short_help `fmap` getGHCiState
-  case maybe_cmd of
-    GotCommand (_,f,_) -> f (dropWhile isSpace rest)
-    BadCommand ->
-      do liftIO $ hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
-                           ++ htxt)
-         return False
-    NoLastCommand ->
-      do liftIO $ hPutStr stdout ("there is no last command to perform\n"
-                           ++ htxt)
-         return False
-
-shellEscape :: String -> GHCi Bool
-shellEscape str = liftIO (system str >> return False)
-
-lookupCommand :: String -> GHCi (MaybeCommand)
-lookupCommand "" = do
-  st <- getGHCiState
-  case last_command st of
-      Just c -> return $ GotCommand c
-      Nothing -> return NoLastCommand
-lookupCommand str = do
-  mc <- lookupCommand' str
-  st <- getGHCiState
-  setGHCiState st{ last_command = mc }
-  return $ case mc of
-           Just c -> GotCommand c
-           Nothing -> BadCommand
-
-lookupCommand' :: String -> GHCi (Maybe Command)
-lookupCommand' ":" = return Nothing
-lookupCommand' str' = do
-  macros    <- liftIO $ readIORef macros_ref
-  ghci_cmds <- ghci_commands `fmap` getGHCiState
-  let (str, xcmds) = case str' of
-          ':' : rest -> (rest, [])     -- "::" selects a builtin command
-          _          -> (str', macros) -- otherwise include macros in lookup
-
-      lookupExact  s = find $ (s ==)           . cmdName
-      lookupPrefix s = find $ (s `isPrefixOf`) . cmdName
-
-      builtinPfxMatch = lookupPrefix str ghci_cmds
-
-  -- first, look for exact match (while preferring macros); then, look
-  -- for first prefix match (preferring builtins), *unless* a macro
-  -- overrides the builtin; see #8305 for motivation
-  return $ lookupExact str xcmds <|>
-           lookupExact str ghci_cmds <|>
-           (builtinPfxMatch >>= \c -> lookupExact (cmdName c) xcmds) <|>
-           builtinPfxMatch <|>
-           lookupPrefix str xcmds
-
-getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
-getCurrentBreakSpan = do
-  resumes <- GHC.getResumeContext
-  case resumes of
-    [] -> return Nothing
-    (r:_) -> do
-        let ix = GHC.resumeHistoryIx r
-        if ix == 0
-           then return (Just (GHC.resumeSpan r))
-           else do
-                let hist = GHC.resumeHistory r !! (ix-1)
-                pan <- GHC.getHistorySpan hist
-                return (Just pan)
-
-getCurrentBreakModule :: GHCi (Maybe Module)
-getCurrentBreakModule = do
-  resumes <- GHC.getResumeContext
-  case resumes of
-    [] -> return Nothing
-    (r:_) -> do
-        let ix = GHC.resumeHistoryIx r
-        if ix == 0
-           then return (GHC.breakInfo_module `liftM` GHC.resumeBreakInfo r)
-           else do
-                let hist = GHC.resumeHistory r !! (ix-1)
-                return $ Just $ GHC.getHistoryModule  hist
-
------------------------------------------------------------------------------
---
--- Commands
---
------------------------------------------------------------------------------
-
-noArgs :: GHCi () -> String -> GHCi ()
-noArgs m "" = m
-noArgs _ _  = liftIO $ putStrLn "This command takes no arguments"
-
-withSandboxOnly :: String -> GHCi () -> GHCi ()
-withSandboxOnly cmd this = do
-   dflags <- getDynFlags
-   if not (gopt Opt_GhciSandbox dflags)
-      then printForUser (text cmd <+>
-                         ptext (sLit "is not supported with -fno-ghci-sandbox"))
-      else this
-
------------------------------------------------------------------------------
--- :help
-
-help :: String -> GHCi ()
-help _ = do
-    txt <- long_help `fmap` getGHCiState
-    liftIO $ putStr txt
-
------------------------------------------------------------------------------
--- :info
-
-info :: Bool -> String -> InputT GHCi ()
-info _ "" = throwGhcException (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
-info allInfo s  = handleSourceError GHC.printException $ do
-    unqual <- GHC.getPrintUnqual
-    dflags <- getDynFlags
-    sdocs  <- mapM (infoThing allInfo) (words s)
-    mapM_ (liftIO . putStrLn . showSDocForUser dflags unqual) sdocs
-
-infoThing :: GHC.GhcMonad m => Bool -> String -> m SDoc
-infoThing allInfo str = do
-    names     <- GHC.parseName str
-    mb_stuffs <- mapM (GHC.getInfo allInfo) names
-    let filtered = filterOutChildren (\(t,_f,_ci,_fi) -> t) (catMaybes mb_stuffs)
-    return $ vcat (intersperse (text "") $ map pprInfo filtered)
-
-  -- Filter out names whose parent is also there Good
-  -- example is '[]', which is both a type and data
-  -- constructor in the same type
-filterOutChildren :: (a -> TyThing) -> [a] -> [a]
-filterOutChildren get_thing xs
-  = filterOut has_parent xs
-  where
-    all_names = mkNameSet (map (getName . get_thing) xs)
-    has_parent x = case tyThingParent_maybe (get_thing x) of
-                     Just p  -> getName p `elemNameSet` all_names
-                     Nothing -> False
-
-pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst]) -> SDoc
-pprInfo (thing, fixity, cls_insts, fam_insts)
-  =  pprTyThingInContextLoc thing
-  $$ show_fixity
-  $$ vcat (map GHC.pprInstance cls_insts)
-  $$ vcat (map GHC.pprFamInst  fam_insts)
-  where
-    show_fixity
-        | fixity == GHC.defaultFixity = empty
-        | otherwise                   = ppr fixity <+> pprInfixName (GHC.getName thing)
-
------------------------------------------------------------------------------
--- :main
-
-runMain :: String -> GHCi ()
-runMain s = case toArgs s of
-            Left err   -> liftIO (hPutStrLn stderr err)
-            Right args ->
-                do dflags <- getDynFlags
-                   let main = fromMaybe "main" (mainFunIs dflags)
-                   -- Wrap the main function in 'void' to discard its value instead
-                   -- of printing it (#9086). See Haskell 2010 report Chapter 5.
-                   doWithArgs args $ "Control.Monad.void (" ++ main ++ ")"
-
------------------------------------------------------------------------------
--- :run
-
-runRun :: String -> GHCi ()
-runRun s = case toCmdArgs s of
-           Left err          -> liftIO (hPutStrLn stderr err)
-           Right (cmd, args) -> doWithArgs args cmd
-
-doWithArgs :: [String] -> String -> GHCi ()
-doWithArgs args cmd = enqueueCommands ["System.Environment.withArgs " ++
-                                       show args ++ " (" ++ cmd ++ ")"]
-
------------------------------------------------------------------------------
--- :cd
-
-changeDirectory :: String -> InputT GHCi ()
-changeDirectory "" = do
-  -- :cd on its own changes to the user's home directory
-  either_dir <- liftIO $ tryIO getHomeDirectory
-  case either_dir of
-     Left _e -> return ()
-     Right dir -> changeDirectory dir
-changeDirectory dir = do
-  graph <- GHC.getModuleGraph
-  when (not (null graph)) $
-        liftIO $ putStrLn "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed."
-  GHC.setTargets []
-  _ <- GHC.load LoadAllTargets
-  lift $ setContextAfterLoad False []
-  GHC.workingDirectoryChanged
-  dir' <- expandPath dir
-  liftIO $ setCurrentDirectory dir'
-
-trySuccess :: GHC.GhcMonad m => m SuccessFlag -> m SuccessFlag
-trySuccess act =
-    handleSourceError (\e -> do GHC.printException e
-                                return Failed) $ do
-      act
-
------------------------------------------------------------------------------
--- :edit
-
-editFile :: String -> InputT GHCi ()
-editFile str =
-  do file <- if null str then lift chooseEditFile else expandPath str
-     st <- lift getGHCiState
-     errs <- liftIO $ readIORef $ lastErrorLocations st
-     let cmd = editor st
-     when (null cmd)
-       $ throwGhcException (CmdLineError "editor not set, use :set editor")
-     lineOpt <- liftIO $ do
-         curFileErrs <- filterM (\(f, _) -> unpackFS f `sameFile` file) errs
-         return $ case curFileErrs of
-             (_, line):_ -> " +" ++ show line
-             _ -> ""
-     let cmdArgs = ' ':(file ++ lineOpt)
-     code <- liftIO $ system (cmd ++ cmdArgs)
-
-     when (code == ExitSuccess)
-       $ reloadModule ""
-
--- The user didn't specify a file so we pick one for them.
--- Our strategy is to pick the first module that failed to load,
--- or otherwise the first target.
---
--- XXX: Can we figure out what happened if the depndecy analysis fails
---      (e.g., because the porgrammeer mistyped the name of a module)?
--- XXX: Can we figure out the location of an error to pass to the editor?
--- XXX: if we could figure out the list of errors that occured during the
--- last load/reaload, then we could start the editor focused on the first
--- of those.
-chooseEditFile :: GHCi String
-chooseEditFile =
-  do let hasFailed x = fmap not $ GHC.isLoaded $ GHC.ms_mod_name x
-
-     graph <- GHC.getModuleGraph
-     failed_graph <- filterM hasFailed graph
-     let order g  = flattenSCCs $ GHC.topSortModuleGraph True g Nothing
-         pick xs  = case xs of
-                      x : _ -> GHC.ml_hs_file (GHC.ms_location x)
-                      _     -> Nothing
-
-     case pick (order failed_graph) of
-       Just file -> return file
-       Nothing   ->
-         do targets <- GHC.getTargets
-            case msum (map fromTarget targets) of
-              Just file -> return file
-              Nothing   -> throwGhcException (CmdLineError "No files to edit.")
-
-  where fromTarget (GHC.Target (GHC.TargetFile f _) _ _) = Just f
-        fromTarget _ = Nothing -- when would we get a module target?
-
-
------------------------------------------------------------------------------
--- :def
-
-defineMacro :: Bool{-overwrite-} -> String -> GHCi ()
-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)
-  let defined = map cmdName macros
-  if (null macro_name)
-        then if null defined
-                then liftIO $ putStrLn "no macros defined"
-                else liftIO $ putStr ("the following macros are defined:\n" ++
-                                      unlines defined)
-        else do
-  if (not overwrite && macro_name `elem` defined)
-        then throwGhcException (CmdLineError
-                ("macro '" ++ macro_name ++ "' is already defined"))
-        else do
-
-  let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ]
-
-  -- 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
-  handleSourceError (\e -> GHC.printException e) $
-   do
-    hv <- GHC.compileExpr new_expr
-    liftIO (writeIORef macros_ref -- later defined macros have precedence
-            ((macro_name, lift . runMacro hv, noCompletion) : filtered))
-
-runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
-runMacro fun s = do
-  str <- liftIO ((unsafeCoerce# fun :: String -> IO String) s)
-  -- make sure we force any exceptions in the result, while we are still
-  -- inside the exception handler for commands:
-  seqList str (return ())
-  enqueueCommands (lines str)
-  return False
-
-
------------------------------------------------------------------------------
--- :undef
-
-undefineMacro :: String -> GHCi ()
-undefineMacro str = mapM_ undef (words str)
- where undef macro_name = do
-        cmds <- liftIO (readIORef macros_ref)
-        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))
-
-
------------------------------------------------------------------------------
--- :cmd
-
-cmdCmd :: String -> GHCi ()
-cmdCmd str = do
-  let expr = '(' : str ++ ") :: IO String"
-  handleSourceError (\e -> GHC.printException e) $
-   do
-    hv <- GHC.compileExpr expr
-    cmds <- liftIO $ (unsafeCoerce# hv :: IO String)
-    enqueueCommands (lines cmds)
-    return ()
-
-
------------------------------------------------------------------------------
--- :check
-
-checkModule :: String -> InputT GHCi ()
-checkModule m = do
-  let modl = GHC.mkModuleName m
-  ok <- handleSourceError (\e -> GHC.printException e >> return False) $ do
-          r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl
-          dflags <- getDynFlags
-          liftIO $ putStrLn $ showSDoc dflags $
-           case GHC.moduleInfo r of
-             cm | Just scope <- GHC.modInfoTopLevelScope cm ->
-                let
-                    (loc, glob) = ASSERT( all isExternalName scope )
-                                  partition ((== modl) . GHC.moduleName . GHC.nameModule) scope
-                in
-                        (text "global names: " <+> ppr glob) $$
-                        (text "local  names: " <+> ppr loc)
-             _ -> empty
-          return True
-  afterLoad (successIf ok) False
-
-
------------------------------------------------------------------------------
--- :load, :add, :reload
-
-loadModule :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag
-loadModule fs = timeIt (loadModule' fs)
-
-loadModule_ :: [FilePath] -> InputT GHCi ()
-loadModule_ fs = loadModule (zip fs (repeat Nothing)) >> return ()
-
-loadModule' :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag
-loadModule' files = do
-  let (filenames, phases) = unzip files
-  exp_filenames <- mapM expandPath filenames
-  let files' = zip exp_filenames phases
-  targets <- mapM (uncurry GHC.guessTarget) files'
-
-  -- NOTE: we used to do the dependency anal first, so that if it
-  -- fails we didn't throw away the current set of modules.  This would
-  -- require some re-working of the GHC interface, so we'll leave it
-  -- as a ToDo for now.
-
-  -- unload first
-  _ <- GHC.abandonAll
-  lift discardActiveBreakPoints
-  GHC.setTargets []
-  _ <- GHC.load LoadAllTargets
-
-  GHC.setTargets targets
-  doLoad False LoadAllTargets
-
-
--- :add
-addModule :: [FilePath] -> InputT GHCi ()
-addModule files = do
-  lift revertCAFs -- always revert CAFs on load/add.
-  files' <- mapM expandPath files
-  targets <- mapM (\m -> GHC.guessTarget m Nothing) files'
-  -- remove old targets with the same id; e.g. for :add *M
-  mapM_ GHC.removeTarget [ tid | Target tid _ _ <- targets ]
-  mapM_ GHC.addTarget targets
-  _ <- doLoad False LoadAllTargets
-  return ()
-
-
--- :reload
-reloadModule :: String -> InputT GHCi ()
-reloadModule m = do
-  _ <- doLoad True $
-        if null m then LoadAllTargets
-                  else LoadUpTo (GHC.mkModuleName m)
-  return ()
-
-
-doLoad :: Bool -> LoadHowMuch -> InputT GHCi SuccessFlag
-doLoad retain_context howmuch = do
-  -- turn off breakpoints before we load: we can't turn them off later, because
-  -- the ModBreaks will have gone away.
-  lift discardActiveBreakPoints
-
-  lift resetLastErrorLocations
-  -- Enable buffering stdout and stderr as we're compiling. Keeping these
-  -- handles unbuffered will just slow the compilation down, especially when
-  -- compiling in parallel.
-  gbracket (liftIO $ do hSetBuffering stdout LineBuffering
-                        hSetBuffering stderr LineBuffering)
-           (\_ ->
-            liftIO $ do hSetBuffering stdout NoBuffering
-                        hSetBuffering stderr NoBuffering) $ \_ -> do
-      ok <- trySuccess $ GHC.load howmuch
-      afterLoad ok retain_context
-      return ok
-
-
-afterLoad :: SuccessFlag
-          -> Bool   -- keep the remembered_ctx, as far as possible (:reload)
-          -> InputT GHCi ()
-afterLoad ok retain_context = do
-  lift revertCAFs  -- always revert CAFs on load.
-  lift discardTickArrays
-  loaded_mod_summaries <- getLoadedModules
-  let loaded_mods = map GHC.ms_mod loaded_mod_summaries
-  modulesLoadedMsg ok loaded_mods
-  lift $ setContextAfterLoad retain_context loaded_mod_summaries
-
-setContextAfterLoad :: Bool -> [GHC.ModSummary] -> GHCi ()
-setContextAfterLoad keep_ctxt [] = do
-  setContextKeepingPackageModules keep_ctxt []
-setContextAfterLoad keep_ctxt ms = do
-  -- load a target if one is available, otherwise load the topmost module.
-  targets <- GHC.getTargets
-  case [ m | Just m <- map (findTarget ms) targets ] of
-        []    ->
-          let graph' = flattenSCCs (GHC.topSortModuleGraph True ms Nothing) in
-          load_this (last graph')
-        (m:_) ->
-          load_this m
- where
-   findTarget mds t
-    = case filter (`matches` t) mds of
-        []    -> Nothing
-        (m:_) -> Just m
-
-   summary `matches` Target (TargetModule m) _ _
-        = GHC.ms_mod_name summary == m
-   summary `matches` Target (TargetFile f _) _ _
-        | Just f' <- GHC.ml_hs_file (GHC.ms_location summary)   = f == f'
-   _ `matches` _
-        = False
-
-   load_this summary | m <- GHC.ms_mod summary = do
-        is_interp <- GHC.moduleIsInterpreted m
-        dflags <- getDynFlags
-        let star_ok = is_interp && not (safeLanguageOn dflags)
-              -- We import the module with a * iff
-              --   - it is interpreted, and
-              --   - -XSafe is off (it doesn't allow *-imports)
-        let new_ctx | star_ok   = [mkIIModule (GHC.moduleName m)]
-                    | otherwise = [mkIIDecl   (GHC.moduleName m)]
-        setContextKeepingPackageModules keep_ctxt new_ctx
-
-
--- | Keep any package modules (except Prelude) when changing the context.
-setContextKeepingPackageModules
-        :: Bool                 -- True  <=> keep all of remembered_ctx
-                                -- False <=> just keep package imports
-        -> [InteractiveImport]  -- new context
-        -> GHCi ()
-
-setContextKeepingPackageModules keep_ctx trans_ctx = do
-
-  st <- getGHCiState
-  let rem_ctx = remembered_ctx st
-  new_rem_ctx <- if keep_ctx then return rem_ctx
-                             else keepPackageImports rem_ctx
-  setGHCiState st{ remembered_ctx = new_rem_ctx,
-                   transient_ctx  = filterSubsumed new_rem_ctx trans_ctx }
-  setGHCContextFromGHCiState
-
--- | Filters a list of 'InteractiveImport', clearing out any home package
--- imports so only imports from external packages are preserved.  ('IIModule'
--- counts as a home package import, because we are only able to bring a
--- full top-level into scope when the source is available.)
-keepPackageImports :: [InteractiveImport] -> GHCi [InteractiveImport]
-keepPackageImports = filterM is_pkg_import
-  where
-     is_pkg_import :: InteractiveImport -> GHCi Bool
-     is_pkg_import (IIModule _) = return False
-     is_pkg_import (IIDecl d)
-         = do e <- gtry $ GHC.findModule mod_name (ideclPkgQual d)
-              case e :: Either SomeException Module of
-                Left _  -> return False
-                Right m -> return (not (isHomeModule m))
-        where
-          mod_name = unLoc (ideclName d)
-
-
-modulesLoadedMsg :: SuccessFlag -> [Module] -> InputT GHCi ()
-modulesLoadedMsg ok mods = do
-  dflags <- getDynFlags
-  unqual <- GHC.getPrintUnqual
-  let mod_commas
-        | null mods = text "none."
-        | otherwise = hsep (
-            punctuate comma (map ppr mods)) <> text "."
-      status = case ok of
-                   Failed    -> text "Failed"
-                   Succeeded -> text "Ok"
-
-      msg = status <> text ", modules loaded:" <+> mod_commas
-
-  when (verbosity dflags > 0) $
-     liftIO $ putStrLn $ showSDocForUser dflags unqual msg
-
-makeHDL' :: CLaSH.Backend.Backend backend
-         => (Int -> HdlSyn -> backend)
-         -> IORef CLaSHOpts
-         -> [FilePath]
-         -> InputT GHCi ()
-makeHDL' backend opts lst = makeHDL backend opts =<< case lst of
-  srcs@(_:_) -> return srcs
-  []         -> do
-    modGraph <- GHC.getModuleGraph
-    let sortedGraph = GHC.topSortModuleGraph False modGraph Nothing
-    return $ case (reverse sortedGraph) of
-      ((AcyclicSCC top) : _) -> maybeToList $ (GHC.ml_hs_file . GHC.ms_location) top
-      _                      -> []
-
-makeHDL :: GHC.GhcMonad m
-        => CLaSH.Backend.Backend backend
-        => (Int -> HdlSyn -> backend)
-        -> IORef CLaSHOpts
-        -> [FilePath]
-        -> m ()
-makeHDL backend optsRef srcs = do
-  dflags <- GHC.getSessionDynFlags
-  liftIO $ do startTime <- Clock.getCurrentTime
-              opts  <- readIORef optsRef
-              let iw = opt_intWidth opts
-                  syn = opt_hdlSyn opts
-                  -- determine whether `-outputdir` was used
-                  outputDir = do odir <- objectDir dflags
-                                 hidir <- hiDir dflags
-                                 sdir <- stubDir dflags
-                                 ddir <- dumpDir dflags
-                                 if all (== odir) [hidir,sdir,ddir]
-                                    then Just odir
-                                    else Nothing
-                  opts' = opts {opt_hdlDir = maybe outputDir Just (opt_hdlDir opts)}
-              primDir <- CLaSH.Backend.primDir (backend iw syn)
-              forM_ srcs $ \src -> do
-                (bindingsMap,tcm,tupTcm,topEnt,testInpM,expOutM,primMap) <- generateBindings primDir src (Just dflags)
-                prepTime <- startTime `deepseq` bindingsMap `deepseq` tcm `deepseq` Clock.getCurrentTime
-                let prepStartDiff = Clock.diffUTCTime prepTime startTime
-                putStrLn $ "Loading dependencies took " ++ show prepStartDiff
-                CLaSH.Driver.generateHDL bindingsMap (Just (backend iw syn)) primMap tcm
-                  tupTcm (ghcTypeToHWType iw) reduceConstant topEnt testInpM expOutM opts' (startTime,prepTime)
-
-makeVHDL :: IORef CLaSHOpts -> [FilePath] -> InputT GHCi ()
-makeVHDL = makeHDL' (CLaSH.Backend.initBackend :: Int -> HdlSyn -> VHDLState)
-
-makeVerilog :: IORef CLaSHOpts -> [FilePath] -> InputT GHCi ()
-makeVerilog = makeHDL' (CLaSH.Backend.initBackend :: Int -> HdlSyn -> VerilogState)
-
-makeSystemVerilog :: IORef CLaSHOpts -> [FilePath] -> InputT GHCi ()
-makeSystemVerilog = makeHDL' (CLaSH.Backend.initBackend :: Int -> HdlSyn -> SystemVerilogState)
-
------------------------------------------------------------------------------
--- :type
-
-typeOfExpr :: String -> InputT GHCi ()
-typeOfExpr str
-  = handleSourceError GHC.printException
-  $ do
-       ty <- GHC.exprType str
-       printForUser $ sep [text str, nest 2 (dcolon <+> pprTypeForUser ty)]
-
------------------------------------------------------------------------------
--- :kind
-
-kindOfType :: Bool -> String -> InputT GHCi ()
-kindOfType norm str
-  = handleSourceError GHC.printException
-  $ do
-       (ty, kind) <- GHC.typeKind norm str
-       printForUser $ vcat [ text str <+> dcolon <+> pprTypeForUser kind
-                           , ppWhen norm $ equals <+> pprTypeForUser ty ]
-
-
------------------------------------------------------------------------------
--- :quit
-
-quit :: String -> InputT GHCi Bool
-quit _ = return True
-
-
------------------------------------------------------------------------------
--- :script
-
--- running a script file #1363
-
-scriptCmd :: String -> InputT GHCi ()
-scriptCmd ws = do
-  case words ws of
-    [s]    -> runScript s
-    _      -> throwGhcException (CmdLineError "syntax:  :script <filename>")
-
-runScript :: String    -- ^ filename
-           -> InputT GHCi ()
-runScript filename = do
-  filename' <- expandPath filename
-  either_script <- liftIO $ tryIO (openFile filename' ReadMode)
-  case either_script of
-    Left _err    -> throwGhcException (CmdLineError $ "IO error:  \""++filename++"\" "
-                      ++(ioeGetErrorString _err))
-    Right script -> do
-      st <- lift $ getGHCiState
-      let prog = progname st
-          line = line_number st
-      lift $ setGHCiState st{progname=filename',line_number=0}
-      scriptLoop script
-      liftIO $ hClose script
-      new_st <- lift $ getGHCiState
-      lift $ setGHCiState new_st{progname=prog,line_number=line}
-  where scriptLoop script = do
-          res <- runOneCommand handler $ fileLoop script
-          case res of
-            Nothing -> return ()
-            Just s  -> if s
-              then scriptLoop script
-              else return ()
-
------------------------------------------------------------------------------
--- :issafe
-
--- Displaying Safe Haskell properties of a module
-
-isSafeCmd :: String -> InputT GHCi ()
-isSafeCmd m =
-    case words m of
-        [s] | looksLikeModuleName s -> do
-            md <- lift $ lookupModule s
-            isSafeModule md
-        [] -> do md <- guessCurrentModule "issafe"
-                 isSafeModule md
-        _ -> throwGhcException (CmdLineError "syntax:  :issafe <module>")
-
-isSafeModule :: Module -> InputT GHCi ()
-isSafeModule m = do
-    mb_mod_info <- GHC.getModuleInfo m
-    when (isNothing mb_mod_info)
-         (throwGhcException $ CmdLineError $ "unknown module: " ++ mname)
-
-    dflags <- getDynFlags
-    let iface = GHC.modInfoIface $ fromJust mb_mod_info
-    when (isNothing iface)
-         (throwGhcException $ CmdLineError $ "can't load interface file for module: " ++
-                                    (GHC.moduleNameString $ GHC.moduleName m))
-
-    (msafe, pkgs) <- GHC.moduleTrustReqs m
-    let trust  = showPpr dflags $ getSafeMode $ GHC.mi_trust $ fromJust iface
-        pkg    = if packageTrusted dflags m then "trusted" else "untrusted"
-        (good, bad) = tallyPkgs dflags pkgs
-
-    -- print info to user...
-    liftIO $ putStrLn $ "Trust type is (Module: " ++ trust ++ ", Package: " ++ pkg ++ ")"
-    liftIO $ putStrLn $ "Package Trust: " ++ (if packageTrustOn dflags then "On" else "Off")
-    when (not $ null good)
-         (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++
-                        (intercalate ", " $ map (showPpr dflags) good))
-    case msafe && null bad of
-        True -> liftIO $ putStrLn $ mname ++ " is trusted!"
-        False -> do
-            when (not $ null bad)
-                 (liftIO $ putStrLn $ "Trusted package dependencies (untrusted): "
-                            ++ (intercalate ", " $ map (showPpr dflags) bad))
-            liftIO $ putStrLn $ mname ++ " is NOT trusted!"
-
-  where
-    mname = GHC.moduleNameString $ GHC.moduleName m
-
-    packageTrusted dflags md
-        | thisPackage dflags == modulePackageKey md = True
-        | otherwise = trusted $ getPackageDetails dflags (modulePackageKey md)
-
-    tallyPkgs dflags deps | not (packageTrustOn dflags) = ([], [])
-                          | otherwise = partition part deps
-        where part pkg = trusted $ getPackageDetails dflags pkg
-
------------------------------------------------------------------------------
--- :browse
-
--- Browsing a module's contents
-
-browseCmd :: Bool -> String -> InputT GHCi ()
-browseCmd bang m =
-  case words m of
-    ['*':s] | looksLikeModuleName s -> do
-        md <- lift $ wantInterpretedModule s
-        browseModule bang md False
-    [s] | looksLikeModuleName s -> do
-        md <- lift $ lookupModule s
-        browseModule bang md True
-    [] -> do md <- guessCurrentModule ("browse" ++ if bang then "!" else "")
-             browseModule bang md True
-    _ -> throwGhcException (CmdLineError "syntax:  :browse <module>")
-
-guessCurrentModule :: String -> InputT GHCi Module
--- Guess which module the user wants to browse.  Pick
--- modules that are interpreted first.  The most
--- recently-added module occurs last, it seems.
-guessCurrentModule cmd
-  = do imports <- GHC.getContext
-       when (null imports) $ throwGhcException $
-          CmdLineError (':' : cmd ++ ": no current module")
-       case (head imports) of
-          IIModule m -> GHC.findModule m Nothing
-          IIDecl d   -> GHC.findModule (unLoc (ideclName d)) (ideclPkgQual d)
-
--- without bang, show items in context of their parents and omit children
--- with bang, show class methods and data constructors separately, and
---            indicate import modules, to aid qualifying unqualified names
--- with sorted, sort items alphabetically
-browseModule :: Bool -> Module -> Bool -> InputT GHCi ()
-browseModule bang modl exports_only = do
-  -- :browse reports qualifiers wrt current context
-  unqual <- GHC.getPrintUnqual
-
-  mb_mod_info <- GHC.getModuleInfo modl
-  case mb_mod_info of
-    Nothing -> throwGhcException (CmdLineError ("unknown module: " ++
-                                GHC.moduleNameString (GHC.moduleName modl)))
-    Just mod_info -> do
-        dflags <- getDynFlags
-        let names
-               | exports_only = GHC.modInfoExports mod_info
-               | otherwise    = GHC.modInfoTopLevelScope mod_info
-                                `orElse` []
-
-                -- sort alphabetically name, but putting locally-defined
-                -- identifiers first. We would like to improve this; see #1799.
-            sorted_names = loc_sort local ++ occ_sort external
-                where
-                (local,external) = ASSERT( all isExternalName names )
-                                   partition ((==modl) . nameModule) names
-                occ_sort = sortBy (compare `on` nameOccName)
-                -- try to sort by src location. If the first name in our list
-                -- has a good source location, then they all should.
-                loc_sort ns
-                      | n:_ <- ns, isGoodSrcSpan (nameSrcSpan n)
-                      = sortBy (compare `on` nameSrcSpan) ns
-                      | otherwise
-                      = occ_sort ns
-
-        mb_things <- mapM GHC.lookupName sorted_names
-        let filtered_things = filterOutChildren (\t -> t) (catMaybes mb_things)
-
-        rdr_env <- GHC.getGRE
-
-        let things | bang      = catMaybes mb_things
-                   | otherwise = filtered_things
-            pretty | bang      = pprTyThing
-                   | otherwise = pprTyThingInContext
-
-            labels  [] = text "-- not currently imported"
-            labels  l  = text $ intercalate "\n" $ map qualifier l
-
-            qualifier :: Maybe [ModuleName] -> String
-            qualifier  = maybe "-- defined locally"
-                             (("-- imported via "++) . intercalate ", "
-                               . map GHC.moduleNameString)
-            importInfo = RdrName.getGRE_NameQualifier_maybes rdr_env
-
-            modNames :: [[Maybe [ModuleName]]]
-            modNames   = map (importInfo . GHC.getName) things
-
-            -- annotate groups of imports with their import modules
-            -- the default ordering is somewhat arbitrary, so we group
-            -- by header and sort groups; the names themselves should
-            -- really come in order of source appearance.. (trac #1799)
-            annotate mts = concatMap (\(m,ts)->labels m:ts)
-                         $ sortBy cmpQualifiers $ grp mts
-              where cmpQualifiers =
-                      compare `on` (map (fmap (map moduleNameFS)) . fst)
-            grp []            = []
-            grp mts@((m,_):_) = (m,map snd g) : grp ng
-              where (g,ng) = partition ((==m).fst) mts
-
-        let prettyThings, prettyThings' :: [SDoc]
-            prettyThings = map pretty things
-            prettyThings' | bang      = annotate $ zip modNames prettyThings
-                          | otherwise = prettyThings
-        liftIO $ putStrLn $ showSDocForUser dflags unqual (vcat prettyThings')
-        -- ToDo: modInfoInstances currently throws an exception for
-        -- package modules.  When it works, we can do this:
-        --        $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
-
-
------------------------------------------------------------------------------
--- :module
-
--- Setting the module context.  For details on context handling see
--- "remembered_ctx" and "transient_ctx" in GhciMonad.
-
-moduleCmd :: String -> GHCi ()
-moduleCmd str
-  | all sensible strs = cmd
-  | otherwise = throwGhcException (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
-  where
-    (cmd, strs) =
-        case str of
-          '+':stuff -> rest addModulesToContext   stuff
-          '-':stuff -> rest remModulesFromContext stuff
-          stuff     -> rest setContext            stuff
-
-    rest op stuff = (op as bs, stuffs)
-       where (as,bs) = partitionWith starred stuffs
-             stuffs  = words stuff
-
-    sensible ('*':m) = looksLikeModuleName m
-    sensible m       = looksLikeModuleName m
-
-    starred ('*':m) = Left  (GHC.mkModuleName m)
-    starred m       = Right (GHC.mkModuleName m)
-
-
--- -----------------------------------------------------------------------------
--- Four ways to manipulate the context:
---   (a) :module +<stuff>:     addModulesToContext
---   (b) :module -<stuff>:     remModulesFromContext
---   (c) :module <stuff>:      setContext
---   (d) import <module>...:   addImportToContext
-
-addModulesToContext :: [ModuleName] -> [ModuleName] -> GHCi ()
-addModulesToContext starred unstarred = restoreContextOnFailure $ do
-   addModulesToContext_ starred unstarred
-
-addModulesToContext_ :: [ModuleName] -> [ModuleName] -> GHCi ()
-addModulesToContext_ starred unstarred = do
-   mapM_ addII (map mkIIModule starred ++ map mkIIDecl unstarred)
-   setGHCContextFromGHCiState
-
-remModulesFromContext :: [ModuleName] -> [ModuleName] -> GHCi ()
-remModulesFromContext  starred unstarred = do
-   -- we do *not* call restoreContextOnFailure here.  If the user
-   -- is trying to fix up a context that contains errors by removing
-   -- modules, we don't want GHC to silently put them back in again.
-   mapM_ rm (starred ++ unstarred)
-   setGHCContextFromGHCiState
- where
-   rm :: ModuleName -> GHCi ()
-   rm str = do
-     m <- moduleName <$> lookupModuleName str
-     let filt = filter ((/=) m . iiModuleName)
-     modifyGHCiState $ \st ->
-        st { remembered_ctx = filt (remembered_ctx st)
-           , transient_ctx  = filt (transient_ctx st) }
-
-setContext :: [ModuleName] -> [ModuleName] -> GHCi ()
-setContext starred unstarred = restoreContextOnFailure $ do
-  modifyGHCiState $ \st -> st { remembered_ctx = [], transient_ctx = [] }
-                                -- delete the transient context
-  addModulesToContext_ starred unstarred
-
-addImportToContext :: String -> GHCi ()
-addImportToContext str = restoreContextOnFailure $ do
-  idecl <- GHC.parseImportDecl str
-  addII (IIDecl idecl)   -- #5836
-  setGHCContextFromGHCiState
-
--- Util used by addImportToContext and addModulesToContext
-addII :: InteractiveImport -> GHCi ()
-addII iidecl = do
-  checkAdd iidecl
-  modifyGHCiState $ \st ->
-     st { remembered_ctx = addNotSubsumed iidecl (remembered_ctx st)
-        , transient_ctx = filter (not . (iidecl `iiSubsumes`))
-                                 (transient_ctx st)
-        }
-
--- Sometimes we can't tell whether an import is valid or not until
--- we finally call 'GHC.setContext'.  e.g.
---
---   import System.IO (foo)
---
--- will fail because System.IO does not export foo.  In this case we
--- don't want to store the import in the context permanently, so we
--- catch the failure from 'setGHCContextFromGHCiState' and set the
--- context back to what it was.
---
--- See #6007
---
-restoreContextOnFailure :: GHCi a -> GHCi a
-restoreContextOnFailure do_this = do
-  st <- getGHCiState
-  let rc = remembered_ctx st; tc = transient_ctx st
-  do_this `gonException` (modifyGHCiState $ \st' ->
-     st' { remembered_ctx = rc, transient_ctx = tc })
-
--- -----------------------------------------------------------------------------
--- Validate a module that we want to add to the context
-
-checkAdd :: InteractiveImport -> GHCi ()
-checkAdd ii = do
-  dflags <- getDynFlags
-  let safe = safeLanguageOn dflags
-  case ii of
-    IIModule modname
-       | safe -> throwGhcException $ CmdLineError "can't use * imports with Safe Haskell"
-       | otherwise -> wantInterpretedModuleName modname >> return ()
-
-    IIDecl d -> do
-       let modname = unLoc (ideclName d)
-           pkgqual = ideclPkgQual d
-       m <- GHC.lookupModule modname pkgqual
-       when safe $ do
-           t <- GHC.isModuleTrusted m
-           when (not t) $ throwGhcException $ ProgramError $ ""
-
--- -----------------------------------------------------------------------------
--- Update the GHC API's view of the context
-
--- | Sets the GHC context from the GHCi state.  The GHC context is
--- always set this way, we never modify it incrementally.
---
--- We ignore any imports for which the ModuleName does not currently
--- exist.  This is so that the remembered_ctx can contain imports for
--- modules that are not currently loaded, perhaps because we just did
--- a :reload and encountered errors.
---
--- Prelude is added if not already present in the list.  Therefore to
--- override the implicit Prelude import you can say 'import Prelude ()'
--- at the prompt, just as in Haskell source.
---
-setGHCContextFromGHCiState :: GHCi ()
-setGHCContextFromGHCiState = do
-  st <- getGHCiState
-      -- re-use checkAdd to check whether the module is valid.  If the
-      -- module does not exist, we do *not* want to print an error
-      -- here, we just want to silently keep the module in the context
-      -- until such time as the module reappears again.  So we ignore
-      -- the actual exception thrown by checkAdd, using tryBool to
-      -- turn it into a Bool.
-  iidecls <- filterM (tryBool.checkAdd) (transient_ctx st ++ remembered_ctx st)
-  GHC.setContext $
-     if not (any isPreludeImport iidecls)
-        then iidecls ++ [implicitPreludeImport]
-        else iidecls
-    -- XXX put prel at the end, so that guessCurrentModule doesn't pick it up.
-
-
--- -----------------------------------------------------------------------------
--- Utils on InteractiveImport
-
-mkIIModule :: ModuleName -> InteractiveImport
-mkIIModule = IIModule
-
-mkIIDecl :: ModuleName -> InteractiveImport
-mkIIDecl = IIDecl . simpleImportDecl
-
-iiModules :: [InteractiveImport] -> [ModuleName]
-iiModules is = [m | IIModule m <- is]
-
-iiModuleName :: InteractiveImport -> ModuleName
-iiModuleName (IIModule m) = m
-iiModuleName (IIDecl d)   = unLoc (ideclName d)
-
-preludeModuleName :: ModuleName
-preludeModuleName = GHC.mkModuleName "CLaSH.Prelude"
-
-implicitPreludeImport :: InteractiveImport
-implicitPreludeImport = IIDecl (simpleImportDecl preludeModuleName)
-
-isPreludeImport :: InteractiveImport -> Bool
-isPreludeImport (IIModule {}) = True
-isPreludeImport (IIDecl d)    = unLoc (ideclName d) == preludeModuleName
-
-addNotSubsumed :: InteractiveImport
-               -> [InteractiveImport] -> [InteractiveImport]
-addNotSubsumed i is
-  | any (`iiSubsumes` i) is = is
-  | otherwise               = i : filter (not . (i `iiSubsumes`)) is
-
--- | @filterSubsumed is js@ returns the elements of @js@ not subsumed
--- by any of @is@.
-filterSubsumed :: [InteractiveImport] -> [InteractiveImport]
-               -> [InteractiveImport]
-filterSubsumed is js = filter (\j -> not (any (`iiSubsumes` j) is)) js
-
--- | Returns True if the left import subsumes the right one.  Doesn't
--- need to be 100% accurate, conservatively returning False is fine.
--- (EXCEPT: (IIModule m) *must* subsume itself, otherwise a panic in
--- plusProv will ensue (#5904))
---
--- Note that an IIModule does not necessarily subsume an IIDecl,
--- because e.g. a module might export a name that is only available
--- qualified within the module itself.
---
--- Note that 'import M' does not necessarily subsume 'import M(foo)',
--- because M might not export foo and we want an error to be produced
--- in that case.
---
-iiSubsumes :: InteractiveImport -> InteractiveImport -> Bool
-iiSubsumes (IIModule m1) (IIModule m2) = m1==m2
-iiSubsumes (IIDecl d1) (IIDecl d2)      -- A bit crude
-  =  unLoc (ideclName d1) == unLoc (ideclName d2)
-     && ideclAs d1 == ideclAs d2
-     && (not (ideclQualified d1) || ideclQualified d2)
-     && (ideclHiding d1 `hidingSubsumes` ideclHiding d2)
-  where
-     _                    `hidingSubsumes` Just (False,L _ []) = True
-     Just (False, L _ xs) `hidingSubsumes` Just (False,L _ ys)
-                                                           = all (`elem` xs) ys
-     h1                   `hidingSubsumes` h2              = h1 == h2
-iiSubsumes _ _ = False
-
-
-----------------------------------------------------------------------------
--- :set
-
--- set options in the interpreter.  Syntax is exactly the same as the
--- ghc command line, except that certain options aren't available (-C,
--- -E etc.)
---
--- This is pretty fragile: most options won't work as expected.  ToDo:
--- figure out which ones & disallow them.
-
-setCmd :: String -> GHCi ()
-setCmd ""   = showOptions False
-setCmd "-a" = showOptions True
-setCmd str
-  = case getCmd str of
-    Right ("args",    rest) ->
-        case toArgs rest of
-            Left err -> liftIO (hPutStrLn stderr err)
-            Right args -> setArgs args
-    Right ("prog",    rest) ->
-        case toArgs rest of
-            Right [prog] -> setProg prog
-            _ -> liftIO (hPutStrLn stderr "syntax: :set prog <progname>")
-    Right ("prompt",  rest) -> setPrompt  $ dropWhile isSpace rest
-    Right ("prompt2", rest) -> setPrompt2 $ dropWhile isSpace rest
-    Right ("editor",  rest) -> setEditor  $ dropWhile isSpace rest
-    Right ("stop",    rest) -> setStop    $ dropWhile isSpace rest
-    _ -> case toArgs str of
-         Left err -> liftIO (hPutStrLn stderr err)
-         Right wds -> setOptions wds
-
-setiCmd :: String -> GHCi ()
-setiCmd ""   = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags False
-setiCmd "-a" = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags True
-setiCmd str  =
-  case toArgs str of
-    Left err -> liftIO (hPutStrLn stderr err)
-    Right wds -> newDynFlags True wds
-
-showOptions :: Bool -> GHCi ()
-showOptions show_all
-  = do st <- getGHCiState
-       dflags <- getDynFlags
-       let opts = options st
-       liftIO $ putStrLn (showSDoc dflags (
-              text "options currently set: " <>
-              if null opts
-                   then text "none."
-                   else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
-           ))
-       getDynFlags >>= liftIO . showDynFlags show_all
-
-
-showDynFlags :: Bool -> DynFlags -> IO ()
-showDynFlags show_all dflags = do
-  showLanguages' show_all dflags
-  putStrLn $ showSDoc dflags $
-     text "GHCi-specific dynamic flag settings:" $$
-         nest 2 (vcat (map (setting gopt) ghciFlags))
-  putStrLn $ showSDoc dflags $
-     text "other dynamic, non-language, flag settings:" $$
-         nest 2 (vcat (map (setting gopt) others))
-  putStrLn $ showSDoc dflags $
-     text "warning settings:" $$
-         nest 2 (vcat (map (setting wopt) DynFlags.fWarningFlags))
-  where
-        setting test flag
-          | quiet     = empty
-          | is_on     = fstr name
-          | otherwise = fnostr name
-          where name = flagSpecName flag
-                f = flagSpecFlag flag
-                is_on = test f dflags
-                quiet = not show_all && test f default_dflags == is_on
-
-        default_dflags = defaultDynFlags (settings dflags)
-
-        fstr   str = text "-f"    <> text str
-        fnostr str = text "-fno-" <> text str
-
-        (ghciFlags,others)  = partition (\f -> flagSpecFlag f `elem` flgs)
-                                        DynFlags.fFlags
-        flgs = [ Opt_PrintExplicitForalls
-               , Opt_PrintExplicitKinds
-               , Opt_PrintBindResult
-               , Opt_BreakOnException
-               , Opt_BreakOnError
-               , Opt_PrintEvldWithShow
-               ]
-
-setArgs, setOptions :: [String] -> GHCi ()
-setProg, setEditor, setStop :: String -> GHCi ()
-
-setArgs args = do
-  st <- getGHCiState
-  setGHCiState st{ GhciMonad.args = args }
-
-setProg prog = do
-  st <- getGHCiState
-  setGHCiState st{ progname = prog }
-
-setEditor cmd = do
-  st <- getGHCiState
-  setGHCiState st{ editor = cmd }
-
-setStop str@(c:_) | isDigit c
-  = do let (nm_str,rest) = break (not.isDigit) str
-           nm = read nm_str
-       st <- getGHCiState
-       let old_breaks = breaks st
-       if all ((/= nm) . fst) old_breaks
-              then printForUser (text "Breakpoint" <+> ppr nm <+>
-                                 text "does not exist")
-              else do
-       let new_breaks = map fn old_breaks
-           fn (i,loc) | i == nm   = (i,loc { onBreakCmd = dropWhile isSpace rest })
-                      | otherwise = (i,loc)
-       setGHCiState st{ breaks = new_breaks }
-setStop cmd = do
-  st <- getGHCiState
-  setGHCiState st{ stop = cmd }
-
-setPrompt :: String -> GHCi ()
-setPrompt = setPrompt_ f err
-  where
-    f v st = st { prompt = v }
-    err st = "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
-
-setPrompt2 :: String -> GHCi ()
-setPrompt2 = setPrompt_ f err
-  where
-    f v st = st { prompt2 = v }
-    err st = "syntax: :set prompt2 <prompt>, currently \"" ++ prompt2 st ++ "\""
-
-setPrompt_ :: (String -> GHCiState -> GHCiState) -> (GHCiState -> String) -> String -> GHCi ()
-setPrompt_ f err value = do
-  st <- getGHCiState
-  if null value
-      then liftIO $ hPutStrLn stderr $ err st
-      else case value of
-           '\"' : _ -> case reads value of
-                       [(value', xs)] | all isSpace xs ->
-                           setGHCiState $ f value' st
-                       _ ->
-                           liftIO $ hPutStrLn stderr "Can't parse prompt string. Use Haskell syntax."
-           _ -> setGHCiState $ f value st
-
-setOptions wds =
-   do -- first, deal with the GHCi opts (+s, +t, etc.)
-      let (plus_opts, minus_opts)  = partitionWith isPlus wds
-      mapM_ setOpt plus_opts
-      -- then, dynamic flags
-      newDynFlags False minus_opts
-
-newDynFlags :: Bool -> [String] -> GHCi ()
-newDynFlags interactive_only minus_opts = do
-      let lopts = map noLoc minus_opts
-
-      idflags0 <- GHC.getInteractiveDynFlags
-      (idflags1, leftovers, warns) <- GHC.parseDynamicFlags idflags0 lopts
-
-      liftIO $ handleFlagWarnings idflags1 warns
-      when (not $ null leftovers)
-           (throwGhcException . CmdLineError
-            $ "Some flags have not been recognized: "
-            ++ (concat . intersperse ", " $ map unLoc leftovers))
-
-      when (interactive_only &&
-              packageFlags idflags1 /= packageFlags idflags0) $ do
-          liftIO $ hPutStrLn stderr "cannot set package flags with :seti; use :set"
-      GHC.setInteractiveDynFlags idflags1
-      installInteractivePrint (interactivePrint idflags1) False
-
-      dflags0 <- getDynFlags
-      when (not interactive_only) $ do
-        (dflags1, _, _) <- liftIO $ GHC.parseDynamicFlags dflags0 lopts
-        new_pkgs <- GHC.setProgramDynFlags dflags1
-
-        -- if the package flags changed, reset the context and link
-        -- the new packages.
-        dflags2 <- getDynFlags
-        when (packageFlags dflags2 /= packageFlags dflags0) $ do
-          when (verbosity dflags2 > 0) $
-            liftIO . putStrLn $
-              "package flags have changed, resetting and loading new packages..."
-          GHC.setTargets []
-          _ <- GHC.load LoadAllTargets
-          liftIO $ linkPackages dflags2 new_pkgs
-          -- package flags changed, we can't re-use any of the old context
-          setContextAfterLoad False []
-          -- and copy the package state to the interactive DynFlags
-          idflags <- GHC.getInteractiveDynFlags
-          GHC.setInteractiveDynFlags
-              idflags{ pkgState = pkgState dflags2
-                     , pkgDatabase = pkgDatabase dflags2
-                     , packageFlags = packageFlags dflags2 }
-
-        let ld0length   = length $ ldInputs dflags0
-            fmrk0length = length $ cmdlineFrameworks dflags0
-
-            newLdInputs     = drop ld0length (ldInputs dflags2)
-            newCLFrameworks = drop fmrk0length (cmdlineFrameworks dflags2)
-
-        when (not (null newLdInputs && null newCLFrameworks)) $
-          liftIO $ linkCmdLineLibs $
-            dflags2 { ldInputs = newLdInputs
-                    , cmdlineFrameworks = newCLFrameworks }
-
-      return ()
-
-
-unsetOptions :: String -> GHCi ()
-unsetOptions str
-  =   -- first, deal with the GHCi opts (+s, +t, etc.)
-     let opts = words str
-         (minus_opts, rest1) = partition isMinus opts
-         (plus_opts, rest2)  = partitionWith isPlus rest1
-         (other_opts, rest3) = partition (`elem` map fst defaulters) rest2
-
-         defaulters =
-           [ ("args"   , setArgs default_args)
-           , ("prog"   , setProg default_progname)
-           , ("prompt" , setPrompt default_prompt)
-           , ("prompt2", setPrompt2 default_prompt2)
-           , ("editor" , liftIO findEditor >>= setEditor)
-           , ("stop"   , setStop default_stop)
-           ]
-
-         no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
-         no_flag ('-':'X':rest) = return ("-XNo" ++ rest)
-         no_flag f = throwGhcException (ProgramError ("don't know how to reverse " ++ f))
-
-     in if (not (null rest3))
-           then liftIO (putStrLn ("unknown option: '" ++ head rest3 ++ "'"))
-           else do
-             mapM_ (fromJust.flip lookup defaulters) other_opts
-
-             mapM_ unsetOpt plus_opts
-
-             no_flags <- mapM no_flag minus_opts
-             newDynFlags False no_flags
-
-isMinus :: String -> Bool
-isMinus ('-':_) = True
-isMinus _ = False
-
-isPlus :: String -> Either String String
-isPlus ('+':opt) = Left opt
-isPlus other     = Right other
-
-setOpt, unsetOpt :: String -> GHCi ()
-
-setOpt str
-  = case strToGHCiOpt str of
-        Nothing -> liftIO (putStrLn ("unknown option: '" ++ str ++ "'"))
-        Just o  -> setOption o
-
-unsetOpt str
-  = case strToGHCiOpt str of
-        Nothing -> liftIO (putStrLn ("unknown option: '" ++ str ++ "'"))
-        Just o  -> unsetOption o
-
-strToGHCiOpt :: String -> (Maybe GHCiOption)
-strToGHCiOpt "m" = Just Multiline
-strToGHCiOpt "s" = Just ShowTiming
-strToGHCiOpt "t" = Just ShowType
-strToGHCiOpt "r" = Just RevertCAFs
-strToGHCiOpt _   = Nothing
-
-optToStr :: GHCiOption -> String
-optToStr Multiline  = "m"
-optToStr ShowTiming = "s"
-optToStr ShowType   = "t"
-optToStr RevertCAFs = "r"
-
-
--- ---------------------------------------------------------------------------
--- :show
-
-showCmd :: String -> GHCi ()
-showCmd ""   = showOptions False
-showCmd "-a" = showOptions True
-showCmd str = do
-  st <- getGHCiState
-  case words str of
-        ["args"]     -> liftIO $ putStrLn (show (GhciMonad.args st))
-        ["prog"]     -> liftIO $ putStrLn (show (progname st))
-        ["prompt"]   -> liftIO $ putStrLn (show (prompt st))
-        ["prompt2"]  -> liftIO $ putStrLn (show (prompt2 st))
-        ["editor"]   -> liftIO $ putStrLn (show (editor st))
-        ["stop"]     -> liftIO $ putStrLn (show (stop st))
-        ["imports"]  -> showImports
-        ["modules" ] -> showModules
-        ["bindings"] -> showBindings
-        ["linker"]   ->
-            do dflags <- getDynFlags
-               liftIO $ showLinkerState dflags
-        ["breaks"]   -> showBkptTable
-        ["context"]  -> showContext
-        ["packages"]  -> showPackages
-        ["paths"]     -> showPaths
-        ["languages"] -> showLanguages -- backwards compat
-        ["language"]  -> showLanguages
-        ["lang"]      -> showLanguages -- useful abbreviation
-        _ -> throwGhcException (CmdLineError ("syntax:  :show [ args | prog | prompt | prompt2 | editor | stop | modules\n" ++
-                                              "               | bindings | breaks | context | packages | language ]"))
-
-showiCmd :: String -> GHCi ()
-showiCmd str = do
-  case words str of
-        ["languages"]  -> showiLanguages -- backwards compat
-        ["language"]   -> showiLanguages
-        ["lang"]       -> showiLanguages -- useful abbreviation
-        _ -> throwGhcException (CmdLineError ("syntax:  :showi language"))
-
-showImports :: GHCi ()
-showImports = do
-  st <- getGHCiState
-  dflags <- getDynFlags
-  let rem_ctx   = reverse (remembered_ctx st)
-      trans_ctx = transient_ctx st
-
-      show_one (IIModule star_m)
-          = ":module +*" ++ moduleNameString star_m
-      show_one (IIDecl imp) = showPpr dflags imp
-
-      prel_imp
-        | any isPreludeImport (rem_ctx ++ trans_ctx) = []
-        | otherwise = ["import CLaSH.Prelude -- implicit"]
-
-      trans_comment s = s ++ " -- added automatically"
-  --
-  liftIO $ mapM_ putStrLn (prel_imp ++ map show_one rem_ctx
-                                    ++ map (trans_comment . show_one) trans_ctx)
-
-showModules :: GHCi ()
-showModules = do
-  loaded_mods <- getLoadedModules
-        -- we want *loaded* modules only, see #1734
-  let show_one ms = do m <- GHC.showModule ms; liftIO (putStrLn m)
-  mapM_ show_one loaded_mods
-
-getLoadedModules :: GHC.GhcMonad m => m [GHC.ModSummary]
-getLoadedModules = do
-  graph <- GHC.getModuleGraph
-  filterM (GHC.isLoaded . GHC.ms_mod_name) graph
-
-showBindings :: GHCi ()
-showBindings = do
-    bindings <- GHC.getBindings
-    (insts, finsts) <- GHC.getInsts
-    docs     <- mapM makeDoc (reverse bindings)
-                  -- reverse so the new ones come last
-    let idocs  = map GHC.pprInstanceHdr insts
-        fidocs = map GHC.pprFamInst finsts
-    mapM_ printForUserPartWay (docs ++ idocs ++ fidocs)
-  where
-    makeDoc (AnId i) = pprTypeAndContents i
-    makeDoc tt = do
-        mb_stuff <- GHC.getInfo False (getName tt)
-        return $ maybe (text "") pprTT mb_stuff
-
-    pprTT :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst]) -> SDoc
-    pprTT (thing, fixity, _cls_insts, _fam_insts)
-      = pprTyThing thing
-        $$ show_fixity
-      where
-        show_fixity
-            | fixity == GHC.defaultFixity  = empty
-            | otherwise                    = ppr fixity <+> ppr (GHC.getName thing)
-
-
-printTyThing :: TyThing -> GHCi ()
-printTyThing tyth = printForUser (pprTyThing tyth)
-
-showBkptTable :: GHCi ()
-showBkptTable = do
-  st <- getGHCiState
-  printForUser $ prettyLocations (breaks st)
-
-showContext :: GHCi ()
-showContext = do
-   resumes <- GHC.getResumeContext
-   printForUser $ vcat (map pp_resume (reverse resumes))
-  where
-   pp_resume res =
-        ptext (sLit "--> ") <> text (GHC.resumeStmt res)
-        $$ nest 2 (ptext (sLit "Stopped at") <+> ppr (GHC.resumeSpan res))
-
-showPackages :: GHCi ()
-showPackages = do
-  dflags <- getDynFlags
-  let pkg_flags = packageFlags dflags
-  liftIO $ putStrLn $ showSDoc dflags $
-    text ("active package flags:"++if null pkg_flags then " none" else "") $$
-      nest 2 (vcat (map pprFlag pkg_flags))
-
-showPaths :: GHCi ()
-showPaths = do
-  dflags <- getDynFlags
-  liftIO $ do
-    cwd <- getCurrentDirectory
-    putStrLn $ showSDoc dflags $
-      text "current working directory: " $$
-        nest 2 (text cwd)
-    let ipaths = importPaths dflags
-    putStrLn $ showSDoc dflags $
-      text ("module import search paths:"++if null ipaths then " none" else "") $$
-        nest 2 (vcat (map text ipaths))
-
-showLanguages :: GHCi ()
-showLanguages = getDynFlags >>= liftIO . showLanguages' False
-
-showiLanguages :: GHCi ()
-showiLanguages = GHC.getInteractiveDynFlags >>= liftIO . showLanguages' False
-
-showLanguages' :: Bool -> DynFlags -> IO ()
-showLanguages' show_all dflags =
-  putStrLn $ showSDoc dflags $ vcat
-     [ text "base language is: " <>
-         case language dflags of
-           Nothing          -> text "Haskell2010"
-           Just Haskell98   -> text "Haskell98"
-           Just Haskell2010 -> text "Haskell2010"
-     , (if show_all then text "all active language options:"
-                    else text "with the following modifiers:") $$
-          nest 2 (vcat (map (setting xopt) DynFlags.xFlags))
-     ]
-  where
-   setting test flag
-          | quiet     = empty
-          | is_on     = text "-X" <> text name
-          | otherwise = text "-XNo" <> text name
-          where name = flagSpecName flag
-                f = flagSpecFlag flag
-                is_on = test f dflags
-                quiet = not show_all && test f default_dflags == is_on
-
-   default_dflags =
-       defaultDynFlags (settings dflags) `lang_set`
-         case language dflags of
-           Nothing -> Just Haskell2010
-           other   -> other
-
--- -----------------------------------------------------------------------------
--- Completion
-
-completeCmd :: String -> GHCi ()
-completeCmd argLine0 = case parseLine argLine0 of
-    Just ("repl", resultRange, left) -> do
-        (unusedLine,compls) <- ghciCompleteWord (reverse left,"")
-        let compls' = takeRange resultRange compls
-        liftIO . putStrLn $ unwords [ show (length compls'), show (length compls), show (reverse unusedLine) ]
-        forM_ (takeRange resultRange compls) $ \(Completion r _ _) -> do
-            liftIO $ print r
-    _ -> throwGhcException (CmdLineError "Syntax: :complete repl [<range>] <quoted-string-to-complete>")
-  where
-    parseLine argLine
-        | null argLine = Nothing
-        | null rest1   = Nothing
-        | otherwise    = (,,) dom <$> resRange <*> s
-      where
-        (dom, rest1) = breakSpace argLine
-        (rng, rest2) = breakSpace rest1
-        resRange | head rest1 == '"' = parseRange ""
-                 | otherwise         = parseRange rng
-        s | head rest1 == '"' = readMaybe rest1 :: Maybe String
-          | otherwise         = readMaybe rest2
-        breakSpace = fmap (dropWhile isSpace) . break isSpace
-
-    takeRange (lb,ub) = maybe id (drop . pred) lb . maybe id take ub
-
-    -- syntax: [n-][m] with semantics "drop (n-1) . take m"
-    parseRange :: String -> Maybe (Maybe Int,Maybe Int)
-    parseRange s = case span isDigit s of
-                   (_, "") ->
-                       -- upper limit only
-                       Just (Nothing, bndRead s)
-                   (s1, '-' : s2)
-                    | all isDigit s2 ->
-                       Just (bndRead s1, bndRead s2)
-                   _ ->
-                       Nothing
-      where
-        bndRead x = if null x then Nothing else Just (read x)
-
-
-
-completeGhciCommand, completeMacro, completeIdentifier, completeModule,
-    completeSetModule, completeSeti, completeShowiOptions,
-    completeHomeModule, completeSetOptions, completeShowOptions,
-    completeHomeModuleOrFile, completeExpression
-    :: CompletionFunc GHCi
-
-ghciCompleteWord :: CompletionFunc GHCi
-ghciCompleteWord line@(left,_) = case firstWord of
-    ':':cmd     | null rest     -> completeGhciCommand line
-                | otherwise     -> do
-                        completion <- lookupCompletion cmd
-                        completion line
-    "import"    -> completeModule line
-    _           -> completeExpression line
-  where
-    (firstWord,rest) = break isSpace $ dropWhile isSpace $ reverse left
-    lookupCompletion ('!':_) = return completeFilename
-    lookupCompletion c = do
-        maybe_cmd <- lookupCommand' c
-        case maybe_cmd of
-            Just (_,_,f) -> return f
-            Nothing -> return completeFilename
-
-completeGhciCommand = wrapCompleter " " $ \w -> do
-  macros <- liftIO $ readIORef macros_ref
-  cmds   <- ghci_commands `fmap` getGHCiState
-  let macro_names = map (':':) . map cmdName $ macros
-  let command_names = map (':':) . map cmdName $ cmds
-  let{ candidates = case w of
-      ':' : ':' : _ -> map (':':) command_names
-      _ -> nub $ macro_names ++ command_names }
-  return $ filter (w `isPrefixOf`) candidates
-
-completeMacro = wrapIdentCompleter $ \w -> do
-  cmds <- liftIO $ readIORef macros_ref
-  return (filter (w `isPrefixOf`) (map cmdName cmds))
-
-completeIdentifier = wrapIdentCompleter $ \w -> do
-  rdrs <- GHC.getRdrNamesInScope
-  dflags <- GHC.getSessionDynFlags
-  return (filter (w `isPrefixOf`) (map (showPpr dflags) rdrs))
-
-completeModule = wrapIdentCompleter $ \w -> do
-  dflags <- GHC.getSessionDynFlags
-  let pkg_mods = allVisibleModules dflags
-  loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
-  return $ filter (w `isPrefixOf`)
-        $ map (showPpr dflags) $ loaded_mods ++ pkg_mods
-
-completeSetModule = wrapIdentCompleterWithModifier "+-" $ \m w -> do
-  dflags <- GHC.getSessionDynFlags
-  modules <- case m of
-    Just '-' -> do
-      imports <- GHC.getContext
-      return $ map iiModuleName imports
-    _ -> do
-      let pkg_mods = allVisibleModules dflags
-      loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
-      return $ loaded_mods ++ pkg_mods
-  return $ filter (w `isPrefixOf`) $ map (showPpr dflags) modules
-
-completeHomeModule = wrapIdentCompleter listHomeModules
-
-listHomeModules :: String -> GHCi [String]
-listHomeModules w = do
-    g <- GHC.getModuleGraph
-    let home_mods = map GHC.ms_mod_name g
-    dflags <- getDynFlags
-    return $ sort $ filter (w `isPrefixOf`)
-            $ map (showPpr dflags) home_mods
-
-completeSetOptions = wrapCompleter flagWordBreakChars $ \w -> do
-  return (filter (w `isPrefixOf`) opts)
-    where opts = "args":"prog":"prompt":"prompt2":"editor":"stop":flagList
-          flagList = map head $ group $ sort allFlags
-
-completeSeti = wrapCompleter flagWordBreakChars $ \w -> do
-  return (filter (w `isPrefixOf`) flagList)
-    where flagList = map head $ group $ sort allFlags
-
-completeShowOptions = wrapCompleter flagWordBreakChars $ \w -> do
-  return (filter (w `isPrefixOf`) opts)
-    where opts = ["args", "prog", "prompt", "prompt2", "editor", "stop",
-                     "modules", "bindings", "linker", "breaks",
-                     "context", "packages", "paths", "language", "imports"]
-
-completeShowiOptions = wrapCompleter flagWordBreakChars $ \w -> do
-  return (filter (w `isPrefixOf`) ["language"])
-
-completeHomeModuleOrFile = completeWord Nothing filenameWordBreakChars
-                $ unionComplete (fmap (map simpleCompletion) . listHomeModules)
-                            listFiles
-
-unionComplete :: Monad m => (a -> m [b]) -> (a -> m [b]) -> a -> m [b]
-unionComplete f1 f2 line = do
-  cs1 <- f1 line
-  cs2 <- f2 line
-  return (cs1 ++ cs2)
-
-wrapCompleter :: String -> (String -> GHCi [String]) -> CompletionFunc GHCi
-wrapCompleter breakChars fun = completeWord Nothing breakChars
-    $ fmap (map simpleCompletion . nubSort) . fun
-
-wrapIdentCompleter :: (String -> GHCi [String]) -> CompletionFunc GHCi
-wrapIdentCompleter = wrapCompleter word_break_chars
-
-wrapIdentCompleterWithModifier :: String -> (Maybe Char -> String -> GHCi [String]) -> CompletionFunc GHCi
-wrapIdentCompleterWithModifier modifChars fun = completeWordWithPrev Nothing word_break_chars
-    $ \rest -> fmap (map simpleCompletion . nubSort) . fun (getModifier rest)
- where
-  getModifier = find (`elem` modifChars)
-
--- | Return a list of visible module names for autocompletion.
--- (NB: exposed != visible)
-allVisibleModules :: DynFlags -> [ModuleName]
-allVisibleModules dflags = listVisibleModuleNames dflags
-
-completeExpression = completeQuotedWord (Just '\\') "\"" listFiles
-                        completeIdentifier
-
-
--- -----------------------------------------------------------------------------
--- commands for debugger
-
-sprintCmd, printCmd, forceCmd :: String -> GHCi ()
-sprintCmd = pprintCommand False False
-printCmd  = pprintCommand True False
-forceCmd  = pprintCommand False True
-
-pprintCommand :: Bool -> Bool -> String -> GHCi ()
-pprintCommand bind force str = do
-  pprintClosureCommand bind force str
-
-stepCmd :: String -> GHCi ()
-stepCmd arg = withSandboxOnly ":step" $ step arg
-  where
-  step []         = doContinue (const True) GHC.SingleStep
-  step expression = runStmt expression GHC.SingleStep >> return ()
-
-stepLocalCmd :: String -> GHCi ()
-stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg
-  where
-  step expr
-   | not (null expr) = stepCmd expr
-   | otherwise = do
-      mb_span <- getCurrentBreakSpan
-      case mb_span of
-        Nothing  -> stepCmd []
-        Just loc -> do
-           Just md <- getCurrentBreakModule
-           current_toplevel_decl <- enclosingTickSpan md loc
-           doContinue (`isSubspanOf` current_toplevel_decl) GHC.SingleStep
-
-stepModuleCmd :: String -> GHCi ()
-stepModuleCmd arg = withSandboxOnly ":stepmodule" $ step arg
-  where
-  step expr
-   | not (null expr) = stepCmd expr
-   | otherwise = do
-      mb_span <- getCurrentBreakSpan
-      case mb_span of
-        Nothing  -> stepCmd []
-        Just pan -> do
-           let f some_span = srcSpanFileName_maybe pan == srcSpanFileName_maybe some_span
-           doContinue f GHC.SingleStep
-
--- | Returns the span of the largest tick containing the srcspan given
-enclosingTickSpan :: Module -> SrcSpan -> GHCi SrcSpan
-enclosingTickSpan _ (UnhelpfulSpan _) = panic "enclosingTickSpan UnhelpfulSpan"
-enclosingTickSpan md (RealSrcSpan src) = do
-  ticks <- getTickArray md
-  let line = srcSpanStartLine src
-  ASSERT(inRange (bounds ticks) line) do
-  let toRealSrcSpan (UnhelpfulSpan _) = panic "enclosingTickSpan UnhelpfulSpan"
-      toRealSrcSpan (RealSrcSpan s) = s
-      enclosing_spans = [ pan | (_,pan) <- ticks ! line
-                               , realSrcSpanEnd (toRealSrcSpan pan) >= realSrcSpanEnd src]
-  return . head . sortBy leftmost_largest $ enclosing_spans
-
-traceCmd :: String -> GHCi ()
-traceCmd arg
-  = withSandboxOnly ":trace" $ tr arg
-  where
-  tr []         = doContinue (const True) GHC.RunAndLogSteps
-  tr expression = runStmt expression GHC.RunAndLogSteps >> return ()
-
-continueCmd :: String -> GHCi ()
-continueCmd = noArgs $ withSandboxOnly ":continue" $ doContinue (const True) GHC.RunToCompletion
-
--- doContinue :: SingleStep -> GHCi ()
-doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
-doContinue pre step = do
-  runResult <- resume pre step
-  _ <- afterRunStmt pre runResult
-  return ()
-
-abandonCmd :: String -> GHCi ()
-abandonCmd = noArgs $ withSandboxOnly ":abandon" $ do
-  b <- GHC.abandon -- the prompt will change to indicate the new context
-  when (not b) $ liftIO $ putStrLn "There is no computation running."
-
-deleteCmd :: String -> GHCi ()
-deleteCmd argLine = withSandboxOnly ":delete" $ do
-   deleteSwitch $ words argLine
-   where
-   deleteSwitch :: [String] -> GHCi ()
-   deleteSwitch [] =
-      liftIO $ putStrLn "The delete command requires at least one argument."
-   -- delete all break points
-   deleteSwitch ("*":_rest) = discardActiveBreakPoints
-   deleteSwitch idents = do
-      mapM_ deleteOneBreak idents
-      where
-      deleteOneBreak :: String -> GHCi ()
-      deleteOneBreak str
-         | all isDigit str = deleteBreak (read str)
-         | otherwise = return ()
-
-historyCmd :: String -> GHCi ()
-historyCmd arg
-  | null arg        = history 20
-  | all isDigit arg = history (read arg)
-  | otherwise       = liftIO $ putStrLn "Syntax:  :history [num]"
-  where
-  history num = do
-    resumes <- GHC.getResumeContext
-    case resumes of
-      [] -> liftIO $ putStrLn "Not stopped at a breakpoint"
-      (r:_) -> do
-        let hist = GHC.resumeHistory r
-            (took,rest) = splitAt num hist
-        case hist of
-          [] -> liftIO $ putStrLn $
-                   "Empty history. Perhaps you forgot to use :trace?"
-          _  -> do
-                 pans <- mapM GHC.getHistorySpan took
-                 let nums  = map (printf "-%-3d:") [(1::Int)..]
-                     names = map GHC.historyEnclosingDecls took
-                 printForUser (vcat(zipWith3
-                                 (\x y z -> x <+> y <+> z)
-                                 (map text nums)
-                                 (map (bold . hcat . punctuate colon . map text) names)
-                                 (map (parens . ppr) pans)))
-                 liftIO $ putStrLn $ if null rest then "<end of history>" else "..."
-
-bold :: SDoc -> SDoc
-bold c | do_bold   = text start_bold <> c <> text end_bold
-       | otherwise = c
-
-backCmd :: String -> GHCi ()
-backCmd = noArgs $ withSandboxOnly ":back" $ do
-  (names, _, pan) <- GHC.back
-  printForUser $ ptext (sLit "Logged breakpoint at") <+> ppr pan
-  printTypeOfNames names
-   -- run the command set with ":set stop <cmd>"
-  st <- getGHCiState
-  enqueueCommands [stop st]
-
-forwardCmd :: String -> GHCi ()
-forwardCmd = noArgs $ withSandboxOnly ":forward" $ do
-  (names, ix, pan) <- GHC.forward
-  printForUser $ (if (ix == 0)
-                    then ptext (sLit "Stopped at")
-                    else ptext (sLit "Logged breakpoint at")) <+> ppr pan
-  printTypeOfNames names
-   -- run the command set with ":set stop <cmd>"
-  st <- getGHCiState
-  enqueueCommands [stop st]
-
--- handle the "break" command
-breakCmd :: String -> GHCi ()
-breakCmd argLine = withSandboxOnly ":break" $ breakSwitch $ words argLine
-
-breakSwitch :: [String] -> GHCi ()
-breakSwitch [] = do
-   liftIO $ putStrLn "The break command requires at least one argument."
-breakSwitch (arg1:rest)
-   | looksLikeModuleName arg1 && not (null rest) = do
-        md <- wantInterpretedModule arg1
-        breakByModule md rest
-   | all isDigit arg1 = do
-        imports <- GHC.getContext
-        case iiModules imports of
-           (mn : _) -> do
-              md <- lookupModuleName mn
-              breakByModuleLine md (read arg1) rest
-           [] -> do
-              liftIO $ putStrLn "No modules are loaded with debugging support."
-   | otherwise = do -- try parsing it as an identifier
-        wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
-        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
-        case loc of
-            RealSrcLoc l ->
-               ASSERT( isExternalName name )
-                    findBreakAndSet (GHC.nameModule name) $
-                         findBreakByCoord (Just (GHC.srcLocFile l))
-                                          (GHC.srcLocLine l,
-                                           GHC.srcLocCol l)
-            UnhelpfulLoc _ ->
-                noCanDo name $ text "can't find its location: " <> ppr loc
-       where
-          noCanDo n why = printForUser $
-                text "cannot set breakpoint on " <> ppr n <> text ": " <> why
-
-breakByModule :: Module -> [String] -> GHCi ()
-breakByModule md (arg1:rest)
-   | all isDigit arg1 = do  -- looks like a line number
-        breakByModuleLine md (read arg1) rest
-breakByModule _ _
-   = breakSyntax
-
-breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
-breakByModuleLine md line args
-   | [] <- args = findBreakAndSet md $ findBreakByLine line
-   | [col] <- args, all isDigit col =
-        findBreakAndSet md $ findBreakByCoord Nothing (line, read col)
-   | otherwise = breakSyntax
-
-breakSyntax :: a
-breakSyntax = throwGhcException (CmdLineError "Syntax: :break [<mod>] <line> [<column>]")
-
-findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
-findBreakAndSet md lookupTickTree = do
-   dflags <- getDynFlags
-   tickArray <- getTickArray md
-   (breakArray, _) <- getModBreak md
-   case lookupTickTree tickArray of
-      Nothing  -> liftIO $ putStrLn $ "No breakpoints found at that location."
-      Just (tick, pan) -> do
-         success <- liftIO $ setBreakFlag dflags True breakArray tick
-         if success
-            then do
-               (alreadySet, nm) <-
-                     recordBreak $ BreakLocation
-                             { breakModule = md
-                             , breakLoc = pan
-                             , breakTick = tick
-                             , onBreakCmd = ""
-                             }
-               printForUser $
-                  text "Breakpoint " <> ppr nm <>
-                  if alreadySet
-                     then text " was already set at " <> ppr pan
-                     else text " activated at " <> ppr pan
-            else do
-            printForUser $ text "Breakpoint could not be activated at"
-                                 <+> ppr pan
-
--- When a line number is specified, the current policy for choosing
--- the best breakpoint is this:
---    - the leftmost complete subexpression on the specified line, or
---    - the leftmost subexpression starting on the specified line, or
---    - the rightmost subexpression enclosing the specified line
---
-findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,SrcSpan)
-findBreakByLine line arr
-  | not (inRange (bounds arr) line) = Nothing
-  | otherwise =
-    listToMaybe (sortBy (leftmost_largest `on` snd)  comp)   `mplus`
-    listToMaybe (sortBy (leftmost_smallest `on` snd) incomp) `mplus`
-    listToMaybe (sortBy (rightmost `on` snd) ticks)
-  where
-        ticks = arr ! line
-
-        starts_here = [ tick | tick@(_,pan) <- ticks,
-                               GHC.srcSpanStartLine (toRealSpan pan) == line ]
-
-        (comp, incomp) = partition ends_here starts_here
-            where ends_here (_,pan) = GHC.srcSpanEndLine (toRealSpan pan) == line
-        toRealSpan (RealSrcSpan pan) = pan
-        toRealSpan (UnhelpfulSpan _) = panic "findBreakByLine UnhelpfulSpan"
-
-findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
-                 -> Maybe (BreakIndex,SrcSpan)
-findBreakByCoord mb_file (line, col) arr
-  | not (inRange (bounds arr) line) = Nothing
-  | otherwise =
-    listToMaybe (sortBy (rightmost `on` snd) contains ++
-                 sortBy (leftmost_smallest `on` snd) after_here)
-  where
-        ticks = arr ! line
-
-        -- the ticks that span this coordinate
-        contains = [ tick | tick@(_,pan) <- ticks, pan `spans` (line,col),
-                            is_correct_file pan ]
-
-        is_correct_file pan
-                 | Just f <- mb_file = GHC.srcSpanFile (toRealSpan pan) == f
-                 | otherwise         = True
-
-        after_here = [ tick | tick@(_,pan) <- ticks,
-                              let pan' = toRealSpan pan,
-                              GHC.srcSpanStartLine pan' == line,
-                              GHC.srcSpanStartCol pan' >= col ]
-
-        toRealSpan (RealSrcSpan pan) = pan
-        toRealSpan (UnhelpfulSpan _) = panic "findBreakByCoord UnhelpfulSpan"
-
--- For now, use ANSI bold on terminals that we know support it.
--- Otherwise, we add a line of carets under the active expression instead.
--- In particular, on Windows and when running the testsuite (which sets
--- TERM to vt100 for other reasons) we get carets.
--- We really ought to use a proper termcap/terminfo library.
-do_bold :: Bool
-do_bold = (`isPrefixOf` unsafePerformIO mTerm) `any` ["xterm", "linux"]
-    where mTerm = System.Environment.getEnv "TERM"
-                  `catchIO` \_ -> return "TERM not set"
-
-start_bold :: String
-start_bold = "\ESC[1m"
-end_bold :: String
-end_bold   = "\ESC[0m"
-
-
------------------------------------------------------------------------------
--- :list
-
-listCmd :: String -> InputT GHCi ()
-listCmd c = listCmd' c
-
-listCmd' :: String -> InputT GHCi ()
-listCmd' "" = do
-   mb_span <- lift getCurrentBreakSpan
-   case mb_span of
-      Nothing ->
-          printForUser $ text "Not stopped at a breakpoint; nothing to list"
-      Just (RealSrcSpan pan) ->
-          listAround pan True
-      Just pan@(UnhelpfulSpan _) ->
-          do resumes <- GHC.getResumeContext
-             case resumes of
-                 [] -> panic "No resumes"
-                 (r:_) ->
-                     do let traceIt = case GHC.resumeHistory r of
-                                      [] -> text "rerunning with :trace,"
-                                      _ -> empty
-                            doWhat = traceIt <+> text ":back then :list"
-                        printForUser (text "Unable to list source for" <+>
-                                      ppr pan
-                                   $$ text "Try" <+> doWhat)
-listCmd' str = list2 (words str)
-
-list2 :: [String] -> InputT GHCi ()
-list2 [arg] | all isDigit arg = do
-    imports <- GHC.getContext
-    case iiModules imports of
-        [] -> liftIO $ putStrLn "No module to list"
-        (mn : _) -> do
-          md <- lift $ lookupModuleName mn
-          listModuleLine md (read arg)
-list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
-        md <- wantInterpretedModule arg1
-        listModuleLine md (read arg2)
-list2 [arg] = do
-        wantNameFromInterpretedModule noCanDo arg $ \name -> do
-        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
-        case loc of
-            RealSrcLoc l ->
-               do tickArray <- ASSERT( isExternalName name )
-                               lift $ getTickArray (GHC.nameModule name)
-                  let mb_span = findBreakByCoord (Just (GHC.srcLocFile l))
-                                        (GHC.srcLocLine l, GHC.srcLocCol l)
-                                        tickArray
-                  case mb_span of
-                    Nothing       -> listAround (realSrcLocSpan l) False
-                    Just (_, UnhelpfulSpan _) -> panic "list2 UnhelpfulSpan"
-                    Just (_, RealSrcSpan pan) -> listAround pan False
-            UnhelpfulLoc _ ->
-                  noCanDo name $ text "can't find its location: " <>
-                                 ppr loc
-    where
-        noCanDo n why = printForUser $
-            text "cannot list source code for " <> ppr n <> text ": " <> why
-list2  _other =
-        liftIO $ putStrLn "syntax:  :list [<line> | <module> <line> | <identifier>]"
-
-listModuleLine :: Module -> Int -> InputT GHCi ()
-listModuleLine modl line = do
-   graph <- GHC.getModuleGraph
-   let this = filter ((== modl) . GHC.ms_mod) graph
-   case this of
-     [] -> panic "listModuleLine"
-     summ:_ -> do
-           let filename = expectJust "listModuleLine" (ml_hs_file (GHC.ms_location summ))
-               loc = mkRealSrcLoc (mkFastString (filename)) line 0
-           listAround (realSrcLocSpan loc) False
-
--- | list a section of a source file around a particular SrcSpan.
--- If the highlight flag is True, also highlight the span using
--- start_bold\/end_bold.
-
--- GHC files are UTF-8, so we can implement this by:
--- 1) read the file in as a BS and syntax highlight it as before
--- 2) convert the BS to String using utf-string, and write it out.
--- It would be better if we could convert directly between UTF-8 and the
--- console encoding, of course.
-listAround :: MonadIO m => RealSrcSpan -> Bool -> InputT m ()
-listAround pan do_highlight = do
-      contents <- liftIO $ BS.readFile (unpackFS file)
-      -- Drop carriage returns to avoid duplicates, see #9367.
-      let ls  = BS.split '\n' $ BS.filter (/= '\r') contents
-          ls' = take (line2 - line1 + 1 + pad_before + pad_after) $
-                        drop (line1 - 1 - pad_before) $ ls
-          fst_line = max 1 (line1 - pad_before)
-          line_nos = [ fst_line .. ]
-
-          highlighted | do_highlight = zipWith highlight line_nos ls'
-                      | otherwise    = [\p -> BS.concat[p,l] | l <- ls']
-
-          bs_line_nos = [ BS.pack (show l ++ "  ") | l <- line_nos ]
-          prefixed = zipWith ($) highlighted bs_line_nos
-          output   = BS.intercalate (BS.pack "\n") prefixed
-
-      utf8Decoded <- liftIO $ BS.useAsCStringLen output
-                        $ \(p,n) -> utf8DecodeString (castPtr p) n
-      liftIO $ putStrLn utf8Decoded
-  where
-        file  = GHC.srcSpanFile pan
-        line1 = GHC.srcSpanStartLine pan
-        col1  = GHC.srcSpanStartCol pan - 1
-        line2 = GHC.srcSpanEndLine pan
-        col2  = GHC.srcSpanEndCol pan - 1
-
-        pad_before | line1 == 1 = 0
-                   | otherwise  = 1
-        pad_after = 1
-
-        highlight | do_bold   = highlight_bold
-                  | otherwise = highlight_carets
-
-        highlight_bold no line prefix
-          | no == line1 && no == line2
-          = let (a,r) = BS.splitAt col1 line
-                (b,c) = BS.splitAt (col2-col1) r
-            in
-            BS.concat [prefix, a,BS.pack start_bold,b,BS.pack end_bold,c]
-          | no == line1
-          = let (a,b) = BS.splitAt col1 line in
-            BS.concat [prefix, a, BS.pack start_bold, b]
-          | no == line2
-          = let (a,b) = BS.splitAt col2 line in
-            BS.concat [prefix, a, BS.pack end_bold, b]
-          | otherwise   = BS.concat [prefix, line]
-
-        highlight_carets no line prefix
-          | no == line1 && no == line2
-          = BS.concat [prefix, line, nl, indent, BS.replicate col1 ' ',
-                                         BS.replicate (col2-col1) '^']
-          | no == line1
-          = BS.concat [indent, BS.replicate (col1 - 2) ' ', BS.pack "vv", nl,
-                                         prefix, line]
-          | no == line2
-          = BS.concat [prefix, line, nl, indent, BS.replicate col2 ' ',
-                                         BS.pack "^^"]
-          | otherwise   = BS.concat [prefix, line]
-         where
-           indent = BS.pack ("  " ++ replicate (length (show no)) ' ')
-           nl = BS.singleton '\n'
-
-
--- --------------------------------------------------------------------------
--- Tick arrays
-
-getTickArray :: Module -> GHCi TickArray
-getTickArray modl = do
-   st <- getGHCiState
-   let arrmap = tickarrays st
-   case lookupModuleEnv arrmap modl of
-      Just arr -> return arr
-      Nothing  -> do
-        (_breakArray, ticks) <- getModBreak modl
-        let arr = mkTickArray (assocs ticks)
-        setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}
-        return arr
-
-discardTickArrays :: GHCi ()
-discardTickArrays = do
-   st <- getGHCiState
-   setGHCiState st{tickarrays = emptyModuleEnv}
-
-mkTickArray :: [(BreakIndex,SrcSpan)] -> TickArray
-mkTickArray ticks
-  = accumArray (flip (:)) [] (1, max_line)
-        [ (line, (nm,pan)) | (nm,pan) <- ticks,
-                              let pan' = toRealSpan pan,
-                              line <- srcSpanLines pan' ]
-    where
-        max_line = foldr max 0 (map (GHC.srcSpanEndLine . toRealSpan . snd) ticks)
-        srcSpanLines pan = [ GHC.srcSpanStartLine pan ..  GHC.srcSpanEndLine pan ]
-        toRealSpan (RealSrcSpan pan) = pan
-        toRealSpan (UnhelpfulSpan _) = panic "mkTickArray UnhelpfulSpan"
-
--- don't reset the counter back to zero?
-discardActiveBreakPoints :: GHCi ()
-discardActiveBreakPoints = do
-   st <- getGHCiState
-   mapM_ (turnOffBreak.snd) (breaks st)
-   setGHCiState $ st { breaks = [] }
-
-deleteBreak :: Int -> GHCi ()
-deleteBreak identity = do
-   st <- getGHCiState
-   let oldLocations    = breaks st
-       (this,rest)     = partition (\loc -> fst loc == identity) oldLocations
-   if null this
-      then printForUser (text "Breakpoint" <+> ppr identity <+>
-                         text "does not exist")
-      else do
-           mapM_ (turnOffBreak.snd) this
-           setGHCiState $ st { breaks = rest }
-
-turnOffBreak :: BreakLocation -> GHCi Bool
-turnOffBreak loc = do
-  dflags <- getDynFlags
-  (arr, _) <- getModBreak (breakModule loc)
-  liftIO $ setBreakFlag dflags False arr (breakTick loc)
-
-getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
-getModBreak m = do
-   Just mod_info <- GHC.getModuleInfo m
-   let modBreaks  = GHC.modInfoModBreaks mod_info
-   let arr        = GHC.modBreaks_flags modBreaks
-   let ticks      = GHC.modBreaks_locs  modBreaks
-   return (arr, ticks)
-
-setBreakFlag :: DynFlags -> Bool -> GHC.BreakArray -> Int -> IO Bool
-setBreakFlag dflags toggle arr i
-   | toggle    = GHC.setBreakOn  dflags arr i
-   | otherwise = GHC.setBreakOff dflags arr i
-
-
--- ---------------------------------------------------------------------------
--- User code exception handling
-
--- This is the exception handler for exceptions generated by the
--- user's code and exceptions coming from children sessions;
--- it normally just prints out the exception.  The
--- handler must be recursive, in case showing the exception causes
--- more exceptions to be raised.
---
--- Bugfix: if the user closed stdout or stderr, the flushing will fail,
--- raising another exception.  We therefore don't put the recursive
--- handler arond the flushing operation, so if stderr is closed
--- GHCi will just die gracefully rather than going into an infinite loop.
-handler :: SomeException -> GHCi Bool
-
-handler exception = do
-  flushInterpBuffers
-  liftIO installSignalHandlers
-  ghciHandle handler (showException exception >> return False)
-
-showException :: SomeException -> GHCi ()
-showException se =
-  liftIO $ case fromException se of
-           -- omit the location for CmdLineError:
-           Just (CmdLineError s)    -> putException s
-           -- ditto:
-           Just ph@(PhaseFailed {}) -> putException (showGhcException ph "")
-           Just other_ghc_ex        -> putException (show other_ghc_ex)
-           Nothing                  ->
-               case fromException se of
-               Just UserInterrupt -> putException "Interrupted."
-               _                  -> putException ("*** Exception: " ++ show se)
-  where
-    putException = hPutStrLn stderr
-
-
------------------------------------------------------------------------------
--- recursive exception handlers
-
--- Don't forget to unblock async exceptions in the handler, or if we're
--- in an exception loop (eg. let a = error a in a) the ^C exception
--- may never be delivered.  Thanks to Marcin for pointing out the bug.
-
-ghciHandle :: (HasDynFlags m, ExceptionMonad m) => (SomeException -> m a) -> m a -> m a
-ghciHandle h m = gmask $ \restore -> do
-                 dflags <- getDynFlags
-                 gcatch (restore (GHC.prettyPrintGhcErrors dflags m)) $ \e -> restore (h e)
-
-ghciTry :: GHCi a -> GHCi (Either SomeException a)
-ghciTry (GHCi m) = GHCi $ \s -> gtry (m s)
-
-tryBool :: GHCi a -> GHCi Bool
-tryBool m = do
-    r <- ghciTry m
-    case r of
-      Left _  -> return False
-      Right _ -> return True
-
--- ----------------------------------------------------------------------------
--- Utils
-
-lookupModule :: GHC.GhcMonad m => String -> m Module
-lookupModule mName = lookupModuleName (GHC.mkModuleName mName)
-
-lookupModuleName :: GHC.GhcMonad m => ModuleName -> m Module
-lookupModuleName mName = GHC.lookupModule mName Nothing
-
-isHomeModule :: Module -> Bool
-isHomeModule m = GHC.modulePackageKey m == mainPackageKey
-
--- TODO: won't work if home dir is encoded.
--- (changeDirectory may not work either in that case.)
-expandPath :: MonadIO m => String -> InputT m String
-expandPath = liftIO . expandPathIO
-
-expandPathIO :: String -> IO String
-expandPathIO p =
-  case dropWhile isSpace p of
-   ('~':d) -> do
-        tilde <- getHomeDirectory -- will fail if HOME not defined
-        return (tilde ++ '/':d)
-   other ->
-        return other
-
-sameFile :: FilePath -> FilePath -> IO Bool
-sameFile path1 path2 = do
-    absPath1 <- canonicalizePath path1
-    absPath2 <- canonicalizePath path2
-    return $ absPath1 == absPath2
-
-wantInterpretedModule :: GHC.GhcMonad m => String -> m Module
-wantInterpretedModule str = wantInterpretedModuleName (GHC.mkModuleName str)
-
-wantInterpretedModuleName :: GHC.GhcMonad m => ModuleName -> m Module
-wantInterpretedModuleName modname = do
-   modl <- lookupModuleName modname
-   let str = moduleNameString modname
-   dflags <- getDynFlags
-   when (GHC.modulePackageKey modl /= thisPackage dflags) $
-      throwGhcException (CmdLineError ("module '" ++ str ++ "' is from another package;\nthis command requires an interpreted module"))
-   is_interpreted <- GHC.moduleIsInterpreted modl
-   when (not is_interpreted) $
-       throwGhcException (CmdLineError ("module '" ++ str ++ "' is not interpreted; try \':add *" ++ str ++ "' first"))
-   return modl
-
-wantNameFromInterpretedModule :: GHC.GhcMonad m
-                              => (Name -> SDoc -> m ())
-                              -> String
-                              -> (Name -> m ())
-                              -> m ()
-wantNameFromInterpretedModule noCanDo str and_then =
-  handleSourceError GHC.printException $ do
-   names <- GHC.parseName str
-   case names of
-      []    -> return ()
-      (n:_) -> do
-            let modl = ASSERT( isExternalName n ) GHC.nameModule n
-            if not (GHC.isExternalName n)
-               then noCanDo n $ ppr n <>
-                                text " is not defined in an interpreted module"
-               else do
-            is_interpreted <- GHC.moduleIsInterpreted modl
-            if not is_interpreted
-               then noCanDo n $ text "module " <> ppr modl <>
-                                text " is not interpreted"
-               else and_then n
diff --git a/src-bin/Main.hs b/src-bin/Main.hs
--- a/src-bin/Main.hs
+++ b/src-bin/Main.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, NondecreasingIndentation, TupleSections #-}
+{-# LANGUAGE CPP, NondecreasingIndentation, ScopedTypeVariables, TupleSections #-}
 {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
 
 -----------------------------------------------------------------------------
@@ -27,10 +27,17 @@
 import DriverPipeline   ( oneShot, compileFile )
 import DriverMkDepend   ( doMkDependHS )
 #ifdef GHCI
-import InteractiveUI    ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )
+import GHCi.UI          ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )
 #endif
 
+-- Frontend plugins
+#ifdef GHCI
+import DynamicLoading
+import Plugins
+#endif
+import Module           ( ModuleName )
 
+
 -- Various other random stuff that we need
 import Config
 import Constants
@@ -46,6 +53,7 @@
 import SrcLoc
 import Util
 import Panic
+import UniqSupply
 import MonadUtils       ( liftIO )
 
 -- Imports for --abi-hash
@@ -67,12 +75,14 @@
 
 -- clash additions
 import           Paths_clash_ghc
-import           InteractiveUI (makeHDL)
+import           GHCi.UI (makeHDL)
 import           Exception (gcatch)
 import           Data.IORef (IORef, newIORef, readIORef)
 import qualified Data.Version (showVersion)
 import           Control.Exception (Exception(..),ErrorCall (..),throw)
 
+import qualified GHC.LanguageExtensions as LangExt
+
 import qualified CLaSH.Backend
 import           CLaSH.Backend.SystemVerilog (SystemVerilogState)
 import           CLaSH.Backend.VHDL    (VHDLState)
@@ -101,19 +111,21 @@
    initGCStatistics -- See Note [-Bsymbolic and hooks]
    hSetBuffering stdout LineBuffering
    hSetBuffering stderr LineBuffering
-   GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
 
--- Disable CPR analysis in versions older than GHC 7.11 by always inserting the
--- -fcpr-off flag. From GHC 7.11 and up, CPR analysis, specifically the
--- worker/wrapper it creates, can be turned off with a DynFlag.
---
--- See [NOTE: CPR breaks CLaSH] why the worker/wrapper introduced by the CPR
--- analysis is bad for CLaSH
-#if __GLASGOW_HASKELL__ >= 711
+   -- Handle GHC-specific character encoding flags, allowing us to control how
+   -- GHC produces output regardless of OS.
+   env <- getEnvironment
+   case lookup "GHC_CHARENC" env of
+    Just "UTF-8" -> do
+     hSetEncoding stdout utf8
+     hSetEncoding stderr utf8
+    _ -> do
+     -- Avoid GHC erroring out when trying to display unhandled characters
+     hSetTranslit stdout
+     hSetTranslit stderr
+
+   GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
     argv0 <- getArgs
-#else
-    argv0 <- fmap ("-fcpr-off":) getArgs
-#endif
     libDir <- ghcLibDir
 
     let argv1 = map (mkGeneralLocated "on the commandline") argv0
@@ -128,6 +140,8 @@
                              , opt_hdlDir      = Nothing
                              , opt_hdlSyn      = Other
                              , opt_errorExtra  = False
+                             , opt_floatSupport = False
+                             , opt_allowZero   = False
                              })
     (argv3, clashFlagWarnings) <- parseCLaSHFlags r argv2
 
@@ -158,31 +172,37 @@
             dflags <- GHC.getSessionDynFlags
             let dflagsExtra = foldl DynFlags.xopt_set
                                     dflags
-                                    [ DynFlags.Opt_TemplateHaskell
-                                    , DynFlags.Opt_Arrows
-                                    , DynFlags.Opt_DataKinds
-                                    , DynFlags.Opt_TypeOperators
-                                    , DynFlags.Opt_FlexibleContexts
-                                    , DynFlags.Opt_ConstraintKinds
-                                    , DynFlags.Opt_TypeFamilies
-                                    , DynFlags.Opt_BinaryLiterals
-                                    , DynFlags.Opt_ExplicitNamespaces
-                                    , DynFlags.Opt_KindSignatures
+                                    [ LangExt.TemplateHaskell
+                                    , LangExt.TemplateHaskellQuotes
+                                    , LangExt.DataKinds
+                                    , LangExt.TypeOperators
+                                    , LangExt.FlexibleContexts
+                                    , LangExt.ConstraintKinds
+                                    , LangExt.TypeFamilies
+                                    , LangExt.BinaryLiterals
+                                    , LangExt.ExplicitNamespaces
+                                    , LangExt.KindSignatures
+                                    , LangExt.DeriveLift
+                                    , LangExt.TypeApplications
+                                    , LangExt.ScopedTypeVariables
+                                    , LangExt.MagicHash
+                                    , LangExt.ExplicitForAll
                                     ]
                 dflagsExtra1 = foldl DynFlags.xopt_unset dflagsExtra
-                                     [ DynFlags.Opt_ImplicitPrelude
-                                     , DynFlags.Opt_MonomorphismRestriction
+                                     [ LangExt.ImplicitPrelude
+                                     , LangExt.MonomorphismRestriction
                                      ]
 
                 ghcTyLitNormPlugin = GHC.mkModuleName "GHC.TypeLits.Normalise"
                 ghcTyLitExtrPlugin = GHC.mkModuleName "GHC.TypeLits.Extra.Solver"
+                ghcTyLitKNPlugin   = GHC.mkModuleName "GHC.TypeLits.KnownNat.Solver"
                 dflagsExtra2 = dflagsExtra1
                                   { DynFlags.pluginModNames = nub $
                                       ghcTyLitNormPlugin : ghcTyLitExtrPlugin :
+                                      ghcTyLitKNPlugin :
                                       DynFlags.pluginModNames dflagsExtra1
                                   }
 
-
             case postStartupMode of
                 Left preLoadMode ->
                     liftIO $ do
@@ -215,20 +235,7 @@
                DoSystemVerilog -> (CompManager, dflt_target,    LinkInMemory)
                _               -> (OneShot,     dflt_target,    LinkBinary)
 
-  let dflags1 = case lang of
-                HscInterpreted ->
-                    let platform = targetPlatform dflags0
-                        dflags0a = updateWays $ dflags0 { ways = interpWays }
-                        dflags0b = foldl gopt_set dflags0a
-                                 $ concatMap (wayGeneralFlags platform)
-                                             interpWays
-                        dflags0c = foldl gopt_unset dflags0b
-                                 $ concatMap (wayUnsetGeneralFlags platform)
-                                             interpWays
-                    in dflags0c
-                _ ->
-                    dflags0
-      dflags2 = dflags1{ ghcMode   = mode,
+  let dflags1 = dflags0{ ghcMode   = mode,
                          hscTarget = lang,
                          ghcLink   = link,
                          verbosity = case postLoadMode of
@@ -240,15 +247,30 @@
       -- can be overriden from the command-line
       -- XXX: this should really be in the interactive DynFlags, but
       -- we don't set that until later in interactiveUI
-      dflags3  | DoInteractive <- postLoadMode = imp_qual_enabled
+      dflags2  | DoInteractive <- postLoadMode = imp_qual_enabled
                | DoEval _      <- postLoadMode = imp_qual_enabled
-               | otherwise                     = dflags2
-        where imp_qual_enabled = dflags2 `gopt_set` Opt_ImplicitImportQualified
+               | otherwise                     = dflags1
+        where imp_qual_enabled = dflags1 `gopt_set` Opt_ImplicitImportQualified
 
         -- The rest of the arguments are "dynamic"
         -- Leftover ones are presumably files
-  (dflags4, fileish_args, dynamicFlagWarnings) <- GHC.parseDynamicFlags dflags3 args
+  (dflags3, fileish_args, dynamicFlagWarnings) <-
+      GHC.parseDynamicFlags dflags2 args
 
+  let dflags4 = case lang of
+                HscInterpreted | not (gopt Opt_ExternalInterpreter dflags3) ->
+                    let platform = targetPlatform dflags3
+                        dflags3a = updateWays $ dflags3 { ways = interpWays }
+                        dflags3b = foldl gopt_set dflags3a
+                                 $ concatMap (wayGeneralFlags platform)
+                                             interpWays
+                        dflags3c = foldl gopt_unset dflags3b
+                                 $ concatMap (wayUnsetGeneralFlags platform)
+                                             interpWays
+                    in dflags3c
+                _ ->
+                    dflags3
+
   GHC.prettyPrintGhcErrors dflags4 $ do
 
   let flagWarnings' = flagWarnings ++ dynamicFlagWarnings
@@ -258,9 +280,6 @@
        liftIO $ exitWith (ExitFailure 1)) $ do
          liftIO $ handleFlagWarnings dflags4 flagWarnings'
 
-        -- make sure we clean up after ourselves
-  GHC.defaultCleanupHandler dflags4 $ do
-
   liftIO $ showBanner postLoadMode dflags4
 
   let
@@ -292,6 +311,7 @@
     printInfoForUser (dflags6 { pprCols = 200 })
                      (pkgQual dflags6) (pprModuleMap dflags6)
 
+  liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6)
         ---------------- Final sanity checking -----------
   liftIO $ checkOptions postLoadMode dflags6 srcs objs
 
@@ -310,6 +330,7 @@
        DoEval exprs           -> ghciUI clashOpts srcs $ Just $ reverse exprs
        DoAbiHash              -> abiHash (map fst srcs)
        ShowPackages           -> liftIO $ showPackages dflags6
+       DoFrontend f           -> doFrontend f srcs
        DoVHDL                 -> clash makeVHDL
        DoVerilog              -> clash makeVerilog
        DoSystemVerilog        -> clash makeSystemVerilog
@@ -322,7 +343,11 @@
   _ -> case fromException e of
     Just (ErrorCall msg) ->
       throwOneError (mkPlainErrMsg df noSrcSpan (text "CLaSH error call:" $$ text msg))
-    _ -> throwOneError (mkPlainErrMsg df noSrcSpan (text "Other error:" $$ text (displayException e)))
+    _ -> case fromException e of
+      Just (e' :: SourceError) -> do
+        GHC.printException e'
+        liftIO $ exitWith (ExitFailure 1)
+      _ -> throwOneError (mkPlainErrMsg df noSrcSpan (text "Other error:" $$ text (displayException e)))
   where
     srcInfo = text "NB: The source location of the error is not exact, only indicative, as it is acquired after optimisations." $$
               text "The actual location of the error can be in a function that is inlined." $$
@@ -410,9 +435,10 @@
 
         -- -prof and --interactive are not a good combination
    when ((filter (not . wayRTSOnly) (ways dflags) /= interpWays)
-         && isInterpretiveMode mode) $
+         && isInterpretiveMode mode
+         && not (gopt Opt_ExternalInterpreter dflags)) $
       do throwGhcException (UsageError
-                   "--interactive can't be used with -prof or -unreg.")
+              "-fexternal-interpreter is required when using --interactive with a non-standard way (-prof, -static, or -dynamic).")
         -- -ohi sanity check
    if (isJust (outputHi dflags) &&
       (isCompManagerMode mode || srcs `lengthExceeds` 1))
@@ -436,10 +462,15 @@
         then throwGhcException (UsageError "no input files")
         else do
 
+   case mode of
+      StopBefore HCc | hscTarget dflags /= HscC
+        -> throwGhcException $ UsageError $
+           "the option -C is only available with an unregisterised GHC"
+      _ -> return ()
+
      -- Verify that output files point somewhere sensible.
    verifyOutputFiles dflags
 
-
 -- Compiler output options
 
 -- Called to verify that the output files point somewhere valid.
@@ -534,6 +565,7 @@
   | DoEval [String]         -- ghc -e foo -e bar => DoEval ["bar", "foo"]
   | DoAbiHash               -- ghc --abi-hash
   | ShowPackages            -- ghc --show-packages
+  | DoFrontend ModuleName   -- ghc --frontend Plugin.Module
   | DoVHDL                  -- ghc --vhdl
   | DoVerilog               -- ghc --verilog
   | DoSystemVerilog         -- ghc --systemverilog
@@ -559,6 +591,9 @@
 doEvalMode :: String -> Mode
 doEvalMode str = mkPostLoadMode (DoEval [str])
 
+doFrontendMode :: String -> Mode
+doFrontendMode str = mkPostLoadMode (DoFrontend (mkModuleName str))
+
 mkPostLoadMode :: PostLoadMode -> Mode
 mkPostLoadMode = Right . Right
 
@@ -574,6 +609,10 @@
 isDoMakeMode (Right (Right DoMake)) = True
 isDoMakeMode _ = False
 
+isDoEvalMode :: Mode -> Bool
+isDoEvalMode (Right (Right (DoEval _))) = True
+isDoEvalMode _ = False
+
 #ifdef GHCI
 isInteractiveMode :: PostLoadMode -> Bool
 isInteractiveMode DoInteractive = True
@@ -675,8 +714,8 @@
           "LibDir",
           "Global Package DB",
           "C compiler flags",
-          "Gcc Linker flags",
-          "Ld Linker flags"],
+          "C compiler link flags",
+          "ld flags"],
     let k' = "-print-" ++ map (replaceSpace . toLower) k
         replaceSpace ' ' = '-'
         replaceSpace c   = c
@@ -696,6 +735,7 @@
   , defFlag "-interactive" (PassFlag (setMode doInteractiveMode))
   , defFlag "-abi-hash"    (PassFlag (setMode doAbiHashMode))
   , defFlag "e"            (SepArg   (\s -> setMode (doEvalMode s) "-e"))
+  , defFlag "-frontend"    (SepArg   (\s -> setMode (doFrontendMode s) "-frontend"))
   , defFlag "-vhdl"        (PassFlag (setMode doVHDLMode))
   , defFlag "-verilog"     (PassFlag (setMode doVerilogMode))
   , defFlag "-systemverilog" (PassFlag (setMode doSystemVerilogMode))
@@ -722,6 +762,15 @@
                       | isShowGhcUsageMode newMode &&
                         isDoInteractiveMode oldMode ->
                             ((showGhciUsageMode, newFlag), [])
+
+                    -- If we have both -e and --interactive then -e always wins
+                    _ | isDoEvalMode oldMode &&
+                        isDoInteractiveMode newMode ->
+                            ((oldMode, oldFlag), [])
+                      | isDoEvalMode newMode &&
+                        isDoInteractiveMode oldMode ->
+                            ((newMode, newFlag), [])
+
                     -- Otherwise, --help/--version/--numeric-version always win
                       | isDominantFlag oldMode -> ((oldMode, oldFlag), [])
                       | isDominantFlag newMode -> ((newMode, newFlag), [])
@@ -764,13 +813,7 @@
 
 doMake :: [(String,Maybe Phase)] -> Ghc ()
 doMake srcs  = do
-    let (hs_srcs, non_hs_srcs) = partition haskellish srcs
-
-        haskellish (f,Nothing) =
-          looksLikeModuleName f || isHaskellUserSrcFilename f || '.' `notElem` f
-        haskellish (_,Just phase) =
-          phase `notElem` [ As True, As False, Cc, Cobjc, Cobjcpp, CmmCpp, Cmm
-                          , StopLn]
+    let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs
 
     hsc_env <- GHC.getSession
 
@@ -918,6 +961,20 @@
 dumpPackagesSimple dflags = putMsg dflags (pprPackagesSimple dflags)
 
 -- -----------------------------------------------------------------------------
+-- Frontend plugin support
+
+doFrontend :: ModuleName -> [(String, Maybe Phase)] -> Ghc ()
+#ifndef GHCI
+doFrontend _ _ =
+    throwGhcException (CmdLineError "not built for interactive use")
+#else
+doFrontend modname srcs = do
+    hsc_env <- getSession
+    frontend_plugin <- liftIO $ loadFrontendPlugin hsc_env modname
+    frontend frontend_plugin (frontendPluginOpts (hsc_dflags hsc_env)) srcs
+#endif
+
+-- -----------------------------------------------------------------------------
 -- ABI hash support
 
 {-
@@ -927,8 +984,8 @@
 System.Bar.  The modules must already be compiled, and appropriate -i
 options may be necessary in order to find the .hi files.
 
-This is used by Cabal for generating the InstalledPackageId for a
-package.  The InstalledPackageId must change when the visible ABI of
+This is used by Cabal for generating the ComponentId for a
+package.  The ComponentId must change when the visible ABI of
 the package chagnes, so during registration Cabal calls ghc --abi-hash
 to get a hash of the package's ABI.
 -}
@@ -968,7 +1025,7 @@
 
   putStrLn (showPpr dflags f)
 
--- -----------------------------------------------------------------------------
+-----------------------------------------------------------------------------
 -- VHDL Generation
 
 makeHDL' :: CLaSH.Backend.Backend backend => (Int -> HdlSyn -> backend) ->  IORef CLaSHOpts -> [(String,Maybe Phase)] -> Ghc ()
@@ -992,7 +1049,7 @@
   where
     oneError f =
         "unrecognised flag: " ++ f ++ "\n" ++
-        (case fuzzyMatch f (nub allFlags) of
+        (case fuzzyMatch f (nub allNonDeprecatedFlags) of
             [] -> ""
             suggs -> "did you mean one of:\n" ++ unlines (map ("  " ++) suggs))
 
diff --git a/src-ghc/CLaSH/GHC/CLaSHFlags.hs b/src-ghc/CLaSH/GHC/CLaSHFlags.hs
--- a/src-ghc/CLaSH/GHC/CLaSHFlags.hs
+++ b/src-ghc/CLaSH/GHC/CLaSHFlags.hs
@@ -46,6 +46,8 @@
   , defFlag "clash-hdldir" (SepArg (setHdlDir r))
   , defFlag "clash-hdlsyn" (SepArg (setHdlSyn r))
   , defFlag "clash-error-extra" (NoArg (liftEwM (setErrorExtra r)))
+  , defFlag "clash-float-support" (NoArg (liftEwM (setFloatSupport r)))
+  , defFlag "clash-allow-zero-width" (NoArg (liftEwM (setAllowZeroWidth r)))
   ]
 
 setInlineLimit :: IORef CLaSHOpts
@@ -97,3 +99,9 @@
 
 setErrorExtra :: IORef CLaSHOpts -> IO ()
 setErrorExtra r = modifyIORef r (\c -> c {opt_errorExtra = True})
+
+setFloatSupport :: IORef CLaSHOpts -> IO ()
+setFloatSupport r = modifyIORef r (\c -> c {opt_floatSupport = True})
+
+setAllowZeroWidth :: IORef CLaSHOpts -> IO ()
+setAllowZeroWidth r = modifyIORef r (\c -> c {opt_allowZero = True})
diff --git a/src-ghc/CLaSH/GHC/Evaluator.hs b/src-ghc/CLaSH/GHC/Evaluator.hs
--- a/src-ghc/CLaSH/GHC/Evaluator.hs
+++ b/src-ghc/CLaSH/GHC/Evaluator.hs
@@ -6,6 +6,7 @@
 
 {-# LANGUAGE ViewPatterns      #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
 
 module CLaSH.GHC.Evaluator where
 
@@ -16,19 +17,23 @@
 import qualified Data.HashMap.Strict as HashMap
 import qualified Data.List           as List
 import Data.Text                     (Text)
+import           GHC.Real            (Ratio (..))
 import           Unbound.Generics.LocallyNameless (runFreshM, bind, embed,
                                                    string2Name)
 
 import           CLaSH.Core.DataCon  (DataCon (..))
 import           CLaSH.Core.Literal  (Literal (..))
+import           CLaSH.Core.Pretty   (showDoc)
 import           CLaSH.Core.Term     (Term (..))
-import           CLaSH.Core.Type     (Type (..), ConstTy (..),
+import           CLaSH.Core.Type     (Type (..), ConstTy (..), LitTy (..),
                                       TypeView (..), tyView, mkFunTy,
                                       mkTyConApp, splitFunForallTy)
 import           CLaSH.Core.TyCon    (TyCon, TyConName, tyConDataCons)
 import           CLaSH.Core.TysPrim  (typeNatKind)
-import           CLaSH.Core.Util     (collectArgs,mkApps,mkVec,termType,tyNatSize)
+import           CLaSH.Core.Util     (collectArgs,mkApps,mkRTree,mkVec,termType,
+                                      tyNatSize)
 import           CLaSH.Core.Var      (Var (..))
+import           CLaSH.Util          (clogBase, flogBase, curLoc)
 
 reduceConstant :: HashMap.HashMap TyConName TyCon -> Bool -> Term -> Term
 reduceConstant tcm isSubj e@(collectArgs -> (Prim nm ty, args)) = case nm of
@@ -99,6 +104,11 @@
                    }
        in maybe e Data dc
 
+  "GHC.Integer.Logarithms.integerLogBase#"
+    | Just (a,b) <- integerLiterals tcm isSubj args
+    , Just c <- flogBase a b
+    -> (Literal . IntLiteral . toInteger) c
+
   "GHC.Integer.Type.integerToInt"
     | [Literal (IntegerLiteral i)] <- reduceTerms tcm isSubj args
     -> integerToIntLiteral i
@@ -128,6 +138,17 @@
   "GHC.Integer.Type.remInteger" | Just (i,j) <- integerLiterals tcm isSubj args
     -> integerToIntegerLiteral (i `rem` j)
 
+  "GHC.Integer.Type.divModInteger" | Just (i,j) <- integerLiterals tcm isSubj args
+    -> let (_,tyView -> TyConApp ubTupTcNm [liftedKi,_,intTy,_]) = splitFunForallTy ty
+           (Just ubTupTc) = HashMap.lookup ubTupTcNm tcm
+           [ubTupDc] = tyConDataCons ubTupTc
+           (d,m) = divMod i j
+       in  mkApps (Data ubTupDc) [ Right liftedKi, Right liftedKi
+                                 , Right intTy,    Right intTy
+                                 , Left (Literal (IntegerLiteral d))
+                                 , Left (Literal (IntegerLiteral m))
+                                 ]
+
   "GHC.Integer.Type.gtInteger" | Just (i,j) <- integerLiterals tcm isSubj args
     -> boolToBoolLiteral tcm ty (i > j)
 
@@ -184,6 +205,83 @@
             [intDc] = tyConDataCons intTc
         in  mkApps (Data intDc) [Left (Literal (IntLiteral i))]
 
+  "GHC.Float.$w$sfromRat''" -- XXX: Very fragile
+    | [Literal (IntLiteral _minEx)
+      ,Literal (IntLiteral matDigs)
+      ,Literal (IntegerLiteral n)
+      ,Literal (IntegerLiteral d)] <- reduceTerms tcm isSubj args
+    -> case fromInteger matDigs of
+          matDigs'
+            | matDigs' == floatDigits (undefined :: Float)
+            -> Literal (FloatLiteral (toRational (fromRational (n :% d) :: Float)))
+            | matDigs' == floatDigits (undefined :: Double)
+            -> Literal (DoubleLiteral (toRational (fromRational (n :% d) :: Double)))
+          _ -> error $ $(curLoc) ++ "GHC.Float.$w$sfromRat'': Not a Float or Double: " ++ showDoc e
+
+  "GHC.Float.$w$sfromRat''1" -- XXX: Very fragile
+    | [Literal (IntLiteral _minEx)
+      ,Literal (IntLiteral matDigs)
+      ,Literal (IntegerLiteral n)
+      ,Literal (IntegerLiteral d)] <- reduceTerms tcm isSubj args
+    -> case fromInteger matDigs of
+          matDigs'
+            | matDigs' == floatDigits (undefined :: Float)
+            -> Literal (FloatLiteral (toRational (fromRational (n :% d) :: Float)))
+            | matDigs' == floatDigits (undefined :: Double)
+            -> Literal (DoubleLiteral (toRational (fromRational (n :% d) :: Double)))
+          _ -> error $ $(curLoc) ++ "GHC.Float.$w$sfromRat'': Not a Float or Double: " ++ showDoc e
+
+  "GHC.Integer.Type.doubleFromInteger"
+    | [Literal (IntegerLiteral i)] <- reduceTerms tcm isSubj args
+    -> Literal (DoubleLiteral (toRational (fromInteger i :: Double)))
+
+  "GHC.Prim.double2Float#"
+    | [Literal (DoubleLiteral d)] <- reduceTerms tcm isSubj args
+    -> Literal (FloatLiteral (toRational (fromRational d :: Float)))
+
+  "GHC.Base.eqString"
+    | [(_,[Left (Literal (StringLiteral s1))])
+      ,(_,[Left (Literal (StringLiteral s2))])
+      ] <- map collectArgs (Either.lefts args)
+    -> boolToBoolLiteral tcm ty (s1 == s2)
+
+  "CLaSH.Promoted.Nat.powSNat"
+    | [Right a, Right b] <- (map (runExcept . tyNatSize tcm) . Either.rights) args
+    -> let c = case a of
+                 2 -> 1 `shiftL` (fromInteger b)
+                 _ -> a ^ b
+           (_,tyView -> TyConApp snatTcNm _) = splitFunForallTy ty
+           (Just snatTc) = HashMap.lookup snatTcNm tcm
+           [snatDc] = tyConDataCons snatTc
+       in  mkApps (Data snatDc) [Right (LitTy (NumTy c)), Left (Literal (IntegerLiteral c))]
+
+  "CLaSH.Promoted.Nat.flogBaseSNat"
+    | [_,_,Right a, Right b] <- (map (runExcept . tyNatSize tcm) . Either.rights) args
+    , Just c <- flogBase a b
+    , let c' = toInteger c
+    -> let (_,tyView -> TyConApp snatTcNm _) = splitFunForallTy ty
+           (Just snatTc) = HashMap.lookup snatTcNm tcm
+           [snatDc] = tyConDataCons snatTc
+       in  mkApps (Data snatDc) [Right (LitTy (NumTy c')), Left (Literal (IntegerLiteral c'))]
+
+  "CLaSH.Promoted.Nat.clogBaseSNat"
+    | [_,_,Right a, Right b] <- (map (runExcept . tyNatSize tcm) . Either.rights) args
+    , Just c <- clogBase a b
+    , let c' = toInteger c
+    -> let (_,tyView -> TyConApp snatTcNm _) = splitFunForallTy ty
+           (Just snatTc) = HashMap.lookup snatTcNm tcm
+           [snatDc] = tyConDataCons snatTc
+       in  mkApps (Data snatDc) [Right (LitTy (NumTy c')), Left (Literal (IntegerLiteral c'))]
+
+  "CLaSH.Promoted.Nat.logBaseSNat"
+    | [_,Right a, Right b] <- (map (runExcept . tyNatSize tcm) . Either.rights) args
+    , Just c <- flogBase a b
+    , let c' = toInteger c
+    -> let (_,tyView -> TyConApp snatTcNm _) = splitFunForallTy ty
+           (Just snatTc) = HashMap.lookup snatTcNm tcm
+           [snatDc] = tyConDataCons snatTc
+       in  mkApps (Data snatDc) [Right (LitTy (NumTy c')), Left (Literal (IntegerLiteral c'))]
+
   "CLaSH.Sized.Internal.BitVector.eq#" | Just (i,j) <- bitVectorLiterals tcm isSubj args
     -> boolToBoolLiteral tcm ty (i == j)
 
@@ -241,9 +339,13 @@
     , nm' == "CLaSH.Sized.Internal.Unsigned.fromInteger#"
     -> integerToIntegerLiteral i
 
-  "CLaSH.Promoted.Nat.SNat"
-    | [(Literal (IntegerLiteral _),[]), (Data _,_)] <- (map collectArgs . Either.lefts) args
-    -> mkApps snatCon args
+  "CLaSH.Sized.RTree.treplicate"
+    | isSubj
+    , (TyConApp treeTcNm [lenTy,argTy]) <- tyView (runFreshM (termType tcm e))
+    , Right len <- runExcept (tyNatSize tcm lenTy)
+    -> let (Just treeTc) = HashMap.lookup treeTcNm tcm
+           [lrCon,brCon] = tyConDataCons treeTc
+       in  mkRTree lrCon brCon argTy len (replicate (2^len) (last $ Either.lefts args))
 
   "CLaSH.Sized.Vector.replicate"
     | isSubj
@@ -357,17 +459,3 @@
     nName        = string2Name "n"
     nVar         = VarTy typeNatKind nName
     nTV          = TyVar nName (embed typeNatKind)
-
-snatCon :: Term
-snatCon = Data (MkData snanNm 1 snatTy [nName] [] argTys)
-  where
-    snanNm = string2Name "CLaSH.Promoted.Nat.SNat"
-    snatTy = ForAllTy (bind nTV funTy)
-    argTys = [ConstTy (TyCon (string2Name "GHC.Integer.Type.Integer"))
-             ,AppTy (AppTy (ConstTy (TyCon (string2Name "Data.Proxy.Proxy"))) typeNatKind)
-                    nVar
-             ]
-    funTy  = foldr mkFunTy (ConstTy (TyCon (string2Name "CLaSH.Promoted.Nat.SNat"))) argTys
-    nName  = string2Name "n"
-    nVar   = VarTy typeNatKind nName
-    nTV    = TyVar nName (embed typeNatKind)
diff --git a/src-ghc/CLaSH/GHC/GHC2Core.hs b/src-ghc/CLaSH/GHC/GHC2Core.hs
--- a/src-ghc/CLaSH/GHC/GHC2Core.hs
+++ b/src-ghc/CLaSH/GHC/GHC2Core.hs
@@ -4,7 +4,6 @@
   Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>
 -}
 
-{-# LANGUAGE CPP              #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TemplateHaskell  #-}
 {-# LANGUAGE TupleSections    #-}
@@ -46,27 +45,27 @@
 import qualified Unbound.Generics.LocallyNameless     as Unbound
 
 -- GHC API
-import CoAxiom    (CoAxiom (co_ax_branches), CoAxBranch (cab_lhs,cab_rhs), brListMapM)
-import Coercion   (Coercion (..),Role(..),coercionType,coercionKind,mkCoercionType)
+import CoAxiom    (CoAxiom (co_ax_branches), CoAxBranch (cab_lhs,cab_rhs),
+                   fromBranches)
+import Coercion   (Role(..),coercionType,coercionKind,mkCoercionType)
 import CoreFVs    (exprSomeFreeVars)
 import CoreSyn    (AltCon (..), Bind (..), CoreExpr,
-                   Expr (..), rhssOfAlts)
+                   Expr (..), Unfolding (..), rhssOfAlts, unfoldingTemplate)
 import DataCon    (DataCon, dataConExTyVars,
                    dataConName, dataConRepArgTys,
                    dataConTag, dataConTyCon,
-                   dataConUnivTyVars, dataConWorkId,
-                   dataConWrapId_maybe)
+                   dataConUnivTyVars, dataConWorkId)
 import DynFlags   (unsafeGlobalDynFlags)
 import FamInstEnv (FamInst (..), FamInstEnvs,
                    familyInstances)
 import FastString (unpackFS)
 import Id         (isDataConId_maybe)
-import IdInfo     (IdDetails (..))
-import Kind       (isSuperKindTyCon)
+import IdInfo     (IdDetails (..), unfoldingInfo)
 import Literal    (Literal (..))
 import Module     (moduleName, moduleNameString)
 import Name       (Name, nameModule_maybe,
                    nameOccName, nameUnique, getSrcSpan)
+import PrelNames  (tYPETyConKey)
 import OccName    (occNameString)
 import Outputable (showPpr, showSDocUnsafe)
 import Pair       (Pair (..))
@@ -75,21 +74,18 @@
 import TyCon      (AlgTyConRhs (..), TyCon,
                    algTyConRhs, isAlgTyCon, isFamilyTyCon,
                    isFunTyCon, isNewTyCon,
-                   isPrimTyCon, isTupleTyCon, isClosedSynFamilyTyCon_maybe,
-#if __GLASGOW_HASKELL__ >= 711
+                   isPrimTyCon, isTupleTyCon,
+                   isClosedSynFamilyTyConWithAxiom_maybe,
                    expandSynTyCon_maybe,
-#else
-                   tcExpandTyCon_maybe,
-#endif
                    tyConArity,
                    tyConDataCons, tyConKind,
                    tyConName, tyConUnique)
-import Type       (mkTopTvSubst, substTy, tcView)
-import TypeRep    (TyLit (..), Type (..))
-import Unique     (Uniquable (..), Unique, getKey)
+import Type       (mkTvSubstPrs, substTy, coreView)
+import TyCoRep    (Coercion (..), TyBinder (..), TyLit (..), Type (..))
+import Unique     (Uniquable (..), Unique, getKey, hasKey)
 import Var        (Id, TyVar, Var, idDetails,
                    isTyVar, varName, varType,
-                   varUnique)
+                   varUnique, idInfo)
 import VarSet     (isEmptyVarSet)
 
 -- Local imports
@@ -139,7 +135,7 @@
       | isTupleTyCon tc     = mkTupleTyCon
       | isAlgTyCon tc       = mkAlgTyCon
       | isPrimTyCon tc      = mkPrimTyCon
-      | isSuperKindTyCon tc = mkSuperKindTyCon
+      | tc `hasKey` tYPETyConKey = mkSuperKindTyCon
       | otherwise           = mkVoidTyCon
       where
         tcArity = tyConArity tc
@@ -162,12 +158,13 @@
         mkFunTyCon = do
           tcName <- coreToName tyConName tyConUnique qualfiedNameString tc
           tcKind <- coreToType (tyConKind tc)
-          substs <- case isClosedSynFamilyTyCon_maybe tc of
+          substs <- case isClosedSynFamilyTyConWithAxiom_maybe tc of
             Nothing -> let instances = familyInstances fiEnvs tc
                        in  mapM famInstToSubst instances
-            Just cx -> let bx = co_ax_branches cx
-                       in  brListMapM (\b -> (,) <$> mapM coreToType (cab_lhs b)
-                                                 <*> coreToType (cab_rhs b)) bx
+            Just cx -> let bx = fromBranches (co_ax_branches cx)
+                       in  mapM (\b -> (,) <$> mapM coreToType (cab_lhs b)
+                                           <*> coreToType (cab_rhs b))
+                                bx
           return
             C.FunTyCon
             { C.tyConName  = tcName
@@ -179,7 +176,7 @@
         mkTupleTyCon = do
           tcName <- coreToName tyConName tyConUnique qualfiedNameString tc
           tcKind <- coreToType (tyConKind tc)
-          tcDc   <- fmap (C.DataTyCon . (:[])) . coreToDataCon False . head . tyConDataCons $ tc
+          tcDc   <- fmap (C.DataTyCon . (:[])) . coreToDataCon . head . tyConDataCons $ tc
           return
             C.AlgTyCon
             { C.tyConName   = tcName
@@ -218,14 +215,14 @@
 makeAlgTyConRhs :: AlgTyConRhs
                 -> State GHC2CoreState (Maybe C.AlgTyConRhs)
 makeAlgTyConRhs algTcRhs = case algTcRhs of
-  DataTyCon dcs _ -> Just <$> C.DataTyCon <$> mapM (coreToDataCon False) dcs
-  NewTyCon dc _ (rhsTvs,rhsEtad) _ -> Just <$> (C.NewTyCon <$> coreToDataCon False dc
+  DataTyCon dcs _ -> Just <$> C.DataTyCon <$> mapM coreToDataCon dcs
+  NewTyCon dc _ (rhsTvs,rhsEtad) _ -> Just <$> (C.NewTyCon <$> coreToDataCon dc
                                                            <*> ((,) <$> mapM coreToVar rhsTvs
                                                                     <*> coreToType rhsEtad
                                                                )
                                                )
   AbstractTyCon _ -> return Nothing
-  DataFamilyTyCon -> return Nothing
+  TupleTyCon {}   -> error "Cannot handle tuple tycons"
 
 coreToTerm :: PrimMap a
            -> [Var]
@@ -235,7 +232,9 @@
 coreToTerm primMap unlocs srcsp coreExpr = Reader.runReaderT (term coreExpr) srcsp
   where
     term :: CoreExpr -> ReaderT SrcSpan (State GHC2CoreState) C.Term
-    term (Var x)                 = lift (var x)
+    term (Var x)                 = do
+      srcsp' <- Reader.ask
+      lift (var srcsp' x)
     term (Lit l)                 = return $ C.Literal (coreToLiteral l)
     term (App eFun (Type tyArg)) = C.TyApp <$> term eFun <*> lift (coreToType tyArg)
     term (App eFun eArg)         = C.App   <$> term eFun <*> term eArg
@@ -295,15 +294,22 @@
     term (Type t)          = C.Prim (pack "_TY_") <$> lift (coreToType t)
     term (Coercion co)     = C.Prim (pack "_CO_") <$> lift (coreToType (coercionType co))
 
-    var x = do
+    var srcsp' x = do
         xVar   <- coreToVar x
         xPrim  <- coreToPrimVar x
         let xNameS = pack $ Unbound.name2String xPrim
         xType  <- coreToType (varType x)
         case isDataConId_maybe x of
           Just dc -> case HashMap.lookup xNameS primMap of
-                      Just _  -> return $ C.Prim xNameS xType
-                      Nothing -> C.Data <$> coreToDataCon (isDataConWrapId x && not (isNewTyCon (dataConTyCon dc))) dc
+            Just _  -> return $ C.Prim xNameS xType
+            Nothing -> if isDataConWrapId x && not (isNewTyCon (dataConTyCon dc))
+              then let xInfo = idInfo x
+                       unfolding = unfoldingInfo xInfo
+                   in  case unfolding of
+                          CoreUnfolding {} -> Reader.runReaderT (term (unfoldingTemplate unfolding)) srcsp'
+                          NoUnfolding -> error ("No unfolding for DC wrapper: " ++ showPpr unsafeGlobalDynFlags x)
+                          _ -> error ("Unexpected unfolding for DC wrapper: " ++ showPpr unsafeGlobalDynFlags x)
+              else C.Data <$> coreToDataCon dc
           Nothing -> case HashMap.lookup xNameS primMap of
             Just (Primitive f _)
               | f == pack "CLaSH.Signal.Internal.mapSignal#" -> return (mapSignalTerm xType)
@@ -325,7 +331,7 @@
     alt (LitAlt l  , _ , e) = bind (C.LitPat . embed $ coreToLiteral l) <$> term e
     alt (DataAlt dc, xs, e) = case span isTyVar xs of
       (tyvs,tmvs) -> bind <$> (C.DataPat . embed <$>
-                                lift (coreToDataCon False dc) <*>
+                                lift (coreToDataCon dc) <*>
                                 (rebind <$>
                                   lift (mapM coreToTyVar tyvs) <*>
                                   lift (mapM coreToId tmvs))) <*>
@@ -341,13 +347,13 @@
       MachWord   i   -> C.WordLiteral i
       MachWord64 i   -> C.WordLiteral i
       LitInteger i _ -> C.IntegerLiteral i
-      MachFloat r    -> C.RationalLiteral r
-      MachDouble r   -> C.RationalLiteral r
+      MachFloat r    -> C.FloatLiteral r
+      MachDouble r   -> C.DoubleLiteral r
       MachNullAddr   -> C.StringLiteral []
       MachLabel fs _ _ -> C.StringLiteral (unpackFS fs)
 
 addUsefull :: SrcSpan -> ReaderT SrcSpan (State GHC2CoreState) a
-            -> ReaderT SrcSpan (State GHC2CoreState) a
+           -> ReaderT SrcSpan (State GHC2CoreState) a
 addUsefull x = Reader.local (\r -> if isGoodSrcSpan x then x else r)
 
 isIntegerTy :: Type -> State GHC2CoreState Bool
@@ -366,7 +372,7 @@
   case tc1M of
     Just _ -> return tc1M
     _ -> hasPrimCo co2
-hasPrimCo (ForAllCo _ co) = hasPrimCo co
+hasPrimCo (ForAllCo _ _ co) = hasPrimCo co
 
 hasPrimCo co@(AxiomInstCo _ _ coers) = do
     let (Pair ty1 _) = coercionKind co
@@ -394,7 +400,7 @@
     Just _ -> return tc1M
     _ -> hasPrimCo co2
 
-hasPrimCo (AxiomRuleCo _ _ coers) = do
+hasPrimCo (AxiomRuleCo _ coers) = do
   tcs <- catMaybes <$> mapM hasPrimCo coers
   return (listToMaybe tcs)
 
@@ -405,20 +411,11 @@
 
 hasPrimCo _ = return Nothing
 
-coreToDataCon :: Bool
-              -> DataCon
+coreToDataCon :: DataCon
               -> State GHC2CoreState C.DataCon
-coreToDataCon mkWrap dc = do
+coreToDataCon dc = do
     repTys <- mapM coreToType (dataConRepArgTys dc)
-    dcTy   <- if mkWrap
-                then case dataConWrapId_maybe dc of
-                        Just wrapId -> coreToType (varType wrapId)
-                        Nothing     -> error $ concat [ $(curLoc)
-                                                      , "DataCon Wrapper: "
-                                                      , showPpr unsafeGlobalDynFlags dc
-                                                      , " not found"
-                                                      ]
-                else coreToType (varType $ dataConWorkId dc)
+    dcTy   <- coreToType (varType $ dataConWorkId dc)
     mkDc dcTy repTys
   where
     mkDc dcTy repTys = do
@@ -436,31 +433,28 @@
 
 coreToType :: Type
            -> State GHC2CoreState C.Type
-coreToType ty = coreToType' $ fromMaybe ty (tcView ty)
+coreToType ty = coreToType' $ fromMaybe ty (coreView ty)
 
 coreToType' :: Type
             -> State GHC2CoreState C.Type
 coreToType' (TyVarTy tv) = C.VarTy <$> coreToType (varType tv) <*> (coreToVar tv)
 coreToType' (TyConApp tc args)
   | isFunTyCon tc = foldl C.AppTy (C.ConstTy C.Arrow) <$> mapM coreToType args
-#if __GLASGOW_HASKELL__ >= 711
   | otherwise     = case expandSynTyCon_maybe tc args of
-#else
-  | otherwise     = case tcExpandTyCon_maybe tc args of
-#endif
                       Just (substs,synTy,remArgs) -> do
-                        let substs' = mkTopTvSubst substs
+                        let substs' = mkTvSubstPrs substs
                             synTy'  = substTy substs' synTy
                         foldl C.AppTy <$> coreToType synTy' <*> mapM coreToType remArgs
                       _ -> do
                         tcName <- coreToName tyConName tyConUnique qualfiedNameString tc
                         tyConMap %= (HSM.insert tcName tc)
                         C.mkTyConApp <$> (pure tcName) <*> mapM coreToType args
-coreToType' (FunTy ty1 ty2)  = C.mkFunTy <$> coreToType ty1 <*> coreToType ty2
-coreToType' (ForAllTy tv ty) = C.ForAllTy <$>
-                               (bind <$> coreToTyVar tv <*> coreToType ty)
+coreToType' (ForAllTy (Named tv _) ty) = C.ForAllTy <$> (bind <$> coreToTyVar tv <*> coreToType ty)
+coreToType' (ForAllTy (Anon ty1) ty2)  = C.mkFunTy <$> coreToType ty1 <*> coreToType ty2
 coreToType' (LitTy tyLit)    = return $ C.LitTy (coreToTyLit tyLit)
 coreToType' (AppTy ty1 ty2)  = C.AppTy <$> coreToType ty1 <*> coreToType' ty2
+coreToType' t@(CastTy _ _)   = error ("Cannot handle CastTy " ++ showPpr unsafeGlobalDynFlags t)
+coreToType' t@(CoercionTy _) = error ("Cannot handle CoercionTy " ++ showPpr unsafeGlobalDynFlags t)
 
 coreToTyLit :: TyLit
             -> C.LitTy
@@ -619,14 +613,14 @@
 -- | Given the type:
 --
 -- @
--- forall t.forall n.forall a.SClock t -> Vec n (Signal' t a) ->
+-- forall t.forall n.forall a.Vec n (Signal' t a) ->
 -- Signal' t (Vec n a)
 -- @
 --
 -- Generate the term:
 --
 -- @
--- /\(t:Clock)./\(n:Nat)./\(a:*).\(sclk:SClock t).\(vs:Signal' (Vec n a)).vs
+-- /\(t:Clock)./\(n:Nat)./\(a:*).\(vs:Signal' t (Vec n a)).vs
 -- @
 vecUnwrapTerm :: C.Type
               -> C.Term
@@ -634,9 +628,8 @@
     C.TyLam (bind tTV (
     C.TyLam (bind nTV (
     C.TyLam (bind aTV (
-    C.Lam   (bind sclkId (
     C.Lam   (bind vsId (
-    C.Var vsTy vsName))))))))))
+    C.Var vsTy vsName))))))))
   where
     (tTV,nTV,aTV,funTy) = runFreshM $ do
       { (tTV',C.ForAllTy tvNTy) <- unbind tvTTy
@@ -644,12 +637,9 @@
       ; (aTV',funTy')           <- unbind tvATy
       ; return (tTV',nTV',aTV',funTy')
       }
-    (C.FunTy sclkTy funTy'') = C.tyView funTy
-    (C.FunTy _ vsTy)         = C.tyView funTy''
-    sclkName = string2Name "sclk"
-    vsName   = string2Name "vs"
-    sclkId   = C.Id sclkName (embed sclkTy)
-    vsId     = C.Id vsName   (embed vsTy)
+    (C.FunTy _ vsTy) = C.tyView funTy
+    vsName           = string2Name "vs"
+    vsId             = C.Id vsName   (embed vsTy)
 
 vecUnwrapTerm ty = error $ $(curLoc) ++ show ty
 
@@ -697,26 +687,34 @@
 
 traverseTerm ty = error $ $(curLoc) ++ show ty
 
+-- ∀ (r :: GHC.Types.RuntimeRep)
+--   (a :: GHC.Prim.TYPE GHC.Types.PtrRepLifted)
+--   (b :: GHC.Prim.TYPE r).
+-- (a -> b) -> a -> b
+
+
 -- | Given the type:
 --
--- @forall a. forall b. (a -> b) -> a -> b@
+-- @forall (r :: Rep) (a :: TYPE Lifted) (b :: TYPE r). (a -> b) -> a -> b@
 --
 -- Generate the term:
 --
--- @/\(a:*)./\(b:*).\(f : (a -> b)).\(x : a).f x@
+-- @/\(r:Rep)/\(a:TYPE Lifted)./\(b:TYPE r).\(f : (a -> b)).\(x : a).f x@
 dollarTerm :: C.Type
            -> C.Term
-dollarTerm (C.ForAllTy tvATy) =
+dollarTerm (C.ForAllTy tvRTy) =
+    C.TyLam (bind rTV (
     C.TyLam (bind aTV (
     C.TyLam (bind bTV (
     C.Lam   (bind fId (
     C.Lam   (bind xId (
-    C.App (C.Var fTy fName) (C.Var aTy xName)))))))))
+    C.App (C.Var fTy fName) (C.Var aTy xName)))))))))))
   where
-    (aTV,bTV,funTy) = runFreshM $ do
-      { (aTV',C.ForAllTy tvBTy) <- unbind tvATy
+    (rTV,aTV,bTV,funTy) = runFreshM $ do
+      { (rTV',C.ForAllTy tvATy) <- unbind tvRTy
+      ; (aTV',C.ForAllTy tvBTy) <- unbind tvATy
       ; (bTV',funTy')           <- unbind tvBTy
-      ; return (aTV',bTV',funTy')
+      ; return (rTV',aTV',bTV',funTy')
       }
     (C.FunTy fTy funTy'') = C.tyView funTy
     (C.FunTy aTy _)       = C.tyView funTy''
@@ -741,5 +739,5 @@
 
 isDataConWrapId :: Id -> Bool
 isDataConWrapId v = case idDetails v of
-                      DataConWrapId {} -> True
-                      _                -> False
+  DataConWrapId {} -> True
+  _                -> False
diff --git a/src-ghc/CLaSH/GHC/GenerateBindings.hs b/src-ghc/CLaSH/GHC/GenerateBindings.hs
--- a/src-ghc/CLaSH/GHC/GenerateBindings.hs
+++ b/src-ghc/CLaSH/GHC/GenerateBindings.hs
@@ -162,7 +162,7 @@
 mkTupTyCons :: GHC2CoreState -> (GHC2CoreState,IntMap TyConName)
 mkTupTyCons tcMap = (tcMap'',tupTcCache)
   where
-    tupTyCons        = map (GHC.tupleTyCon GHC.BoxedTuple) [2..62]
+    tupTyCons        = map (GHC.tupleTyCon GHC.Boxed) [2..62]
     (tcNames,tcMap') = State.runState (mapM (\tc -> coreToName GHC.tyConName GHC.tyConUnique qualfiedNameString tc) tupTyCons) tcMap
     tupTcCache       = IM.fromList (zip [2..62] tcNames)
     tupHM            = HashMap.fromList (zip tcNames tupTyCons)
diff --git a/src-ghc/CLaSH/GHC/LoadInterfaceFiles.hs b/src-ghc/CLaSH/GHC/LoadInterfaceFiles.hs
--- a/src-ghc/CLaSH/GHC/LoadInterfaceFiles.hs
+++ b/src-ghc/CLaSH/GHC/LoadInterfaceFiles.hs
@@ -4,6 +4,7 @@
   Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>
 -}
 
+{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell     #-}
@@ -50,7 +51,11 @@
   hscEnv <- GHC.getSession
   let localEnv = TcRnTypes.IfLclEnv modName (text "runIfl")
                    UniqFM.emptyUFM UniqFM.emptyUFM
+#if MIN_VERSION_GLASGOW_HASKELL(8,0,1,20161117)
+  let globalEnv = TcRnTypes.IfGblEnv (text "CLaSH.runIfl") Nothing
+#else
   let globalEnv = TcRnTypes.IfGblEnv Nothing
+#endif
   MonadUtils.liftIO $ TcRnMonad.initTcRnIf 'r' hscEnv globalEnv
                         localEnv action
 
@@ -163,8 +168,9 @@
         in Left (bndr,dfExpr)
       CoreSyn.NoUnfolding
         | Demand.isBottomingSig $ IdInfo.strictnessInfo _idInfo
-        -> Left (bndr,CoreSyn.mkTyApps (CoreSyn.Var MkCore.uNDEFINED_ID)
-                                       [Var.varType _id]
+        -> Left (bndr, MkCore.mkRuntimeErrorApp MkCore.aBSENT_ERROR_ID
+                                                (Var.varType _id)
+                                                "no_unfolding"
                 )
       _ -> Right bndr
   _ -> Right bndr
diff --git a/src-ghc/CLaSH/GHC/LoadModules.hs b/src-ghc/CLaSH/GHC/LoadModules.hs
--- a/src-ghc/CLaSH/GHC/LoadModules.hs
+++ b/src-ghc/CLaSH/GHC/LoadModules.hs
@@ -5,9 +5,11 @@
 -}
 
 {-# LANGUAGE CPP                 #-}
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE ViewPatterns        #-}
 
 module CLaSH.GHC.LoadModules
   ( loadModules
@@ -20,7 +22,8 @@
 #endif
 
 -- External Modules
-import           Data.List                    (nub)
+import           Data.Generics.Uniplate.DataOnly (transform)
+import           Data.List                    (foldl', nub)
 import           Data.Word                    (Word8)
 import           CLaSH.Annotations.TopEntity  (TopEntity)
 import           System.Exit                  (ExitCode (..))
@@ -53,6 +56,7 @@
 import           Outputable                   ((<>),dot,ppr)
 import qualified Outputable
 import qualified OccName
+import qualified GHC.LanguageExtensions       as LangExt
 
 -- Internal Modules
 import           CLaSH.GHC.LoadInterfaceFiles
@@ -69,7 +73,7 @@
        127         -> Panic.pgmError noGHC
        i'          -> Panic.pgmError $ "Calling GHC failed with error code: " ++ show i'
   where
-    noGHC = "CLaSH needs the GHC compiler it was build with, ghc-" ++ TOOL_VERSION_ghc ++
+    noGHC = "CLaSH needs the GHC compiler it was built with, ghc-" ++ TOOL_VERSION_ghc ++
             ", but it was not found. Make sure its location is in your PATH variable."
 
 getProcessOutput :: String -> IO (Maybe String, ExitCode)
@@ -94,8 +98,7 @@
         , Maybe CoreSyn.CoreBndr                   -- testInput bndr
         , Maybe CoreSyn.CoreBndr                   -- expectedOutput bndr
         )
-loadModules modName dflagsM = GHC.defaultErrorHandler DynFlags.defaultFatalMessager
-                              DynFlags.defaultFlushOut $ do
+loadModules modName dflagsM = do
   libDir <- MonadUtils.liftIO ghcLibDir
 
   GHC.runGhc (Just libDir) $ do
@@ -104,24 +107,34 @@
                 Nothing -> do
                   df <- GHC.getSessionDynFlags
                   let dfEn = foldl DynFlags.xopt_set df
-                                [ DynFlags.Opt_TemplateHaskell
-                                , DynFlags.Opt_DataKinds
-                                , DynFlags.Opt_TypeOperators
-                                , DynFlags.Opt_FlexibleContexts
-                                , DynFlags.Opt_ConstraintKinds
-                                , DynFlags.Opt_TypeFamilies
-                                , DynFlags.Opt_BinaryLiterals
-                                , DynFlags.Opt_ExplicitNamespaces
-                                , DynFlags.Opt_KindSignatures
+                                [ LangExt.TemplateHaskell
+                                , LangExt.TemplateHaskellQuotes
+                                , LangExt.DataKinds
+                                , LangExt.TypeOperators
+                                , LangExt.FlexibleContexts
+                                , LangExt.ConstraintKinds
+                                , LangExt.TypeFamilies
+                                , LangExt.BinaryLiterals
+                                , LangExt.ExplicitNamespaces
+                                , LangExt.KindSignatures
+                                , LangExt.DeriveLift
+                                , LangExt.TypeApplications
+                                , LangExt.ScopedTypeVariables
+                                , LangExt.MagicHash
+                                , LangExt.ExplicitForAll
                                 ]
                   let dfDis = foldl DynFlags.xopt_unset dfEn
-                                [ DynFlags.Opt_ImplicitPrelude
-                                , DynFlags.Opt_MonomorphismRestriction
+                                [ LangExt.ImplicitPrelude
+                                , LangExt.MonomorphismRestriction
+                                , LangExt.Strict
+                                , LangExt.StrictData
                                 ]
                   let ghcTyLitNormPlugin = GHC.mkModuleName "GHC.TypeLits.Normalise"
                       ghcTyLitExtrPlugin = GHC.mkModuleName "GHC.TypeLits.Extra.Solver"
+                      ghcTyLitKNPlugin   = GHC.mkModuleName "GHC.TypeLits.KnownNat.Solver"
                   let dfPlug = dfDis { DynFlags.pluginModNames = nub $
-                                          ghcTyLitNormPlugin : ghcTyLitExtrPlugin : DynFlags.pluginModNames dfDis
+                                          ghcTyLitNormPlugin : ghcTyLitExtrPlugin :
+                                          ghcTyLitKNPlugin : DynFlags.pluginModNames dfDis
                                      }
                   return dfPlug
 
@@ -150,7 +163,7 @@
     let modGraph' = map disableOptimizationsFlags modGraph
         modGraph2 = Digraph.flattenSCCs (GHC.topSortModuleGraph True modGraph' Nothing)
     tidiedMods <- mapM (\m -> do { pMod  <- parseModule m
-                                 ; tcMod <- GHC.typecheckModule pMod
+                                 ; tcMod <- GHC.typecheckModule (removeStrictnessAnnotations pMod)
                                  -- The purpose of the home package table (HPT) is to track
                                  -- the already compiled modules, so subsequent modules can
                                  -- rely/use those compilation results
@@ -260,14 +273,16 @@
               })
 
 wantedOptimizationFlags :: GHC.DynFlags -> GHC.DynFlags
-wantedOptimizationFlags df = foldl DynFlags.gopt_unset (foldl DynFlags.gopt_set df wanted) unwanted
+wantedOptimizationFlags df =
+  foldl' DynFlags.xopt_unset
+    (foldl' DynFlags.gopt_unset
+        (foldl' DynFlags.gopt_set df wanted) unwanted) unwantedLang
   where
     wanted = [ Opt_CSE -- CSE
              , Opt_Specialise -- Specialise on types, specialise type-class-overloaded function defined in this module for the types
              , Opt_DoLambdaEtaExpansion -- transform nested series of lambdas into one with multiple arguments, helps us achieve only top-level lambdas
              , Opt_CaseMerge -- We want fewer case-statements
              , Opt_DictsCheap -- Makes dictionaries seem cheap to optimizer: hopefully inline
-             , Opt_SimpleListLiterals -- Avoids 'build' rule
              , Opt_ExposeAllUnfoldings -- We need all the unfoldings we can get
              , Opt_ForceRecomp -- Force recompilation: never bad
              , Opt_EnableRewriteRules -- Reduce number of functions
@@ -276,9 +291,9 @@
              , Opt_FloatIn -- Moves let-bindings inwards, although it defeats the normal-form with a single top-level let-binding, it helps with other transformations
              , Opt_DictsStrict -- Hopefully helps remove class method selectors
              , Opt_DmdTxDictSel -- I think demand and strictness are related, strictness helps with dead-code, enable
-#if __GLASGOW_HASKELL__ >= 711
              , Opt_Strictness -- Strictness analysis helps with dead-code analysis. However, see [NOTE: CPR breaks CLaSH]
-#endif
+             , Opt_SpecialiseAggressively -- Needed to compile Fixed point number functions quickly
+             , Opt_CrossModuleSpecialise -- Needed to compile Fixed point number functions quickly
              ]
 
     unwanted = [ Opt_LiberateCase -- Perform unrolling of recursive RHS: avoid
@@ -300,17 +315,17 @@
                , Opt_OmitInterfacePragmas -- We need all the unfoldings we can get
                , Opt_IrrefutableTuples -- Introduce irrefutPatError: avoid
                , Opt_Loopification -- STG pass, don't care
-#if __GLASGOW_HASKELL__ >= 711
                , Opt_CprAnal -- The worker/wrapper introduced by CPR breaks CLaSH, see [NOTE: CPR breaks CLaSH]
-#else
-               , Opt_Strictness -- Strictness analysis helps with dead-code analysis. However, see [NOTE: CPR breaks CLaSH]
-                                -- So, strictness analysis must be disabled completely on GHC versions below 8.0,
-                                -- because strictness analysis implies demand analysis, which implies CPR analysis,
-                                -- which cannot be completely disabled due to https://ghc.haskell.org/trac/ghc/ticket/10696.
-                                -- This bug shows itself as: https://github.com/clash-lang/clash-compiler/issues/174
-#endif
+               , Opt_FullLaziness -- increases sharing, but seems to result in worse circuits (in both area and propagation delay)
                ]
 
+    -- Coercions between Integer and CLaSH' numeric primitives cause CLaSH to
+    -- fail. As strictness only affects simulation behaviour, removing them
+    -- is perfectly safe.
+    unwantedLang = [ LangExt.Strict
+                   , LangExt.StrictData
+                   ]
+
 -- [NOTE: CPR breaks CLaSH]
 -- We used to completely disable strictness analysis because it causes GHC to
 -- do the so-called "Constructed Product Result" (CPR) analysis, which in turn
@@ -334,3 +349,61 @@
 -- properly. At the moment, CLaSH cannot deal with this recursive type and the
 -- recursive functions involved, and hence we need to disable this useful transformation. After
 -- everything is done properly, we should enable it again.
+
+-- | Remove all strictness annotations:
+--
+-- * Remove strictness annotations from data type declarations
+--   (only works for data types that are currently being compiled, i.e.,
+--    that are not part of a pre-compiled imported library)
+--
+-- We need to remove strictness annotations because GHC will introduce casts
+-- between Integer and CLaSH' numeric primitives otherwise, where CLaSH will
+-- error when it sees such casts. The reason it does this is because
+-- Integer is a completely unconstrained integer type and is currently
+-- (erroneously) translated to a 64-bit integer in the HDL; this means that
+-- we could lose bits when the original numeric type had more bits than 64.
+--
+-- Removing these strictness annotations is perfectly safe, as they only
+-- affect simulation behaviour.
+removeStrictnessAnnotations ::
+     GHC.ParsedModule
+  -> GHC.ParsedModule
+removeStrictnessAnnotations pm =
+    pm {GHC.pm_parsed_source = fmap rmPS (GHC.pm_parsed_source pm)}
+  where
+    rmPS :: GHC.DataId name => GHC.HsModule name -> GHC.HsModule name
+    rmPS hsm = hsm {GHC.hsmodDecls = (fmap . fmap) rmHSD (GHC.hsmodDecls hsm)}
+
+    rmHSD :: GHC.DataId name => GHC.HsDecl name -> GHC.HsDecl name
+    rmHSD (GHC.TyClD tyClDecl) = GHC.TyClD (rmTyClD tyClDecl)
+    rmHSD hsd = hsd
+
+    rmTyClD :: GHC.DataId name => GHC.TyClDecl name -> GHC.TyClDecl name
+    rmTyClD dc@(GHC.DataDecl {}) = dc {GHC.tcdDataDefn = rmDataDefn (GHC.tcdDataDefn dc)}
+    rmTyClD tyClD = tyClD
+
+    rmDataDefn :: GHC.DataId name => GHC.HsDataDefn name -> GHC.HsDataDefn name
+    rmDataDefn hdf = hdf {GHC.dd_cons = (fmap . fmap) rmCD (GHC.dd_cons hdf)}
+
+    rmCD :: GHC.DataId name => GHC.ConDecl name -> GHC.ConDecl name
+    rmCD gadt@(GHC.ConDeclGADT {}) = gadt {GHC.con_type = rmSigType (GHC.con_type gadt)}
+    rmCD h98@(GHC.ConDeclH98 {})   = h98  {GHC.con_details = rmConDetails (GHC.con_details h98)}
+
+    -- type LHsSigType name = HsImplicitBndrs name (LHsType name)
+    rmSigType :: GHC.DataId name => GHC.LHsSigType name -> GHC.LHsSigType name
+    rmSigType hsIB = hsIB {GHC.hsib_body = rmHsType (GHC.hsib_body hsIB)}
+
+    -- type HsConDeclDetails name = HsConDetails (LBangType name) (Located [LConDeclField name])
+    rmConDetails :: GHC.DataId name => GHC.HsConDeclDetails name -> GHC.HsConDeclDetails name
+    rmConDetails (GHC.PrefixCon args) = GHC.PrefixCon (fmap rmHsType args)
+    rmConDetails (GHC.RecCon rec)     = GHC.RecCon ((fmap . fmap . fmap) rmConDeclF rec)
+    rmConDetails (GHC.InfixCon l r)   = GHC.InfixCon (rmHsType l) (rmHsType r)
+
+    rmHsType :: GHC.DataId name => GHC.Located (GHC.HsType name) -> GHC.Located (GHC.HsType name)
+    rmHsType = transform go
+      where
+        go (GHC.unLoc -> GHC.HsBangTy _ ty) = ty
+        go ty = ty
+
+    rmConDeclF :: GHC.DataId name => GHC.ConDeclField name -> GHC.ConDeclField name
+    rmConDeclF cdf = cdf {GHC.cd_fld_type = rmHsType (GHC.cd_fld_type cdf)}
diff --git a/src-ghc/CLaSH/GHC/NetlistTypes.hs b/src-ghc/CLaSH/GHC/NetlistTypes.hs
--- a/src-ghc/CLaSH/GHC/NetlistTypes.hs
+++ b/src-ghc/CLaSH/GHC/NetlistTypes.hs
@@ -27,10 +27,11 @@
 import CLaSH.Util                       (curLoc)
 
 ghcTypeToHWType :: Int
+                -> Bool
                 -> HashMap TyConName TyCon
                 -> Type
                 -> Maybe (Either String HWType)
-ghcTypeToHWType iw = go
+ghcTypeToHWType iw floatSupport = go
   where
     go m ty@(tyView -> TyConApp tc args) = runExceptT $
       case name2String tc of
@@ -74,10 +75,14 @@
         "GHC.Prim.Word#"                -> return (Unsigned iw)
         "GHC.Prim.Int64#"               -> return (Signed 64)
         "GHC.Prim.Word64#"              -> return (Unsigned 64)
+        "GHC.Prim.Float#" | floatSupport -> return (BitVector 32)
+        "GHC.Prim.Double#" | floatSupport -> return (BitVector 64)
         "GHC.Prim.ByteArray#"           ->
           fail $ "Can't translate type: " ++ showDoc ty
 
         "GHC.Types.Bool"                -> return Bool
+        "GHC.Types.Float" | floatSupport-> return (BitVector 32)
+        "GHC.Types.Double" | floatSupport -> return (BitVector 64)
         "GHC.Prim.~#"                   ->
           fail $ "Can't translate type: " ++ showDoc ty
 
@@ -103,6 +108,12 @@
           sz     <- mapExceptT (Just . coerce) (tyNatSize m szTy)
           elHWTy <- ExceptT $ return $ coreTypeToHWType go m elTy
           return $ Vector (fromInteger sz) elHWTy
+
+        "CLaSH.Sized.RTree.RTree" -> do
+          let [szTy,elTy] = args
+          sz     <- mapExceptT (Just . coerce) (tyNatSize m szTy)
+          elHWTy <- ExceptT $ return $ coreTypeToHWType go m elTy
+          return $ RTree (fromInteger sz) elHWTy
 
         "String" -> return String
         "GHC.Types.[]" -> case tyView (head args) of