diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,47 @@
 # Changelog for the Clash project
 
+## 1.8.3 *Oct 6th 2025*
+
+Added:
+* `Counter` instances for `Bool`, `Bit`, `Int`, `Int8`, `Int16`, `Int32`, `Int64`, `Word`, `Word8`, `Word16`, `Word32`, `Word64`, `Identity` and `Maybe`. [#2692](https://github.com/clash-lang/clash-compiler/pull/2692)
+* The Vec type now has a [COMPLETE pragma](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/pragmas.html#complete-pragma) to avoid incomplete pattern matches when using the `(:>)` pattern. [#3020](https://github.com/clash-lang/clash-compiler/pull/3020)
+* RamOp now has an AutoReg instance. [#2792](https://github.com/clash-lang/clash-compiler/pull/2792)
+* Added instance `NFDataX (SimOnly a)` [#2900](https://github.com/clash-lang/clash-compiler/pull/2900)
+* Support for GHC 9.10 on Windows (macOS and Linux were already supported) [#2945](https://github.com/clash-lang/clash-compiler/pull/2945)
+* Added a `BitPack` instance for `Char` [#2957](https://github.com/clash-lang/clash-compiler/pull/2957)
+* Support for GHC 9.10.2 [#3003](https://github.com/clash-lang/clash-compiler/pull/3003)
+
+Changed:
+* Functions defined on `Clash.Class.Counter` are now public [#2692](https://github.com/clash-lang/clash-compiler/pull/2692)
+
+Fixed:
+* Clash hanging when rendering `Index n` literals, for large values of `n` [#2813](https://github.com/clash-lang/clash-compiler/issues/2813)
+* Render overflowed Index literals as don't-cares in HDL [#2970](https://github.com/clash-lang/clash-compiler/pull/2970)
+* Clash errors out when `Clash.Sized.Vector.splitAt` is compile-time evaluated in an illegal context [#2831]https://github.com/clash-lang/clash-compiler/issues/2831
+* `Clash.Explicit.DDR`: [#2911](https://github.com/clash-lang/clash-compiler/pull/2911)
+  - `ddrIn`: VHDL: Remove data input from sensitivity list of `ddrIn_neg_latch` register as it is superfluous. This should not affect functionality.
+  - `ddrOut`: VHDL: Fix incorrect usage of `Enable` input when the domain is set to asynchronous resets. Deasserting the `Enable` exhibited wrong behavior before this fix.
+* `Clash.Xilinx.DDR`: [#2911](https://github.com/clash-lang/clash-compiler/pull/2911)
+  - These primitives only support clocks where the rising edge is the active edge. Using them in a domain with falling active edges now causes an error.
+  - `oddr`: Fix VHDL and SystemVerilog erroring out during HDL generation
+  - Symbols in HDL for both `iddr` and `oddr` were renamed to match their function.
+* `Clash.Intel.DDR`: [#2911](https://github.com/clash-lang/clash-compiler/pull/2911)
+  - These primitives only support clocks where the rising edge is the active edge. Using them in a domain with falling active edges now causes an error.
+  - Fix rendering HDL. It variously errored out or generated non-working HDL.
+  - Rendering HDL no longer causes Clash to issue a warning about an argument unused in Haskell but used in the primitive black box.
+* `makeTopEntity` now accounts for `SimOnly` constructs. This can prevent warnings in situtations where the `SimOnly` type would contain types `makeTopEntity` cannot handle. [#2897](https://github.com/clash-lang/clash-compiler/pull/2897)
+* Clash did not build on GHC 9.6.7 (but did on 9.6.6) [#2916](https://github.com/clash-lang/clash-compiler/issues/2916)
+* Ignore `Tick`s in `TermLiteral Integer`, `TermLiteral Char`, `TermLiteral Natural`, and `TermLiteral (SNat n)` [#2925](https://github.com/clash-lang/clash-compiler/pull/2925)
+* Fixed laziness issue in internal black box `imap_go` [#2542](https://github.com/clash-lang/clash-compiler/issues/2542)
+* Clash's evaluator now uses `TemplateHaskell` names to detect renamed symbols in `GHC.*` and `Clash.*`. Fixes errors similar to `No blackbox found for: GHC.Internal.Base.eqString` [#2972](https://github.com/clash-lang/clash-compiler/issues/2972)
+* No blackbox found for: `GHC.Internal.Control.Exception.Base.recSelError` on GHC 9.10 [#2966](https://github.com/clash-lang/clash-compiler/issues/2966)
+* Verilog and System Verilog code gen bug for `map head` [#2809](https://github.com/clash-lang/clash-compiler/issues/2809)
+* Error parsing blackbox: `Clash.Sized.Vector.head` [#2988](https://github.com/clash-lang/clash-compiler/issues/2988)
+* Clash no longer duplicates included datafiles when component is instantiated multiple times [#3008](https://github.com/clash-lang/clash-compiler/issues/3008)
+* Clash will no longer emit "no blackbox found for" `GHC.Real`'s exponentiation function if it is applied to constants [#3010](https://github.com/clash-lang/clash-compiler/pull/3010)
+* Clash will no longer error out when converting `ensureSpine` on Clash number types to HDL [#3021](https://github.com/clash-lang/clash-compiler/issues/3021)
+* Clash will no longer ignore Synthesize annotations when the function is used in an argument position [#3024](https://github.com/clash-lang/clash-compiler/issues/3024)
+
 ## 1.8.2 *Jan 3rd 2025*
 
 Added:
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -27,5 +27,13 @@
 
   * Support for multiple clock domains, with type safe clock domain crossing.
 
-# Support
-For updates and questions join the mailing list clash-language+subscribe@googlegroups.com or read the [forum](https://groups.google.com/d/forum/clash-language)
+# Open-source community
+Clash benefits from an active community. Whether you need a question answered or
+want to contribute to open-source features, browse the features below to make
+the most of Clash.
+
+- [Discourse: long form discussions and questions](https://clash-lang.discourse.group/)
+- [Discord: short form discussions and community chat room](https://discord.gg/rebGq25FB4)
+- [Slack: short form discussions and questions](https://functionalprogramming.slack.com/archives/CPGMJFF50)
+  (Invite yourself at [fpslack.com](https://fpslack.com))
+- [Github: issue tracker](https://github.com/clash-lang/clash-compiler/issues)
diff --git a/clash-ghc.cabal b/clash-ghc.cabal
--- a/clash-ghc.cabal
+++ b/clash-ghc.cabal
@@ -1,6 +1,6 @@
 Cabal-version:        2.2
 Name:                 clash-ghc
-Version:              1.8.2
+Version:              1.8.3
 Synopsis:             Clash: a functional hardware description language - GHC frontend
 Description:
   Clash is a functional hardware description language that borrows both its
@@ -121,8 +121,10 @@
 library
   import:             common-options
   HS-Source-Dirs:     src-ghc, src-bin-common
-  if impl(ghc >= 9.10.0)
-    HS-Source-Dirs: src-bin-9.10
+  if impl(ghc >= 9.10.2)
+    HS-Source-Dirs: src-bin-9.10.2
+  elif impl(ghc >= 9.10.0)
+    HS-Source-Dirs: src-bin-9.10.1
   elif impl(ghc >= 9.8.0)
     HS-Source-Dirs: src-bin-9.8
   elif impl(ghc >= 9.6.0)
@@ -158,7 +160,7 @@
                       containers                >= 0.5.4.0  && < 0.8,
                       data-binary-ieee754       >= 0.4.4    && < 0.6,
                       directory                 >= 1.2      && < 1.4,
-                      extra                     >= 1.6      && < 1.8,
+                      extra                     >= 1.6      && < 1.9,
                       filepath                  >= 1.3      && < 1.6,
                       process                   >= 1.2      && < 1.7,
                       hashable                  >= 1.1.2.3  && < 1.6,
@@ -170,15 +172,15 @@
                       transformers              >= 0.5.2.0  && < 0.7,
                       unordered-containers      >= 0.2.1.0  && < 0.3,
 
-                      clash-lib                 == 1.8.2,
-                      clash-prelude             == 1.8.2,
+                      clash-lib                 == 1.8.3,
+                      clash-prelude             == 1.8.3,
                       ghc-typelits-extra        >= 0.3.2    && < 0.5,
                       ghc-typelits-knownnat     >= 0.6      && < 0.8,
                       ghc-typelits-natnormalise >= 0.6      && < 0.8,
                       deepseq                   >= 1.3.0.2  && < 1.6,
                       time                      >= 1.4.0.1  && < 1.15,
                       ghc-boot                  >= 8.6.0    && < 9.11,
-                      ghc-prim                  >= 0.3.1.0  && < 0.12,
+                      ghc-prim                  >= 0.3.1.0  && < 0.13,
                       ghci                      >= 8.6.0    && < 9.11,
                       uniplate                  >= 1.6.12   && < 1.8,
                       reflection                >= 2.1.2    && < 3.0,
@@ -211,7 +213,7 @@
     CPP-Options:      -DUSE_GHC_PATHS=1
 
   if os(windows)
-    Build-Depends:    Win32                     >= 2.3.1    && < 2.14
+    Build-Depends:    Win32                     >= 2.3.1    && < 2.15
   else
     Build-Depends:    unix                      >= 2.7.1    && < 2.9
 
diff --git a/src-bin-9.10.1/Clash/GHCi/Leak.hs b/src-bin-9.10.1/Clash/GHCi/Leak.hs
new file mode 100644
--- /dev/null
+++ b/src-bin-9.10.1/Clash/GHCi/Leak.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE RecordWildCards, LambdaCase #-}
+module Clash.GHCi.Leak
+  ( LeakIndicators
+  , getLeakIndicators
+  , checkLeakIndicators
+  ) where
+
+import Control.Monad
+import Data.Bits
+import Foreign.Ptr (ptrToIntPtr, intPtrToPtr)
+import GHC
+import GHC.Ptr (Ptr (..))
+import Clash.GHCi.Util
+import GHC.Driver.Env
+import GHC.Driver.Ppr
+import GHC.Utils.Outputable
+import GHC.Unit.Module.ModDetails
+import GHC.Unit.Home.ModInfo
+import GHC.Platform (target32Bit)
+import GHC.Linker.Types
+import Prelude
+import System.Mem
+import System.Mem.Weak
+import GHC.Types.Unique.DFM
+import Control.Exception
+
+-- Checking for space leaks in GHCi. See #15111, and the
+-- -fghci-leak-check flag.
+
+data LeakIndicators = LeakIndicators [LeakModIndicators]
+
+data LeakModIndicators = LeakModIndicators
+  { leakMod :: Weak HomeModInfo
+  , leakIface :: Weak ModIface
+  , leakDetails :: Weak ModDetails
+  , leakLinkable :: [Maybe (Weak Linkable)]
+  }
+
+-- | Grab weak references to some of the data structures representing
+-- the currently loaded modules.
+getLeakIndicators :: HscEnv -> IO LeakIndicators
+getLeakIndicators hsc_env =
+  fmap LeakIndicators $
+    forM (eltsUDFM (hsc_HPT hsc_env)) $ \hmi@HomeModInfo{..} -> do
+      leakMod <- mkWeakPtr hmi Nothing
+      leakIface <- mkWeakPtr hm_iface Nothing
+      leakDetails <- mkWeakPtr hm_details Nothing
+      leakLinkable <-  mkWeakLinkables hm_linkable
+      return $ LeakModIndicators{..}
+  where
+    mkWeakLinkables :: HomeModLinkable -> IO [Maybe (Weak Linkable)]
+    mkWeakLinkables (HomeModLinkable mbc mo) =
+      mapM (\ln -> traverse (flip mkWeakPtr Nothing <=< evaluate) ln) [mbc, mo]
+
+-- | Look at the LeakIndicators collected by an earlier call to
+-- `getLeakIndicators`, and print messasges if any of them are still
+-- alive.
+checkLeakIndicators :: DynFlags -> LeakIndicators -> IO ()
+checkLeakIndicators dflags (LeakIndicators leakmods)  = do
+  performGC
+  forM_ leakmods $ \LeakModIndicators{..} -> do
+    deRefWeak leakMod >>= \case
+      Nothing -> return ()
+      Just hmi ->
+        report ("HomeModInfo for " ++
+          showSDoc dflags (ppr (mi_module (hm_iface hmi)))) (Just hmi)
+    deRefWeak leakIface >>= \case
+      Nothing -> return ()
+      Just miface -> report ("ModIface:" ++ moduleNameString (moduleName (mi_module miface))) (Just miface)
+    deRefWeak leakDetails >>= report "ModDetails"
+    forM_ leakLinkable $ \l -> forM_ l $ \l' -> deRefWeak l' >>= report "Linkable"
+ where
+  report :: String -> Maybe a -> IO ()
+  report _ Nothing = return ()
+  report msg (Just a) = do
+    addr <- anyToPtr a
+    putStrLn ("-fghci-leak-check: " ++ msg ++ " is still alive at " ++
+              show (maskTagBits addr))
+
+  tagBits
+    | target32Bit (targetPlatform dflags) = 2
+    | otherwise = 3
+
+  maskTagBits :: Ptr a -> Ptr a
+  maskTagBits p = intPtrToPtr (ptrToIntPtr p .&. complement (shiftL 1 tagBits - 1))
diff --git a/src-bin-9.10.1/Clash/GHCi/UI.hs b/src-bin-9.10.1/Clash/GHCi/UI.hs
new file mode 100644
--- /dev/null
+++ b/src-bin-9.10.1/Clash/GHCi/UI.hs
@@ -0,0 +1,4883 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NondecreasingIndentation #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-# OPTIONS -fno-warn-name-shadowing #-}
+-- This module does a lot of it
+
+-----------------------------------------------------------------------------
+--
+-- GHC Interactive User Interface
+--
+-- (c) The GHC Team 2005-2006
+--
+-----------------------------------------------------------------------------
+
+module Clash.GHCi.UI (
+        interactiveUI,
+        GhciSettings(..),
+        defaultGhciSettings,
+        ghciCommands,
+        ghciWelcomeMsg,
+        makeHDL
+    ) where
+
+-- GHCi
+import qualified Clash.GHCi.UI.Monad as GhciMonad ( args, runStmt, runDecls' )
+import Clash.GHCi.UI.Monad hiding ( args, runStmt )
+import Clash.GHCi.UI.Info
+import Clash.GHCi.UI.Exception
+import GHC.Runtime.Debugger
+
+-- The GHC interface
+import GHC.Runtime.Interpreter
+import GHCi.RemoteTypes
+import GHCi.BreakArray( breakOn, breakOff )
+import GHC.ByteCode.Types
+import GHC.Core.DataCon
+import GHC.Core.ConLike
+import GHC.Core.PatSyn
+import GHC.Driver.Flags
+import GHC.Driver.Errors
+import GHC.Driver.Errors.Types
+import GHC.Driver.Phases
+import GHC.Driver.Session as DynFlags
+import GHC.Driver.Ppr hiding (printForUser)
+import GHC.Utils.Error hiding (traceCmd)
+import GHC.Driver.Monad ( modifySession )
+import GHC.Driver.Make ( newIfaceCache, ModIfaceCache(..) )
+import GHC.Driver.Config.Parser (initParserOpts)
+import GHC.Driver.Config.Diagnostic
+import qualified GHC
+import GHC ( LoadHowMuch(..), Target(..),  TargetId(..),
+             Resume, SingleStep, Ghc,
+             GetDocsFailure(..), pushLogHookM,
+             getModuleGraph, handleSourceError, ms_mod )
+import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation)
+import GHC.Hs.ImpExp
+import GHC.Hs
+import GHC.Driver.Env
+import GHC.Runtime.Context
+import GHC.Types.TyThing
+import GHC.Types.TyThing.Ppr
+import GHC.Core.TyCo.Ppr
+import GHC.Types.SafeHaskell ( getSafeMode )
+import GHC.Types.SourceError ( SourceError )
+import GHC.Types.Name
+import GHC.Types.Var ( varType )
+import GHC.Iface.Syntax ( showToHeader )
+import GHC.Builtin.Names
+import GHC.Builtin.Types( stringTyCon_RDR )
+import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrName )
+import GHC.Types.SrcLoc as SrcLoc
+import qualified GHC.Parser.Lexer as Lexer
+import GHC.Parser.Header ( toArgs )
+import qualified GHC.Parser.Header as Header
+import GHC.Types.PkgQual
+
+import GHC.Unit
+import GHC.Unit.Finder as Finder
+import GHC.Unit.Module.Graph (filterToposortToModules)
+import GHC.Unit.Module.ModSummary
+
+import GHC.Data.StringBuffer
+import GHC.Utils.Outputable
+import GHC.Utils.Logger
+
+-- Other random utilities
+import GHC.Types.Basic hiding ( isTopLevel )
+import GHC.Data.Graph.Directed
+import GHC.Utils.Encoding
+import GHC.Data.FastString
+import qualified GHC.Linker.Loader as Loader
+import GHC.Data.Maybe ( orElse, expectJust )
+import GHC.Types.Name.Set
+import GHC.Utils.Panic hiding ( showException, try )
+import GHC.Utils.Misc
+import qualified GHC.LanguageExtensions as LangExt
+import GHC.Data.Bag (unitBag)
+import qualified GHC.Data.Strict as Strict
+import GHC.Types.Error
+
+-- 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.Catch as MC
+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 ( elemIndices, find, intercalate, intersperse, minimumBy,
+                   isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Set as S
+import Data.Maybe
+import qualified Data.Map as M
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as IntMap
+import Data.Time.LocalTime ( getZonedTime )
+import Data.Time.Format ( formatTime, defaultTimeLocale )
+import Data.Version ( showVersion )
+import qualified Data.Semigroup as S
+import Prelude hiding ((<>))
+
+import GHC.Utils.Exception as Exception hiding (catch, mask, handle)
+import Foreign hiding (void)
+import GHC.Stack hiding (SrcLoc(..))
+import GHC.Unit.Env
+import GHC.Unit.Home.ModInfo
+
+import System.Directory
+import System.Environment
+import System.Exit ( exitWith, ExitCode(..) )
+import System.FilePath
+import System.Info
+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)
+
+import Unsafe.Coerce
+
+#if !defined(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 Clash.GHCi.Leak
+import qualified GHC.Unit.Module.Graph as GHC
+
+-- clash additions
+import           Clash.Backend (Backend(initBackend, hdlKind, primDirs))
+import           Clash.Backend.SystemVerilog (SystemVerilogState)
+import           Clash.Backend.VHDL (VHDLState)
+import           Clash.Backend.Verilog (VerilogState)
+import qualified Clash.Driver
+import           Clash.Driver.Bool (fromGhcOverridingBool)
+import           Clash.Driver.Types (ClashOpts(..), ClashEnv(..), ClashDesign(..))
+import           Clash.GHC.Evaluator
+import           Clash.GHC.GenerateBindings
+import           Clash.GHC.NetlistTypes
+import           Clash.GHC.PartialEval
+import           Clash.GHCi.Common
+import           Clash.Util (clashLibVersion, reportTimeDiff)
+import           Data.Proxy
+import qualified Data.Time.Clock as Clock
+import qualified Paths_clash_ghc
+
+-----------------------------------------------------------------------------
+
+data GhciSettings = GhciSettings {
+        availableCommands :: [Command],
+        shortHelpText     :: String,
+        fullHelpText      :: String,
+        defPrompt         :: PromptFunction,
+        defPromptCont     :: PromptFunction
+    }
+
+defaultGhciSettings :: IORef ClashOpts -> GhciSettings
+defaultGhciSettings opts =
+    GhciSettings {
+        availableCommands = ghciCommands opts,
+        shortHelpText     = defShortHelpText,
+        defPrompt         = default_prompt,
+        defPromptCont     = default_prompt_cont,
+        fullHelpText      = defFullHelpText
+    }
+
+ghciWelcomeMsg :: String
+ghciWelcomeMsg = "Clashi, version " ++ Data.Version.showVersion Paths_clash_ghc.version ++
+                 " (using clash-lib, version " ++ Data.Version.showVersion clashLibVersion ++
+                 "):\nhttps://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,             completeBreakpoint),
+  ("back",      keepGoing backCmd,              noCompletion),
+  ("browse",    keepGoing' (browseCmd False),   completeModule),
+  ("browse!",   keepGoing' (browseCmd True),    completeModule),
+  ("cd",        keepGoingMulti' changeDirectory,     completeFilename),
+  ("check",     keepGoing' checkModule,         completeHomeModule),
+  ("continue",  keepGoing continueCmd,          noCompletion),
+  ("cmd",       keepGoing cmdCmd,               completeExpression),
+  ("def",       keepGoing (defineMacro False),  completeExpression),
+  ("def!",      keepGoing (defineMacro True),   completeExpression),
+  ("delete",    keepGoing deleteCmd,            noCompletion),
+  ("disable",   keepGoing disableCmd,           noCompletion),
+  ("doc",       keepGoing' docCmd,              completeIdentifier),
+  ("edit",      keepGoingMulti' editFile,            completeFilename),
+  ("enable",    keepGoing enableCmd,            noCompletion),
+  ("force",     keepGoing forceCmd,             completeExpression),
+  ("forward",   keepGoing forwardCmd,           noCompletion),
+  ("help",      keepGoingMulti help,                 noCompletion),
+  ("history",   keepGoingMulti historyCmd,           noCompletion),
+  ("info",      keepGoingMulti' (info False),        completeIdentifier),
+  ("info!",     keepGoingMulti' (info True),         completeIdentifier),
+  ("issafe",    keepGoing' isSafeCmd,           completeModule),
+  ("ignore",    keepGoing ignoreCmd,            noCompletion),
+  ("kind",      keepGoingMulti' (kindOfType False),  completeIdentifier),
+  ("kind!",     keepGoingMulti' (kindOfType True),   completeIdentifier),
+  ("load",      keepGoingPaths loadModule_,     completeHomeModuleOrFile),
+  ("load!",     keepGoingPaths loadModuleDefer, completeHomeModuleOrFile),
+  ("list",      keepGoing' listCmd,             noCompletion),
+  ("module",    keepGoing moduleCmd,            completeSetModule),
+  ("main",      keepGoing runMain,              completeFilename),
+  ("print",     keepGoing printCmd,             completeExpression),
+  ("quit",      quit,                           noCompletion),
+  ("reload",    keepGoingMulti' reloadModule,   noCompletion),
+  ("reload!",   keepGoingMulti' reloadModuleDefer,   noCompletion),
+  ("run",       keepGoing runRun,               completeFilename),
+  ("script",    keepGoing' scriptCmd,           completeFilename),
+  ("set",       keepGoingMulti setCmd,          completeSetOptions),
+  ("seti",      keepGoingMulti setiCmd,         completeSeti),
+  ("show",      keepGoingMulti' showCmd,        completeShowOptions),
+  ("showi",     keepGoing showiCmd,             completeShowiOptions),
+  ("sprint",    keepGoing sprintCmd,            completeExpression),
+  ("step",      keepGoing stepCmd,              completeIdentifier),
+  ("steplocal", keepGoing stepLocalCmd,         completeIdentifier),
+  ("stepmodule",keepGoing stepModuleCmd,        completeIdentifier),
+  ("type",      keepGoingMulti' typeOfExpr,          completeExpression),
+  ("trace",     keepGoing traceCmd,             completeExpression),
+  ("unadd",     keepGoingPaths unAddModule,     completeFilename),
+  ("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),
+  ("instances", keepGoing' instancesCmd,        completeExpression)
+  ] ++ 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
+
+word_break_chars_pred :: Char -> Bool
+word_break_chars_pred '.' = False
+word_break_chars_pred c = c `elem` (spaces ++ specials) || isSymbolChar c
+
+symbols, specials, spaces :: String
+symbols = "!#$%&*+/<=>?@\\^|-~"
+specials = "(),;[]`{}"
+spaces = " \t\n"
+
+flagWordBreakChars :: String
+flagWordBreakChars = " \t\n"
+
+
+showSDocForUser' :: GHC.GhcMonad m => SDoc -> m String
+showSDocForUser' doc = do
+    dflags <- getDynFlags
+    unit_state <- hsc_units <$> GHC.getSession
+    name_ppr_ctx <- GHC.getNamePprCtx
+    pure $ showSDocForUser dflags unit_state name_ppr_ctx doc
+
+showSDocForUserQualify :: GHC.GhcMonad m => SDoc -> m String
+showSDocForUserQualify doc = do
+    dflags <- getDynFlags
+    unit_state <- hsc_units <$> GHC.getSession
+    pure $ showSDocForUser dflags unit_state alwaysQualify doc
+
+
+keepGoing :: (String -> GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
+keepGoing a str = keepGoing' (lift . a) str
+
+keepGoingMulti :: (String -> GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
+keepGoingMulti a str = keepGoingMulti' (lift . a) str
+
+keepGoing' :: GhciMonad m => (a -> m ()) -> a -> m CmdExecOutcome
+keepGoing' a str = do
+  in_multi <- inMultiMode
+  if in_multi
+    then
+      liftIO $ hPutStrLn stderr "Command is not supported (yet) in multi-mode"
+    else
+      a str
+  return CmdSuccess
+
+-- For commands which are actually support in multi-mode, initially just :reload
+keepGoingMulti' :: GhciMonad m => (String -> m ()) -> String -> m CmdExecOutcome
+keepGoingMulti' a str = a str >> return CmdSuccess
+
+inMultiMode :: GhciMonad m => m Bool
+inMultiMode = multiMode <$> getGHCiState
+
+keepGoingPaths :: ([FilePath] -> InputT GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
+keepGoingPaths a str
+ = do case toArgsNoLoc str of
+          Left err -> liftIO $ hPutStrLn stderr err >> return CmdSuccess
+          Right args -> keepGoing' a args
+
+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" ++
+  "   :def[!] <cmd> <expr>        define command :<cmd> (later defined command has\n" ++
+  "                               precedence, ::<cmd> is always a builtin command)\n" ++
+  "                               (!: redefine an existing command name)\n" ++
+  "   :doc <name>                 display docs for the given name (experimental)\n" ++
+  "   :edit <file>                edit file\n" ++
+  "   :edit                       edit last module\n" ++
+  "   :help, :?                   display this list of commands\n" ++
+  "   :info[!] [<name> ...]       display information about the given names\n" ++
+  "                               (!: do not filter instances)\n" ++
+  "   :instances <type>           display the class instances available for <type>\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" ++
+  "   :type +d <expr>             show the type of <expr>, defaulting type variables\n" ++
+  "   :unadd <module> ...         remove module(s) from the current target set\n" ++
+  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
+  "   ::<cmd>                     run the builtin command\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 [<count>]         resume after a breakpoint [and set break ignore count]\n" ++
+  "   :delete <number> ...        delete the specified breakpoints\n" ++
+  "   :delete *                   delete all breakpoints\n" ++
+  "   :disable <number> ...       disable the specified breakpoints\n" ++
+  "   :disable *                  disable all breakpoints\n" ++
+  "   :enable <number> ...        enable the specified breakpoints\n" ++
+  "   :enable *                   enable 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" ++
+  "   :ignore <breaknum> <count>  for break <breaknum> set break ignore <count>\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 local-config { source | ignore }\n" ++
+  "                               set whether to source .ghci in current dir\n" ++
+  "                               (loading untrusted config is a security issue)\n" ++
+  "   :set args <arg> ...         set the arguments returned by System.Environment.getArgs\n" ++
+  "   :set prog <progname>        set the value returned by System.Environment.getProgName\n" ++
+  "   :set prompt <prompt>        set the prompt used in GHCi\n" ++
+  "   :set prompt-cont <prompt>   set the continuation prompt used in GHCi\n" ++
+  "   :set prompt-function <expr> set the function to handle the prompt\n" ++
+  "   :set prompt-cont-function <expr>\n" ++
+  "                               set the function to handle the continuation prompt\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 targets               show the current set of targets\n" ++
+  "   :show <setting>             show value of <setting>, which is one of\n" ++
+  "                                  [args, prog, editor, stop]\n" ++
+  "   :showi language             show language flags for interactive evaluation\n" ++
+  "\n" ++
+  " The User's Guide has more information. An online copy can be found here:\n" ++
+  "\n" ++
+  "   https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html\n" ++
+  "\n"
+
+findEditor :: IO String
+findEditor = do
+    getEnv "VISUAL" <|> getEnv "EDITOR" <|> defaultEditor
+  where
+    defaultEditor = do
+#if defined(mingw32_HOST_OS)
+      win <- System.Win32.getWindowsDirectory
+      return (win </> "notepad.exe")
+#else
+      return ""
+#endif
+
+default_progname, default_stop :: String
+default_progname = "<interactive>"
+default_stop = ""
+
+default_prompt, default_prompt_cont :: PromptFunction
+default_prompt = generatePromptFunctionFromString "clashi> "
+default_prompt_cont = generatePromptFunctionFromString "clashi| "
+
+default_args :: [String]
+default_args = []
+
+interactiveUI :: GhciSettings -> [(FilePath, Maybe UnitId, Maybe Phase)] -> Maybe [String]
+              -> Ghc ()
+interactiveUI config srcs maybe_exprs = do
+   -- This is a HACK to make sure dynflags are not overwritten when setting
+   -- options. When GHCi is made properly multi component it should be removed.
+   modifySession (\env -> hscSetActiveUnitId (hscActiveUnitId env) env)
+   -- 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) <- runInternal initInterpBuffering
+
+   -- The initial set of DynFlags used for interactive evaluation is the same
+   -- as the global DynFlags, plus -XExtendedDefaultRules and
+   -- -XNoMonomorphismRestriction.
+   -- See Note [Changing language extensions for interactive evaluation] #10857
+   dflags <- getDynFlags
+   let dflags' = (xopt_set_unlessExplSpec
+                      LangExt.ExtendedDefaultRules xopt_set)
+               . (xopt_set_unlessExplSpec
+                      LangExt.MonomorphismRestriction xopt_unset)
+               $ dflags
+   GHC.setInteractiveDynFlags dflags'
+   _ <- GHC.setProgramDynFlags
+               -- Set Opt_KeepGoing so that :reload loads as much as
+               -- possible
+               (gopt_set dflags Opt_KeepGoing)
+
+   -- Update the LogAction. Ensure we don't override the user's log action lest
+   -- we break -ddump-json (#14078)
+   lastErrLocationsRef <- liftIO $ newIORef []
+   pushLogHookM (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
+   let prelude_import =
+         case simpleImportDecl preludeModuleName of
+           -- Set to True because Prelude is implicitly imported.
+           impDecl@ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}}
+   hsc_env <- GHC.getSession
+   let in_multi = length (hsc_all_home_unit_ids hsc_env) > 1
+   empty_cache <- liftIO newIfaceCache
+   startGHCi (runGHCi srcs maybe_exprs)
+        GHCiState{ progname           = default_progname,
+                   args               = default_args,
+                   evalWrapper        = eval_wrapper,
+                   prompt             = defPrompt config,
+                   prompt_cont        = defPromptCont config,
+                   stop               = default_stop,
+                   editor             = default_editor,
+                   options            = [],
+                   multiMode          = in_multi,
+                   localConfig        = SourceLocalConfig,
+                   -- 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             = IntMap.empty,
+                   tickarrays         = emptyModuleEnv,
+                   ghci_commands      = availableCommands config,
+                   ghci_macros        = [],
+                   last_command       = Nothing,
+                   cmd_wrapper        = (cmdSuccess =<<),
+                   cmdqueue           = [],
+                   remembered_ctx     = [],
+                   transient_ctx      = [],
+                   extra_imports      = [],
+                   prelude_imports    = [prelude_import],
+                   ghc_e              = isJust maybe_exprs,
+                   short_help         = shortHelpText config,
+                   long_help          = fullHelpText config,
+                   lastErrorLocations = lastErrLocationsRef,
+                   mod_infos          = M.empty,
+                   flushStdHandles    = flush,
+                   noBuffering        = nobuffering,
+                   ifaceCache = empty_cache
+                 }
+
+   return ()
+
+{-
+Note [Changing language extensions for interactive evaluation]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+GHCi maintains two sets of options:
+
+- The "loading options" apply when loading modules
+- The "interactive options" apply when evaluating expressions and commands
+    typed at the GHCi prompt.
+
+The loading options are mostly created in ghc/Main.hs:main' from the command
+line flags. In the function ghc/GHCi/UI.hs:interactiveUI the loading options
+are copied to the interactive options.
+
+These interactive options (but not the loading options!) are supplemented
+unconditionally by setting ExtendedDefaultRules ON and
+MonomorphismRestriction OFF. The unconditional setting of these options
+eventually overwrite settings already specified at the command line.
+
+Therefore instead of unconditionally setting ExtendedDefaultRules and
+NoMonomorphismRestriction for the interactive options, we use the function
+'xopt_set_unlessExplSpec' to first check whether the extension has already
+specified at the command line.
+
+The ghci config file has not yet been processed.
+-}
+
+resetLastErrorLocations :: GhciMonad m => m ()
+resetLastErrorLocations = do
+    st <- getGHCiState
+    liftIO $ writeIORef (lastErrorLocations st) []
+
+ghciLogAction :: IORef [(FastString, Int)] -> LogAction -> LogAction
+ghciLogAction lastErrLocations old_log_action
+              dflags msg_class srcSpan msg = do
+    old_log_action dflags msg_class srcSpan msg
+    case msg_class of
+        MCDiagnostic SevError _reason _code -> case srcSpan of
+            RealSrcSpan rsp _ -> modifyIORef lastErrLocations
+                (++ [(srcLocFile (realSrcSpanStart rsp), srcLocLine (realSrcSpanStart rsp))])
+            _ -> return ()
+        _ -> return ()
+
+-- | Takes a file name and prefixes it with the appropriate
+-- GHC appdir.
+-- Uses ~/.ghc (getAppUserDataDirectory) if it exists
+-- If it doesn't, then it uses $XDG_DATA_HOME/ghc
+-- Earlier we always used to use ~/.ghc, but we want
+-- to gradually move to $XDG_DATA_HOME to respect the XDG specification
+--
+-- As a migration strategy, we will only create new directories in
+-- the appropriate XDG location. However, we will use the old directory
+-- if it already exists.
+getAppDataFile :: FilePath -> IO (Maybe FilePath)
+getAppDataFile file = do
+    let new_path = tryIO (getXdgDirectory XdgConfig "clash") >>= \case
+          Left _ -> pure Nothing
+          Right dir -> flip catchIO (const $ return Nothing) $ do
+            createDirectoryIfMissing False dir
+            pure $ Just $ dir </> file
+
+    e_old_path <- tryIO (getAppUserDataDirectory "clash")
+    case e_old_path of
+      Right old_path -> doesDirectoryExist old_path >>= \case
+        True -> pure $ Just $ old_path </> file
+        False -> new_path
+      Left _ -> new_path
+
+runGHCi :: [(FilePath, Maybe UnitId, Maybe Phase)] -> Maybe [String] -> GHCi ()
+runGHCi paths maybe_exprs = do
+  dflags <- getDynFlags
+  let
+   ignore_dot_ghci = gopt Opt_IgnoreDotGhci dflags
+
+   app_user_dir = liftIO $ getAppDataFile "clashi.conf"
+
+   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
+
+  processedCfgs <- if ignore_dot_ghci
+    then pure []
+    else do
+      userCfgs <- do
+        paths <- catMaybes <$> sequence [ app_user_dir, home_dir ]
+        checkedPaths <- liftIO $ filterM checkFileAndDirPerms paths
+        liftIO . fmap (nub . catMaybes) $ mapM canonicalizePath' checkedPaths
+
+      localCfg <- do
+        let path = ".clashi"
+        ok <- liftIO $ checkFileAndDirPerms path
+        if ok then liftIO $ canonicalizePath' path else pure Nothing
+
+      mapM_ sourceConfigFile userCfgs
+        -- Process the global and user .ghci
+        -- (but not $CWD/.ghci or CLI args, yet)
+
+      behaviour <- localConfig <$> getGHCiState
+
+      processedLocalCfg <- case localCfg of
+        Just path | path `notElem` userCfgs ->
+          -- don't read .ghci twice if CWD is $HOME
+          case behaviour of
+            SourceLocalConfig -> localCfg <$ sourceConfigFile path
+            IgnoreLocalConfig -> pure Nothing
+        _ -> pure Nothing
+
+      pure $ maybe id (:) processedLocalCfg userCfgs
+
+  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 arg_cfgs \\ processedCfgs
+    -- Dedup, and remove any configs we already processed.
+    -- Importantly, if $PWD/.ghci was ignored due to configuration,
+    -- explicitly specifying it does cause it to be processed.
+
+  -- Perform a :reload for files given on the GHCi command line
+  -- The appropriate targets will already be set
+  -- 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) $
+                    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
+            -- Set different defaulting rules (See #280)
+            runGHCiExpressions
+              ["default ((), [], Prelude.Integer, Prelude.Int, Prelude.Double, Prelude.String)"]
+
+            -- enter the interactive loop
+            runGHCiInput $ runCommands $ nextInputLine show_prompt is_tty
+        Just exprs -> do
+            -- just evaluate the expression we were given
+            runGHCiExpressions exprs
+
+  -- and finally, exit
+  liftIO $ when (verbosity dflags > 0) $ putStrLn "Leaving Clashi."
+
+runGHCiExpressions :: [String] -> GHCi ()
+runGHCiExpressions exprs = do
+            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 failure, see #7962, #9916, #17560, #18441
+                _ <- runCommands' hdle
+                     (Just $ hdle (toException $ ExitFailure 1) >> return ())
+                     (return Nothing)
+                return ()
+
+runGHCiInput :: InputT GHCi a -> GHCi a
+runGHCiInput f = do
+    dflags <- getDynFlags
+    let ghciHistory = gopt Opt_GhciHistory dflags
+    let localGhciHistory = gopt Opt_LocalGhciHistory dflags
+    currentDirectory <- liftIO $ getCurrentDirectory
+
+    histFile <- case (ghciHistory, localGhciHistory) of
+      (True, True) -> return (Just (currentDirectory </> ".clashi_history"))
+      (True, _) -> liftIO $ getAppDataFile "clashi_history"
+      _ -> 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
+#if defined(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 :: GhciMonad m => m ()
+incrementLineNo = modifyGHCiState incLineNo
+  where
+    incLineNo st = st { line_number = line_number st + 1 }
+
+fileLoop :: GhciMonad m => Handle -> m (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')
+
+formatCurrentTime :: String -> IO String
+formatCurrentTime format =
+  getZonedTime >>= return . (formatTime defaultTimeLocale format)
+
+getUserName :: IO String
+getUserName = do
+#if defined(mingw32_HOST_OS)
+  getEnv "USERNAME"
+    `catchIO` \e -> do
+      putStrLn $ show e
+      return ""
+#else
+  getLoginName
+#endif
+
+getInfoForPrompt :: GhciMonad m => m (SDoc, [String], Int)
+getInfoForPrompt = 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
+
+        myIdeclName d | Just m <- ideclAs d = unLoc m
+                      | otherwise           = unLoc (ideclName d)
+
+        modules_names =
+             ['*':(moduleNameString m) | IIModule m <- rev_imports] ++
+             [moduleNameString (myIdeclName d) | IIDecl d <- rev_imports]
+        line = 1 + line_number st
+
+  return (dots <> context_bit, modules_names, line)
+
+-- | Takes a string, presumably following "%call", and tries to parse
+-- a command and arguments in parentheses:
+--
+-- > parseCallEscape "  (cmd arg1 arg2)rest" = Just ("cmd" :| ["arg1", "arg2"], "rest")
+-- > parseCallEscape "( )rest" = Nothing
+--
+parseCallEscape :: String -> Maybe (NE.NonEmpty String, String)
+parseCallEscape s = case dropWhile isSpace s of
+  '(' : sinceOpen -> case span (/= ')') sinceOpen of
+    (call, ')' : sinceClosed)
+      | cmd : args <- words call -> Just (cmd NE.:| args, sinceClosed)
+    _ -> Nothing
+  _ -> Nothing
+
+checkPromptStringForErrors :: String -> Maybe String
+checkPromptStringForErrors ('%':'c':'a':'l':'l':xs) =
+  case parseCallEscape xs of
+    Nothing  -> Just ("Incorrect %call syntax. " ++
+                      "Should be %call(a command and arguments).")
+    Just (_, afterClosed) -> checkPromptStringForErrors afterClosed
+checkPromptStringForErrors ('%':'%':xs) = checkPromptStringForErrors xs
+checkPromptStringForErrors (_:xs) = checkPromptStringForErrors xs
+checkPromptStringForErrors "" = Nothing
+
+generatePromptFunctionFromString :: String -> PromptFunction
+generatePromptFunctionFromString promptS modules_names line =
+        processString promptS
+  where
+        processString :: String -> GHCi SDoc
+        processString ('%':'s':xs) =
+            liftM2 (<>) (return modules_list) (processString xs)
+            where
+              modules_list = hsep . map text . ordNub $ modules_names
+        processString ('%':'l':xs) =
+            liftM2 (<>) (return $ ppr line) (processString xs)
+        processString ('%':'d':xs) =
+            liftM2 (<>) (liftM text formatted_time) (processString xs)
+            where
+              formatted_time = liftIO $ formatCurrentTime "%a %b %d"
+        processString ('%':'t':xs) =
+            liftM2 (<>) (liftM text formatted_time) (processString xs)
+            where
+              formatted_time = liftIO $ formatCurrentTime "%H:%M:%S"
+        processString ('%':'T':xs) = do
+            liftM2 (<>) (liftM text formatted_time) (processString xs)
+            where
+              formatted_time = liftIO $ formatCurrentTime "%I:%M:%S"
+        processString ('%':'@':xs) = do
+            liftM2 (<>) (liftM text formatted_time) (processString xs)
+            where
+              formatted_time = liftIO $ formatCurrentTime "%I:%M %P"
+        processString ('%':'A':xs) = do
+            liftM2 (<>) (liftM text formatted_time) (processString xs)
+            where
+              formatted_time = liftIO $ formatCurrentTime "%H:%M"
+        processString ('%':'u':xs) =
+            liftM2 (<>) (liftM text user_name) (processString xs)
+            where
+              user_name = liftIO $ getUserName
+        processString ('%':'w':xs) =
+            liftM2 (<>) (liftM text current_directory) (processString xs)
+            where
+              current_directory = liftIO $ getCurrentDirectory
+        processString ('%':'o':xs) =
+            liftM ((text os) <>) (processString xs)
+        processString ('%':'a':xs) =
+            liftM ((text arch) <>) (processString xs)
+        processString ('%':'N':xs) =
+            liftM ((text compilerName) <>) (processString xs)
+        processString ('%':'V':xs) =
+            liftM ((text $ showVersion compilerVersion) <>) (processString xs)
+        processString ('%':'c':'a':'l':'l':xs) = do
+            -- Input has just been validated by parseCallEscape
+            let (cmd NE.:| args, afterClosed) = fromJust $ parseCallEscape xs
+            respond <- liftIO $ do
+                (code, out, err) <-
+                    readProcessWithExitCode
+                    cmd args ""
+                    `catchIO` \e -> return (ExitFailure 1, "", show e)
+                case code of
+                    ExitSuccess -> return out
+                    _ -> do
+                        hPutStrLn stderr err
+                        return ""
+            liftM ((text respond) <>) (processString afterClosed)
+        processString ('%':'%':xs) =
+            liftM ((char '%') <>) (processString xs)
+        processString (x:xs) =
+            liftM (char x <>) (processString xs)
+        processString "" =
+            return empty
+
+mkPrompt :: GHCi String
+mkPrompt = do
+  st <- getGHCiState
+  dflags <- getDynFlags
+  (context, modules_names, line) <- getInfoForPrompt
+
+  prompt_string <- (prompt st) modules_names line
+  let prompt_doc = context <> prompt_string
+
+  return (showSDoc dflags prompt_doc)
+
+queryQueue :: GhciMonad m => m (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 :: GhciMonad m => Maybe String -> Bool -> m ()
+installInteractivePrint Nothing _  = return ()
+installInteractivePrint (Just ipFun) exprmode = do
+  ok <- trySuccess $ do
+                name NE.:| _ <- 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 ()
+runCommands' eh sourceErrorHandler gCmd = mask $ \unmask -> do
+    b <- handle (\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 ()
+      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 command was unsuccessful. GHCi will continue in either case.
+-- TODO: replace Bool with CmdExecOutcome
+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  -> do
+      st <- getGHCiState
+      ghciHandle (\e -> lift $ eh e >>= return . Just) $
+        handleSourceError printErrorAndFail $
+          cmd_wrapper st $ doCommand c
+               -- source error's are handled by runStmt
+               -- is the handler necessary here?
+  where
+    printErrorAndFail err = do
+        printGhciException 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 = prompt_cont st }
+      mb_cmd <- collectCommand q "" `MC.finally`
+                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 :{ .. :}"
+
+    cmdOutcome :: CmdExecOutcome -> Maybe Bool
+    cmdOutcome CleanExit = Nothing
+    cmdOutcome CmdSuccess = Just True
+    cmdOutcome CmdFailure = Just False
+
+    -- | Handle a line of input
+    doCommand :: String -> InputT GHCi CommandResult
+
+    -- command
+    doCommand stmt | stmt'@(':' : cmd) <- removeSpaces stmt = do
+      (stats, result) <- runWithStats (const Nothing) $ specialCommand cmd
+      return $ CommandComplete stmt' (cmdOutcome <$> result) stats
+
+    -- 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 CommandIncomplete
+            Just ml_stmt -> do
+              -- temporarily compensate line-number for multi-line input
+              (stats, result) <- runAndPrintStats runAllocs $ lift $
+                runStmtWithLineNum fst_line_num ml_stmt GHC.RunToCompletion
+              return $
+                CommandComplete ml_stmt (Just . runSuccess <$> result) stats
+        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
+          (stats, result) <- runAndPrintStats runAllocs $ lift $
+            runStmtWithLineNum fst_line_num stmt' GHC.RunToCompletion
+          return $ CommandComplete stmt' (Just . runSuccess <$> result) stats
+
+    -- 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
+  :: GhciMonad m => String -> m (Maybe String) -> m (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.initParserState (initParserOpts 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 = prompt_cont 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 :: GhciMonad m => [String] -> m ()
+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 :: GhciMonad m => String -> SingleStep -> m (Maybe GHC.ExecResult)
+runStmt input step = do
+  pflags <- initParserOpts <$> GHC.getInteractiveDynFlags
+  -- In GHCi, we disable `-fdefer-type-errors`, as well as `-fdefer-type-holes`
+  -- and `-fdefer-out-of-scope-variables` for **naked expressions**. The
+  -- declarations and statements are not affected.
+  -- See Note [Deferred type errors in GHCi] in GHC.Tc.Module
+  st <- getGHCiState
+  let source = progname st
+  let line = line_number st
+
+  -- Add any LANGUAGE/OPTIONS_GHC pragmas we find find.
+  set_pragmas pflags
+
+  if | GHC.isStmt pflags input -> do
+         hsc_env <- GHC.getSession
+         mb_stmt <- liftIO (runInteractiveHsc hsc_env (hscParseStmtWithLocation source line input))
+         case mb_stmt of
+           Nothing ->
+             -- empty statement / comment
+             return (Just exec_complete)
+           Just stmt ->
+             run_stmt stmt
+
+     -- Otherwise assume a declaration (or a list of declarations)
+     -- and/or import(s) (#20473).
+     -- Note: `GHC.isDecl` returns False on input like
+     -- `data Infix a b = a :@: b; infixl 4 :@:`
+     -- and should therefore not be used here.
+     | otherwise -> do
+         hsc_env <- GHC.getSession
+         let !ic = hsc_IC hsc_env  -- Bang-pattern to avoid space leaks
+         setDumpFilePrefix ic
+           -- `-ddump-to-file` must work for normal GHCi compilations /
+           --     evaluations. (#17500)
+         -- Use >>= \case instead of MonadFail desugaring to take into
+         -- consideration `instance XXModule p = DataConCantHappen`.
+         -- Tracked in #15681
+         liftIO (hscParseModuleWithLocation hsc_env source line input) >>= \case
+           HsModule { hsmodDecls = decls, hsmodImports = imports } -> do
+             run_imports imports
+             run_decls decls
+  where
+    exec_complete = GHC.ExecComplete (Right []) 0
+
+    run_imports imports = mapM_ (addImportToContext . unLoc) imports
+
+    set_pragmas pflags =
+      let stringbuf = stringToStringBuffer input
+          (_msgs, loc_opts) = Header.getOptions pflags stringbuf "<interactive>"
+          opts = unLoc <$> loc_opts
+      in setOptions opts
+
+    run_stmt :: GhciMonad m => GhciLStmt GhcPs -> m (Maybe GHC.ExecResult)
+    run_stmt stmt = do
+           m_result <- GhciMonad.runStmt stmt input step
+           case m_result of
+               Nothing     -> return Nothing
+               Just result -> Just <$> afterRunStmt (const True) result
+
+    -- `x = y` (a declaration) should be treated as `let x = y` (a statement).
+    -- The reason is because GHCi wasn't designed to support `x = y`, but then
+    -- b98ff3 (#7253) added support for it, except it did not do a good job and
+    -- caused problems like:
+    --
+    --  - not adding the binders defined this way in the necessary places caused
+    --    `x = y` to not work in some cases (#12091).
+    --  - some GHCi command crashed after `x = y` (#15721)
+    --  - warning generation did not work for `x = y` (#11606)
+    --  - because `x = y` is a declaration (instead of a statement) differences
+    --    in generated code caused confusion (#16089)
+    --
+    -- Instead of dealing with all these problems individually here we fix this
+    -- mess by just treating `x = y` as `let x = y`.
+    run_decls :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe GHC.ExecResult)
+    -- Only turn `FunBind` and `VarBind` into statements, other bindings
+    -- (e.g. `PatBind`) need to stay as decls.
+    run_decls [L l (ValD _ bind@FunBind{})] = run_stmt (mk_stmt (locA l) bind)
+    run_decls [L l (ValD _ bind@VarBind{})] = run_stmt (mk_stmt (locA l) bind)
+    -- Note that any `x = y` declarations below will be run as declarations
+    -- instead of statements (e.g. `...; x = y; ...`)
+    run_decls decls = 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.runDecls' decls
+      forM m_result $ \result ->
+        afterRunStmt (const True) (GHC.ExecComplete (Right result) 0)
+
+    mk_stmt :: SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs
+    mk_stmt loc bind =
+      let
+        la  = L (noAnnSrcSpan loc)
+        la' = L (noAnnSrcSpan loc)
+      in la (LetStmt noAnn (HsValBinds noAnn (ValBinds NoAnnSortKey (unitBag (la' bind)) [])))
+
+    setDumpFilePrefix :: GHC.GhcMonad m => InteractiveContext -> m () -- #17500
+    setDumpFilePrefix ic = do
+        dflags <- GHC.getInteractiveDynFlags
+        GHC.setInteractiveDynFlags dflags { dumpPrefix = modStr ++ "." }
+      where
+        modStr = moduleNameString $ moduleName $ icInteractiveModule $ ic
+
+-- | Clean up the GHCi environment after a statement has run
+afterRunStmt :: GhciMonad m
+             => (SrcSpan -> Bool) -> GHC.ExecResult -> m 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
+         | first_resume : _ <- resumes
+         , isNothing  mb_info ||
+           step_here (GHC.resumeSpan first_resume) -> do
+               mb_id_loc <- toBreakIdAndLocation mb_info
+               let bCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc
+               if (null bCmd)
+                 then printStoppedAtBreakInfo first_resume names
+                 else enqueueCommands [bCmd]
+               -- run the command set with ":set stop <cmd>"
+               st <- getGHCiState
+               enqueueCommands [stop st]
+               return ()
+         | otherwise -> resume step_here GHC.SingleStep Nothing >>=
+                        afterRunStmt step_here >> return ()
+
+  flushInterpBuffers
+  withSignalHandlers $ do
+     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 :: GhciMonad m
+                     => Maybe GHC.BreakInfo -> m (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) <- IntMap.assocs (breaks st),
+                                  breakModule loc == md,
+                                  breakTick loc == nm ]
+
+printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
+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 :: GHC.GhcMonad m => [Name] -> m ()
+printTypeOfNames names
+ = mapM_ (printTypeOfName ) $ sortBy compareNames names
+
+compareNames :: Name -> Name -> Ordering
+compareNames = on compare getOccString S.<> on SrcLoc.leftmost_smallest getSrcSpan
+
+printTypeOfName :: GHC.GhcMonad m => Name -> m ()
+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 CmdExecOutcome
+specialCommand ('!':str) = lift $ shellEscape (dropWhile isSpace str)
+specialCommand str = do
+  let (cmd,rest) = break isSpace str
+  maybe_cmd <- lookupCommand cmd
+  htxt <- short_help <$> getGHCiState
+  case maybe_cmd of
+    GotCommand cmd -> (cmdAction cmd) (dropWhile isSpace rest)
+    BadCommand ->
+      do liftIO $ hPutStr stderr ("unknown command ':" ++ cmd ++ "'\n"
+                           ++ htxt)
+         return CmdFailure
+    NoLastCommand ->
+      do liftIO $ hPutStr stderr ("there is no last command to perform\n"
+                           ++ htxt)
+         return CmdFailure
+
+shellEscape :: MonadIO m => String -> m CmdExecOutcome
+shellEscape str = liftIO $ do
+  exitCode <- system str
+  case exitCode of
+    ExitSuccess -> return CmdSuccess
+    ExitFailure _ -> return CmdFailure
+
+lookupCommand :: GhciMonad m => String -> m (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' :: GhciMonad m => String -> m (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 `isPrefixOptOf`) . 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
+
+-- This predicate is for prefix match with a command-body and
+-- suffix match with an option, such as `!`.
+-- The current implementation assumes only the `!` character
+-- as the option delimiter.
+-- See also #17345
+isPrefixOptOf :: String -> String -> Bool
+isPrefixOptOf s x = let (body, opt) = break (== '!') s
+                    in  (body `isPrefixOf` x) && (opt `isSuffixOf` x)
+
+getCurrentBreakSpan :: GHC.GhcMonad m => m (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 :: GHC.GhcMonad m => m (Maybe [String])
+getCallStackAtCurrentBreakpoint = do
+  resumes <- GHC.getResumeContext
+  case resumes of
+    [] -> return Nothing
+    (r:_) -> do
+       interp <- hscInterp <$> GHC.getSession
+       Just <$> liftIO (costCentreStackInfo interp (GHC.resumeCCS r))
+
+getCurrentBreakModule :: GHC.GhcMonad m => m (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 :: MonadIO m => m () -> String -> m ()
+noArgs m "" = m
+noArgs _ _  = liftIO $ putStrLn "This command takes no arguments"
+
+withSandboxOnly :: GHC.GhcMonad m => String -> m () -> m ()
+withSandboxOnly cmd this = do
+   dflags <- getDynFlags
+   if not (gopt Opt_GhciSandbox dflags)
+      then printForUser (text cmd <+>
+                         text "is not supported with -fno-ghci-sandbox")
+      else this
+
+-----------------------------------------------------------------------------
+-- :help
+
+help :: GhciMonad m => String -> m ()
+help _ = do
+    txt <- long_help `fmap` getGHCiState
+    liftIO $ putStr txt
+
+-----------------------------------------------------------------------------
+-- :info
+
+info :: GHC.GhcMonad m => Bool -> String -> m ()
+info _ "" = throwGhcException (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
+info allInfo s  = handleSourceError printGhciException $ do
+    forM_ (words s) $ \thing -> do
+      sdoc <- infoThing allInfo thing
+      rendered <- showSDocForUser' sdoc
+      liftIO (putStrLn rendered)
+
+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,_sd) -> t)
+                                     (catMaybes (NE.toList 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) -> SDoc
+pprInfo (thing, fixity, cls_insts, fam_insts, docs)
+  =  docs
+  $$ pprTyThingInContextLoc thing
+  $$ showFixity thing fixity
+  $$ vcat (map GHC.pprInstance cls_insts)
+  $$ vcat (map GHC.pprFamInst  fam_insts)
+
+-----------------------------------------------------------------------------
+-- :main
+
+runMain :: GhciMonad m => String -> m ()
+runMain s = case toArgsNoLoc s of
+              Left err   -> liftIO (hPutStrLn stderr err)
+              Right args -> doWithMain (doWithArgs args)
+  where
+    doWithMain fun = do
+      dflags  <- getDynFlags
+      let main = fromMaybe "main" (mainFunIs dflags)
+      handleSourceError printErrAndMaybeExit $ do
+        -- doing this will prevent the main to run when it is not in scope
+        -- this might seem useless, but it doesn't suggest other functions
+        -- to be used, which is exactly what we want here. See #23996.
+        _ <- GHC.parseName main
+
+        -- Wrap the main function in 'void' to discard its value instead
+        -- of printing it (#9086). See Haskell 2010 report Chapter 5.
+        fun $ "Control.Monad.void (" ++ main ++ ")"
+
+
+
+
+-----------------------------------------------------------------------------
+-- :run
+
+runRun :: GhciMonad m => String -> m ()
+runRun s = case toCmdArgs s of
+           Left err          -> liftIO (hPutStrLn stderr err)
+           Right (cmd, args) -> doWithArgs args cmd
+
+doWithArgs :: GhciMonad m => [String] -> String -> m ()
+doWithArgs args cmd = enqueueCommands ["System.Environment.withArgs " ++
+                                       show args ++ " (" ++ cmd ++ ")"]
+
+{-
+Akin to @Prelude.words@, but acts like the Bourne shell, treating
+quoted strings as Haskell Strings, and also parses Haskell [String]
+syntax.
+-}
+
+getCmd :: String -> Either String             -- Error
+                           (String, String) -- (Cmd, Rest)
+getCmd s = case break isSpace $ dropWhile isSpace s of
+           ([], _) -> Left ("Couldn't find command in " ++ show s)
+           res -> Right res
+
+toCmdArgs :: String -> Either String             -- Error
+                              (String, [String]) -- (Cmd, Args)
+toCmdArgs s = case getCmd s of
+              Left err -> Left err
+              Right (cmd, s') -> case toArgsNoLoc s' of
+                                 Left err -> Left err
+                                 Right args -> Right (cmd, args)
+
+-- wrapper around GHC.Parser.Header.toArgs, but without locations
+toArgsNoLoc :: String -> Either String [String]
+toArgsNoLoc str = map unLoc <$> toArgs fake_loc str
+  where
+    fake_loc = mkRealSrcLoc (fsLit "<interactive>") 1 1
+    -- this should never be seen, because it's discarded with the `map unLoc`
+
+-----------------------------------------------------------------------------
+-- :cd
+
+changeDirectory :: GhciMonad m => String -> m ()
+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 $ GHC.mgModSummaries graph)) $
+        liftIO $ putStrLn "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed."
+  -- delete defined breakpoints and clear the interface file cache (#1620)
+  clearCaches
+  setContextAfterLoad False Nothing
+  GHC.workingDirectoryChanged
+  dir' <- expandPath dir
+  liftIO $ setCurrentDirectory dir'
+  -- With -fexternal-interpreter, we have to change the directory of the subprocess too.
+  -- (this gives consistent behaviour with and without -fexternal-interpreter)
+  interp <- hscInterp <$> GHC.getSession
+  case interpInstance interp of
+    ExternalInterp {} -> do
+      fhv <- compileGHCiExpr $
+        "System.Directory.setCurrentDirectory " ++ show dir'
+      liftIO $ evalIO interp fhv
+    _ -> pure ()
+
+trySuccess :: GhciMonad m => m SuccessFlag -> m SuccessFlag
+trySuccess act =
+    handleSourceError (\e -> do printErrAndMaybeExit e -- immediately exit fith failure if in ghc -e
+                                pure Failed) act
+
+-----------------------------------------------------------------------------
+-- :edit
+
+editFile :: GhciMonad m => String -> m ()
+editFile str =
+  do file <- if null str then 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 ""
+
+-- 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 dependency 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 occurred during the
+-- last load/reaload, then we could start the editor focused on the first
+-- of those.
+chooseEditFile :: GHC.GhcMonad m => m String
+chooseEditFile =
+  do let hasFailed (GHC.ModuleNode _deps x) = fmap not $ isLoadedModSummary x
+         hasFailed _ = return False
+
+     graph <- GHC.getModuleGraph
+     failed_graph <-
+       GHC.mkModuleGraph <$> filterM hasFailed (GHC.mgModSummaries' graph)
+     let order g  = flattenSCCs $ filterToposortToModules $
+           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 { targetId = GHC.TargetFile f _ } = Just f
+        fromTarget _ = Nothing -- when would we get a module target?
+
+
+-----------------------------------------------------------------------------
+-- :def
+
+defineMacro :: GhciMonad m => Bool{-overwrite-} -> String -> m ()
+defineMacro _ (':':_) = (liftIO $ hPutStrLn stderr
+                          "macro name cannot start with a colon")
+                            >> failIfExprEvalMode
+defineMacro _ ('!':_) = (liftIO $ hPutStrLn stderr
+                          "macro name cannot start with an exclamation mark")
+                            >> failIfExprEvalMode
+                          -- little code duplication allows to grep error msg
+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
+    isCommand <- isJust <$> lookupCommand' macro_name
+    let check_newname
+          | macro_name `elem` defined = throwGhcException (CmdLineError
+            ("macro '" ++ macro_name ++ "' is already defined. " ++ hint))
+          | isCommand = throwGhcException (CmdLineError
+            ("macro '" ++ macro_name ++ "' overwrites builtin command. " ++ hint))
+          | otherwise = return ()
+        hint = " Use ':def!' to overwrite."
+
+    unless overwrite check_newname
+    -- compile the expression
+    handleSourceError printErrAndMaybeExit $ do
+      step <- getGhciStepIO
+      expr <- GHC.parseExpr definition
+      -- > ghciStepIO . definition :: String -> IO String
+      let stringTy :: LHsType GhcPs
+          stringTy = nlHsTyVar NotPromoted stringTyCon_RDR
+          ioM :: LHsType GhcPs -- AZ
+          ioM = nlHsTyVar NotPromoted (getRdrName ioTyConName) `nlHsAppTy` stringTy
+          body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
+                                     `mkHsApp` (nlHsPar expr)
+          tySig = mkHsWildCardBndrs $ noLocA $ mkHsImplicitSigType $
+                  nlHsFunTy stringTy ioM
+          new_expr = L (getLoc expr) $ ExprWithTySig noAnn 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
+  :: GhciMonad m
+  => GHC.ForeignHValue  -- String -> IO String
+  -> String
+  -> m CmdExecOutcome
+runMacro fun s = do
+  interp <- hscInterp <$> GHC.getSession
+  str <- liftIO $ evalStringToIOString interp fun s
+  enqueueCommands (lines str)
+  return CmdSuccess
+
+
+-----------------------------------------------------------------------------
+-- :undef
+
+undefineMacro :: GhciMonad m => String -> m ()
+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 :: GhciMonad m => String -> m ()
+cmdCmd str = handleSourceError printErrAndMaybeExit $ do
+    step <- getGhciStepIO
+    expr <- GHC.parseExpr str
+    -- > ghciStepIO str :: IO String
+    let new_expr = step `mkHsApp` expr
+    hv <- GHC.compileParsedExprRemote new_expr
+
+    interp <- hscInterp <$> GHC.getSession
+    cmds <- liftIO $ evalString interp hv
+    enqueueCommands (lines cmds)
+
+-- | Generate a typed ghciStepIO expression
+-- @ghciStepIO :: Ty String -> IO String@.
+getGhciStepIO :: GHC.GhcMonad m => m (LHsExpr GhcPs)
+getGhciStepIO = do
+  ghciTyConName <- GHC.getGHCiMonad
+  let stringTy = nlHsTyVar NotPromoted stringTyCon_RDR
+      ghciM = nlHsTyVar NotPromoted (getRdrName ghciTyConName) `nlHsAppTy` stringTy
+      ioM = nlHsTyVar NotPromoted (getRdrName ioTyConName) `nlHsAppTy` stringTy
+      body = nlHsVar (getRdrName ghciStepIoMName)
+      tySig = mkHsWildCardBndrs $ noLocA $ mkHsImplicitSigType $
+              nlHsFunTy ghciM ioM
+  return $ noLocA $ ExprWithTySig noAnn body tySig
+
+-----------------------------------------------------------------------------
+-- :check
+
+checkModule :: GhciMonad m => String -> m ()
+checkModule m = do
+  let modl = GHC.mkModuleName m
+  ok <- handleSourceError (\e -> printErrAndMaybeExit 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) Check
+
+-----------------------------------------------------------------------------
+-- :doc
+
+docCmd :: GHC.GhcMonad m => String -> m ()
+docCmd "" =
+  throwGhcException (CmdLineError "syntax: ':doc <thing-you-want-docs-for>'")
+docCmd s  = do
+  -- TODO: Maybe also get module headers for module names
+  names <- GHC.parseName s
+
+  docs <- traverse (buildDocComponents s) names
+
+  let sdocs = pprDocs (NE.toList docs)
+      sdocs' = vcat (intersperse (text "") sdocs)
+  sdoc <- showSDocForUser' sdocs'
+  liftIO (putStrLn sdoc)
+
+data DocComponents =
+  DocComponents
+    { docs      :: Maybe [HsDoc GhcRn]   -- ^ subject's haddocks
+    , sigAndLoc :: Maybe SDoc          -- ^ type signature + category + location
+    , argDocs   :: IntMap (HsDoc GhcRn) -- ^ haddocks for arguments
+    }
+
+buildDocComponents :: GHC.GhcMonad m => String -> Name -> m DocComponents
+buildDocComponents str name = do
+  mbThing <- GHC.lookupName name
+  let sigAndLoc = sigAndLocDoc str <$> mbThing
+  (docs, argDocs)
+    <- either handleGetDocsFailure pure
+         =<< GHC.getDocs name
+
+  pure DocComponents{..}
+
+-- | Produce output containing the type/kind signature, category, and definition
+-- location of a TyThing.
+sigAndLocDoc :: String -> TyThing -> SDoc
+sigAndLocDoc str tyThing =
+  let tyThingTyDoc :: TyThing -> SDoc
+      tyThingTyDoc = \case
+        AnId i                      -> pprSigmaType $ varType i
+        AConLike (RealDataCon dc)   -> pprSigmaType $ dataConDisplayType False dc
+        AConLike (PatSynCon patSyn) -> pprPatSynType patSyn
+        ATyCon tyCon                -> pprSigmaType $ GHC.tyConKind tyCon
+        ACoAxiom _                  -> empty
+
+      tyDoc = tyThingTyDoc tyThing
+      sigDoc = text str <+> nest 2 (dcolon <+> tyDoc)
+      comment =
+        hsep [ char '\t' <> text "--"
+             , pprTyThingCategory tyThing
+             , text "defined" <+> pprNameDefnLoc (getName tyThing)
+             ]
+   in hang sigDoc 2 comment
+
+pprDocs :: [DocComponents] -> [SDoc]
+pprDocs docs
+  | null nonEmptyDocs = pprDoc <$> take 1 docs
+  -- elide <has no documentation> if there's at least one non-empty doc (#15784)
+  | otherwise = pprDoc <$> nonEmptyDocs
+  where
+    empty DocComponents{docs = mb_decl_docs, argDocs = arg_docs}
+      = maybe True null mb_decl_docs && null arg_docs
+    nonEmptyDocs = filter (not . empty) docs
+
+-- TODO: also print arg docs.
+pprDoc :: DocComponents -> SDoc
+pprDoc DocComponents{sigAndLoc = mb_sig_loc, docs = mb_decl_docs} =
+  maybe
+    (text "<has no documentation>")
+    formatDoc
+    mb_decl_docs
+  where
+    formatDoc doc =
+      vcat [ fromMaybe empty mb_sig_loc -- print contextual info (#19055)
+           , pprHsDocStrings $ map hsDocString doc
+           ]
+
+handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m a
+handleGetDocsFailure no_docs = do
+  dflags <- getDynFlags
+  let msg = showPpr dflags no_docs
+  throwGhcException $ case no_docs of
+    NameHasNoModule {} -> Sorry msg
+    NoDocsInIface {} -> InstallationError msg
+    InteractiveName -> ProgramError msg
+
+-----------------------------------------------------------------------------
+-- :instances
+
+instancesCmd :: String -> InputT GHCi ()
+instancesCmd "" =
+  throwGhcException (CmdLineError "syntax: ':instances <type-you-want-instances-for>'")
+instancesCmd s = do
+  handleSourceError printGhciException $ do
+    ty <- GHC.parseInstanceHead s
+    res <- GHC.getInstancesForType ty
+
+    printForUser $ vcat $ map ppr res
+
+-----------------------------------------------------------------------------
+-- :load, :add, :unadd, :reload
+
+-- these are mainly used for displaying a more informative response
+data LoadType = Add !Int | Unadd !Int | Load | Reload | Check
+
+isReload :: LoadType -> Bool
+isReload Reload = True
+isReload _      = False
+
+-- | Sets '-fdefer-type-errors' if 'defer' is true, executes 'load' and unsets
+-- '-fdefer-type-errors' again if it has not been set before.
+wrapDeferTypeErrors :: GHC.GhcMonad m => m a -> m a
+wrapDeferTypeErrors load =
+  MC.bracket
+    (do
+      -- Force originalFlags to avoid leaking the associated HscEnv
+      !originalFlags <- getDynFlags
+      void $ GHC.setProgramDynFlags $
+         setGeneralFlag' Opt_DeferTypeErrors originalFlags
+      return originalFlags)
+    (\originalFlags -> void $ GHC.setProgramDynFlags originalFlags)
+    (\_ -> load)
+
+loadModule :: GhciMonad m => [(FilePath, Maybe UnitId, Maybe Phase)] -> m SuccessFlag
+loadModule fs = do
+  (_, result) <- runAndPrintStats (const Nothing) (loadModule' fs)
+  either (liftIO . Exception.throwIO) return result
+
+-- | @:load@ command
+loadModule_ :: GhciMonad m => [FilePath] -> m ()
+loadModule_ fs = void $ loadModule (zip3 fs (repeat Nothing) (repeat Nothing))
+
+loadModuleDefer :: GhciMonad m => [FilePath] -> m ()
+loadModuleDefer = wrapDeferTypeErrors . loadModule_
+
+loadModule' :: GhciMonad m => [(FilePath, Maybe UnitId, Maybe Phase)] -> m SuccessFlag
+loadModule' files = do
+  let (filenames, uids, phases) = unzip3 files
+  exp_filenames <- mapM expandPath filenames
+  let files' = zip3 exp_filenames uids phases
+  targets <- mapM (\(file, uid, phase) -> GHC.guessTarget file uid phase) 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.
+
+  hsc_env <- GHC.getSession
+  let !dflags = hsc_dflags hsc_env
+
+  let load_module = do
+        -- unload first
+        _ <- GHC.abandonAll
+        clearCaches
+
+        GHC.setTargets targets
+        doLoadAndCollectInfo Load LoadAllTargets
+
+  if gopt Opt_GhciLeakCheck dflags
+    then do
+      -- Grab references to the currently loaded modules so that we can see if
+      -- they leak.
+      leak_indicators <- liftIO $ getLeakIndicators hsc_env
+      success <- load_module
+      liftIO $ checkLeakIndicators dflags leak_indicators
+      return success
+    else
+      load_module
+
+-- | @:add@ command
+addModule :: GhciMonad m => [FilePath] -> m ()
+addModule files = do
+  revertCAFs -- always revert CAFs on load/add.
+  files' <- mapM expandPath files
+  targets <- mapM (\m -> GHC.guessTarget m Nothing Nothing) files'
+  targets' <- filterM checkTarget targets
+  -- remove old targets with the same id; e.g. for :add *M
+  mapM_ GHC.removeTarget [ tid | Target { targetId = tid } <- targets' ]
+  mapM_ GHC.addTarget targets'
+  _ <- doLoadAndCollectInfo (Add $ length targets') LoadAllTargets
+  return ()
+  where
+    checkTarget :: GhciMonad m => Target -> m Bool
+    checkTarget Target { targetId = TargetModule m } = checkTargetModule m
+    checkTarget Target { targetId = TargetFile f _ } = checkTargetFile f
+
+    checkTargetModule :: GhciMonad m => ModuleName -> m Bool
+    checkTargetModule m = do
+      hsc_env <- GHC.getSession
+      let home_unit = hsc_home_unit hsc_env
+      result <- liftIO $
+        Finder.findImportedModule hsc_env m (ThisPkg (homeUnitId home_unit))
+      case result of
+        Found _ _ -> return True
+        _ -> do liftIO $ hPutStrLn stderr ("Module " ++ moduleNameString m ++ " not found")
+                failIfExprEvalMode
+                return False
+
+    checkTargetFile :: GhciMonad m => String -> m Bool
+    checkTargetFile f = do
+      exists <- liftIO (doesFileExist f)
+      unless exists $ do
+        liftIO $ hPutStrLn stderr $ "File " ++ f ++ " not found"
+        failIfExprEvalMode
+      return exists
+
+-- | @:unadd@ command
+unAddModule :: GhciMonad m => [FilePath] -> m ()
+unAddModule files = do
+  files' <- mapM expandPath files
+  targets <- mapM (\m -> GHC.guessTarget m Nothing Nothing) files'
+  let removals = [ tid | Target { targetId = tid } <- targets ]
+  mapM_ GHC.removeTarget removals
+  _ <- doLoadAndCollectInfo (Unadd $ length removals) LoadAllTargets
+  return ()
+
+-- | @:reload@ command
+reloadModule :: GhciMonad m => String -> m ()
+reloadModule m = do
+  session <- GHC.getSession
+  let home_unit = homeUnitId (hsc_home_unit session)
+  ok <- doLoadAndCollectInfo Reload (loadTargets home_unit)
+  when (failed ok) failIfExprEvalMode
+  where
+    loadTargets hu | null m    = LoadAllTargets
+                   | otherwise = LoadUpTo (mkModule hu (GHC.mkModuleName m))
+
+reloadModuleDefer :: GhciMonad m => String -> m ()
+reloadModuleDefer = wrapDeferTypeErrors . reloadModule
+
+-- | 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 :: GhciMonad m => LoadType -> LoadHowMuch -> m SuccessFlag
+doLoadAndCollectInfo load_type howmuch = do
+  doCollectInfo <- isOptionSet CollectInfo
+
+  doLoad load_type howmuch >>= \case
+    Succeeded | doCollectInfo -> do
+      mod_summaries <- GHC.mgModSummaries <$> getModuleGraph
+      -- MP: :set +c code path only works in single package mode atm, hence
+      -- this call to isLoaded is ok. collectInfo needs to be modified further to
+      -- work with :set +c so I have punted on that for now.
+      loaded <- filterM GHC.isLoaded (map ms_mod_name mod_summaries)
+      v <- mod_infos <$> getGHCiState
+      !newInfos <- collectInfo v loaded
+      modifyGHCiState (\st -> st { mod_infos = newInfos })
+      pure Succeeded
+    flag -> pure flag
+
+doLoad :: GhciMonad m => LoadType -> LoadHowMuch -> m SuccessFlag
+doLoad load_type howmuch = do
+  -- turn off breakpoints before we load: we can't turn them off later, because
+  -- the ModBreaks will have gone away.
+  discardActiveBreakPoints
+
+  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.
+  let setBuffering t = liftIO $ do
+        hSetBuffering stdout t
+        hSetBuffering stderr t
+  MC.bracket_ (setBuffering LineBuffering) (setBuffering NoBuffering) $ do
+      hmis <- ifaceCache <$> getGHCiState
+      -- If GHCi message gets its own configuration at some stage then this will need to be
+      -- modified to 'embedUnknownDiagnostic'.
+      ok <- trySuccess $ GHC.loadWithCache (Just hmis) (mkUnknownDiagnostic . GHCiMessage) howmuch
+      afterLoad ok load_type
+      pure ok
+
+
+
+afterLoad
+  :: GhciMonad m
+  => SuccessFlag
+  -> LoadType
+  -> m ()
+afterLoad ok load_type = do
+  revertCAFs  -- always revert CAFs on load.
+  discardTickArrays
+  loaded_mods <- getLoadedModules
+  modulesLoadedMsg ok loaded_mods load_type
+  graph <- GHC.getModuleGraph
+  setContextAfterLoad (isReload load_type) (Just graph)
+
+setContextAfterLoad :: GhciMonad m => Bool -> Maybe GHC.ModuleGraph -> m ()
+setContextAfterLoad keep_ctxt Nothing = do
+  setContextKeepingPackageModules keep_ctxt []
+setContextAfterLoad keep_ctxt (Just graph) = do
+  -- load a target if one is available, otherwise load the topmost module.
+  targets <- GHC.getTargets
+  loaded_graph <- filterM is_loaded $ GHC.mgModSummaries' graph
+  case [ m | Just m <- map (findTarget loaded_graph) targets ] of
+        []    ->
+          let graph' = flattenSCCs $ filterToposortToModules $
+                GHC.topSortModuleGraph True (GHC.mkModuleGraph loaded_graph) Nothing
+          in case graph' of
+              [] -> setContextKeepingPackageModules keep_ctxt []
+              xs -> load_this (last xs)
+        (m:_) ->
+          load_this m
+ where
+   is_loaded (GHC.ModuleNode _ ms) = isLoadedModSummary ms
+   is_loaded _ = return False
+
+   findTarget mds t
+    = case mapMaybe (`matches` t) mds of
+        []    -> Nothing
+        (m:_) -> Just m
+
+   (GHC.ModuleNode _ summary) `matches` Target { targetId = TargetModule m }
+        = if GHC.ms_mod_name summary == m then Just summary else Nothing
+   (GHC.ModuleNode _ summary) `matches` Target { targetId = TargetFile f _ }
+        | Just f' <- GHC.ml_hs_file (GHC.ms_location summary)   =
+          if f == f' then Just summary else Nothing
+   _ `matches` _ = Nothing
+
+   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
+  :: GhciMonad m
+  => Bool                 -- True  <=> keep all of remembered_ctx
+                          -- False <=> just keep package imports
+  -> [InteractiveImport]  -- new context
+  -> m ()
+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
+  :: GHC.GhcMonad m => [InteractiveImport] -> m [InteractiveImport]
+keepPackageImports = filterM is_pkg_import
+  where
+     is_pkg_import :: GHC.GhcMonad m => InteractiveImport -> m Bool
+     is_pkg_import (IIModule _) = return False
+     is_pkg_import (IIDecl d)
+         = do pkgqual <- GHC.renameRawPkgQualM (unLoc $ ideclName d) (ideclPkgQual d)
+              e <- MC.try $ GHC.findQualifiedModule pkgqual mod_name
+              case e :: Either SomeException Module of
+                Left _  -> return False
+                Right m -> return (not (isMainUnitModule m))
+        where
+          mod_name = unLoc (ideclName d)
+
+
+
+modulesLoadedMsg :: GHC.GhcMonad m => SuccessFlag -> [GHC.ModSummary] -> LoadType -> m ()
+modulesLoadedMsg ok mods load_type = do
+  dflags <- getDynFlags
+  when (verbosity dflags > 0) $ do
+     mod_names <- mapM mod_name mods
+     rendered_msg <- showSDocForUser' $
+       if gopt Opt_ShowLoadedModules dflags
+         then loaded_msg mod_names
+         else msg
+     liftIO $ putStrLn rendered_msg
+  where
+    num_mods = length mods
+    none_loaded = num_mods == 0
+
+    loaded_msg names =
+      let mod_commas
+           | null mods = text "none."
+           | otherwise = hsep (punctuate comma names) <> text "."
+      in status <> text ", modules loaded:" <+> mod_commas
+
+    msg  = status <> comma <+> msg' <> dot
+    msg' = case load_type of
+      Reload  -> if none_loaded
+                   then "no modules to be reloaded"
+                   else n_mods num_mods "reloaded"
+      Load    -> if none_loaded
+                   then "unloaded all modules"
+                   else n_mods num_mods "loaded"
+      Check   -> n_mods 1 "checked"
+      Add   n -> n_mods n "added"
+      Unadd n -> n_mods n "unadded"
+    n_mods amount action = speakNOf amount "module" <+> action
+
+    status | Succeeded <- ok = "Ok"
+           | otherwise       = "Failed"
+
+    mod_name mod = do
+        is_interpreted <- GHC.moduleIsBootOrNotObjectLinkable mod
+        pure $ if is_interpreted
+               then ppr (GHC.ms_mod mod)
+               else ppr (GHC.ms_mod mod)
+                    <+> parens (text $ normalise $ msObjFilePath mod)
+                    -- Fix #9887
+
+-- | Run an 'ExceptT' wrapped 'GhcMonad' while handling source errors
+-- and printing 'throwE' strings to 'stderr'. If in expression
+-- evaluation mode - throw GhcException and exit.
+runExceptGhciMonad :: GhciMonad m => ExceptT SDoc m () -> m ()
+runExceptGhciMonad act = handleSourceError printGhciException $
+                         either handleErr pure =<<
+                         runExceptT act
+  where
+    handleErr sdoc = do
+        rendered <- showSDocForUserQualify sdoc
+        liftIO $ hPutStrLn stderr rendered
+        failIfExprEvalMode
+
+-- | 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'
+  :: forall backend
+   . Backend backend
+  => Proxy backend
+  -> IORef ClashOpts
+  -> [FilePath]
+  -> InputT GHCi ()
+makeHDL' backend opts lst = go =<< case lst of
+  srcs@(_:_) -> return srcs
+  []         -> do
+    modGraph <- GHC.getModuleGraph
+    let sortedGraph =
+          -- TODO: this might break backpack
+          filterToposortToModules $
+          GHC.topSortModuleGraph False modGraph Nothing
+    return $ case (reverse sortedGraph) of
+      ((AcyclicSCC top) : _) -> maybeToList $ (GHC.ml_hs_file . GHC.ms_location) top
+      _                      -> []
+ where
+  go srcs = do
+    dflags <- GHC.getSessionDynFlags
+    goX dflags srcs `MC.finally` recover dflags
+
+  goX dflags srcs = do
+    -- Issue #439 step 1
+    (dflagsX,_,_) <- parseDynamicFlagsCmdLine dflags
+                       [ noLoc "-fobject-code"   -- For #439
+                       , noLoc "-fforce-recomp"  -- Actually compile to object-code
+                       , noLoc "-keep-tmp-files" -- To prevent linker errors from
+                                                 -- multiple calls to :hdl command
+                       ]
+    _ <- GHC.setSessionDynFlags dflagsX
+    reloadModule ""
+    -- Issue #439 step 2
+    -- Unload any object files
+    -- This fixes: https://github.com/clash-lang/clash-compiler/issues/439#issuecomment-522015868
+    env <- GHC.getSession
+    liftIO (Loader.unload (hscInterp env) env [])
+    -- Finally generate the HDL
+    makeHDL backend (return ()) opts srcs
+
+  recover dflags = do
+    _ <- GHC.setSessionDynFlags dflags
+    reloadModule ""
+
+makeHDL
+  :: forall backend m
+   . (GHC.GhcMonad m, Backend backend)
+  => Proxy backend
+  -> Ghc ()
+  -> IORef ClashOpts
+  -> [FilePath]
+  -> m ()
+makeHDL Proxy startAction optsRef srcs = do
+  dflags <- GHC.getSessionDynFlags
+  liftIO $ do startTime <- Clock.getCurrentTime
+              opts0  <- readIORef optsRef
+              let opts1  = opts0 { opt_color = fromGhcOverridingBool (useColor dflags) }
+              let iw     = opt_intWidth opts1
+                  hdl    = hdlKind backend
+                  -- 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
+                  idirs = importPaths dflags
+                  opts2 = opts1 { opt_hdlDir = maybe outputDir Just (opt_hdlDir opts1)
+                                , opt_importPaths = idirs}
+                  backend = initBackend @backend opts2
+
+              checkMonoLocalBinds dflags
+              checkImportDirs opts0 idirs
+
+              primDirs_ <- primDirs backend
+
+              forM_ srcs $ \src -> do
+                -- Generate bindings:
+                let dbs = reverse [p | PackageDB (PkgDbPath p) <- packageDBFlags dflags]
+                (clashEnv, clashDesign) <- generateBindings opts2 startAction primDirs_ idirs dbs hdl src (Just dflags)
+
+                let getMain = getMainTopEntity src clashDesign
+                mainTopEntity <- traverse getMain (GHC.mainFunIs dflags)
+                prepTime <- startTime `deepseq` designBindings clashDesign `deepseq` envTyConMap clashEnv `deepseq` Clock.getCurrentTime
+                let prepStartDiff = reportTimeDiff prepTime startTime
+                putStrLn $ "GHC+Clash: Loading modules cumulatively took " ++ prepStartDiff
+
+                -- Generate HDL:
+                Clash.Driver.generateHDL
+                  clashEnv
+                  clashDesign
+                  (Just backend)
+                  (ghcTypeToHWType iw)
+                  ghcEvaluator
+                  evaluator
+                  mainTopEntity
+                  startTime
+
+makeVHDL :: IORef ClashOpts -> [FilePath] -> InputT GHCi ()
+makeVHDL = makeHDL' (Proxy @VHDLState)
+
+makeVerilog :: IORef ClashOpts -> [FilePath] -> InputT GHCi ()
+makeVerilog = makeHDL' (Proxy @VerilogState)
+
+makeSystemVerilog :: IORef ClashOpts -> [FilePath] -> InputT GHCi ()
+makeSystemVerilog = makeHDL' (Proxy @SystemVerilogState)
+
+-----------------------------------------------------------------------------
+-- | @:type@ command. See also Note [TcRnExprMode] in GHC.Tc.Module.
+
+typeOfExpr :: GhciMonad m => String -> m ()
+typeOfExpr str = handleSourceError printErrAndMaybeExit $
+    case break isSpace str of
+      ("+v", _)    -> printForUser (text "`:type +v' has gone; use `:type' instead")
+      ("+d", rest) -> do_it GHC.TM_Default (dropWhile isSpace rest)
+      _            -> do_it GHC.TM_Inst    str
+  where
+    do_it mode expr_str
+      = do { ty <- GHC.exprType mode expr_str
+           ;    printForUser $ sep [ text expr_str
+                                   , nest 2 (dcolon <+> pprSigmaType ty)] }
+
+-----------------------------------------------------------------------------
+-- | @:type-at@ command
+
+typeAtCmd :: GhciMonad m => String -> m ()
+typeAtCmd str = runExceptGhciMonad $ do
+    (span',sample) <- exceptT $ parseSpanArg str
+    infos      <- lift $ mod_infos <$> getGHCiState
+    (info, ty) <- findType infos span' sample
+    let mb_rdr_env = case modinfoRdrEnv info of
+          Strict.Just rdrs -> Just rdrs
+          Strict.Nothing   -> Nothing
+    lift $ printForUserGlobalRdrEnv
+              mb_rdr_env
+              (sep [text sample,nest 2 (dcolon <+> ppr ty)])
+
+-----------------------------------------------------------------------------
+-- | @:uses@ command
+
+usesCmd :: GhciMonad m => String -> m ()
+usesCmd str = runExceptGhciMonad $ do
+    (span',sample) <- exceptT $ parseSpanArg str
+    infos  <- lift $ mod_infos <$> getGHCiState
+    uses   <- findNameUses infos span' sample
+    forM_ uses (liftIO . putStrLn . showSrcSpan)
+
+-----------------------------------------------------------------------------
+-- | @:loc-at@ command
+
+locAtCmd :: GhciMonad m => String -> m ()
+locAtCmd str = runExceptGhciMonad $ do
+    (span',sample) <- exceptT $ parseSpanArg str
+    infos    <- lift $ mod_infos <$> getGHCiState
+    (_,_,sp) <- findLoc infos span' sample
+    liftIO . putStrLn . showSrcSpan $ sp
+
+-----------------------------------------------------------------------------
+-- | @:all-types@ command
+
+allTypesCmd :: GhciMonad m => String -> m ()
+allTypesCmd _ = runExceptGhciMonad $ do
+    infos <- lift $ mod_infos <$> getGHCiState
+    forM_ (M.elems infos) $ \mi ->
+        forM_ (modinfoSpans mi) (lift . printSpan)
+  where
+    printSpan span'
+      | Just ty <- spaninfoType span' = do
+        tyInfo <- (unwords . words) <$>
+                  showSDocForUserQualify (pprSigmaType 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)
+                              -- End column of RealSrcSpan is the column
+                              -- after the end of the span.
+                              (mkRealSrcLoc fs el (ec + 1))
+
+    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 (unhelpfulSpanFS 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
+    -- The end column is the column after the end of the span see the
+    -- RealSrcSpan module
+    ec = let ec' = srcSpanEndCol    spn in if ec' == 0 then 0 else ec' - 1
+
+-----------------------------------------------------------------------------
+-- | @:kind@ command
+
+kindOfType :: GhciMonad m => Bool -> String -> m ()
+kindOfType norm str = handleSourceError printErrAndMaybeExit $ do
+    (ty, kind) <- GHC.typeKind norm str
+    printForUser $ vcat [ text str <+> dcolon <+> pprSigmaType kind
+                        , ppWhen norm $ equals <+> pprSigmaType ty ]
+
+-----------------------------------------------------------------------------
+-- :quit
+
+quit :: Monad m => String -> m CmdExecOutcome
+quit _ = return CleanExit
+
+
+-----------------------------------------------------------------------------
+-- :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>")
+
+-- | A version of 'words' that treats sequences enclosed in double quotes as
+-- single words and that does not break on backslash-escaped spaces.
+-- E.g., 'words\' "\"lorem ipsum\" dolor"' and 'words\' "lorem\\ ipsum dolor"'
+-- yield '["lorem ipsum", "dolor"]'.
+-- Used to scan for file paths in 'scriptCmd'.
+words' :: String -> [String]
+words' s = case dropWhile isSpace s of
+  "" -> []
+  s'@('\"' : _) | [(w, s'')] <- reads s' -> w : words' s''
+  s' -> go id s'
+ where
+  go acc []                          = [acc []]
+  go acc ('\\' : c : cs) | isSpace c = go (acc . (c :)) cs
+  go acc (c : cs) | isSpace c = acc [] : words' cs
+                  | otherwise = go (acc . (c :)) cs
+
+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 :: GHC.GhcMonad m => String -> m ()
+isSafeCmd m =
+    case words m of
+        [s] | looksLikeModuleName s -> do
+            md <- lookupModule s
+            isSafeModule md
+        [] -> do md <- guessCurrentModule "issafe"
+                 isSafeModule md
+        _ -> throwGhcException (CmdLineError "syntax:  :issafe <module>")
+
+isSafeModule :: GHC.GhcMonad m => Module -> m ()
+isSafeModule m = do
+    mb_mod_info <- GHC.getModuleInfo m
+    when (isNothing mb_mod_info)
+         (throwGhcException $ CmdLineError $ "unknown module: " ++ mname)
+
+    dflags <- getDynFlags
+    hsc_env <- GHC.getSession
+    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  = show $ getSafeMode $ GHC.mi_trust $ fromJust iface
+        pkg    = if packageTrusted hsc_env m then "trusted" else "untrusted"
+        (good, bad) = tallyPkgs hsc_env 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 $ S.null good)
+         (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++
+                        (intercalate ", " $ map (showPpr dflags) (S.toList good)))
+    case msafe && S.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) (S.toList bad)))
+            liftIO $ putStrLn $ mname ++ " is NOT trusted!"
+
+  where
+    mname = GHC.moduleNameString $ GHC.moduleName m
+
+    packageTrusted hsc_env md
+        | isHomeModule (hsc_home_unit hsc_env) md = True
+        | otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md)
+
+    tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (S.empty, S.empty)
+                          | otherwise = S.partition part deps
+        where part pkg   = unitIsTrusted $ unsafeLookupUnitId unit_state pkg
+              unit_state = hsc_units hsc_env
+              dflags     = hsc_dflags hsc_env
+
+-----------------------------------------------------------------------------
+-- :browse
+
+-- Browsing a module's contents
+
+browseCmd :: GHC.GhcMonad m => Bool -> String -> m ()
+browseCmd bang m =
+  case words m of
+    ['*':s] | looksLikeModuleName s -> do
+        md <- wantInterpretedModule s
+        browseModule bang md False
+    [s] | looksLikeModuleName s -> do
+        md <- lookupModule s
+        browseModule bang md True
+    [] -> do md <- guessCurrentModule ("browse" ++ if bang then "!" else "")
+             browseModule bang md True
+    _ -> throwGhcException (CmdLineError "syntax:  :browse <module>")
+
+guessCurrentModule :: GHC.GhcMonad m => String -> m 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
+  case imports of
+    [] -> throwGhcException $ CmdLineError (':' : cmd ++ ": no current module")
+    IIModule m : _ -> GHC.findQualifiedModule NoPkgQual m
+    IIDecl d : _ -> do
+      pkgqual <- GHC.renameRawPkgQualM (unLoc $ ideclName d) (ideclPkgQual d)
+      GHC.findQualifiedModule pkgqual (unLoc (ideclName 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 :: GHC.GhcMonad m => Bool -> Module -> Bool -> m ()
+browseModule bang modl exports_only = do
+  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
+        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 (SrcLoc.leftmost_smallest `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 showToHeader
+                   | otherwise = pprTyThingInContext showToHeader
+
+            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.. (#1799)
+            annotate mts = concatMap (\(m,ts)->labels m:ts)
+                         $ sortBy cmpQualifiers $ grp mts
+              where cmpQualifiers =
+                      compare `on` (map (fmap (map (unpackFS . 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
+
+        -- :browse reports qualifiers wrt current context
+        rendered_things <- showSDocForUser' (vcat prettyThings')
+        liftIO $ putStrLn rendered_things
+        -- 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 :: GhciMonad m => String -> m ()
+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 :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
+addModulesToContext starred unstarred = restoreContextOnFailure $ do
+   addModulesToContext_ starred unstarred
+
+addModulesToContext_ :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
+addModulesToContext_ starred unstarred = do
+   mapM_ addII (map mkIIModule starred ++ map mkIIDecl unstarred)
+   setGHCContextFromGHCiState
+
+remModulesFromContext :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
+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 :: GhciMonad m => ModuleName -> m ()
+   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 :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
+setContext starred unstarred = restoreContextOnFailure $ do
+  modifyGHCiState $ \st -> st { remembered_ctx = [], transient_ctx = [] }
+                                -- delete the transient context
+  addModulesToContext_ starred unstarred
+
+addImportToContext :: GhciMonad m => ImportDecl GhcPs -> m ()
+addImportToContext idecl = restoreContextOnFailure $ do
+  addII (IIDecl idecl)   -- #5836
+  setGHCContextFromGHCiState
+
+-- Util used by addImportToContext and addModulesToContext
+addII :: GhciMonad m => InteractiveImport -> m ()
+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 :: GhciMonad m => m a -> m a
+restoreContextOnFailure do_this = do
+  st <- getGHCiState
+  let rc = remembered_ctx st; tc = transient_ctx st
+  do_this `MC.onException` (modifyGHCiState $ \st' ->
+     st' { remembered_ctx = rc, transient_ctx = tc })
+
+-- -----------------------------------------------------------------------------
+-- Validate a module that we want to add to the context
+
+checkAdd :: GHC.GhcMonad m => InteractiveImport -> m ()
+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 <- GHC.renameRawPkgQualM modname (ideclPkgQual d)
+       m <- GHC.lookupQualifiedModule pkgqual modname
+       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 :: GhciMonad m => m ()
+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)
+
+  prel_iidecls <- getImplicitPreludeImports iidecls
+  valid_prel_iidecls <- filterM (tryBool . checkAdd) prel_iidecls
+
+  extra_imports <- filterM (tryBool . checkAdd) (map IIDecl (extra_imports st))
+
+  GHC.setContext $ iidecls ++ extra_imports ++ valid_prel_iidecls
+
+
+getImplicitPreludeImports :: GhciMonad m
+                          => [InteractiveImport] -> m [InteractiveImport]
+getImplicitPreludeImports iidecls = do
+     -- allow :seti to override -XNoImplicitPrelude
+  st <- getGHCiState
+
+  -- We add the prelude imports if there are no *-imports, and we also
+  -- allow each prelude import to be subsumed by another explicit import
+  -- of the same module.  This means that you can override the prelude import
+  -- with "import Prelude hiding (map)", for example.
+  let prel_iidecls =
+         if not (any isIIModule iidecls)
+            then [ IIDecl imp
+                 | imp <- prelude_imports st
+                 , not (any (sameImpModule imp) iidecls) ]
+            else []
+
+  return prel_iidecls
+
+-- -----------------------------------------------------------------------------
+-- Utils on InteractiveImport
+
+mkIIModule :: ModuleName -> InteractiveImport
+mkIIModule = IIModule
+
+mkIIDecl :: ModuleName -> InteractiveImport
+mkIIDecl = IIDecl . simpleImportDecl
+
+iiModules :: [InteractiveImport] -> [ModuleName]
+iiModules is = [m | IIModule m <- is]
+
+isIIModule :: InteractiveImport -> Bool
+isIIModule (IIModule _) = True
+isIIModule _ = False
+
+iiModuleName :: InteractiveImport -> ModuleName
+iiModuleName (IIModule m) = m
+iiModuleName (IIDecl d)   = unLoc (ideclName d)
+
+preludeModuleName :: ModuleName
+preludeModuleName = GHC.mkModuleName "Clash.Prelude"
+
+sameImpModule :: ImportDecl GhcPs -> InteractiveImport -> Bool
+sameImpModule _ (IIModule _) = False -- we only care about imports here
+sameImpModule imp (IIDecl d) = unLoc (ideclName d) == unLoc (ideclName imp)
+
+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 (isImportDeclQualified (ideclQualified d1)) || isImportDeclQualified (ideclQualified d2))
+     && (ideclImportList d1 `hidingSubsumes` ideclImportList d2)
+  where
+     _                    `hidingSubsumes` Just (Exactly,L _ []) = True
+     Just (Exactly, L _ xs) `hidingSubsumes` Just (Exactly,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 :: GhciMonad m => String -> m ()
+setCmd ""   = showOptions False
+setCmd "-a" = showOptions True
+setCmd str
+  = case getCmd str of
+    Right ("args",    rest) ->
+        case toArgsNoLoc rest of
+            Left err -> liftIO (hPutStrLn stderr err)
+            Right args -> setArgs args
+    Right ("prog",    rest) ->
+        case toArgsNoLoc rest of
+            Right [prog] -> setProg prog
+            _ -> liftIO (hPutStrLn stderr "syntax: :set prog <progname>")
+
+    Right ("prompt",           rest) ->
+        setPromptString setPrompt (dropWhile isSpace rest)
+                        "syntax: set prompt <string>"
+    Right ("prompt-function",  rest) ->
+        setPromptFunc setPrompt $ dropWhile isSpace rest
+    Right ("prompt-cont",          rest) ->
+        setPromptString setPromptCont (dropWhile isSpace rest)
+                        "syntax: :set prompt-cont <string>"
+    Right ("prompt-cont-function", rest) ->
+        setPromptFunc setPromptCont $ dropWhile isSpace rest
+
+    Right ("editor",  rest) -> setEditor  $ dropWhile isSpace rest
+    Right ("stop",    rest) -> setStop    $ dropWhile isSpace rest
+    Right ("local-config", rest) ->
+        setLocalConfigBehaviour $ dropWhile isSpace rest
+    _ -> case toArgsNoLoc str of
+         Left err -> liftIO (hPutStrLn stderr err)
+         Right wds -> () <$ keepGoing' setOptions wds
+
+setiCmd :: GhciMonad m => String -> m ()
+setiCmd ""   = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags False
+setiCmd "-a" = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags True
+setiCmd str  =
+  case toArgsNoLoc str of
+    Left err -> liftIO (hPutStrLn stderr err)
+    Right wds -> newDynFlags True wds
+
+showOptions :: GhciMonad m => Bool -> m ()
+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)
+           ))
+       liftIO $ showDynFlags show_all dflags
+
+
+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 :: String -> String -> (flag -> DynFlags -> Bool) -> FlagSpec flag -> SDoc
+        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 :: GhciMonad m => [String] -> m ()
+setProg, setEditor, setStop :: GhciMonad m => String -> m ()
+setLocalConfigBehaviour :: GhciMonad m => String -> m ()
+
+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 })
+
+setLocalConfigBehaviour s
+  | s == "source" =
+      modifyGHCiState (\st -> st { localConfig = SourceLocalConfig })
+  | s == "ignore" =
+      modifyGHCiState (\st -> st { localConfig = IgnoreLocalConfig })
+  | otherwise = throwGhcException
+      (CmdLineError "syntax:  :set local-config { source | ignore }")
+
+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
+       case IntMap.lookup nm old_breaks of
+         Nothing ->  printForUser (text "Breakpoint" <+> ppr nm <+>
+                                   text "does not exist")
+         Just loc -> do
+            let new_breaks = IntMap.insert nm
+                                loc { onBreakCmd = dropWhile isSpace rest }
+                                old_breaks
+            setGHCiState st{ breaks = new_breaks }
+setStop cmd = modifyGHCiState (\st -> st { stop = cmd })
+
+setPrompt :: GhciMonad m => PromptFunction -> m ()
+setPrompt v = modifyGHCiState (\st -> st {prompt = v})
+
+setPromptCont :: GhciMonad m => PromptFunction -> m ()
+setPromptCont v = modifyGHCiState (\st -> st {prompt_cont = v})
+
+setPromptFunc :: GHC.GhcMonad m => (PromptFunction -> m ()) -> String -> m ()
+setPromptFunc fSetPrompt s = do
+    -- We explicitly annotate the type of the expression to ensure
+    -- that unsafeCoerce# is passed the exact type necessary rather
+    -- than a more general one
+    let exprStr = "(" ++ s ++ ") :: [String] -> Int -> IO String"
+    (HValue funValue) <- GHC.compileExpr exprStr
+    fSetPrompt (convertToPromptFunction $ unsafeCoerce funValue)
+    where
+      convertToPromptFunction :: ([String] -> Int -> IO String)
+                              -> PromptFunction
+      convertToPromptFunction func = (\mods line -> liftIO $
+                                       liftM text (func mods line))
+
+setPromptString :: MonadIO m
+                => (PromptFunction -> m ()) -> String -> String -> m ()
+setPromptString fSetPrompt value err = do
+  if null value
+    then liftIO $ hPutStrLn stderr $ err
+    else case value of
+           ('\"':_) ->
+             case reads value of
+               [(value', xs)] | all isSpace xs ->
+                 setParsedPromptString fSetPrompt value'
+               _ -> liftIO $ hPutStrLn stderr
+                             "Can't parse prompt string. Use Haskell syntax."
+           _ ->
+             setParsedPromptString fSetPrompt value
+
+setParsedPromptString :: MonadIO m
+                      => (PromptFunction -> m ()) ->  String -> m ()
+setParsedPromptString fSetPrompt s = do
+  case (checkPromptStringForErrors s) of
+    Just err ->
+      liftIO $ hPutStrLn stderr err
+    Nothing ->
+      fSetPrompt $ generatePromptFunctionFromString s
+
+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
+      when (not (null minus_opts)) $ newDynFlags False minus_opts
+
+-- | newDynFlags will *not* read package environment files, therefore we
+-- use 'parseDynamicFlagsCmdLine' rather than 'parseDynamicFlags'. This
+-- function is called very often and results in repeatedly loading
+-- environment files (see #19650)
+newDynFlags :: GhciMonad m => Bool -> [String] -> m ()
+newDynFlags interactive_only minus_opts = do
+      let lopts = map noLoc minus_opts
+
+      logger <- getLogger
+      idflags0 <- GHC.getInteractiveDynFlags
+      (idflags1, leftovers, warns) <- DynFlags.parseDynamicFlagsCmdLine idflags0 lopts
+
+      liftIO $ printOrThrowDiagnostics logger (initPrintConfig idflags1) (initDiagOpts idflags1) (GhcDriverMessage <$> warns)
+      when (not $ null leftovers) (unknownFlagsErr $ 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 $ DynFlags.parseDynamicFlagsCmdLine dflags0 lopts
+        must_reload <- 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
+        let interp  = hscInterp hsc_env
+        when (packageFlagsChanged dflags2 dflags0) $ do
+          when (verbosity dflags2 > 0) $
+            liftIO . putStrLn $
+              "package flags have changed, resetting and loading new packages..."
+          -- Clear caches and eventually defined breakpoints. (#1620)
+          clearCaches
+          when must_reload $ do
+            let units = preloadUnits (hsc_units hsc_env)
+            liftIO $ Loader.loadPackages interp hsc_env units
+          -- package flags changed, we can't re-use any of the old context
+          setContextAfterLoad False Nothing
+          -- and copy the package flags to the interactive DynFlags
+          idflags <- GHC.getInteractiveDynFlags
+          GHC.setInteractiveDynFlags
+              idflags{ packageFlags = packageFlags dflags2 }
+
+        let ld0length   = length $ ldInputs dflags0
+            fmrk0length = length $ cmdlineFrameworks dflags0
+
+            newLdInputs     = drop ld0length (ldInputs dflags2)
+            newCLFrameworks = drop fmrk0length (cmdlineFrameworks dflags2)
+
+            dflags'  = dflags2 { ldInputs = newLdInputs
+                               , cmdlineFrameworks = newCLFrameworks
+                               }
+            hsc_env' = hscSetFlags dflags' hsc_env
+
+        when (not (null newLdInputs && null newCLFrameworks)) $
+          liftIO $ Loader.loadCmdLineLibs (hscInterp hsc_env') hsc_env'
+
+      return ()
+
+unknownFlagsErr :: [String] -> a
+unknownFlagsErr fs = throwGhcException $ CmdLineError $ concatMap oneError fs
+  where
+    oneError f =
+        "unrecognised flag: " ++ f ++ "\n" ++
+        (case flagSuggestions ghciFlags f of
+            [] -> ""
+            suggs -> "did you mean one of:\n" ++ unlines (map ("  " ++) suggs))
+    ghciFlags = nubSort $ flagsForCompletion True
+
+unsetOptions :: GhciMonad m => String -> m ()
+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)
+           , ("prompt-cont", setPromptCont default_prompt_cont)
+           , ("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 case rest3 of
+          opt:_ -> liftIO (putStrLn ("unknown option: '" ++ opt ++ "'"))
+          [] -> do
+             mapM_ (fromJust.flip lookup defaulters) other_opts
+
+             mapM_ unsetOpt plus_opts
+
+             no_flags <- mapM no_flag minus_opts
+             when (not (null no_flags)) $ 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 :: GhciMonad m => String -> m ()
+
+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 :: forall m. GhciMonad m => String -> m ()
+showCmd ""   = showOptions False
+showCmd "-a" = showOptions True
+showCmd str = do
+    st <- getGHCiState
+    dflags <- getDynFlags
+    hsc_env <- GHC.getSession
+
+    let lookupCmd :: String -> Maybe (m ())
+        lookupCmd name = lookup name $ map (\(_,b,c) -> (b,c)) cmds
+
+        -- (show in help?, command name, action)
+        action :: String -> m () -> (Bool, String, m ())
+        action name m = (True, name, m)
+
+        hidden :: String -> m () -> (Bool, String, m ())
+        hidden name m = (False, name, m)
+
+        cmds =
+            [ action "args"       $ liftIO $ putStrLn (show (GhciMonad.args st))
+            , action "prog"       $ liftIO $ putStrLn (show (progname 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"     $ do
+               msg <- liftIO $ Loader.showLoaderState (hscInterp hsc_env)
+               dflags <- getDynFlags
+               liftIO $ putStrLn $ showSDoc dflags msg
+            , action "breaks"     $ showBkptTable
+            , action "context"    $ showContext
+            , action "packages"   $ showUnits
+            , action "paths"      $ showPaths
+            , action "language"   $ showLanguages
+            , hidden "languages"  $ showLanguages -- backwards compat
+            , hidden "lang"       $ showLanguages -- useful abbreviation
+            , action "targets"    $ showTargets
+            ]
+
+    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 :: GHC.GhcMonad m => String -> m ()
+showiCmd str = do
+  case words str of
+        ["languages"]  -> showiLanguages -- backwards compat
+        ["language"]   -> showiLanguages
+        ["lang"]       -> showiLanguages -- useful abbreviation
+        _ -> throwGhcException (CmdLineError ("syntax:  :showi language"))
+
+showImports :: GhciMonad m => m ()
+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_iidecls <- getImplicitPreludeImports (rem_ctx ++ trans_ctx)
+
+  let show_prel p = show_one p ++ " -- implicit"
+      show_extra p = show_one (IIDecl p) ++ " -- fixed"
+
+      trans_comment s = s ++ " -- added automatically" :: String
+  --
+  liftIO $ mapM_ putStrLn (map show_one rem_ctx ++
+                           map (trans_comment . show_one) trans_ctx ++
+                           map show_prel prel_iidecls ++
+                           map show_extra (extra_imports st))
+
+showModules :: GHC.GhcMonad m => m ()
+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 isLoadedModSummary (GHC.mgModSummaries graph)
+
+showBindings :: GHC.GhcMonad m => m ()
+showBindings = do
+    bindings <- GHC.getBindings
+    (insts, finsts) <- GHC.getInsts
+    let idocs  = map GHC.pprInstanceHdr insts
+        fidocs = map GHC.pprFamInst finsts
+        binds = filter (not . isDerivedOccName . getOccName) bindings -- #12525
+        -- See Note [Filter bindings]
+    docs <- mapM makeDoc (reverse binds)
+                  -- reverse so the new ones come last
+    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) -> SDoc
+    pprTT (thing, fixity, _cls_insts, _fam_insts, _docs)
+      = pprTyThing showToHeader thing
+        $$ showFixity thing fixity
+
+
+printTyThing :: GHC.GhcMonad m => TyThing -> m ()
+printTyThing tyth = printForUser (pprTyThing showToHeader tyth)
+
+isLoadedModSummary :: GHC.GhcMonad m => ModSummary -> m Bool
+isLoadedModSummary ms = GHC.isLoadedModule (ms_unitid ms) (ms_mod_name ms)
+
+{-
+Note [Filter bindings]
+~~~~~~~~~~~~~~~~~~~~~~
+If we don't filter the bindings returned by the function GHC.getBindings,
+then the :show bindings command will also show unwanted bound names,
+internally generated by GHC, eg:
+    $tcFoo :: GHC.Types.TyCon = _
+    $trModule :: GHC.Unit.Module = _ .
+
+The filter was introduced as a fix for #12525 [1]. Comment:1 [2] to this
+ticket contains an analysis of the situation and suggests the solution
+implemented above.
+
+The same filter was also implemented to fix #11051 [3]. See the
+Note [What to show to users] in GHC.Runtime.Eval
+
+[1] https://gitlab.haskell.org/ghc/ghc/issues/12525
+[2] https://gitlab.haskell.org/ghc/ghc/issues/12525#note_123489
+[3] https://gitlab.haskell.org/ghc/ghc/issues/11051
+-}
+
+
+showBkptTable :: GhciMonad m => m ()
+showBkptTable = do
+  st <- getGHCiState
+  printForUser $ prettyLocations (breaks st)
+
+showContext :: GHC.GhcMonad m => m ()
+showContext = do
+   resumes <- GHC.getResumeContext
+   printForUser $ vcat (map pp_resume (reverse resumes))
+  where
+   pp_resume res =
+        text "--> " <> text (GHC.resumeStmt res)
+        $$ nest 2 (pprStopped res)
+
+pprStopped :: GHC.Resume -> SDoc
+pprStopped res =
+  text "Stopped in"
+    <+> ((case mb_mod_name of
+           Nothing -> empty
+           Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
+         <> text (GHC.resumeDecl res))
+    <> char ',' <+> ppr (GHC.resumeSpan res)
+ where
+  mb_mod_name = moduleName <$> GHC.breakInfo_module <$> GHC.resumeBreakInfo res
+
+showUnits :: GHC.GhcMonad m => m ()
+showUnits = 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 :: GHC.GhcMonad m => m ()
+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 :: GHC.GhcMonad m => m ()
+showLanguages = getDynFlags >>= liftIO . showLanguages' False
+
+showiLanguages :: GHC.GhcMonad m => m ()
+showiLanguages = GHC.getInteractiveDynFlags >>= liftIO . showLanguages' False
+
+showLanguages' :: Bool -> DynFlags -> IO ()
+showLanguages' show_all dflags =
+  putStrLn $ showSDoc dflags $ vcat
+     [ text "base language is: " <>
+         case lang of
+           Haskell98   -> text "Haskell98"
+           Haskell2010 -> text "Haskell2010"
+           GHC2021     -> text "GHC2021"
+           GHC2024     -> text "GHC2024"
+     , (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` Just lang
+
+   lang = fromMaybe defaultLanguage (language dflags)
+
+
+showTargets :: GHC.GhcMonad m => m ()
+showTargets = mapM_ showTarget =<< GHC.getTargets
+  where
+    showTarget :: GHC.GhcMonad m => Target -> m ()
+    showTarget Target { targetId = TargetFile f _ } = liftIO (putStrLn f)
+    showTarget Target { targetId = TargetModule m } =
+      liftIO (putStrLn $ moduleNameString m)
+
+-- -----------------------------------------------------------------------------
+-- 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 [] = Nothing
+    parseLine argLine = case breakSpace argLine of
+      (_, []) -> Nothing
+      (dom, rest1@('"' : _)) -> (dom,,) <$> parseRange "" <*> (readMaybe rest1 :: Maybe String)
+      (dom, rest1) -> (dom,,) <$> parseRange rng <*> readMaybe rest2
+        where
+          (rng, rest2) = breakSpace rest1
+
+    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, completeBreakpoint
+    :: GhciMonad m => CompletionFunc m
+
+-- | 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 `isPrefixOptOf`) 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
+    ('.':_)  -> wrapCompleter (specials ++ spaces) complete line
+               -- operator or qualification
+    (x:_) | isSymbolChar x -> wrapCompleter' (\c -> c `elem` (specials ++ spaces) || not (isSymbolChar c))
+                                 complete line         -- operator
+    _                      -> wrapIdentCompleter complete line
+  where
+    complete w = do
+      rdrs <- GHC.getRdrNamesInScope
+      dflags <- GHC.getSessionDynFlags
+      return (filter (w `isPrefixOf`) (map (showPpr dflags) rdrs))
+
+-- TAB-completion for the :break command.
+-- Build and return a list of breakpoint identifiers with a given prefix.
+-- See Note [Tab-completion for :break]
+completeBreakpoint = wrapCompleter spaces $ \w -> do          -- #3000
+    -- bid ~ breakpoint identifier = a name of a function that is
+    --       eligible to set a breakpoint.
+    let (mod_str, _, _) = splitIdent w
+    bids_mod_breaks <- bidsFromModBreaks mod_str
+    bids_inscopes <- bidsFromInscopes
+    pure $ nub $ filter (isPrefixOf w) $ bids_mod_breaks ++ bids_inscopes
+  where
+    -- Extract all bids from ModBreaks for a given module name prefix
+    bidsFromModBreaks :: GhciMonad m => String -> m [String]
+    bidsFromModBreaks mod_pref = do
+        imods <- interpretedHomeMods
+        let pmods = filter ((isPrefixOf mod_pref) . showModule) imods
+        nonquals <- case null mod_pref of
+          -- If the prefix is empty, then for functions declared in a module
+          -- in scope, don't qualify the function name.
+          -- (eg: `main` instead of `Main.main`)
+            True -> do
+                imports <- GHC.getContext
+                pure [ m | IIModule m <- imports]
+            False -> return []
+        bidss <- mapM (bidsByModule nonquals) pmods
+        pure $ concat bidss
+
+    -- Return a list of interpreted home modules
+    interpretedHomeMods :: GhciMonad m => m [Module]
+    interpretedHomeMods = do
+        graph <- GHC.getModuleGraph
+        let hmods = ms_mod <$> GHC.mgModSummaries graph
+        filterM GHC.moduleIsInterpreted hmods
+
+    -- Return all possible bids for a given Module
+    bidsByModule :: GhciMonad m => [ModuleName] -> Module -> m [String]
+    bidsByModule nonquals mod = do
+      (_, decls) <- getModBreak mod
+      let bids = nub $ declPath <$> elems decls
+      pure $ case (moduleName mod) `elem` nonquals of
+              True  -> bids
+              False -> (combineModIdent (showModule mod)) <$> bids
+
+    -- Extract all bids from all top-level identifiers in scope.
+    bidsFromInscopes :: GhciMonad m => m [String]
+    bidsFromInscopes = do
+        dflags <- getDynFlags
+        rdrs <- GHC.getRdrNamesInScope
+        inscopess <- mapM createInscope $ (showSDoc dflags . ppr) <$> rdrs
+        imods <- interpretedHomeMods
+        let topLevels = filter ((`elem` imods) . snd) $ concat inscopess
+        bidss <- mapM (addNestedDecls) topLevels
+        pure $ concat bidss
+
+    -- Return a list of (bid,module) for a single top-level in-scope identifier
+    createInscope :: GhciMonad m => String -> m [(String, Module)]
+    createInscope str_rdr = do
+        names <- GHC.parseName str_rdr
+        pure $ map (str_rdr, ) $ NE.toList $ GHC.nameModule <$> names
+
+    -- For every top-level identifier in scope, add the bids of the nested
+    -- declarations. See Note [Field modBreaks_decls] in GHC.ByteCode.Types
+    addNestedDecls :: GhciMonad m => (String, Module) -> m [String]
+    addNestedDecls (ident, mod) = do
+        (_, decls) <- getModBreak mod
+        let (mod_str, topLvl, _) = splitIdent ident
+            ident_decls = [ elm | elm@(el : _) <- elems decls, el == topLvl ]
+            bids = nub $ declPath <$> ident_decls
+        pure $ map (combineModIdent mod_str) bids
+
+completeModule = wrapIdentCompleterMod $ \w -> do
+  hsc_env <- GHC.getSession
+  let pkg_mods = allVisibleModules (hsc_units hsc_env)
+  loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
+  return $ filter (w `isPrefixOf`)
+        $ map (showPpr (hsc_dflags hsc_env)) $ loaded_mods ++ pkg_mods
+
+completeSetModule = wrapIdentCompleterWithModifier "+-" $ \m w -> do
+  hsc_env <- GHC.getSession
+  modules <- case m of
+    Just '-' -> do
+      imports <- GHC.getContext
+      return $ map iiModuleName imports
+    _ -> do
+      let pkg_mods = allVisibleModules (hsc_units hsc_env)
+      loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
+      return $ loaded_mods ++ pkg_mods
+  return $ filter (w `isPrefixOf`) $ map (showPpr (hsc_dflags hsc_env)) modules
+
+completeHomeModule = wrapIdentCompleterMod listHomeModules
+
+listHomeModules :: GHC.GhcMonad m => String -> m [String]
+listHomeModules w = do
+    g <- GHC.getModuleGraph
+    let home_mods = map GHC.ms_mod_name (GHC.mgModSummaries 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":"prompt-cont":"prompt-function":
+                 "prompt-cont-function":"editor":"stop":flagList
+          flagList = map NE.head $ NE.group $ sort allNonDeprecatedFlags
+
+completeSeti = wrapCompleter flagWordBreakChars $ \w -> do
+  return (filter (w `isPrefixOf`) flagList)
+    where flagList = map NE.head $ NE.group $ sort allNonDeprecatedFlags
+
+completeShowOptions = wrapCompleter flagWordBreakChars $ \w -> do
+  return (filter (w `isPrefixOf`) opts)
+    where opts = ["args", "prog", "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 :: Monad m => String -> (String -> m [String]) -> CompletionFunc m
+wrapCompleter breakChars = wrapCompleter' (`elem` breakChars)
+
+wrapCompleter' :: Monad m => (Char -> Bool) -> (String -> m [String]) -> CompletionFunc m
+wrapCompleter' breakPred fun = completeWord' Nothing breakPred
+    $ fmap (map simpleCompletion . nubSort) . fun
+
+wrapIdentCompleter :: Monad m => (String -> m [String]) -> CompletionFunc m
+wrapIdentCompleter = wrapCompleter' word_break_chars_pred
+
+wrapIdentCompleterMod :: Monad m => (String -> m [String]) -> CompletionFunc m
+wrapIdentCompleterMod = wrapCompleter' go
+  where
+    go '.' = False -- Treated specially since it is a separator for module qualifiers
+    go c = word_break_chars_pred c
+
+wrapIdentCompleterWithModifier
+  :: Monad m
+  => String -> (Maybe Char -> String -> m [String]) -> CompletionFunc m
+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 :: UnitState -> [ModuleName]
+allVisibleModules unit_state = listVisibleModuleNames unit_state
+
+completeExpression = completeQuotedWord (Just '\\') "\"" listFiles
+                        completeIdentifier
+
+
+{-
+Note [Tab-completion for :break]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In tab-completion for the `:break` command, only those
+identifiers should be shown, that are accepted in the
+`:break` command. Hence these identifiers must be
+
+- defined in an interpreted module
+- listed in a `ModBreaks` value as a possible breakpoint.
+
+The identifiers may be qualified or unqualified.
+
+To get all possible top-level breakpoints for tab-completion
+with the correct qualification do:
+
+1. Build a list called `bids_mod_breaks` of identifier names eligible
+for setting breakpoints: For every interpreted module with the
+correct module prefix read all identifier names from the `decls` field
+of the `ModBreaks` array.
+
+2. Build a list called `bids_inscopess` of identifiers in scope:
+Take all RdrNames in scope, and filter by interpreted modules.
+Fore each of these top-level identifiers add from the `ModBreaks`
+arrays the available identifiers of the nested functions.
+
+3.) Combine both lists, filter by the given prefix, and remove duplicates.
+-}
+
+-- -----------------------------------------------------------------------------
+-- commands for debugger
+
+sprintCmd, printCmd, forceCmd :: GHC.GhcMonad m => String -> m ()
+sprintCmd = pprintClosureCommand False False
+printCmd  = pprintClosureCommand True False
+forceCmd  = pprintClosureCommand False True
+
+stepCmd :: GhciMonad m => String -> m ()
+stepCmd arg = withSandboxOnly ":step" $ step arg
+  where
+  step []         = doContinue (const True) GHC.SingleStep
+  step expression = runStmt expression GHC.SingleStep >> return ()
+
+stepLocalCmd :: GhciMonad m => String -> m ()
+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 (UnhelpfulSpan _) -> liftIO $ putStrLn (            -- #14690
+           ":steplocal is not possible." ++
+           "\nCannot determine current top-level binding after " ++
+           "a break on error / exception.\nUse :stepmodule.")
+        Just loc -> do
+           md <- fromMaybe (panic "stepLocalCmd") <$> getCurrentBreakModule
+           current_toplevel_decl <- enclosingTickSpan md loc
+           doContinue (`isSubspanOf` RealSrcSpan current_toplevel_decl Strict.Nothing) GHC.SingleStep
+
+stepModuleCmd :: GhciMonad m => String -> m ()
+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 :: GhciMonad m => Module -> SrcSpan -> m RealSrcSpan
+enclosingTickSpan _ (UnhelpfulSpan _) = panic "enclosingTickSpan UnhelpfulSpan"
+enclosingTickSpan md (RealSrcSpan src _) = do
+  ticks <- getTickArray md
+  let line = srcSpanStartLine src
+  massert (inRange (bounds ticks) line)
+  let enclosing_spans = [ pan | (_,pan) <- ticks ! line
+                               , realSrcSpanEnd pan >= realSrcSpanEnd src]
+  return . minimumBy leftmostLargestRealSrcSpan $ enclosing_spans
+ where
+
+leftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering
+leftmostLargestRealSrcSpan = on compare realSrcSpanStart S.<> on (flip compare) realSrcSpanEnd
+
+traceCmd :: GhciMonad m => String -> m ()
+traceCmd arg
+  = withSandboxOnly ":trace" $ tr arg
+  where
+  tr []         = doContinue (const True) GHC.RunAndLogSteps
+  tr expression = runStmt expression GHC.RunAndLogSteps >> return ()
+
+continueCmd :: GhciMonad m => String -> m ()                  -- #19157
+continueCmd argLine = withSandboxOnly ":continue" $
+  case contSwitch (words argLine) of
+    Left sdoc   -> printForUser sdoc
+    Right mbCnt -> doContinue' (const True) GHC.RunToCompletion mbCnt
+    where
+      contSwitch :: [String] -> Either SDoc (Maybe Int)
+      contSwitch [ ] = Right Nothing
+      contSwitch [x] = Just <$> getIgnoreCount x
+      contSwitch  _  = Left $
+          text "After ':continue' only one ignore count is allowed"
+
+doContinue :: GhciMonad m => (SrcSpan -> Bool) -> SingleStep -> m ()
+doContinue pre step = doContinue' pre step Nothing
+
+doContinue' :: GhciMonad m => (SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ()
+doContinue' pre step mbCnt= do
+  runResult <- resume pre step mbCnt
+  _ <- afterRunStmt pre runResult
+  return ()
+
+abandonCmd :: GhciMonad m => String -> m ()
+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 :: GhciMonad m => String -> m ()
+deleteCmd argLine = withSandboxOnly ":delete" $ do
+   deleteSwitch $ words argLine
+   where
+   deleteSwitch :: GhciMonad m => [String] -> m ()
+   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 :: GhciMonad m => String -> m ()
+      deleteOneBreak str
+         | all isDigit str = deleteBreak (read str)
+         | otherwise = return ()
+
+enableCmd :: GhciMonad m => String -> m ()
+enableCmd argLine = withSandboxOnly ":enable" $ do
+    enaDisaSwitch True $ words argLine
+
+disableCmd :: GhciMonad m => String -> m ()
+disableCmd argLine = withSandboxOnly ":disable" $ do
+    enaDisaSwitch False $ words argLine
+
+enaDisaSwitch :: GhciMonad m => Bool -> [String] -> m ()
+enaDisaSwitch enaDisa [] =
+    printForUser (text "The" <+> text strCmd <+>
+                  text "command requires at least one argument.")
+  where
+    strCmd = if enaDisa then ":enable" else ":disable"
+enaDisaSwitch enaDisa ("*" : _) = enaDisaAllBreaks enaDisa
+enaDisaSwitch enaDisa idents = do
+    mapM_ (enaDisaOneBreak enaDisa) idents
+  where
+    enaDisaOneBreak :: GhciMonad m => Bool -> String -> m ()
+    enaDisaOneBreak enaDisa strId = do
+      sdoc_loc <- checkEnaDisa enaDisa strId
+      case sdoc_loc of
+        Left sdoc -> printForUser sdoc
+        Right loc -> enaDisaAssoc enaDisa (read strId, loc)
+
+checkEnaDisa :: GhciMonad m => Bool -> String -> m (Either SDoc BreakLocation)
+checkEnaDisa enaDisa strId = do
+    sdoc_loc <- getBreakLoc strId
+    pure $ sdoc_loc >>= checkEnaDisaState enaDisa strId
+
+getBreakLoc :: GhciMonad m => String -> m (Either SDoc BreakLocation)
+getBreakLoc strId = do
+    st <- getGHCiState
+    case readMaybe strId >>= flip IntMap.lookup (breaks st) of
+      Nothing -> return $ Left (text "Breakpoint" <+> text strId <+>
+                                text "not found")
+      Just loc -> return $ Right loc
+
+checkEnaDisaState :: Bool -> String -> BreakLocation -> Either SDoc BreakLocation
+checkEnaDisaState enaDisa strId loc = do
+    if breakEnabled loc == enaDisa
+    then Left $
+        text "Breakpoint" <+> text strId <+> text "already in desired state"
+    else Right loc
+
+enaDisaAssoc :: GhciMonad m => Bool -> (Int, BreakLocation) -> m ()
+enaDisaAssoc enaDisa (intId, loc) = do
+    st <- getGHCiState
+    newLoc <- turnBreakOnOff enaDisa loc
+    let new_breaks = IntMap.insert intId newLoc (breaks st)
+    setGHCiState $ st { breaks = new_breaks }
+
+enaDisaAllBreaks :: GhciMonad m => Bool -> m()
+enaDisaAllBreaks enaDisa = do
+    st <- getGHCiState
+    mapM_ (enaDisaAssoc enaDisa) $ IntMap.assocs $ breaks st
+
+historyCmd :: GHC.GhcMonad m => String -> m ()
+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
+
+ignoreCmd  :: GhciMonad m => String -> m ()                     -- #19157
+ignoreCmd argLine = withSandboxOnly ":ignore" $ do
+    result <- ignoreSwitch (words argLine)
+    case result of
+      Left sdoc -> printForUser sdoc
+      Right (loc, count)   -> do
+        let breakInfo = GHC.BreakInfo (breakModule loc) (breakTick loc)
+        setupBreakpoint breakInfo count
+
+ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
+ignoreSwitch [break, count] = do
+    sdoc_loc <- getBreakLoc break
+    pure $ (,) <$> sdoc_loc <*> getIgnoreCount count
+ignoreSwitch _ = pure $ Left $ text "Syntax:  :ignore <breaknum> <count>"
+
+getIgnoreCount :: String -> Either SDoc Int
+getIgnoreCount str =
+    case readMaybe str of
+      Nothing              -> Left $ sdocIgnore <+> "is not numeric"
+      Just cnt | cnt < 0   -> Left $ sdocIgnore <+> "must be >= 0"
+               | otherwise -> Right cnt
+    where
+      sdocIgnore = text "Ignore count" <+> quotes (text str)
+
+setupBreakpoint :: GhciMonad m => GHC.BreakInfo -> Int -> m()
+setupBreakpoint loc count = do
+    hsc_env <- GHC.getSession
+    GHC.setupBreakpoint hsc_env loc count
+
+backCmd :: GhciMonad m => String -> m ()
+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 $ text "Logged breakpoint at" <+> ppr pan
+      printTypeOfNames names
+       -- run the command set with ":set stop <cmd>"
+      st <- getGHCiState
+      enqueueCommands [stop st]
+
+forwardCmd :: GhciMonad m => String -> m ()
+forwardCmd arg
+  | null arg        = forward 1
+  | all isDigit arg = forward (read arg)
+  | otherwise       = liftIO $ putStrLn "Syntax:  :forward [num]"
+  where
+  forward num = withSandboxOnly ":forward" $ do
+      (names, ix, pan, _) <- GHC.forward num
+      printForUser $ (if (ix == 0)
+                        then text "Stopped at"
+                        else text "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 :: GhciMonad m => String -> m ()
+breakCmd argLine = withSandboxOnly ":break" $ breakSwitch $ words argLine
+
+breakSwitch :: GhciMonad m => [String] -> m ()
+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
+        breakById arg1
+
+breakByModule :: GhciMonad m => Module -> [String] -> m ()
+breakByModule md (arg1:rest)
+   | all isDigit arg1 = do  -- looks like a line number
+        breakByModuleLine md (read arg1) rest
+breakByModule _ _
+   = breakSyntax
+
+breakByModuleLine :: GhciMonad m => Module -> Int -> [String] -> m ()
+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
+
+-- Set a breakpoint for an identifier
+-- See Note [Setting Breakpoints by Id]
+breakById :: GhciMonad m => String -> m ()                          -- #3000
+breakById inp = do
+    let (mod_str, top_level, fun_str) = splitIdent inp
+        mod_top_lvl = combineModIdent mod_str top_level
+    mb_mod <- catch (lookupModuleInscope mod_top_lvl)
+                    (\(_ :: SomeException) -> lookupModuleInGraph mod_str)
+      -- If the top-level name is not in scope, `lookupModuleInscope` will
+      -- throw an exception, then lookup the module name in the module graph.
+    mb_err_msg <- validateBP mod_str fun_str mb_mod
+    case mb_err_msg of
+        Just err_msg -> printForUser $
+          text "Cannot set breakpoint on" <+> quotes (text inp)
+          <> text ":" <+> err_msg
+        Nothing -> do
+          -- No errors found, go and set the breakpoint
+          mb_mod_info  <- GHC.getModuleInfo $ fromJust mb_mod
+          let modBreaks = case mb_mod_info of
+                (Just mod_info) -> GHC.modInfoModBreaks mod_info
+                Nothing         -> emptyModBreaks
+          findBreakAndSet (fromJust mb_mod) $ findBreakForBind fun_str modBreaks
+  where
+    -- Try to lookup the module for an identifier that is in scope.
+    -- `parseName` throws an exception, if the identifier is not in scope
+    lookupModuleInscope :: GhciMonad m => String -> m (Maybe Module)
+    lookupModuleInscope mod_top_lvl = do
+        names <- GHC.parseName mod_top_lvl
+        pure $ Just $ NE.head $ GHC.nameModule <$> names
+
+    -- Lookup the Module of a module name in the module graph
+    lookupModuleInGraph :: GhciMonad m => String -> m (Maybe Module)
+    lookupModuleInGraph mod_str = do
+        graph <- GHC.getModuleGraph
+        let hmods = ms_mod <$> GHC.mgModSummaries graph
+        pure $ find ((== mod_str) . showModule) hmods
+
+    -- Check validity of an identifier to set a breakpoint:
+    --  1. The module of the identifier must exist
+    --  2. the identifier must be in an interpreted module
+    --  3. the ModBreaks array for module `mod` must have an entry
+    --     for the function
+    validateBP :: GhciMonad m => String -> String -> Maybe Module
+                       -> m (Maybe SDoc)
+    validateBP mod_str fun_str Nothing = pure $ Just $ quotes (text
+        (combineModIdent mod_str (Prelude.takeWhile (/= '.') fun_str)))
+        <+> text "not in scope"
+    validateBP _ "" (Just _) = pure $ Just $ text "Function name is missing"
+    validateBP _ fun_str (Just modl) = do
+        isInterpr <- GHC.moduleIsInterpreted modl
+        (_, decls) <- getModBreak modl
+        mb_err_msg <- case isInterpr of
+          False -> pure $ Just $ text "Module" <+> quotes (ppr modl)
+                        <+> text "is not interpreted"
+          True -> case fun_str `elem` (declPath <$> elems decls) of
+                False -> pure $ Just $
+                   text "No breakpoint found for" <+> quotes (text fun_str)
+                   <+> "in module" <+> quotes (ppr modl)
+                True  -> pure Nothing
+        pure mb_err_msg
+
+breakSyntax :: a
+breakSyntax = throwGhcException $ CmdLineError ("Syntax: :break [<mod>.]<func>[.<func>]\n"
+                                             ++ "        :break [<mod>] <line> [<column>]")
+
+findBreakAndSet :: GhciMonad m
+                => Module -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
+findBreakAndSet md lookupTickTree = do
+   tickArray <- getTickArray md
+   case lookupTickTree tickArray of
+      []  -> liftIO $ putStrLn $ "No breakpoints found at that location."
+      some -> mapM_ breakAt some
+ where
+   breakAt (tick, pan) = do
+         setBreakFlag md tick True
+         (alreadySet, nm) <-
+               recordBreak $ BreakLocation
+                       { breakModule = md
+                       , breakLoc = RealSrcSpan pan Strict.Nothing
+                       , breakTick = tick
+                       , onBreakCmd = ""
+                       , breakEnabled = True
+                       }
+         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 breakpoints for all the RHSs of the
+-- equations corresponding to a binding.  So we find all breakpoints
+-- for
+--   (a) this binder only (it maybe a top-level or a nested declaration)
+--   (b) that do not have an enclosing breakpoint
+findBreakForBind :: String -> GHC.ModBreaks -> TickArray
+                 -> [(BreakIndex,RealSrcSpan)]
+findBreakForBind str_name modbreaks _ = filter (not . enclosed) ticks
+  where
+    ticks = [ (index, span)
+            | (index, decls) <- assocs (GHC.modBreaks_decls modbreaks),
+              str_name == declPath decls,
+              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 Strict.Nothing `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"
+
+{-
+Note [Setting Breakpoints by Id]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+To set a breakpoint first check whether a ModBreaks array contains a
+breakpoint with the given function name:
+In `:break M.foo` `M` may be a module name or a local alias of an import
+statement. To lookup a breakpoint in the ModBreaks, the effective module
+name is needed. Even if a module called `M` exists, `M` may still be
+a local alias. To get the module name, parse the top-level identifier with
+`GHC.parseName`. If this succeeds, extract the module name from the
+returned value. If it fails, catch the exception and assume `M` is a real
+module name.
+
+The names of nested functions are stored in `ModBreaks.modBreaks_decls`.
+-}
+
+-----------------------------------------------------------------------------
+-- :where
+
+whereCmd :: GHC.GhcMonad m => String -> m ()
+whereCmd = noArgs $ do
+  mstrs <- getCallStackAtCurrentBreakpoint
+  case mstrs of
+    Nothing -> return ()
+    Just strs -> liftIO $ putStrLn (renderStack strs)
+
+-----------------------------------------------------------------------------
+-- :list
+
+listCmd :: GhciMonad m => String -> m ()
+listCmd "" = do
+   mb_span <- 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 :: GhciMonad m => [String] -> m ()
+list2 [arg] | all isDigit arg = do
+    imports <- GHC.getContext
+    case iiModules imports of
+        [] -> liftIO $ putStrLn "No module to list"
+        (mn : _) -> do
+          md <- 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) $
+                               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 :: GHC.GhcMonad m => Module -> Int -> m ()
+listModuleLine modl line = do
+   graph <- GHC.getModuleGraph
+   let this = GHC.mgLookupModule graph modl
+   case this of
+     Nothing -> panic "listModuleLine"
+     Just 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 -> 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
+
+      let utf8Decoded = utf8DecodeByteString output
+      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 :: GhciMonad m => Module -> m TickArray
+getTickArray modl = do
+   st <- getGHCiState
+   let arrmap = tickarrays st
+   case lookupModuleEnv arrmap modl of
+      Just arr -> return arr
+      Nothing  -> do
+        (ticks, _) <- getModBreak modl
+        let arr = mkTickArray (assocs ticks)
+        setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}
+        return arr
+
+discardTickArrays :: GhciMonad m => m ()
+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 :: GhciMonad m => m ()
+discardActiveBreakPoints = do
+   st <- getGHCiState
+   mapM_ (turnBreakOnOff False) $ breaks st
+   setGHCiState $ st { breaks = IntMap.empty }
+
+discardInterfaceCache :: GhciMonad m => m ()
+discardInterfaceCache =
+   void (liftIO . iface_clearCache . ifaceCache =<< getGHCiState)
+
+clearHPTs :: GhciMonad m => m ()
+clearHPTs = do
+  let pruneHomeUnitEnv hme = hme { homeUnitEnv_hpt = emptyHomePackageTable }
+      discardMG hsc = hsc { hsc_mod_graph = GHC.emptyMG }
+  modifySession (discardMG . discardIC . hscUpdateHUG (unitEnv_map pruneHomeUnitEnv))
+
+
+-- The unused package warning doesn't make sense once the targets get out of
+-- sync with the package flags. See #21110
+-- Therefore if it's turned on, the warnings are issued until the module context
+-- changes (via :load or :cd), at which stage the package flags are not going to change
+-- but the loaded modules will probably not use all the specified packages so the
+-- warning becomes spurious. At that point the warning is silently disabled.
+disableUnusedPackages :: GhciMonad m => m ()
+disableUnusedPackages = newDynFlags False ["-Wno-unused-packages"]
+
+deleteBreak :: GhciMonad m => Int -> m ()
+deleteBreak identity = do
+   st <- getGHCiState
+   let oldLocations = breaks st
+   case IntMap.lookup identity oldLocations of
+       Nothing -> printForUser (text "Breakpoint" <+> ppr identity <+>
+                                text "does not exist")
+       Just loc -> do
+           _ <- (turnBreakOnOff False) loc
+           let rest = IntMap.delete identity oldLocations
+           setGHCiState $ st { breaks = rest }
+
+turnBreakOnOff :: GhciMonad m => Bool -> BreakLocation -> m BreakLocation
+turnBreakOnOff onOff loc
+  | onOff == breakEnabled loc = return loc
+  | otherwise = do
+      setBreakFlag (breakModule loc) (breakTick loc)  onOff
+      return loc { breakEnabled = onOff }
+
+getModBreak :: GHC.GhcMonad m
+            => Module -> m (Array Int SrcSpan, Array Int [String])
+getModBreak m = do
+   mod_info      <- fromMaybe (panic "getModBreak") <$> GHC.getModuleInfo m
+   let modBreaks  = GHC.modInfoModBreaks mod_info
+   let ticks      = GHC.modBreaks_locs  modBreaks
+   let decls      = GHC.modBreaks_decls modBreaks
+   return (ticks, decls)
+
+setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
+setBreakFlag  md ix enaDisa = do
+  let enaDisaToCount True = breakOn
+      enaDisaToCount False = breakOff
+  setupBreakpoint (GHC.BreakInfo md ix) $ enaDisaToCount enaDisa
+
+-- ---------------------------------------------------------------------------
+-- 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 around the flushing operation, so if stderr is closed
+-- GHCi will just die gracefully rather than going into an infinite loop.
+handler :: GhciMonad m => SomeException -> m Bool
+handler exception = do
+  flushInterpBuffers
+  withSignalHandlers $
+     ghciHandle handler (showException exception >> return False)
+
+showException :: MonadIO m => SomeException -> m ()
+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
+
+failIfExprEvalMode :: GhciMonad m => m ()
+failIfExprEvalMode = do
+  s <- getGHCiState
+  when (ghc_e s) $
+    liftIO (exitWith (ExitFailure 1))
+
+-- | When in expression evaluation mode (ghc -e), we want to exit immediately.
+-- Otherwis, just print out the message.
+printErrAndMaybeExit :: (GhciMonad m, MonadIO m, HasLogger m) => SourceError -> m ()
+printErrAndMaybeExit = (>> failIfExprEvalMode) . printGhciException
+
+-----------------------------------------------------------------------------
+-- 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 :: (HasLogger m, ExceptionMonad m) => (SomeException -> m a) -> m a -> m a
+ghciHandle h m = mask $ \restore -> do
+                 -- Force dflags to avoid leaking the associated HscEnv
+                 !log <- getLogger
+                 catch (restore (GHC.prettyPrintGhcErrors log m)) $ \e -> restore (h e)
+
+ghciTry :: ExceptionMonad m => m a -> m (Either SomeException a)
+ghciTry m = fmap Right m `catch` \e -> return $ Left e
+
+tryBool :: ExceptionMonad m => m a -> m 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.lookupQualifiedModule NoPkgQual mName
+
+isMainUnitModule :: Module -> Bool
+isMainUnitModule m = GHC.moduleUnit m == mainUnit
+
+showModule :: Module -> String
+showModule = moduleNameString . moduleName
+
+-- Return a String with the declPath of the function of a breakpoint.
+-- See Note [Field modBreaks_decls] in GHC.ByteCode.Types
+declPath :: [String] -> String
+declPath = intercalate "."
+
+-- | Optionally show a fixity declaration like @infixr 4 #@
+--
+-- We always display the fixity of terms with symbolic names (like <$>).
+-- For other terms we only display the fixity if it has been set to a
+-- value other than the default infixl 9.
+--
+-- We have no way of distinguishing between a fixity that has been
+-- manually set to infixl 9 and a fixity that has assumed infixl 9 as
+-- the default, so we choose to not display the fixity in both cases
+-- (for terms with non-symbolic names).
+--
+-- See #19200.
+showFixity :: TyThing -> Fixity -> SDoc
+showFixity thing fixity
+    | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)
+        = ppr fixity <+> pprInfixName (GHC.getName thing)
+    | otherwise = empty
+
+-- TODO: won't work if home dir is encoded.
+-- (changeDirectory may not work either in that case.)
+expandPath :: MonadIO m => String -> 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
+   home_unit <- hsc_home_unit <$> GHC.getSession
+   unless (isHomeModule home_unit modl) $
+      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 printGhciException $ do
+    n NE.:| _ <- GHC.parseName str
+    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
+
+clearCaches :: GhciMonad m => m ()
+clearCaches = discardActiveBreakPoints
+              >> discardInterfaceCache
+              >> disableUnusedPackages
+              >> clearHPTs
+
+
+
+-- Split up a string with an eventually qualified declaration name into 3 components
+--   1. module name
+--   2. top-level decl
+--   3. full-name of the eventually nested decl, but without module qualification
+-- eg  "foo"           = ("", "foo", "foo")
+--     "A.B.C.foo"     = ("A.B.C", "foo", "foo")
+--     "M.N.foo.bar"   = ("M.N", "foo", "foo.bar")
+splitIdent :: String -> (String, String, String)
+splitIdent [] = ("", "", "")
+splitIdent inp@(a : _)
+    | (isUpper a) = case fixs of
+        []            -> (inp, "", "")
+        (i1 : [] )    -> (upto i1, from i1, from i1)
+        (i1 : i2 : _) -> (upto i1, take (i2 - i1 - 1) (from i1), from i1)
+    | otherwise = case ixs of
+        []            -> ("", inp, inp)
+        (i1 : _)      -> ("", upto i1, inp)
+  where
+    ixs = elemIndices '.' inp        -- indices of '.' in whole input
+    fixs = dropWhile isNextUc ixs    -- indices of '.' in function names              --
+    isNextUc ix = isUpper $ safeInp !! (ix+1)
+    safeInp = inp ++ " "
+    upto i = take i inp
+    from i = drop (i + 1) inp
+
+-- Qualify an identifier name with a module name
+-- combineModIdent "A" "foo"  =  "A.foo"
+-- combineModIdent ""  "foo"  =  "foo"
+combineModIdent :: String -> String -> String
+combineModIdent mod ident
+          | null mod   = ident
+          | null ident = mod
+          | otherwise  = mod ++ "." ++ ident
diff --git a/src-bin-9.10.1/Clash/GHCi/UI/Exception.hs b/src-bin-9.10.1/Clash/GHCi/UI/Exception.hs
new file mode 100644
--- /dev/null
+++ b/src-bin-9.10.1/Clash/GHCi/UI/Exception.hs
@@ -0,0 +1,142 @@
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Clash.GHCi.UI.Exception(printGhciException, GHCiMessage(..)) where
+
+import GHC.Prelude
+
+import GHC.Driver.Config.Diagnostic
+import GHC.Driver.Errors
+import GHC.Driver.Errors.Types
+import GHC.Driver.Session
+
+import GHC.Iface.Errors.Ppr
+import GHC.Iface.Errors.Types
+
+import qualified GHC.LanguageExtensions as LangExt
+
+import GHC.Tc.Errors.Ppr
+import GHC.Tc.Errors.Types
+
+import GHC.Types.Error
+import GHC.Types.SourceError
+
+import GHC.Unit.State
+
+import GHC.Utils.Logger
+import GHC.Utils.Outputable
+
+import Control.Monad.IO.Class
+
+
+-- | Print the all diagnostics in a 'SourceError'.  Specialised for GHCi error reporting
+-- for some error messages.
+printGhciException :: (HasLogger m, MonadIO m, HasDynFlags m) => SourceError -> m ()
+printGhciException err = do
+  dflags <- getDynFlags
+  logger <- getLogger
+  let !diag_opts = initDiagOpts dflags
+      !print_config = initPrintConfig dflags
+  liftIO $ printMessages logger print_config diag_opts (GHCiMessage <$> (srcErrorMessages err))
+
+
+newtype GHCiMessage = GHCiMessage { _getGhciMessage :: GhcMessage }
+
+instance Diagnostic GHCiMessage where
+  type DiagnosticOpts GHCiMessage = DiagnosticOpts GhcMessage
+
+  diagnosticMessage opts (GHCiMessage msg) = ghciDiagnosticMessage opts msg
+
+  diagnosticReason (GHCiMessage msg) = diagnosticReason msg
+
+  diagnosticHints (GHCiMessage msg) = ghciDiagnosticHints msg
+
+  diagnosticCode (GHCiMessage msg)  = diagnosticCode msg
+
+
+-- | Modifications to hint messages which we want to display in GHCi.
+ghciDiagnosticHints :: GhcMessage -> [GhcHint]
+ghciDiagnosticHints msg = map modifyHintForGHCi (diagnosticHints msg)
+  where
+    modifyHintForGHCi :: GhcHint -> GhcHint
+    modifyHintForGHCi = \case
+      SuggestExtension extHint -> SuggestExtension $ modifyExtHintForGHCi extHint
+      hint -> hint
+    modifyExtHintForGHCi :: LanguageExtensionHint -> LanguageExtensionHint
+    modifyExtHintForGHCi = \case
+      SuggestSingleExtension    doc ext  -> SuggestSingleExtension    (suggestSetExt [ext] doc False) ext
+      SuggestExtensionInOrderTo doc ext  -> SuggestExtensionInOrderTo (suggestSetExt [ext] doc False) ext
+      SuggestAnyExtension       doc exts -> SuggestAnyExtension       (suggestSetExt exts  doc True ) exts
+      SuggestExtensions         doc exts -> SuggestExtensions         (suggestSetExt exts  doc False) exts
+    -- Suggest enabling extension with :set -X<ext>
+    -- SuggestAnyExtension will be on multiple lines so the user can select which to enable without editing
+    suggestSetExt :: [LangExt.Extension] -> SDoc -> Bool -> SDoc
+    suggestSetExt exts doc enable_any = doc $$ hang header 2 exts_cmds
+      where
+        header = text "You may enable" <+> which <+> text "language extension" <> plural exts <+> text "in GHCi with:"
+        which
+          | [ _ext ] <- exts
+          = text "this"
+          | otherwise
+          = if enable_any
+            then text "these"
+            else text "all of these"
+        exts_cmds
+          | enable_any
+          = vcat $ map (\ext -> text ":set -X" <> ppr ext) exts
+          | otherwise
+          = text ":set" <> hcat (map (\ext -> text " -X" <> ppr ext) exts)
+
+-- Modifications to error messages which we want to display in GHCi
+ghciDiagnosticMessage :: GhcMessageOpts -> GhcMessage -> DecoratedSDoc
+ghciDiagnosticMessage ghc_opts msg =
+  case msg of
+    GhcTcRnMessage tc_msg ->
+      case tcRnMessage (tcMessageOpts ghc_opts) tc_msg of
+        Nothing -> diagnosticMessage ghc_opts msg
+        Just sdoc -> sdoc
+    GhcDriverMessage  (DriverInterfaceError err) ->
+      case ghciInterfaceError err of
+        Just sdoc -> mkSimpleDecorated sdoc
+        Nothing -> diagnosticMessage ghc_opts msg
+    GhcDriverMessage {} -> diagnosticMessage ghc_opts msg
+    GhcPsMessage  {} -> diagnosticMessage ghc_opts msg
+    GhcDsMessage  {} -> diagnosticMessage ghc_opts msg
+    GhcUnknownMessage  {} -> diagnosticMessage ghc_opts msg
+  where
+    tcRnMessage tc_opts tc_msg =
+      case tc_msg of
+        TcRnInterfaceError err -> mkSimpleDecorated <$> (ghciInterfaceError err)
+        TcRnMessageWithInfo unit_state msg_with_info ->
+          case msg_with_info of
+           TcRnMessageDetailed err_info wrapped_msg
+             -> messageWithInfoDiagnosticMessage unit_state err_info
+                  (tcOptsShowContext tc_opts)
+                  <$> tcRnMessage tc_opts wrapped_msg
+        TcRnWithHsDocContext ctxt wrapped_msg ->
+          messageWithHsDocContext tc_opts ctxt <$> tcRnMessage tc_opts wrapped_msg
+        _ -> Nothing
+
+    opts = tcOptsIfaceOpts (tcMessageOpts ghc_opts)
+
+    ghciInterfaceError (Can'tFindInterface err looking_for) =
+      hangNotEmpty (lookingForHerald looking_for) 2 <$> ghciMissingInterfaceErrorDiagnostic err
+    ghciInterfaceError _ = Nothing
+
+    ghciMissingInterfaceErrorDiagnostic reason =
+      case reason of
+        CantFindErr us module_or_interface cfi -> Just (pprWithUnitState us $ cantFindErrorX pkg_hidden_hint may_show_locations module_or_interface cfi)
+        _ -> Nothing
+      where
+
+        may_show_locations = mayShowLocations ":set -v" (ifaceShowTriedFiles opts)
+
+        pkg_hidden_hint = pkgHiddenHint hidden_msg (ifaceBuildingCabalPackage opts)
+          where
+            hidden_msg pkg =
+              text "You can run" <+>
+              quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
+              text "to expose it." $$
+              text "(Note: this unloads all the modules in the current scope.)"
diff --git a/src-bin-9.10.1/Clash/GHCi/UI/Info.hs b/src-bin-9.10.1/Clash/GHCi/UI/Info.hs
new file mode 100644
--- /dev/null
+++ b/src-bin-9.10.1/Clash/GHCi/UI/Info.hs
@@ -0,0 +1,409 @@
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns        #-}
+
+{-# OPTIONS -fno-warn-name-shadowing #-}
+
+-- | Get information on modules, expressions, and identifiers
+module Clash.GHCi.UI.Info
+    ( ModInfo(..)
+    , SpanInfo(..)
+    , spanInfoFromRealSrcSpan
+    , collectInfo
+    , findLoc
+    , findNameUses
+    , findType
+    , getModInfo
+    ) where
+
+import           Control.Exception
+import           Control.Monad
+import           Control.Monad.Catch as MC
+import           Control.Monad.Trans.Class
+import           Control.Monad.Trans.Except
+import           Control.Monad.Trans.Maybe
+import           Data.Data
+import           Data.Function
+import           Data.List (find, sortBy)
+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           GHC.Hs.Syn.Type
+import           GHC.Driver.Session (HasDynFlags(..))
+import           GHC.Data.FastString
+import           GHC
+import           GHC.Driver.Monad
+import           GHC.Driver.Env
+import           GHC.Driver.Ppr
+import           GHC.Types.Name
+import           GHC.Types.Name.Reader
+import           GHC.Types.Name.Set
+import           GHC.Utils.Outputable
+import           GHC.Types.SrcLoc
+import           GHC.Types.Var
+import qualified GHC.Data.Strict as Strict
+
+-- | 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.
+    , modinfoRdrEnv     :: !(Strict.Maybe IfGlobalRdrEnv)
+      -- ^ What's in scope in the module.
+    , modinfoLastUpdate :: !UTCTime
+      -- ^ The timestamp of the file used to generate this record.
+    }
+
+-- | 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.
+    }
+
+instance Outputable SpanInfo where
+  ppr (SpanInfo s t i) = ppr s <+> ppr t <+> ppr i
+
+-- | 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 s = RealSrcSpan (spaninfoSrcSpan s) Strict.Nothing
+        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
+    rdrs = modInfo_rdrs mi
+    tryExternalModuleResolution =
+      case find (matchName $ mkFastString string) rdrs 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 (moduleUnit modL) <> ":" <>
+                            ppr modL)) return $
+             M.lookup (moduleName modL) infos
+
+     let all_names = modInfo_rdrs info
+
+     maybe (throwE "No matching export in any local modules.") return $
+         find (matchName name) all_names
+  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 TM_Inst 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 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 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
+    unit_state <- hsc_units <$> getSession
+    liftIO (filterM cacheInvalid loaded) >>= \case
+        [] -> return ms
+        invalidated -> do
+            liftIO (putStrLn ("Collecting type info for " ++
+                              show (length invalidated) ++
+                              " module(s) ... "))
+
+            foldM (go df unit_state) ms invalidated
+  where
+    go df unit_state m name = do { info <- getModInfo name; return (M.insert name info m) }
+                   `MC.catch`
+                   (\(e :: SomeException) -> do
+                         liftIO $ putStrLn
+                                $ showSDocForUser df unit_state 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 = srcFilePath (modinfoSummary mi)
+                last' = modinfoLastUpdate mi
+            current <- getModificationTime fp
+            exists <- doesFileExist fp
+            if exists
+                then return $ current /= last'
+                else return True
+
+-- | Get the source file path from a ModSummary.
+-- If the .hs file is missing, and the .o file exists,
+-- we return the .o file path.
+srcFilePath :: ModSummary -> FilePath
+srcFilePath modSum = fromMaybe obj_fp src_fp
+    where
+        src_fp = ml_hs_file ms_loc
+        obj_fp = ml_obj_file ms_loc
+        ms_loc = ms_location modSum
+
+-- | 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
+    let allTypes = processAllTypeCheckedModule typechecked
+        module_info = tm_checked_module_info typechecked
+        !rdr_env = case modInfoRdrEnv module_info of
+          Just rdrs -> Strict.Just rdrs
+            -- NB: this has already been deeply forced; no need to do that again.
+            -- See test case T15369 and Note [Forcing GREInfo] in GHC.Types.GREInfo.
+          Nothing   -> Strict.Nothing
+    ts <- liftIO $ getModificationTime $ srcFilePath m
+    return $
+      ModInfo
+        { modinfoSummary    = m
+        , modinfoSpans      = allTypes
+        , modinfoRdrEnv     = rdr_env
+        , modinfoLastUpdate = ts
+        }
+
+-- | Get the 'Name's from the 'GlobalRdrEnv' of the 'ModInfo', if any.
+modInfo_rdrs :: ModInfo -> [Name]
+modInfo_rdrs mi =
+  case modinfoRdrEnv mi of
+    Strict.Nothing  -> []
+    Strict.Just env -> map greName $ globalRdrEnvElts env
+
+-- | Get ALL source spans in the module.
+processAllTypeCheckedModule :: TypecheckedModule -> [SpanInfo]
+processAllTypeCheckedModule tcm
+  = mapMaybe toSpanInfo
+  $ sortBy cmpSpan
+  $ catMaybes (bts ++ ets ++ pts)
+  where
+    bts = map getTypeLHsBind $ listifyAllSpans tcs
+    ets = map getTypeLHsExpr $ listifyAllSpans tcs
+    pts = map getTypeLPat    $ listifyAllSpans tcs
+
+    tcs = tm_typechecked_source tcm
+
+    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsBind's
+    getTypeLHsBind :: LHsBind GhcTc -> Maybe (Maybe Id,SrcSpan,Type)
+    getTypeLHsBind (L _spn FunBind{fun_id = pid,fun_matches = MG _ _})
+        = Just (Just (unLoc pid), getLocA pid,varType (unLoc pid))
+    getTypeLHsBind _ = Nothing
+
+    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsExpr's
+    getTypeLHsExpr :: LHsExpr GhcTc -> Maybe (Maybe Id,SrcSpan,Type)
+    getTypeLHsExpr e = Just (mid, getLocA e, lhsExprType e)
+      where
+        mid :: Maybe Id
+        mid | HsVar _ (L _ i) <- unwrapVar (unLoc e) = Just i
+            | otherwise                              = Nothing
+
+        unwrapVar (XExpr (WrapExpr (HsWrap _ var))) = var
+        unwrapVar e'                                = e'
+
+    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LPats's
+    getTypeLPat :: LPat GhcTc -> Maybe (Maybe Id,SrcSpan,Type)
+    getTypeLPat (L spn pat) = Just (getMaybeId pat,locA spn,hsPatType pat)
+      where
+        getMaybeId :: Pat GhcTc -> Maybe Id
+        getMaybeId (VarPat _ (L _ vid)) = Just vid
+        getMaybeId _                        = Nothing
+
+    -- | Get ALL source spans in the source.
+    listifyAllSpans :: Typeable a => TypecheckedSource -> [LocatedA a]
+    listifyAllSpans = everythingAllSpans (++) [] ([] `mkQ` (\x -> [x | p x]))
+      where
+        p (L spn _) = isGoodSrcSpan (locA spn)
+
+    -- | Variant of @syb@'s @everything@ (which summarises all nodes
+    -- in top-down, left-to-right order) with a stop-condition on 'NameSet's
+    -- and 'OverLitTc'
+    everythingAllSpans :: (r -> r -> r) -> r -> GenericQ r -> GenericQ r
+    everythingAllSpans k z f x
+      | (False `mkQ` (const True :: NameSet -> Bool)) x = z
+      -- Exception for OverLitTc: we have SrcSpans in the ol_witness field,
+      -- but it's there only for HIE file info (see Note [Source locations for implicit function calls]).
+      -- T16804 fails without this.
+      | (False `mkQ` (const True :: OverLitTc -> 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-9.10.1/Clash/GHCi/UI/Monad.hs b/src-bin-9.10.1/Clash/GHCi/UI/Monad.hs
new file mode 100644
--- /dev/null
+++ b/src-bin-9.10.1/Clash/GHCi/UI/Monad.hs
@@ -0,0 +1,575 @@
+{-# LANGUAGE FlexibleInstances, DeriveFunctor, DerivingVia #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-----------------------------------------------------------------------------
+--
+-- Monadery code used in InteractiveUI
+--
+-- (c) The GHC Team 2005-2006
+--
+-----------------------------------------------------------------------------
+
+module Clash.GHCi.UI.Monad (
+        GHCi(..), startGHCi,
+        GHCiState(..), GhciMonad(..),
+        GHCiOption(..), isOptionSet, setOption, unsetOption,
+        Command(..), CommandResult(..), cmdSuccess,
+        CmdExecOutcome(..),
+        LocalConfigBehaviour(..),
+        PromptFunction,
+        BreakLocation(..),
+        TickArray,
+        extractDynFlags, getDynFlags,
+
+        runStmt, runDecls, runDecls', resume, recordBreak, revertCAFs,
+        ActionStats(..), runAndPrintStats, runWithStats, printStats,
+
+        printForUserNeverQualify,
+        printForUserModInfo, printForUserGlobalRdrEnv,
+        printForUser, printForUserPartWay, prettyLocations,
+
+        compileGHCiExpr,
+        initInterpBuffering,
+        turnOffBuffering, turnOffBuffering_,
+        flushInterpBuffers,
+        runInternal,
+        mkEvalWrapper
+    ) where
+
+import Clash.GHCi.UI.Info (ModInfo)
+import qualified GHC
+import GHC.Driver.Monad hiding (liftIO)
+import GHC.Utils.Outputable
+import qualified GHC.Driver.Ppr as Ppr
+import GHC.Types.Name.Occurrence
+import GHC.Types.Name.Reader
+import GHC.Driver.Session
+import GHC.Data.FastString
+import GHC.Driver.Env
+import GHC.Types.SrcLoc
+import GHC.Types.SafeHaskell
+import GHC.Driver.Make (ModIfaceCache(..))
+import GHC.Unit
+import GHC.Types.Name.Reader as RdrName (mkOrig)
+import qualified GHC.Types.Name.Ppr as Ppr (mkNamePprCtx)
+import GHC.Builtin.Names (gHC_INTERNAL_GHCI_HELPERS)
+import GHC.Runtime.Interpreter
+import GHC.Runtime.Context
+import GHCi.RemoteTypes
+import Clash.GHCi.UI.Exception (printGhciException)
+import GHC.Hs (ImportDecl, GhcPs, GhciLStmt, LHsDecl)
+import GHC.Hs.Utils
+import GHC.Utils.Misc
+import GHC.Utils.Logger
+
+import GHC.Utils.Exception hiding (uninterruptibleMask, mask, catch)
+import Numeric
+import Data.Array
+import Data.IORef
+import Data.Time
+import System.Environment
+import System.IO
+import Control.Monad
+import Prelude hiding ((<>))
+
+import System.Console.Haskeline (CompletionFunc, InputT)
+import Control.Monad.Catch as MC
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Reader
+import Control.Monad.IO.Class
+import Data.Map.Strict (Map)
+import qualified Data.IntMap.Strict as IntMap
+import qualified GHC.Data.EnumSet as EnumSet
+import qualified GHC.LanguageExtensions as LangExt
+
+-----------------------------------------------------------------------------
+-- GHCi monad
+
+data GHCiState = GHCiState
+     {
+        progname       :: String,
+        args           :: [String],
+        evalWrapper    :: ForeignHValue, -- ^ of type @IO a -> IO a@
+        prompt         :: PromptFunction,
+        prompt_cont    :: PromptFunction,
+        editor         :: String,
+        stop           :: String,
+        multiMode      :: Bool,
+        localConfig    :: LocalConfigBehaviour,
+        options        :: [GHCiOption],
+        line_number    :: !Int,         -- ^ input line
+        break_ctr      :: !Int,
+        breaks         :: !(IntMap.IntMap 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
+        cmd_wrapper    :: InputT GHCi CommandResult -> InputT GHCi (Maybe Bool),
+            -- ^ The command wrapper is run for each command or statement.
+            -- The 'Bool' value denotes whether the command is successful and
+            -- 'Nothing' means to exit GHCi.
+        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.
+
+        extra_imports  :: [ImportDecl GhcPs],
+            -- ^ These are "always-on" imports, added to the
+            -- context regardless of what other imports we have.
+            -- This is useful for adding imports that are required
+            -- by setGHCiMonad.  Be careful adding things here:
+            -- you can create ambiguities if these imports overlap
+            -- with other things in scope.
+            --
+            -- NB. although this is not currently used by GHCi itself,
+            -- it was added to support other front-ends that are based
+            -- on the GHCi code.  Potentially we could also expose
+            -- this functionality via GHCi commands.
+
+        prelude_imports :: [ImportDecl GhcPs],
+            -- ^ These imports are added to the context when
+            -- -XImplicitPrelude is on and we don't have a *-module
+            -- in the context.  They can also be overridden by another
+            -- import for the same module, e.g.
+            -- "import Prelude hiding (map)"
+
+        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
+        ifaceCache :: ModIfaceCache
+     }
+
+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 CmdExecOutcome
+     -- ^ The 'CmdExecOutcome' value denotes whether to exit GHCi cleanly or error out
+   , 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
+   }
+
+-- | Used to denote GHCi command execution result. Specifically, used to
+-- distinguish between two ghci execution modes - "REPL" and "Expression
+-- evaluation mode (ghc -e)". When in "REPL" mode, we don't want to exit
+-- GHCi session when error occurs, (which is when we use "CmdSuccess").
+-- Otherwise, when in expression evaluation mode, all command failures
+-- should lead to GHCi session termination (with ExitFailure 1) which is
+-- when "CmdFailure" is used(this is useful when executing scripts).
+-- "CleanExit" is used to signal end of GHCi session (for example, when
+-- ":quit" command is called).
+data CmdExecOutcome
+  = CleanExit
+  | CmdSuccess
+  | CmdFailure
+
+data CommandResult
+   = CommandComplete
+   { cmdInput :: String
+   , cmdResult :: Either SomeException (Maybe Bool)
+   , cmdStats :: ActionStats
+   }
+   | CommandIncomplete
+     -- ^ Unterminated multiline command
+   deriving Show
+
+cmdSuccess :: MonadThrow m => CommandResult -> m (Maybe Bool)
+cmdSuccess CommandComplete{ cmdResult = Left e } = throwM e
+cmdSuccess CommandComplete{ cmdResult = Right r } = return r
+cmdSuccess CommandIncomplete = return $ Just True
+
+type PromptFunction = [String]
+                   -> Int
+                   -> GHCi SDoc
+
+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
+
+-- | Treatment of ./.ghci files.  For now we either load or
+-- ignore.  But later we could implement a "safe mode" where
+-- only safe operations are performed.
+--
+data LocalConfigBehaviour
+  = SourceLocalConfig
+  | IgnoreLocalConfig
+  deriving (Eq)
+
+data BreakLocation
+   = BreakLocation
+   { breakModule :: !GHC.Module
+   , breakLoc    :: !SrcSpan
+   , breakTick   :: {-# UNPACK #-} !Int
+   , breakEnabled:: !Bool
+   , onBreakCmd  :: String
+   }
+
+instance Eq BreakLocation where
+  loc1 == loc2 = breakModule loc1 == breakModule loc2 &&
+                 breakTick loc1   == breakTick loc2
+
+prettyLocations :: IntMap.IntMap BreakLocation -> SDoc
+prettyLocations  locs =
+    case  IntMap.null locs of
+      True  -> text "No active breakpoints."
+      False -> vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ IntMap.toAscList locs
+
+instance Outputable BreakLocation where
+   ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
+                if null (onBreakCmd loc)
+                   then empty
+                   else doubleQuotes (text (onBreakCmd loc))
+      where pprEnaDisa = case breakEnabled loc of
+                True  -> text "enabled"
+                False -> text "disabled"
+
+recordBreak
+  :: GhciMonad m => BreakLocation -> m (Bool{- was already present -}, Int)
+recordBreak brkLoc = do
+   st <- getGHCiState
+   let oldmap = breaks st
+       oldActiveBreaks = IntMap.assocs oldmap
+   -- 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 = IntMap.insert oldCounter brkLoc oldmap
+                        }
+      return (False, oldCounter)
+
+newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> Ghc a }
+    deriving (Functor)
+    deriving (MonadThrow, MonadCatch, MonadMask) via (ReaderT (IORef GHCiState) Ghc)
+
+reflectGHCi :: (Session, IORef GHCiState) -> GHCi a -> IO a
+reflectGHCi (s, gs) m = unGhc (unGHCi m gs) s
+
+startGHCi :: GHCi a -> GHCiState -> Ghc a
+startGHCi g state = do ref <- liftIO $ newIORef state; unGHCi g ref
+
+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 GhcMonad m => GhciMonad m where
+  getGHCiState    :: m GHCiState
+  setGHCiState    :: GHCiState -> m ()
+  modifyGHCiState :: (GHCiState -> GHCiState) -> m ()
+  reifyGHCi       :: ((Session, IORef GHCiState) -> IO a) -> m a
+
+instance GhciMonad GHCi where
+  getGHCiState      = GHCi $ \r -> liftIO $ readIORef r
+  setGHCiState s    = GHCi $ \r -> liftIO $ writeIORef r s
+  modifyGHCiState f = GHCi $ \r -> liftIO $ modifyIORef' r f
+  reifyGHCi f       = GHCi $ \r -> reifyGhc $ \s -> f (s, r)
+
+instance GhciMonad (InputT GHCi) where
+  getGHCiState    = lift getGHCiState
+  setGHCiState    = lift . setGHCiState
+  modifyGHCiState = lift . modifyGHCiState
+  reifyGHCi       = lift . reifyGHCi
+
+liftGhc :: Ghc a -> GHCi a
+liftGhc m = GHCi $ \_ -> m
+
+instance MonadIO GHCi where
+  liftIO = liftGhc . liftIO
+
+instance HasDynFlags GHCi where
+  getDynFlags = getSessionDynFlags
+
+instance HasLogger GHCi where
+  getLogger = hsc_logger <$> getSession
+
+instance GhcMonad GHCi where
+  setSession s' = liftGhc $ setSession s'
+  getSession    = liftGhc $ getSession
+
+
+instance HasDynFlags (InputT GHCi) where
+  getDynFlags = lift getDynFlags
+
+instance HasLogger (InputT GHCi) where
+  getLogger = lift getLogger
+
+instance GhcMonad (InputT GHCi) where
+  setSession = lift . setSession
+  getSession = lift getSession
+
+isOptionSet :: GhciMonad m => GHCiOption -> m Bool
+isOptionSet opt
+ = do st <- getGHCiState
+      return $! (opt `elem` options st)
+
+setOption :: GhciMonad m => GHCiOption -> m ()
+setOption opt
+ = do st <- getGHCiState
+      setGHCiState (st{ options = opt : filter (/= opt) (options st) })
+
+unsetOption :: GhciMonad m => GHCiOption -> m ()
+unsetOption opt
+ = do st <- getGHCiState
+      setGHCiState (st{ options = filter (/= opt) (options st) })
+
+printForUserNeverQualify :: GhcMonad m => SDoc -> m ()
+printForUserNeverQualify doc = do
+  dflags <- GHC.getInteractiveDynFlags
+  liftIO $ Ppr.printForUser dflags stdout neverQualify AllTheWay doc
+
+printForUserModInfo :: GhcMonad m => GHC.ModuleInfo -> SDoc -> m ()
+printForUserModInfo info = printForUserGlobalRdrEnv (GHC.modInfoRdrEnv info)
+
+printForUserGlobalRdrEnv :: (GhcMonad m, Outputable info)
+                         => Maybe (GlobalRdrEnvX info) -> SDoc -> m ()
+printForUserGlobalRdrEnv mb_rdr_env doc = do
+  dflags <- GHC.getInteractiveDynFlags
+  name_ppr_ctx <- mkNamePprCtxFromGlobalRdrEnv dflags mb_rdr_env
+  liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx AllTheWay doc
+    where
+      mkNamePprCtxFromGlobalRdrEnv _ Nothing = GHC.getNamePprCtx
+      mkNamePprCtxFromGlobalRdrEnv dflags (Just rdr_env) =
+        withSession $ \ hsc_env ->
+        let unit_env = hsc_unit_env hsc_env
+            ptc = initPromotionTickContext dflags
+        in  return $ Ppr.mkNamePprCtx ptc unit_env rdr_env
+
+printForUser :: GhcMonad m => SDoc -> m ()
+printForUser doc = do
+  name_ppr_ctx <- GHC.getNamePprCtx
+  dflags <- GHC.getInteractiveDynFlags
+  liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx AllTheWay doc
+
+printForUserPartWay :: GhcMonad m => SDoc -> m ()
+printForUserPartWay doc = do
+  name_ppr_ctx <- GHC.getNamePprCtx
+  dflags <- GHC.getInteractiveDynFlags
+  liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx DefaultDepth doc
+
+-- | Run a single Haskell expression
+runStmt
+  :: GhciMonad m
+  => GhciLStmt GhcPs -> String -> GHC.SingleStep -> m (Maybe GHC.ExecResult)
+runStmt stmt stmt_text step = do
+  st <- getGHCiState
+  GHC.handleSourceError (\e -> do printGhciException 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' stmt stmt_text opts
+
+runDecls :: GhciMonad m => String -> m (Maybe [GHC.Name])
+runDecls decls = do
+  st <- getGHCiState
+  reifyGHCi $ \x ->
+    withProgName (progname st) $
+    withArgs (args st) $
+      reflectGHCi x $ do
+        GHC.handleSourceError (\e -> do printGhciException e
+                                        return Nothing) $ do
+          r <- GHC.runDeclsWithLocation (progname st) (line_number st) decls
+          return (Just r)
+
+runDecls' :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe [GHC.Name])
+runDecls' decls = do
+  st <- getGHCiState
+  reifyGHCi $ \x ->
+    withProgName (progname st) $
+    withArgs (args st) $
+    reflectGHCi x $
+      GHC.handleSourceError
+        (\e -> do printGhciException e
+                  return Nothing)
+        (Just <$> GHC.runParsedDecls decls)
+
+resume :: GhciMonad m => (SrcSpan -> Bool) -> GHC.SingleStep -> Maybe Int -> m GHC.ExecResult
+resume canLogSpan step mbIgnoreCnt = do
+  st <- getGHCiState
+  reifyGHCi $ \x ->
+    withProgName (progname st) $
+    withArgs (args st) $
+      reflectGHCi x $ do
+        GHC.resumeExec canLogSpan step mbIgnoreCnt
+
+-- --------------------------------------------------------------------------
+-- timing & statistics
+
+data ActionStats = ActionStats
+  { actionAllocs :: Maybe Integer
+  , actionElapsedTime :: Double
+  } deriving Show
+
+runAndPrintStats
+  :: GhciMonad m
+  => (a -> Maybe Integer)
+  -> m a
+  -> m (ActionStats, Either SomeException a)
+runAndPrintStats getAllocs action = do
+  result <- runWithStats getAllocs action
+  case result of
+    (stats, Right{}) -> do
+      showTiming <- isOptionSet ShowTiming
+      when showTiming $ do
+        dflags  <- getDynFlags
+        liftIO $ printStats dflags stats
+    _ -> return ()
+  return result
+
+runWithStats
+  :: ExceptionMonad m
+  => (a -> Maybe Integer) -> m a -> m (ActionStats, Either SomeException a)
+runWithStats getAllocs action = do
+  t0 <- liftIO getCurrentTime
+  result <- MC.try action
+  let allocs = either (const Nothing) getAllocs result
+  t1 <- liftIO getCurrentTime
+  let elapsedTime = realToFrac $ t1 `diffUTCTime` t0
+  return (ActionStats allocs elapsedTime, result)
+
+printStats :: DynFlags -> ActionStats -> IO ()
+printStats dflags ActionStats{actionAllocs = mallocs, actionElapsedTime = secs}
+   = do let secs_str = showFFloat (Just 2) secs
+        putStrLn (Ppr.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 . separate . reverse . show $ n
+      where separate n'
+              | n' `lengthAtMost` 3 = n'
+              | otherwise           = take 3 n' ++ "," ++ separate (drop 3 n')
+
+-----------------------------------------------------------------------------
+-- reverting CAFs
+
+revertCAFs :: GhciMonad m => m ()
+revertCAFs = do
+  interp <- hscInterp <$> GHC.getSession
+  liftIO $ interpCmd interp RtsRevertCAFs
+  s <- getGHCiState
+  when (not (ghc_e s)) turnOffBuffering
+     -- Have to turn off buffering again, because we just
+     -- reverted stdout, stderr & stdin to their defaults.
+
+
+-----------------------------------------------------------------------------
+-- 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
+  let mkHelperExpr :: OccName -> Ghc ForeignHValue
+      mkHelperExpr occ =
+        GHC.compileParsedExprRemote
+        $ GHC.nlHsVar $ RdrName.mkOrig gHC_INTERNAL_GHCI_HELPERS occ
+  nobuf <- mkHelperExpr $ mkVarOccFS (fsLit "disableBuffering")
+  flush <- mkHelperExpr $ mkVarOccFS (fsLit "flushAll")
+  return (nobuf, flush)
+
+-- | Invoke "hFlush stdout; hFlush stderr" in the interpreter
+flushInterpBuffers :: GhciMonad m => m ()
+flushInterpBuffers = do
+  st <- getGHCiState
+  interp <- hscInterp <$> GHC.getSession
+  liftIO $ evalIO interp (flushStdHandles st)
+
+-- | Turn off buffering for stdin, stdout, and stderr in the interpreter
+turnOffBuffering :: GhciMonad m => m ()
+turnOffBuffering = do
+  st <- getGHCiState
+  turnOffBuffering_ (noBuffering st)
+
+turnOffBuffering_ :: GhcMonad m => ForeignHValue -> m ()
+turnOffBuffering_ fhv = do
+  interp <- hscInterp <$> getSession
+  liftIO $ evalIO interp fhv
+
+mkEvalWrapper :: GhcMonad m => String -> [String] ->  m ForeignHValue
+mkEvalWrapper progname' args' =
+  runInternal $ GHC.compileParsedExprRemote
+  $ evalWrapper' `GHC.mkHsApp` nlHsString progname'
+                 `GHC.mkHsApp` nlList (map nlHsString args')
+  where
+    nlHsString = nlHsLit . mkHsString
+    evalWrapper' =
+      GHC.nlHsVar $ RdrName.mkOrig gHC_INTERNAL_GHCI_HELPERS (mkVarOccFS (fsLit "evalWrapper"))
+
+-- | Run a 'GhcMonad' action to compile an expression for internal usage.
+runInternal :: GhcMonad m => m a -> m a
+runInternal =
+    withTempSession mkTempSession
+  where
+    mkTempSession = hscUpdateFlags (\dflags -> dflags
+      { -- Running GHCi's internal expression is incompatible with -XSafe.
+          -- We temporarily disable any Safe Haskell settings while running
+          -- GHCi internal expressions. (see #12509)
+        safeHaskell = Sf_None,
+          -- Disable dumping of any data during evaluation of GHCi's internal
+          -- expressions. (#17500)
+        dumpFlags = EnumSet.empty
+      }
+        -- RebindableSyntax can wreak havoc with GHCi in several ways
+          -- (see #13385 and #14342 for examples), so we temporarily
+          -- disable it too.
+          `xopt_unset` LangExt.RebindableSyntax
+          -- We heavily depend on -fimplicit-import-qualified to compile expr
+          -- with fully qualified names without imports.
+          `gopt_set` Opt_ImplicitImportQualified
+      )
+
+compileGHCiExpr :: GhcMonad m => String -> m ForeignHValue
+compileGHCiExpr expr = runInternal $ GHC.compileExprRemote expr
diff --git a/src-bin-9.10.1/Clash/GHCi/Util.hs b/src-bin-9.10.1/Clash/GHCi/Util.hs
new file mode 100644
--- /dev/null
+++ b/src-bin-9.10.1/Clash/GHCi/Util.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+-- | Utilities for GHCi.
+module Clash.GHCi.Util where
+
+-- NOTE: Avoid importing GHC modules here, because the primary purpose
+-- of this module is to not use UnboxedTuples in a module that imports
+-- lots of other modules.  See issue#13101 for more info.
+
+import GHC.Exts
+import GHC.Types
+
+anyToPtr :: a -> IO (Ptr ())
+anyToPtr x =
+  IO (\s -> case anyToAddr# x s of
+              (# s', addr #) -> (# s', Ptr addr #)) :: IO (Ptr ())
diff --git a/src-bin-9.10.1/Clash/Main.hs b/src-bin-9.10.1/Clash/Main.hs
new file mode 100644
--- /dev/null
+++ b/src-bin-9.10.1/Clash/Main.hs
@@ -0,0 +1,1240 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NondecreasingIndentation #-}
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
+
+-----------------------------------------------------------------------------
+--
+-- GHC Driver program
+--
+-- (c) The University of Glasgow 2005
+--
+-----------------------------------------------------------------------------
+
+module Clash.Main (defaultMain, defaultMainWithAction) where
+
+-- The official GHC API
+import qualified GHC
+import GHC              (parseTargetFiles,  Ghc, GhcMonad(..),
+                          LoadHowMuch(..) )
+
+import GHC.Driver.Backend
+import GHC.Driver.CmdLine
+import GHC.Driver.Env
+import GHC.Driver.Errors
+import GHC.Driver.Errors.Types
+import GHC.Driver.Phases
+import GHC.Driver.Session
+import GHC.Driver.Ppr
+import GHC.Driver.Pipeline  ( oneShot, compileFile )
+import GHC.Driver.MakeFile  ( doMkDependHS )
+import GHC.Driver.Backpack  ( doBackpack )
+import GHC.Driver.Plugins
+import GHC.Driver.Config.Logger (initLogFlags)
+import GHC.Driver.Config.Diagnostic
+
+import GHC.Platform
+import GHC.Platform.Ways
+import GHC.Platform.Host
+
+#if defined(HAVE_INTERNAL_INTERPRETER)
+import Clash.GHCi.UI        ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )
+#endif
+
+import GHC.Runtime.Loader   ( loadFrontendPlugin, initializeSessionPlugins )
+
+import GHC.Unit.Env
+import GHC.Unit (UnitId, homeUnitDepends)
+import GHC.Unit.Home.ModInfo (emptyHomePackageTable)
+import GHC.Unit.Module ( ModuleName, mkModuleName )
+import GHC.Unit.Module.ModIface
+import GHC.Unit.State  ( pprUnits, pprUnitsSimple )
+import GHC.Unit.Finder ( findImportedModule, FindResult(..) )
+import qualified GHC.Unit.State as State
+import GHC.Unit.Types  ( IsBootInterface(..) )
+
+import GHC.Types.Basic     ( failed )
+import GHC.Types.SrcLoc
+import GHC.Types.SourceError
+import GHC.Types.Unique.Supply
+import GHC.Types.PkgQual
+
+import GHC.Utils.Error
+import GHC.Utils.Misc
+import GHC.Utils.Panic
+import GHC.Utils.Outputable as Outputable
+import GHC.Utils.Monad       ( liftIO, mapMaybeM )
+import GHC.Utils.Binary        ( openBinMem, put_ )
+import GHC.Utils.Logger
+
+import GHC.Settings.Config
+import GHC.Settings.Constants
+import GHC.Settings.IO
+
+import GHC.HandleEncoding
+import GHC.Data.FastString
+import GHC.SysTools.BaseDir
+
+import GHC.Iface.Load
+import GHC.Iface.Recomp.Binary ( fingerprintBinMem )
+
+import GHC.Tc.Utils.Monad      ( initIfaceCheck )
+import GHC.Iface.Errors.Ppr
+
+-- Standard Haskell libraries
+import System.IO
+import System.Environment
+import System.Exit
+import System.FilePath
+import Control.Monad
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except (throwE, runExceptT)
+import Data.Char
+import Data.List ( partition, intercalate, (\\) )
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Data.Maybe
+import Prelude
+import GHC.ResponseFile (expandResponse)
+import Data.Bifunctor
+import GHC.Data.Graph.Directed
+import qualified Data.List.NonEmpty as NE
+
+-- clash additions
+import           Paths_clash_ghc
+import           Clash.GHCi.UI (makeHDL)
+import           Control.Monad.Catch (catch)
+import           Data.List (nub)
+import           Data.Proxy
+import           Data.IORef (IORef, newIORef, readIORef, modifyIORef')
+import qualified Data.Version (showVersion)
+import           GHC.Data.EnumSet as EnumSet
+import           GHC.Driver.Session as Session
+
+import           Clash.Backend (Backend)
+import           Clash.Backend.SystemVerilog (SystemVerilogState)
+import           Clash.Backend.VHDL    (VHDLState)
+import           Clash.Backend.Verilog (VerilogState)
+import           Clash.Driver.Types
+  (ClashOpts (..), defClashOpts)
+import           Clash.GHC.ClashFlags
+import           Clash.Util (clashLibVersion)
+import           Clash.GHC.LoadModules (ghcLibDir, setWantedLanguageExtensions)
+import           Clash.GHC.Util (handleClashException)
+
+-----------------------------------------------------------------------------
+-- ToDo:
+
+-- time commands when run with -v
+-- user ways
+-- Win32 support: proper signal handling
+-- reading the package configuration file is too slow
+-- -K<size>
+
+-----------------------------------------------------------------------------
+-- GHC's command-line interface
+
+defaultMain :: [String] -> IO ()
+defaultMain = defaultMainWithAction (return ())
+
+defaultMainWithAction :: Ghc () -> [String] -> IO ()
+defaultMainWithAction startAction = flip withArgs $ do
+   hSetBuffering stdout LineBuffering
+   hSetBuffering stderr LineBuffering
+
+   configureHandleEncoding
+   GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
+    -- 1. extract the -B flag from the args
+    argv0 <- getArgs
+
+    let argv1 = map (mkGeneralLocated "on the commandline") argv0
+    libDir <- ghcLibDir
+
+    r <- newIORef defClashOpts
+    (argv2, clashFlagWarnings) <- parseClashFlags r argv1
+
+    -- 2. Parse the "mode" flags (--make, --interactive etc.)
+    (mode, units, argv3, modeFlagWarnings) <- parseModeFlags argv2
+    let flagWarnings = modeFlagWarnings ++ clashFlagWarnings
+
+    -- If all we want to do is something like showing the version number
+    -- then do it now, before we start a GHC session etc. This makes
+    -- getting basic information much more resilient.
+
+    -- In particular, if we wait until later before giving the version
+    -- number then bootstrapping gets confused, as it tries to find out
+    -- what version of GHC it's using before package.conf exists, so
+    -- starting the session fails.
+    case mode of
+        Left preStartupMode ->
+            do case preStartupMode of
+                   ShowSupportedExtensions   -> showSupportedExtensions (Just libDir)
+                   ShowVersion               -> showVersion
+                   ShowNumVersion            -> putStrLn cProjectVersion
+                   ShowOptions isInteractive -> showOptions isInteractive r
+        Right postStartupMode ->
+            -- start our GHC session
+            GHC.runGhc (Just libDir) $ do
+
+            dflags <- GHC.getSessionDynFlags
+            let dflagsExtra = setWantedLanguageExtensions dflags
+
+                ghcTyLitNormPlugin = GHC.mkModuleName "GHC.TypeLits.Normalise"
+                ghcTyLitExtrPlugin = GHC.mkModuleName "GHC.TypeLits.Extra.Solver"
+                ghcTyLitKNPlugin   = GHC.mkModuleName "GHC.TypeLits.KnownNat.Solver"
+                dflagsExtra1 = dflagsExtra
+                                  { Session.pluginModNames = nub $
+                                      ghcTyLitNormPlugin : ghcTyLitExtrPlugin :
+                                      ghcTyLitKNPlugin :
+                                      Session.pluginModNames dflagsExtra
+                                  }
+
+            case postStartupMode of
+                Left preLoadMode ->
+                    liftIO $ do
+                        case preLoadMode of
+                            ShowInfo               -> showInfo dflagsExtra1
+                            ShowGhcUsage           -> showGhcUsage  dflagsExtra1
+                            ShowGhciUsage          -> showGhciUsage dflagsExtra1
+                            PrintWithDynFlags f    -> putStrLn (f dflagsExtra1)
+                Right postLoadMode ->
+                    main' postLoadMode units dflagsExtra1 argv3 flagWarnings startAction r
+
+main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn]
+      -> Ghc () -> IORef ClashOpts
+      -> Ghc ()
+main' postLoadMode units dflags0 args flagWarnings startAction clashOpts = do
+  let args' = case postLoadMode of
+                DoRun -> takeWhile (\arg -> unLoc arg /= "--") args
+                _     -> args
+
+  -- set the default GhcMode, backend and GhcLink.  The backend
+  -- can be further adjusted on a module by module basis, using only
+  -- the -fllvm and -fasm flags.  If the default backend is not
+  -- LLVM or NCG, -fllvm and -fasm have no effect.
+  let dflt_backend = backend dflags0
+      (mode, bcknd, link)
+         = case postLoadMode of
+               DoInteractive   -> (CompManager, interpreterBackend,  LinkInMemory)
+               DoEval _        -> (CompManager, interpreterBackend,  LinkInMemory)
+               DoRun           -> (CompManager, interpreterBackend,  LinkInMemory)
+               DoMake          -> (CompManager, dflt_backend, LinkBinary)
+               DoBackpack      -> (CompManager, dflt_backend, LinkBinary)
+               DoMkDependHS    -> (MkDepend,    dflt_backend, LinkBinary)
+               DoAbiHash       -> (OneShot,     dflt_backend, LinkBinary)
+               DoVHDL          -> (CompManager, noBackend,     NoLink)
+               DoVerilog       -> (CompManager, noBackend,     NoLink)
+               DoSystemVerilog -> (CompManager, noBackend,     NoLink)
+               _               -> (OneShot,     dflt_backend, LinkBinary)
+
+  let dflags1 = dflags0{ ghcMode   = mode,
+                         backend   = bcknd,
+                         ghcLink   = link,
+                         verbosity = case postLoadMode of
+                                         DoEval _ -> 0
+                                         DoRun    -> 0
+                                         _other   -> 1
+                        }
+
+      -- turn on -fimplicit-import-qualified for GHCi now, so that it
+      -- can be overridden from the command-line
+      -- XXX: this should really be in the interactive DynFlags, but
+      -- we don't set that until later in interactiveUI
+      -- We also set -fignore-optim-changes and -fignore-hpc-changes,
+      -- which are program-level options. Again, this doesn't really
+      -- feel like the right place to handle this, but we don't have
+      -- a great story for the moment.
+      dflags2  | DoInteractive <- postLoadMode = def_ghci_flags
+               | DoEval _      <- postLoadMode = def_ghci_flags
+               | DoRun         <- postLoadMode = def_ghci_flags
+               | otherwise                     = dflags1
+        where def_ghci_flags = dflags1 `gopt_set` Opt_ImplicitImportQualified
+                                       `gopt_set` Opt_IgnoreOptimChanges
+                                       `gopt_set` Opt_IgnoreHpcChanges
+                                       -- Setting this by default has the nice effect that
+                                       -- -fno-code and --interactive falls back to interpreter rather than
+                                       -- object code but has little other effect unless you are also using
+                                       -- fat interface files.
+                                       `gopt_set` Opt_UseBytecodeRatherThanObjects
+                                       -- By default enable the debugger by inserting breakpoints
+                                       `gopt_set` Opt_InsertBreakpoints
+
+  logger1 <- getLogger
+  let logger2 = setLogFlags logger1 (initLogFlags dflags2)
+
+        -- The rest of the arguments are "dynamic"
+        -- Leftover ones are presumably files
+  (dflags3, fileish_args, dynamicFlagWarnings) <-
+      GHC.parseDynamicFlags logger2 dflags2 args'
+
+-- Propagate -Werror to Clash
+  liftIO . modifyIORef' clashOpts $ \opts ->
+    opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) }
+
+  let dflags4 = if backendNeedsFullWays bcknd &&
+                   not (gopt Opt_ExternalInterpreter dflags3)
+                then
+                    let platform = targetPlatform dflags3
+                        dflags3a = dflags3 { targetWays_ = hostFullWays }
+                        dflags3b = foldl gopt_set dflags3a
+                                 $ concatMap (wayGeneralFlags platform)
+                                             hostFullWays
+                        dflags3c = foldl gopt_unset dflags3b
+                                 $ concatMap (wayUnsetGeneralFlags platform)
+                                             hostFullWays
+                    in dflags3c
+                else
+                    dflags3
+
+  let logger4 = setLogFlags logger2 (initLogFlags dflags4)
+
+  GHC.prettyPrintGhcErrors logger4 $ do
+
+  let diag_opts = initDiagOpts dflags4
+  let flagWarnings' = GhcDriverMessage <$> mconcat [warnsToMessages diag_opts flagWarnings, dynamicFlagWarnings]
+
+  handleSourceError (\e -> do
+       GHC.printException e
+       liftIO $ exitWith (ExitFailure 1)) $ do
+         liftIO $ printOrThrowDiagnostics logger4 (initPrintConfig dflags4) diag_opts flagWarnings'
+
+  liftIO $ showBanner postLoadMode dflags4
+
+  let (dflags5, srcs, objs) = parseTargetFiles dflags4 (map unLoc fileish_args)
+
+  -- we've finished manipulating the DynFlags, update the session
+  _ <- GHC.setSessionDynFlags dflags5
+  dflags6 <- GHC.getSessionDynFlags
+
+  -- Must do this before loading plugins
+  liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6)
+
+  -- Initialise plugins here because the plugin author might already expect this
+  -- subsequent call to `getLogger` to be affected by a plugin.
+  initializeSessionPlugins
+  hsc_env <- getSession
+  logger <- getLogger
+
+
+        ---------------- Display configuration -----------
+  case verbosity dflags6 of
+    v | v == 4 -> liftIO $ dumpUnitsSimple hsc_env
+      | v >= 5 -> liftIO $ dumpUnits       hsc_env
+      | otherwise -> return ()
+
+        ---------------- Final sanity checking -----------
+  liftIO $ checkOptions postLoadMode dflags6 srcs objs units
+
+  ---------------- Do the business -----------
+  handleSourceError (\e -> do
+       GHC.printException e
+       liftIO $ exitWith (ExitFailure 1)) $ do
+    clashOpts' <- liftIO (readIORef clashOpts)
+    let clash fun = catch (fun startAction clashOpts srcs) (handleClashException dflags6 clashOpts')
+    case postLoadMode of
+       ShowInterface f        -> liftIO $ showIface logger
+                                                    (hsc_dflags hsc_env)
+                                                    (hsc_units  hsc_env)
+                                                    (hsc_NC     hsc_env)
+                                                    f
+       DoMake                 -> doMake units srcs
+       DoMkDependHS           -> doMkDependHS (map fst srcs)
+       StopBefore p           -> liftIO (oneShot hsc_env p srcs)
+       DoInteractive          -> ghciUI clashOpts units srcs Nothing
+       DoEval exprs           -> ghciUI clashOpts units srcs $ Just $ reverse exprs
+       DoRun                  -> doRun clashOpts units srcs args
+       DoAbiHash              -> abiHash (map fst srcs)
+       ShowPackages           -> liftIO $ showUnits hsc_env
+       DoFrontend f           -> doFrontend f srcs
+       DoBackpack             -> doBackpack (map fst srcs)
+       DoVHDL                 -> clash makeVHDL
+       DoVerilog              -> clash makeVerilog
+       DoSystemVerilog        -> clash makeSystemVerilog
+
+  liftIO $ dumpFinalStats logger
+
+doRun :: IORef ClashOpts -> [String] -> [(FilePath, Maybe Phase)] -> [Located String] -> Ghc ()
+doRun clashOpts units srcs args = do
+    dflags <- getDynFlags
+    let mainFun = fromMaybe "main" (mainFunIs dflags)
+    ghciUI clashOpts units srcs (Just ["System.Environment.withArgs " ++ show args' ++ " (Control.Monad.void " ++ mainFun ++ ")"])
+  where
+    args' = drop 1 $ dropWhile (/= "--") $ map unLoc args
+
+ghciUI :: IORef ClashOpts -> [String] -> [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc ()
+#if !defined(HAVE_INTERNAL_INTERPRETER)
+ghciUI _ _ _ _ =
+  throwGhcException (CmdLineError "not built for interactive use")
+#else
+ghciUI clashOpts units srcs maybe_expr = do
+  hs_srcs <- case NE.nonEmpty units of
+    Just ne_units -> do
+      initMulti ne_units
+    Nothing -> do
+      case srcs of
+        [] -> return []
+        _  -> do
+          s <- initMake srcs
+          return $ map (uncurry (,Nothing,)) s
+  interactiveUI (defaultGhciSettings clashOpts) hs_srcs maybe_expr
+#endif
+
+
+-- -----------------------------------------------------------------------------
+-- Option sanity checks
+
+-- | Ensure sanity of options.
+--
+-- Throws 'UsageError' or 'CmdLineError' if not.
+checkOptions :: PostLoadMode -> DynFlags -> [(String,Maybe Phase)] -> [String] -> [String] -> IO ()
+     -- Final sanity checking before kicking off a compilation (pipeline).
+checkOptions mode dflags srcs objs units = do
+     -- Complain about any unknown flags
+   let unknown_opts = [ f | (f@('-':_), _) <- srcs ]
+   when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
+
+   when (not (Set.null (rtsWays (ways dflags)))
+         && isInterpretiveMode mode) $
+        hPutStrLn stderr ("Warning: -debug, -threaded and -ticky are ignored by GHCi")
+
+        -- -prof and --interactive are not a good combination
+   when ((fullWays (ways dflags) /= hostFullWays)
+         && isInterpretiveMode mode
+         && not (gopt Opt_ExternalInterpreter dflags)) $
+      do throwGhcException (UsageError
+              "-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))
+        then throwGhcException (UsageError "-ohi can only be used when compiling a single source file")
+        else do
+
+   if (isJust (dynOutputHi dflags) &&
+      (isCompManagerMode mode || srcs `lengthExceeds` 1))
+     then throwGhcException (UsageError "-dynohi can only be used when compiling a single source file")
+     else do
+
+        -- -o sanity checking
+   if (srcs `lengthExceeds` 1 && isJust (outputFile dflags)
+         && not (isLinkMode mode))
+        then throwGhcException (UsageError "can't apply -o to multiple source files")
+        else do
+
+   let not_linking = not (isLinkMode mode) || isNoLink (ghcLink dflags)
+
+   when (not_linking && not (null objs)) $
+        hPutStrLn stderr ("Warning: the following files would be used as linker inputs, but linking is not being done: " ++ unwords objs)
+
+        -- Check that there are some input files
+        -- (except in the interactive case)
+   if null srcs && (null objs || not_linking) && needsInputsMode mode && null units
+        then throwGhcException (UsageError "no input files" )
+        else do
+
+   case mode of
+      StopBefore StopC | not (backendGeneratesHc (backend dflags))
+        -> throwGhcException $ UsageError $
+           "the option -C is only available with an unregisterised GHC"
+      StopBefore StopAs | ghcLink dflags == NoLink
+        -> throwGhcException $ UsageError $
+           "the options -S and -fno-code are incompatible. Please omit -S"
+
+      _ -> return ()
+
+     -- Verify that output files point somewhere sensible.
+   verifyOutputFiles dflags
+
+-- Compiler output options
+
+-- Called to verify that the output files point somewhere valid.
+--
+-- The assumption is that the directory portion of these output
+-- options will have to exist by the time 'verifyOutputFiles'
+-- is invoked.
+--
+-- We create the directories for -odir, -hidir, -outputdir etc. ourselves if
+-- they don't exist, so don't check for those here (#2278).
+verifyOutputFiles :: DynFlags -> IO ()
+verifyOutputFiles dflags = do
+  let ofile = outputFile dflags
+  when (isJust ofile) $ do
+     let fn = fromJust ofile
+     flg <- doesDirNameExist fn
+     when (not flg) (nonExistentDir "-o" fn)
+  let ohi = outputHi dflags
+  when (isJust ohi) $ do
+     let hi = fromJust ohi
+     flg <- doesDirNameExist hi
+     when (not flg) (nonExistentDir "-ohi" hi)
+ where
+   nonExistentDir flg dir =
+     throwGhcException (CmdLineError ("error: directory portion of " ++
+                             show dir ++ " does not exist (used with " ++
+                             show flg ++ " option.)"))
+
+-----------------------------------------------------------------------------
+-- GHC modes of operation
+
+type Mode = Either PreStartupMode PostStartupMode
+type PostStartupMode = Either PreLoadMode PostLoadMode
+
+data PreStartupMode
+  = ShowVersion                          -- ghc -V/--version
+  | ShowNumVersion                       -- ghc --numeric-version
+  | ShowSupportedExtensions              -- ghc --supported-extensions
+  | ShowOptions Bool {- isInteractive -} -- ghc --show-options
+
+showVersionMode, showNumVersionMode, showSupportedExtensionsMode, showOptionsMode :: Mode
+showVersionMode             = mkPreStartupMode ShowVersion
+showNumVersionMode          = mkPreStartupMode ShowNumVersion
+showSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions
+showOptionsMode             = mkPreStartupMode (ShowOptions False)
+
+mkPreStartupMode :: PreStartupMode -> Mode
+mkPreStartupMode = Left
+
+isShowVersionMode :: Mode -> Bool
+isShowVersionMode (Left ShowVersion) = True
+isShowVersionMode _ = False
+
+isShowNumVersionMode :: Mode -> Bool
+isShowNumVersionMode (Left ShowNumVersion) = True
+isShowNumVersionMode _ = False
+
+data PreLoadMode
+  = ShowGhcUsage                           -- ghc -?
+  | ShowGhciUsage                          -- ghci -?
+  | ShowInfo                               -- ghc --info
+  | PrintWithDynFlags (DynFlags -> String) -- ghc --print-foo
+
+showGhcUsageMode, showGhciUsageMode, showInfoMode :: Mode
+showGhcUsageMode = mkPreLoadMode ShowGhcUsage
+showGhciUsageMode = mkPreLoadMode ShowGhciUsage
+showInfoMode = mkPreLoadMode ShowInfo
+
+printSetting :: String -> Mode
+printSetting k = mkPreLoadMode (PrintWithDynFlags f)
+    where f dflags = fromMaybe (panic ("Setting not found: " ++ show k))
+                   $ lookup k (compilerInfo dflags)
+
+mkPreLoadMode :: PreLoadMode -> Mode
+mkPreLoadMode = Right . Left
+
+isShowGhcUsageMode :: Mode -> Bool
+isShowGhcUsageMode (Right (Left ShowGhcUsage)) = True
+isShowGhcUsageMode _ = False
+
+isShowGhciUsageMode :: Mode -> Bool
+isShowGhciUsageMode (Right (Left ShowGhciUsage)) = True
+isShowGhciUsageMode _ = False
+
+data PostLoadMode
+  = ShowInterface FilePath  -- ghc --show-iface
+  | DoMkDependHS            -- ghc -M
+  | StopBefore StopPhase    -- ghc -E | -C | -S
+                            -- StopBefore StopLn is the default
+  | DoMake                  -- ghc --make
+  | DoBackpack              -- ghc --backpack foo.bkp
+  | DoInteractive           -- ghc --interactive
+  | DoEval [String]         -- ghc -e foo -e bar => DoEval ["bar", "foo"]
+  | DoRun                   -- ghc --run
+  | DoAbiHash               -- ghc --abi-hash
+  | ShowPackages            -- ghc --show-packages
+  | DoFrontend ModuleName   -- ghc --frontend Plugin.Module
+  | DoVHDL                  -- ghc --vhdl
+  | DoVerilog               -- ghc --verilog
+  | DoSystemVerilog         -- ghc --systemverilog
+
+doMkDependHSMode, doMakeMode, doInteractiveMode, doRunMode,
+  doAbiHashMode, showUnitsMode, doVHDLMode, doVerilogMode,
+  doSystemVerilogMode :: Mode
+doMkDependHSMode = mkPostLoadMode DoMkDependHS
+doMakeMode = mkPostLoadMode DoMake
+doInteractiveMode = mkPostLoadMode DoInteractive
+doRunMode = mkPostLoadMode DoRun
+doAbiHashMode = mkPostLoadMode DoAbiHash
+showUnitsMode = mkPostLoadMode ShowPackages
+doVHDLMode = mkPostLoadMode DoVHDL
+doVerilogMode = mkPostLoadMode DoVerilog
+doSystemVerilogMode = mkPostLoadMode DoSystemVerilog
+
+showInterfaceMode :: FilePath -> Mode
+showInterfaceMode fp = mkPostLoadMode (ShowInterface fp)
+
+stopBeforeMode :: StopPhase -> Mode
+stopBeforeMode phase = mkPostLoadMode (StopBefore phase)
+
+doEvalMode :: String -> Mode
+doEvalMode str = mkPostLoadMode (DoEval [str])
+
+doFrontendMode :: String -> Mode
+doFrontendMode str = mkPostLoadMode (DoFrontend (mkModuleName str))
+
+doBackpackMode :: Mode
+doBackpackMode = mkPostLoadMode DoBackpack
+
+mkPostLoadMode :: PostLoadMode -> Mode
+mkPostLoadMode = Right . Right
+
+isDoInteractiveMode :: Mode -> Bool
+isDoInteractiveMode (Right (Right DoInteractive)) = True
+isDoInteractiveMode _ = False
+
+isStopLnMode :: Mode -> Bool
+isStopLnMode (Right (Right (StopBefore NoStop))) = True
+isStopLnMode _ = False
+
+isDoMakeMode :: Mode -> Bool
+isDoMakeMode (Right (Right DoMake)) = True
+isDoMakeMode _ = False
+
+isDoEvalMode :: Mode -> Bool
+isDoEvalMode (Right (Right (DoEval _))) = True
+isDoEvalMode _ = False
+
+#if defined(HAVE_INTERNAL_INTERPRETER)
+isInteractiveMode :: PostLoadMode -> Bool
+isInteractiveMode DoInteractive = True
+isInteractiveMode _             = False
+#endif
+
+-- isInterpretiveMode: byte-code compiler involved
+isInterpretiveMode :: PostLoadMode -> Bool
+isInterpretiveMode DoInteractive = True
+isInterpretiveMode (DoEval _)    = True
+isInterpretiveMode _             = False
+
+needsInputsMode :: PostLoadMode -> Bool
+needsInputsMode DoMkDependHS    = True
+needsInputsMode (StopBefore _)  = True
+needsInputsMode DoMake          = True
+needsInputsMode DoVHDL          = True
+needsInputsMode DoVerilog       = True
+needsInputsMode DoSystemVerilog = True
+needsInputsMode _               = False
+
+-- True if we are going to attempt to link in this mode.
+-- (we might not actually link, depending on the GhcLink flag)
+isLinkMode :: PostLoadMode -> Bool
+isLinkMode (StopBefore NoStop) = True
+isLinkMode DoMake              = True
+isLinkMode DoRun               = True
+isLinkMode DoInteractive       = True
+isLinkMode (DoEval _)          = True
+isLinkMode _                   = False
+
+isCompManagerMode :: PostLoadMode -> Bool
+isCompManagerMode DoRun         = True
+isCompManagerMode DoMake        = True
+isCompManagerMode DoInteractive = True
+isCompManagerMode (DoEval _)    = True
+isCompManagerMode DoVHDL        = True
+isCompManagerMode DoVerilog     = True
+isCompManagerMode DoSystemVerilog = True
+isCompManagerMode _             = False
+
+-- -----------------------------------------------------------------------------
+-- Parsing the mode flag
+
+parseModeFlags :: [Located String]
+               -> IO (Mode, [String],
+                      [Located String],
+                      [Warn])
+parseModeFlags args = do
+  ((leftover, errs1, warns), (mModeFlag, units, errs2, flags')) <-
+        processCmdLineP mode_flags (Nothing, [], [], []) args
+  let mode = case mModeFlag of
+             Nothing     -> doMakeMode
+             Just (m, _) -> m
+
+  -- See Note [Handling errors when parsing command-line flags]
+  unless (null errs1 && null errs2) $ throwGhcException $ errorsToGhcException $
+      map (("on the commandline", )) $ map (unLoc . errMsg) errs1 ++ errs2
+
+  return (mode, units, flags' ++ leftover, warns)
+
+type ModeM = CmdLineP (Maybe (Mode, String), [String], [String], [Located String])
+  -- mode flags sometimes give rise to new DynFlags (eg. -C, see below)
+  -- so we collect the new ones and return them.
+
+mode_flags :: [Flag ModeM]
+mode_flags =
+  [  ------- help / version ----------------------------------------------
+    defFlag "?"                     (PassFlag (setMode showGhcUsageMode))
+  , defFlag "-help"                 (PassFlag (setMode showGhcUsageMode))
+  , defFlag "V"                     (PassFlag (setMode showVersionMode))
+  , defFlag "-version"              (PassFlag (setMode showVersionMode))
+  , defFlag "-numeric-version"      (PassFlag (setMode showNumVersionMode))
+  , defFlag "-info"                 (PassFlag (setMode showInfoMode))
+  , defFlag "-show-options"         (PassFlag (setMode showOptionsMode))
+  , defFlag "-supported-languages"  (PassFlag (setMode showSupportedExtensionsMode))
+  , defFlag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
+  , defFlag "-show-packages"        (PassFlag (setMode showUnitsMode))
+  ] ++
+  [ defFlag k'                      (PassFlag (setMode (printSetting k)))
+  | k <- ["Project version",
+          "Project Git commit id",
+          "Booter version",
+          "Stage",
+          "Build platform",
+          "Host platform",
+          "Target platform",
+          "Have interpreter",
+          "Object splitting supported",
+          "Have native code generator",
+          "Support SMP",
+          "Unregisterised",
+          "Tables next to code",
+          "RTS ways",
+          "Leading underscore",
+          "Debug on",
+          "LibDir",
+          "Global Package DB",
+          "C compiler flags",
+          "C compiler link flags"
+          ],
+    let k' = "-print-" ++ map (replaceSpace . toLower) k
+        replaceSpace ' ' = '-'
+        replaceSpace c   = c
+  ] ++
+      ------- interfaces ----------------------------------------------------
+  [ defFlag "-show-iface"  (HasArg (\f -> setMode (showInterfaceMode f)
+                                               "--show-iface"))
+
+      ------- primary modes ------------------------------------------------
+  , defFlag "c"            (PassFlag (\f -> do setMode (stopBeforeMode NoStop) f
+                                               addFlag "-no-link" f))
+  , defFlag "M"            (PassFlag (setMode doMkDependHSMode))
+  , defFlag "E"            (PassFlag (setMode (stopBeforeMode StopPreprocess )))
+  , defFlag "C"            (PassFlag (setMode (stopBeforeMode StopC)))
+  , defFlag "S"            (PassFlag (setMode (stopBeforeMode StopAs)))
+  , defFlag "-run"         (PassFlag (setMode doRunMode))
+  , defFlag "-make"        (PassFlag (setMode doMakeMode))
+  , defFlag "unit"         (SepArg   (\s -> addUnit s "-unit"))
+  , defFlag "-backpack"    (PassFlag (setMode doBackpackMode))
+  , 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))
+  ]
+
+addUnit :: String -> String -> EwM ModeM ()
+addUnit unit_str _arg = liftEwM $ do
+  (mModeFlag, units, errs, flags') <- getCmdLineState
+  putCmdLineState (mModeFlag, unit_str:units, errs, flags')
+
+setMode :: Mode -> String -> EwM ModeM ()
+setMode newMode newFlag = liftEwM $ do
+    (mModeFlag, units, errs, flags') <- getCmdLineState
+    let (modeFlag', errs') =
+            case mModeFlag of
+            Nothing -> ((newMode, newFlag), errs)
+            Just (oldMode, oldFlag) ->
+                case (oldMode, newMode) of
+                    -- -c/--make are allowed together, and mean --make -no-link
+                    _ |  isStopLnMode oldMode && isDoMakeMode newMode
+                      || isStopLnMode newMode && isDoMakeMode oldMode ->
+                      ((doMakeMode, "--make"), [])
+
+                    -- If we have both --help and --interactive then we
+                    -- want showGhciUsage
+                    _ | isShowGhcUsageMode oldMode &&
+                        isDoInteractiveMode newMode ->
+                            ((showGhciUsageMode, oldFlag), [])
+                      | 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), [])
+                    -- We need to accumulate eval flags like "-e foo -e bar"
+                    (Right (Right (DoEval esOld)),
+                     Right (Right (DoEval [eNew]))) ->
+                        ((Right (Right (DoEval (eNew : esOld))), oldFlag),
+                         errs)
+                    -- Saying e.g. --interactive --interactive is OK
+                    _ | oldFlag == newFlag -> ((oldMode, oldFlag), errs)
+
+                    -- --interactive and --show-options are used together
+                    (Right (Right DoInteractive), Left (ShowOptions _)) ->
+                      ((Left (ShowOptions True),
+                        "--interactive --show-options"), errs)
+                    (Left (ShowOptions _), (Right (Right DoInteractive))) ->
+                      ((Left (ShowOptions True),
+                        "--show-options --interactive"), errs)
+                    -- Otherwise, complain
+                    _ -> let err = flagMismatchErr oldFlag newFlag
+                         in ((oldMode, oldFlag), err : errs)
+    putCmdLineState (Just modeFlag', units, errs', flags')
+  where isDominantFlag f = isShowGhcUsageMode   f ||
+                           isShowGhciUsageMode  f ||
+                           isShowVersionMode    f ||
+                           isShowNumVersionMode f
+
+flagMismatchErr :: String -> String -> String
+flagMismatchErr oldFlag newFlag
+    = "cannot use `" ++ oldFlag ++  "' with `" ++ newFlag ++ "'"
+
+addFlag :: String -> String -> EwM ModeM ()
+addFlag s flag = liftEwM $ do
+  (m, units, e, flags') <- getCmdLineState
+  putCmdLineState (m, units, e, mkGeneralLocated loc s : flags')
+    where loc = "addFlag by " ++ flag ++ " on the commandline"
+
+-- ----------------------------------------------------------------------------
+-- Run --make mode
+
+doMake :: [String] -> [(String, Maybe Phase)] -> Ghc ()
+doMake units targets = do
+  hs_srcs <- case NE.nonEmpty units of
+    Just ne_units -> do
+      initMulti ne_units
+    Nothing -> do
+      s <- initMake targets
+      return $ map (uncurry (,Nothing,)) s
+  case hs_srcs of
+    [] -> return ()
+    _  -> do
+      targets' <- mapM (\(src, uid, phase) -> GHC.guessTarget src uid phase) hs_srcs
+      GHC.setTargets targets'
+      ok_flag <- GHC.load LoadAllTargets
+      when (failed ok_flag) (liftIO $ exitWith (ExitFailure 1))
+
+initMake :: [(String,Maybe Phase)] -> Ghc [(String, Maybe Phase)]
+initMake srcs  = do
+    let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs
+
+    hsc_env <- GHC.getSession
+
+    -- if we have no haskell sources from which to do a dependency
+    -- analysis, then just do one-shot compilation and/or linking.
+    -- This means that "ghc Foo.o Bar.o -o baz" links the program as
+    -- we expect.
+    if (null hs_srcs)
+       then liftIO (oneShot hsc_env NoStop srcs) >> return []
+       else do
+
+    o_files <- mapMaybeM (\x -> liftIO $ compileFile hsc_env NoStop x)
+                 non_hs_srcs
+    dflags <- GHC.getSessionDynFlags
+    let dflags' = dflags { ldInputs = map (FileOption "") o_files
+                                      ++ ldInputs dflags }
+    _ <- GHC.setSessionDynFlags dflags'
+    return hs_srcs
+
+-- Strip out any ["+RTS", ..., "-RTS"] sequences in the command string list.
+removeRTS :: [String] -> [String]
+removeRTS ("+RTS" : xs)  =
+  case dropWhile (/= "-RTS") xs of
+    [] -> []
+    (_ : ys) -> removeRTS ys
+removeRTS (y:ys)         = y : removeRTS ys
+removeRTS []             = []
+
+initMulti :: NE.NonEmpty String -> Ghc ([(String, Maybe UnitId, Maybe Phase)])
+initMulti unitArgsFiles  = do
+  hsc_env <- GHC.getSession
+  let logger = hsc_logger hsc_env
+  initial_dflags <- GHC.getSessionDynFlags
+
+  dynFlagsAndSrcs <- forM unitArgsFiles $ \f -> do
+    when (verbosity initial_dflags > 2) (liftIO $ print f)
+    args <- liftIO $ expandResponse [f]
+    (dflags2, fileish_args, warns) <- parseDynamicFlagsCmdLine initial_dflags (map (mkGeneralLocated f) (removeRTS args))
+    handleSourceError (\e -> do
+       GHC.printException e
+       liftIO $ exitWith (ExitFailure 1)) $ do
+         liftIO $ printOrThrowDiagnostics logger (initPrintConfig dflags2) (initDiagOpts dflags2) (GhcDriverMessage <$> warns)
+
+    let (dflags3, srcs, objs) = parseTargetFiles dflags2 (map unLoc fileish_args)
+        dflags4 = offsetDynFlags dflags3
+
+    let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs
+
+    -- This is dubious as the whole unit environment won't be set-up correctly, but
+    -- that doesn't matter for what we use it for (linking and oneShot)
+    let dubious_hsc_env = hscSetFlags dflags4 hsc_env
+    -- if we have no haskell sources from which to do a dependency
+    -- analysis, then just do one-shot compilation and/or linking.
+    -- This means that "ghc Foo.o Bar.o -o baz" links the program as
+    -- we expect.
+    if (null hs_srcs)
+       then liftIO (oneShot dubious_hsc_env NoStop srcs) >> return (dflags4, [])
+       else do
+
+    o_files <- mapMaybeM (\x -> liftIO $ compileFile dubious_hsc_env NoStop x)
+                 non_hs_srcs
+    let dflags5 = dflags4 { ldInputs = map (FileOption "") o_files
+                                      ++ ldInputs dflags4 }
+
+    liftIO $ checkOptions DoMake dflags5 srcs objs []
+
+    pure (dflags5, hs_srcs)
+
+  let
+    unitDflags = NE.map fst dynFlagsAndSrcs
+    srcs = NE.map (\(dflags, lsrcs) -> map (uncurry (,Just $ homeUnitId_ dflags,)) lsrcs) dynFlagsAndSrcs
+    (hs_srcs, _non_hs_srcs) = unzip (map (partition (\(file, _uid, phase) -> isHaskellishTarget (file, phase))) (NE.toList srcs))
+
+  checkDuplicateUnits initial_dflags (NE.toList (NE.zip unitArgsFiles unitDflags))
+
+  let (initial_home_graph, mainUnitId) = createUnitEnvFromFlags unitDflags
+      home_units = unitEnv_keys initial_home_graph
+
+  home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do
+    let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv
+        hue_flags = homeUnitEnv_dflags homeUnitEnv
+        dflags = homeUnitEnv_dflags homeUnitEnv
+    (dbs,unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger hue_flags cached_unit_dbs home_units
+
+    updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants
+    pure $ HomeUnitEnv
+      { homeUnitEnv_units = unit_state
+      , homeUnitEnv_unit_dbs = Just dbs
+      , homeUnitEnv_dflags = updated_dflags
+      , homeUnitEnv_hpt = emptyHomePackageTable
+      , homeUnitEnv_home_unit = Just home_unit
+      }
+
+  checkUnitCycles initial_dflags home_unit_graph
+
+  let dflags = homeUnitEnv_dflags $ unitEnv_lookup mainUnitId home_unit_graph
+  unitEnv <- assertUnitEnvInvariant <$> (liftIO $ initUnitEnv mainUnitId home_unit_graph (ghcNameVersion dflags) (targetPlatform dflags))
+  let final_hsc_env = hsc_env { hsc_unit_env = unitEnv }
+
+  GHC.setSession final_hsc_env
+
+  -- if we have no haskell sources from which to do a dependency
+  -- analysis, then just do one-shot compilation and/or linking.
+  -- This means that "ghc Foo.o Bar.o -o baz" links the program as
+  -- we expect.
+  if (null hs_srcs)
+      then do
+        liftIO $ hPutStrLn stderr $ "Multi Mode can not be used for one-shot mode."
+        liftIO $ exitWith (ExitFailure 1)
+      else do
+
+{-
+  o_files <- liftIO $ mapMaybeM
+                (\(src, uid, mphase) ->
+                  compileFile (hscSetActiveHomeUnit (ue_unitHomeUnit (fromJust uid) unitEnv) final_hsc_env) NoStop (src, mphase)
+                )
+                (concat non_hs_srcs)
+                -}
+
+  -- MP: This should probably modify dflags for each unit?
+  --let dflags' = dflags { ldInputs = map (FileOption "") o_files
+  --                                  ++ ldInputs dflags }
+  return $ concat hs_srcs
+
+-- | Check that we don't have multiple units with the same UnitId.
+
+checkUnitCycles :: DynFlags -> UnitEnvGraph HomeUnitEnv -> Ghc ()
+checkUnitCycles dflags graph = processSCCs sccs
+  where
+    mkNode :: (UnitId, HomeUnitEnv) -> Node UnitId UnitId
+    mkNode (uid, hue) = DigraphNode uid uid (homeUnitDepends (homeUnitEnv_units hue))
+    nodes = map mkNode (unitEnv_elts graph)
+
+    sccs = stronglyConnCompFromEdgedVerticesOrd nodes
+
+    processSCCs [] = return ()
+    processSCCs (AcyclicSCC _: other_sccs) = processSCCs other_sccs
+    processSCCs (CyclicSCC uids: _) = throwGhcException $ CmdLineError $ showSDoc dflags (cycle_err uids)
+
+
+    cycle_err uids =
+      hang (text "Units form a dependency cycle:")
+           2
+           (one_err uids)
+
+    one_err uids = vcat $
+                    (map (\uid -> text "-" <+> ppr uid <+> text "depends on") start)
+                    ++ [text "-" <+> ppr final]
+      where
+        start = init uids
+        final = last uids
+
+checkDuplicateUnits :: DynFlags -> [(FilePath, DynFlags)] -> Ghc ()
+checkDuplicateUnits dflags flags =
+  unless (null duplicate_ids)
+         (throwGhcException $ CmdLineError $ showSDoc dflags multi_err)
+
+  where
+    uids = map (second homeUnitId_) flags
+    deduplicated_uids = ordNubOn snd uids
+    duplicate_ids = Set.fromList (map snd uids \\ map snd deduplicated_uids)
+
+    duplicate_flags = filter (flip Set.member duplicate_ids . snd) uids
+
+    one_err (fp, home_uid) = text "-" <+> ppr home_uid <+> text "defined in" <+> text fp
+
+    multi_err =
+      hang (text "Multiple units with the same unit-id:")
+           2
+           (vcat (map one_err duplicate_flags))
+
+
+offsetDynFlags :: DynFlags -> DynFlags
+offsetDynFlags dflags =
+  dflags { hiDir = c hiDir
+         , objectDir  = c objectDir
+         , stubDir = c stubDir
+         , hieDir  = c hieDir
+         , dumpDir = c dumpDir  }
+
+  where
+    c f = augment_maybe (f dflags)
+
+    augment_maybe Nothing = Nothing
+    augment_maybe (Just f) = Just (augment f)
+    augment f | isRelative f, Just offset <- workingDirectory dflags = offset </> f
+              | otherwise = f
+
+
+createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> (HomeUnitGraph, UnitId)
+createUnitEnvFromFlags unitDflags =
+  let
+    newInternalUnitEnv dflags = mkHomeUnitEnv dflags emptyHomePackageTable Nothing
+    unitEnvList = NE.map (\dflags -> (homeUnitId_ dflags, newInternalUnitEnv dflags)) unitDflags
+    activeUnit = fst $ NE.head unitEnvList
+  in
+    (unitEnv_new (Map.fromList (NE.toList (unitEnvList))), activeUnit)
+
+-- ---------------------------------------------------------------------------
+-- Various banners and verbosity output.
+
+showBanner :: PostLoadMode -> DynFlags -> IO ()
+showBanner _postLoadMode dflags = do
+   let verb = verbosity dflags
+
+#if defined(HAVE_INTERNAL_INTERPRETER)
+   -- Show the GHCi banner
+   when (isInteractiveMode _postLoadMode && verb >= 1) $ putStrLn ghciWelcomeMsg
+#endif
+
+   -- Display details of the configuration in verbose mode
+   when (verb >= 2) $
+    do hPutStr stderr "Glasgow Haskell Compiler, Version "
+       hPutStr stderr cProjectVersion
+       hPutStr stderr ", stage "
+       hPutStr stderr cStage
+       hPutStr stderr " booted by GHC version "
+       hPutStrLn stderr cBooterVersion
+
+-- We print out a Read-friendly string, but a prettier one than the
+-- Show instance gives us
+showInfo :: DynFlags -> IO ()
+showInfo dflags = do
+        let sq x = " [" ++ x ++ "\n ]"
+        putStrLn $ sq $ intercalate "\n ," $ map show $ compilerInfo dflags
+
+-- TODO use GHC.Utils.Error once that is disentangled from all the other GhcMonad stuff?
+showSupportedExtensions :: Maybe String -> IO ()
+showSupportedExtensions m_top_dir = do
+  res <- runExceptT $ do
+    top_dir <- lift (tryFindTopDir m_top_dir) >>= \case
+      Nothing -> throwE $ SettingsError_MissingData "Could not find the top directory, missing -B flag"
+      Just dir -> pure dir
+    initSettings top_dir
+  arch_os <- case res of
+    Right s -> pure $ platformArchOS $ sTargetPlatform s
+    Left (SettingsError_MissingData msg) -> do
+      hPutStrLn stderr $ "WARNING: " ++ show msg
+      hPutStrLn stderr $ "cannot know target platform so guessing target == host (native compiler)."
+      pure hostPlatformArchOS
+    Left (SettingsError_BadData msg) -> do
+      hPutStrLn stderr msg
+      exitWith $ ExitFailure 1
+  mapM_ putStrLn $ supportedLanguagesAndExtensions arch_os
+
+showVersion :: IO ()
+showVersion = putStrLn $ concat [ "Clash, version "
+                                , Data.Version.showVersion Paths_clash_ghc.version
+                                , " (using clash-lib, version: "
+                                , Data.Version.showVersion clashLibVersion
+                                , ")"
+                                ]
+
+showOptions :: Bool -> IORef ClashOpts -> IO ()
+showOptions isInteractive = putStr . unlines . availableOptions
+    where
+      availableOptions opts = concat [
+        flagsForCompletion isInteractive,
+        map ('-':) (getFlagNames mode_flags),
+        map ('-':) (getFlagNames (flagsClash opts))
+        ]
+      getFlagNames opts         = map flagName opts
+
+showGhcUsage :: DynFlags -> IO ()
+showGhcUsage = showUsage False
+
+showGhciUsage :: DynFlags -> IO ()
+showGhciUsage = showUsage True
+
+showUsage :: Bool -> DynFlags -> IO ()
+showUsage ghci dflags = do
+  let usage_path = if ghci then ghciUsagePath dflags
+                           else ghcUsagePath dflags
+  usage <- readFile usage_path
+  progName <- getProgName
+  dump progName usage
+  where
+    dump progName xs = case xs of
+      ""        -> return ()
+      '$':'$':s -> putStr progName >> dump progName s
+      c:s       -> putChar c >> dump progName s
+
+dumpFinalStats :: Logger -> IO ()
+dumpFinalStats logger = do
+  when (logHasDumpFlag logger Opt_D_faststring_stats) $ dumpFastStringStats logger
+
+  when (logHasDumpFlag logger Opt_D_dump_faststrings) $ do
+    fss <- getFastStringTable
+    let ppr_table         = fmap ppr_segment (fss `zip` [0..])
+        ppr_segment (s,n) = hang (text "Segment" <+> int n) 2 (vcat (fmap ppr_bucket (s `zip` [0..])))
+        ppr_bucket  (b,n) = hang (text "Bucket" <+> int n) 2 (vcat (fmap ftext b))
+    putDumpFileMaybe logger Opt_D_dump_faststrings "FastStrings" FormatText (vcat ppr_table)
+
+dumpFastStringStats :: Logger -> IO ()
+dumpFastStringStats logger = do
+  segments <- getFastStringTable
+  hasZ <- getFastStringZEncCounter
+  let buckets = concat segments
+      bucketsPerSegment = map length segments
+      entriesPerBucket = map length buckets
+      entries = sum entriesPerBucket
+      msg = text "FastString stats:" $$ nest 4 (vcat
+        [ text "segments:         " <+> int (length segments)
+        , text "buckets:          " <+> int (sum bucketsPerSegment)
+        , text "entries:          " <+> int entries
+        , text "largest segment:  " <+> int (maximum bucketsPerSegment)
+        , text "smallest segment: " <+> int (minimum bucketsPerSegment)
+        , text "longest bucket:   " <+> int (maximum entriesPerBucket)
+        , text "has z-encoding:   " <+> (hasZ `pcntOf` entries)
+        ])
+        -- we usually get more "has z-encoding" than "z-encoded", because
+        -- when we z-encode a string it might hash to the exact same string,
+        -- which is not counted as "z-encoded".  Only strings whose
+        -- Z-encoding is different from the original string are counted in
+        -- the "z-encoded" total.
+  putMsg logger msg
+  where
+   x `pcntOf` y = int ((x * 100) `quot` y) Outputable.<> char '%'
+
+showUnits, dumpUnits, dumpUnitsSimple :: HscEnv -> IO ()
+showUnits       hsc_env = putStrLn (showSDoc (hsc_dflags hsc_env) (pprUnits (hsc_units hsc_env)))
+dumpUnits       hsc_env = putMsg (hsc_logger hsc_env) (pprUnits (hsc_units hsc_env))
+dumpUnitsSimple hsc_env = putMsg (hsc_logger hsc_env) (pprUnitsSimple (hsc_units hsc_env))
+
+-- -----------------------------------------------------------------------------
+-- Frontend plugin support
+
+doFrontend :: ModuleName -> [(String, Maybe Phase)] -> Ghc ()
+doFrontend modname srcs = do
+    hsc_env <- getSession
+    (frontend_plugin, _pkgs, _deps) <- liftIO $ loadFrontendPlugin hsc_env modname -- TODO do these need to recorded?
+    frontend frontend_plugin
+      (reverse $ frontendPluginOpts (hsc_dflags hsc_env)) srcs
+
+-- -----------------------------------------------------------------------------
+-- ABI hash support
+
+{-
+        ghc --abi-hash Data.Foo System.Bar
+
+Generates a combined hash of the ABI for modules Data.Foo and
+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 ComponentId for a
+package.  The ComponentId must change when the visible ABI of
+the package changes, so during registration Cabal calls ghc --abi-hash
+to get a hash of the package's ABI.
+-}
+
+-- | Print ABI hash of input modules.
+--
+-- The resulting hash is the MD5 of the GHC version used (#5328,
+-- see 'hiVersion') and of the existing ABI hash from each module (see
+-- 'mi_mod_hash').
+abiHash :: [String] -- ^ List of module names
+        -> Ghc ()
+abiHash strs = do
+  hsc_env <- getSession
+  let dflags    = hsc_dflags hsc_env
+
+  liftIO $ do
+
+  let find_it str = do
+         let modname = mkModuleName str
+         r <- findImportedModule hsc_env modname NoPkgQual
+         case r of
+           Found _ m -> return m
+           _error    ->
+            let opts   = initIfaceMessageOpts dflags
+                err_txt = missingInterfaceErrorDiagnostic opts
+                        $ cannotFindModule hsc_env modname r
+            in throwGhcException . CmdLineError $ showSDoc dflags err_txt
+
+  mods <- mapM find_it strs
+
+  let get_iface modl = loadUserInterface NotBoot (text "abiHash") modl
+  ifaces <- initIfaceCheck (text "abiHash") hsc_env $ mapM get_iface mods
+
+  bh <- openBinMem (3*1024) -- just less than a block
+  put_ bh hiVersion
+    -- package hashes change when the compiler version changes (for now)
+    -- see #5328
+  mapM_ (put_ bh . mi_mod_hash . mi_final_exts) ifaces
+  f <- fingerprintBinMem bh
+
+  putStrLn (showPpr dflags f)
+
+-----------------------------------------------------------------------------
+-- HDL Generation
+
+makeHDL'
+  :: forall backend
+   . Clash.Backend.Backend backend
+  => Proxy backend
+  -> Ghc ()
+  -> IORef ClashOpts
+  -> [(String,Maybe Phase)]
+  -> Ghc ()
+makeHDL' _     _           _ []   = throwGhcException (CmdLineError "No input files")
+makeHDL' proxy startAction r srcs = makeHDL proxy startAction r $ fmap fst srcs
+
+makeVHDL :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
+makeVHDL = makeHDL' (Proxy @VHDLState)
+
+makeVerilog :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
+makeVerilog = makeHDL' (Proxy @VerilogState)
+
+makeSystemVerilog :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
+makeSystemVerilog = makeHDL' (Proxy @SystemVerilogState)
+
+-- -----------------------------------------------------------------------------
+-- Util
+
+unknownFlagsErr :: [String] -> a
+unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs
+  where
+    oneError f =
+        "unrecognised flag: " ++ f ++ "\n" ++
+        (case flagSuggestions (nubSort allNonDeprecatedFlags) f of
+            [] -> ""
+            suggs -> "did you mean one of:\n" ++ unlines (map ("  " ++) suggs))
diff --git a/src-bin-9.10.2/Clash/GHCi/Leak.hs b/src-bin-9.10.2/Clash/GHCi/Leak.hs
new file mode 100644
--- /dev/null
+++ b/src-bin-9.10.2/Clash/GHCi/Leak.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE RecordWildCards, LambdaCase #-}
+module Clash.GHCi.Leak
+  ( LeakIndicators
+  , getLeakIndicators
+  , checkLeakIndicators
+  ) where
+
+import Clash.GHCi.Util
+import Control.Monad
+import Data.Bits
+import Foreign.Ptr (ptrToIntPtr, intPtrToPtr)
+import GHC
+import GHC.Ptr (Ptr (..))
+import GHC.Driver.Env
+import GHC.Driver.Ppr
+import GHC.Utils.Outputable
+import GHC.Unit.Module.ModDetails
+import GHC.Unit.Home.ModInfo
+import GHC.Platform (target32Bit)
+import GHC.Linker.Types
+import Prelude
+import System.Mem
+import System.Mem.Weak
+import GHC.Types.Unique.DFM
+import Control.Exception
+
+-- Checking for space leaks in GHCi. See #15111, and the
+-- -fghci-leak-check flag.
+
+data LeakIndicators = LeakIndicators [LeakModIndicators]
+
+data LeakModIndicators = LeakModIndicators
+  { leakMod :: Weak HomeModInfo
+  , leakIface :: Weak ModIface
+  , leakDetails :: Weak ModDetails
+  , leakLinkable :: [Maybe (Weak Linkable)]
+  }
+
+-- | Grab weak references to some of the data structures representing
+-- the currently loaded modules.
+getLeakIndicators :: HscEnv -> IO LeakIndicators
+getLeakIndicators hsc_env =
+  fmap LeakIndicators $
+    forM (eltsUDFM (hsc_HPT hsc_env)) $ \hmi@HomeModInfo{..} -> do
+      leakMod <- mkWeakPtr hmi Nothing
+      leakIface <- mkWeakPtr hm_iface Nothing
+      leakDetails <- mkWeakPtr hm_details Nothing
+      leakLinkable <-  mkWeakLinkables hm_linkable
+      return $ LeakModIndicators{..}
+  where
+    mkWeakLinkables :: HomeModLinkable -> IO [Maybe (Weak Linkable)]
+    mkWeakLinkables (HomeModLinkable mbc mo) =
+      mapM (\ln -> traverse (flip mkWeakPtr Nothing <=< evaluate) ln) [mbc, mo]
+
+-- | Look at the LeakIndicators collected by an earlier call to
+-- `getLeakIndicators`, and print messasges if any of them are still
+-- alive.
+checkLeakIndicators :: DynFlags -> LeakIndicators -> IO ()
+checkLeakIndicators dflags (LeakIndicators leakmods)  = do
+  performGC
+  forM_ leakmods $ \LeakModIndicators{..} -> do
+    deRefWeak leakMod >>= \case
+      Nothing -> return ()
+      Just hmi ->
+        report ("HomeModInfo for " ++
+          showSDoc dflags (ppr (mi_module (hm_iface hmi)))) (Just hmi)
+    deRefWeak leakIface >>= \case
+      Nothing -> return ()
+      Just miface -> report ("ModIface:" ++ moduleNameString (moduleName (mi_module miface))) (Just miface)
+    deRefWeak leakDetails >>= report "ModDetails"
+    forM_ leakLinkable $ \l -> forM_ l $ \l' -> deRefWeak l' >>= report "Linkable"
+ where
+  report :: String -> Maybe a -> IO ()
+  report _ Nothing = return ()
+  report msg (Just a) = do
+    addr <- anyToPtr a
+    putStrLn ("-fghci-leak-check: " ++ msg ++ " is still alive at " ++
+              show (maskTagBits addr))
+
+  tagBits
+    | target32Bit (targetPlatform dflags) = 2
+    | otherwise = 3
+
+  maskTagBits :: Ptr a -> Ptr a
+  maskTagBits p = intPtrToPtr (ptrToIntPtr p .&. complement (shiftL 1 tagBits - 1))
diff --git a/src-bin-9.10.2/Clash/GHCi/UI.hs b/src-bin-9.10.2/Clash/GHCi/UI.hs
new file mode 100644
--- /dev/null
+++ b/src-bin-9.10.2/Clash/GHCi/UI.hs
@@ -0,0 +1,4902 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NondecreasingIndentation #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-# OPTIONS -fno-warn-name-shadowing #-}
+-- This module does a lot of it
+
+-----------------------------------------------------------------------------
+--
+-- GHC Interactive User Interface
+--
+-- (c) The GHC Team 2005-2006
+--
+-----------------------------------------------------------------------------
+
+module Clash.GHCi.UI (
+        interactiveUI,
+        GhciSettings(..),
+        defaultGhciSettings,
+        ghciCommands,
+        ghciWelcomeMsg,
+        makeHDL
+    ) where
+
+-- GHCi
+import qualified Clash.GHCi.UI.Monad as GhciMonad ( args, runStmt, runDecls' )
+import Clash.GHCi.UI.Monad hiding ( args, runStmt )
+import Clash.GHCi.UI.Info
+import Clash.GHCi.UI.Exception
+import GHC.Runtime.Debugger
+
+-- The GHC interface
+import GHC.Runtime.Interpreter
+import GHCi.RemoteTypes
+import GHCi.BreakArray( breakOn, breakOff )
+import GHC.ByteCode.Types
+import GHC.Core.DataCon
+import GHC.Core.ConLike
+import GHC.Core.PatSyn
+import GHC.Driver.Flags
+import GHC.Driver.Errors
+import GHC.Driver.Errors.Types
+import GHC.Driver.Phases
+import GHC.Driver.Session as DynFlags
+import GHC.Driver.Ppr hiding (printForUser)
+import GHC.Utils.Error hiding (traceCmd)
+import GHC.Driver.Monad ( modifySession )
+import GHC.Driver.Make ( newIfaceCache, ModIfaceCache(..) )
+import GHC.Driver.Config.Parser (initParserOpts)
+import GHC.Driver.Config.Diagnostic
+import qualified GHC
+import GHC ( LoadHowMuch(..), Target(..),  TargetId(..),
+             Resume, SingleStep, Ghc,
+             GetDocsFailure(..), pushLogHookM,
+             getModuleGraph, handleSourceError, ms_mod )
+import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation)
+import GHC.Hs.ImpExp
+import GHC.Hs
+import GHC.Driver.Env
+import GHC.Runtime.Context
+import GHC.Types.TyThing
+import GHC.Types.TyThing.Ppr
+import GHC.Core.TyCo.Ppr
+import GHC.Types.SafeHaskell ( getSafeMode )
+import GHC.Types.SourceError ( SourceError )
+import GHC.Types.Name
+import GHC.Types.Breakpoint
+import GHC.Types.Var ( varType )
+import GHC.Iface.Syntax ( showToHeader )
+import GHC.Builtin.Names
+import GHC.Builtin.Types( stringTyCon_RDR )
+import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrName )
+import GHC.Types.SrcLoc as SrcLoc
+import qualified GHC.Parser.Lexer as Lexer
+import GHC.Parser.Header ( toArgs )
+import qualified GHC.Parser.Header as Header
+import GHC.Types.PkgQual
+
+import GHC.Unit
+import GHC.Unit.Finder as Finder
+import GHC.Unit.Module.Graph (filterToposortToModules)
+import GHC.Unit.Module.ModSummary
+
+import GHC.Data.StringBuffer
+import GHC.Utils.Outputable
+import GHC.Utils.Logger
+
+-- Other random utilities
+import GHC.Types.Basic hiding ( isTopLevel )
+import GHC.Data.Graph.Directed
+import GHC.Utils.Encoding
+import GHC.Data.FastString
+import qualified GHC.Linker.Loader as Loader
+import GHC.Data.Maybe ( orElse, expectJust )
+import GHC.Types.Name.Set
+import GHC.Utils.Panic hiding ( showException, try )
+import GHC.Utils.Misc
+import qualified GHC.LanguageExtensions as LangExt
+import GHC.Data.Bag (unitBag)
+import qualified GHC.Data.Strict as Strict
+import GHC.Types.Error
+
+-- 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.Catch as MC
+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 ( elemIndices, find, intercalate, intersperse, minimumBy,
+                   isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Set as S
+import Data.Maybe
+import qualified Data.Map as M
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as IntMap
+import Data.Time.LocalTime ( getZonedTime )
+import Data.Time.Format ( formatTime, defaultTimeLocale )
+import Data.Version ( showVersion )
+import qualified Data.Semigroup as S
+import Prelude hiding ((<>))
+
+import GHC.Utils.Exception as Exception hiding (catch, mask, handle)
+import Foreign hiding (void)
+import GHC.Stack hiding (SrcLoc(..))
+import GHC.Unit.Env
+import GHC.Unit.Home.ModInfo
+
+import System.Directory
+import System.Environment
+import System.Exit ( exitWith, ExitCode(..) )
+import System.FilePath
+import System.Info
+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)
+
+import Unsafe.Coerce
+
+#if !defined(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 Clash.GHCi.Leak
+import qualified GHC.Unit.Module.Graph as GHC
+
+-- clash additions
+import           Clash.Backend (Backend(initBackend, hdlKind, primDirs))
+import           Clash.Backend.SystemVerilog (SystemVerilogState)
+import           Clash.Backend.VHDL (VHDLState)
+import           Clash.Backend.Verilog (VerilogState)
+import qualified Clash.Driver
+import           Clash.Driver.Bool (fromGhcOverridingBool)
+import           Clash.Driver.Types (ClashOpts(..), ClashEnv(..), ClashDesign(..))
+import           Clash.GHC.Evaluator
+import           Clash.GHC.GenerateBindings
+import           Clash.GHC.NetlistTypes
+import           Clash.GHC.PartialEval
+import           Clash.GHCi.Common
+import           Clash.Util (clashLibVersion, reportTimeDiff)
+import           Data.Proxy
+import qualified Data.Time.Clock as Clock
+import qualified Paths_clash_ghc
+
+-----------------------------------------------------------------------------
+
+data GhciSettings = GhciSettings {
+        availableCommands :: [Command],
+        shortHelpText     :: String,
+        fullHelpText      :: String,
+        defPrompt         :: PromptFunction,
+        defPromptCont     :: PromptFunction
+    }
+
+defaultGhciSettings :: IORef ClashOpts -> GhciSettings
+defaultGhciSettings opts =
+    GhciSettings {
+        availableCommands = ghciCommands opts,
+        shortHelpText     = defShortHelpText,
+        defPrompt         = default_prompt,
+        defPromptCont     = default_prompt_cont,
+        fullHelpText      = defFullHelpText
+    }
+
+ghciWelcomeMsg :: String
+ghciWelcomeMsg = "Clashi, version " ++ Data.Version.showVersion Paths_clash_ghc.version ++
+                 " (using clash-lib, version " ++ Data.Version.showVersion clashLibVersion ++
+                 "):\nhttps://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,             completeBreakpoint),
+  ("back",      keepGoing backCmd,              noCompletion),
+  ("browse",    keepGoing' (browseCmd False),   completeModule),
+  ("browse!",   keepGoing' (browseCmd True),    completeModule),
+  ("cd",        keepGoingMulti' changeDirectory,     completeFilename),
+  ("check",     keepGoing' checkModule,         completeHomeModule),
+  ("continue",  keepGoing continueCmd,          noCompletion),
+  ("cmd",       keepGoing cmdCmd,               completeExpression),
+  ("def",       keepGoing (defineMacro False),  completeExpression),
+  ("def!",      keepGoing (defineMacro True),   completeExpression),
+  ("delete",    keepGoing deleteCmd,            noCompletion),
+  ("disable",   keepGoing disableCmd,           noCompletion),
+  ("doc",       keepGoing' docCmd,              completeIdentifier),
+  ("edit",      keepGoingMulti' editFile,            completeFilename),
+  ("enable",    keepGoing enableCmd,            noCompletion),
+  ("force",     keepGoing forceCmd,             completeExpression),
+  ("forward",   keepGoing forwardCmd,           noCompletion),
+  ("help",      keepGoingMulti help,                 noCompletion),
+  ("history",   keepGoingMulti historyCmd,           noCompletion),
+  ("info",      keepGoingMulti' (info False),        completeIdentifier),
+  ("info!",     keepGoingMulti' (info True),         completeIdentifier),
+  ("issafe",    keepGoing' isSafeCmd,           completeModule),
+  ("ignore",    keepGoing ignoreCmd,            noCompletion),
+  ("kind",      keepGoingMulti' (kindOfType False),  completeIdentifier),
+  ("kind!",     keepGoingMulti' (kindOfType True),   completeIdentifier),
+  ("load",      keepGoingPaths loadModule_,     completeHomeModuleOrFile),
+  ("load!",     keepGoingPaths loadModuleDefer, completeHomeModuleOrFile),
+  ("list",      keepGoing' listCmd,             noCompletion),
+  ("module",    keepGoing moduleCmd,            completeSetModule),
+  ("main",      keepGoing runMain,              completeFilename),
+  ("print",     keepGoing printCmd,             completeExpression),
+  ("quit",      quit,                           noCompletion),
+  ("reload",    keepGoingMulti' reloadModule,   noCompletion),
+  ("reload!",   keepGoingMulti' reloadModuleDefer,   noCompletion),
+  ("run",       keepGoing runRun,               completeFilename),
+  ("script",    keepGoing' scriptCmd,           completeFilename),
+  ("set",       keepGoingMulti setCmd,          completeSetOptions),
+  ("seti",      keepGoingMulti setiCmd,         completeSeti),
+  ("show",      keepGoingMulti' showCmd,        completeShowOptions),
+  ("showi",     keepGoing showiCmd,             completeShowiOptions),
+  ("sprint",    keepGoing sprintCmd,            completeExpression),
+  ("step",      keepGoing stepCmd,              completeIdentifier),
+  ("steplocal", keepGoing stepLocalCmd,         completeIdentifier),
+  ("stepmodule",keepGoing stepModuleCmd,        completeIdentifier),
+  ("type",      keepGoingMulti' typeOfExpr,          completeExpression),
+  ("trace",     keepGoing traceCmd,             completeExpression),
+  ("unadd",     keepGoingPaths unAddModule,     completeFilename),
+  ("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),
+  ("instances", keepGoing' instancesCmd,        completeExpression)
+  ] ++ 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
+
+word_break_chars_pred :: Char -> Bool
+word_break_chars_pred '.' = False
+word_break_chars_pred c = c `elem` (spaces ++ specials) || isSymbolChar c
+
+symbols, specials, spaces :: String
+symbols = "!#$%&*+/<=>?@\\^|-~"
+specials = "(),;[]`{}"
+spaces = " \t\n"
+
+flagWordBreakChars :: String
+flagWordBreakChars = " \t\n"
+
+
+showSDocForUser' :: GHC.GhcMonad m => SDoc -> m String
+showSDocForUser' doc = do
+    dflags <- getDynFlags
+    unit_state <- hsc_units <$> GHC.getSession
+    name_ppr_ctx <- GHC.getNamePprCtx
+    pure $ showSDocForUser dflags unit_state name_ppr_ctx doc
+
+showSDocForUserQualify :: GHC.GhcMonad m => SDoc -> m String
+showSDocForUserQualify doc = do
+    dflags <- getDynFlags
+    unit_state <- hsc_units <$> GHC.getSession
+    pure $ showSDocForUser dflags unit_state alwaysQualify doc
+
+
+keepGoing :: (String -> GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
+keepGoing a str = keepGoing' (lift . a) str
+
+keepGoingMulti :: (String -> GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
+keepGoingMulti a str = keepGoingMulti' (lift . a) str
+
+keepGoing' :: GhciMonad m => (a -> m ()) -> a -> m CmdExecOutcome
+keepGoing' a str = do
+  in_multi <- inMultiMode
+  if in_multi
+    then
+      liftIO $ hPutStrLn stderr "Command is not supported (yet) in multi-mode"
+    else
+      a str
+  return CmdSuccess
+
+-- For commands which are actually support in multi-mode, initially just :reload
+keepGoingMulti' :: GhciMonad m => (String -> m ()) -> String -> m CmdExecOutcome
+keepGoingMulti' a str = a str >> return CmdSuccess
+
+inMultiMode :: GhciMonad m => m Bool
+inMultiMode = multiMode <$> getGHCiState
+
+keepGoingPaths :: ([FilePath] -> InputT GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
+keepGoingPaths a str
+ = do case toArgsNoLoc str of
+          Left err -> liftIO $ hPutStrLn stderr err >> return CmdSuccess
+          Right args -> keepGoing' a args
+
+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" ++
+  "   :def[!] <cmd> <expr>        define command :<cmd> (later defined command has\n" ++
+  "                               precedence, ::<cmd> is always a builtin command)\n" ++
+  "                               (!: redefine an existing command name)\n" ++
+  "   :doc <name>                 display docs for the given name (experimental)\n" ++
+  "   :edit <file>                edit file\n" ++
+  "   :edit                       edit last module\n" ++
+  "   :help, :?                   display this list of commands\n" ++
+  "   :info[!] [<name> ...]       display information about the given names\n" ++
+  "                               (!: do not filter instances)\n" ++
+  "   :instances <type>           display the class instances available for <type>\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" ++
+  "   :type +d <expr>             show the type of <expr>, defaulting type variables\n" ++
+  "   :unadd <module> ...         remove module(s) from the current target set\n" ++
+  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
+  "   ::<cmd>                     run the builtin command\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 [<count>]         resume after a breakpoint [and set break ignore count]\n" ++
+  "   :delete <number> ...        delete the specified breakpoints\n" ++
+  "   :delete *                   delete all breakpoints\n" ++
+  "   :disable <number> ...       disable the specified breakpoints\n" ++
+  "   :disable *                  disable all breakpoints\n" ++
+  "   :enable <number> ...        enable the specified breakpoints\n" ++
+  "   :enable *                   enable 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" ++
+  "   :ignore <breaknum> <count>  for break <breaknum> set break ignore <count>\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 local-config { source | ignore }\n" ++
+  "                               set whether to source .ghci in current dir\n" ++
+  "                               (loading untrusted config is a security issue)\n" ++
+  "   :set args <arg> ...         set the arguments returned by System.Environment.getArgs\n" ++
+  "   :set prog <progname>        set the value returned by System.Environment.getProgName\n" ++
+  "   :set prompt <prompt>        set the prompt used in GHCi\n" ++
+  "   :set prompt-cont <prompt>   set the continuation prompt used in GHCi\n" ++
+  "   :set prompt-function <expr> set the function to handle the prompt\n" ++
+  "   :set prompt-cont-function <expr>\n" ++
+  "                               set the function to handle the continuation prompt\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 targets               show the current set of targets\n" ++
+  "   :show <setting>             show value of <setting>, which is one of\n" ++
+  "                                  [args, prog, editor, stop]\n" ++
+  "   :showi language             show language flags for interactive evaluation\n" ++
+  "\n" ++
+  " The User's Guide has more information. An online copy can be found here:\n" ++
+  "\n" ++
+  "   https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html\n" ++
+  "\n"
+
+findEditor :: IO String
+findEditor = do
+    getEnv "VISUAL" <|> getEnv "EDITOR" <|> defaultEditor
+  where
+    defaultEditor = do
+#if defined(mingw32_HOST_OS)
+      win <- System.Win32.getWindowsDirectory
+      return (win </> "notepad.exe")
+#else
+      return ""
+#endif
+
+default_progname, default_stop :: String
+default_progname = "<interactive>"
+default_stop = ""
+
+default_prompt, default_prompt_cont :: PromptFunction
+default_prompt = generatePromptFunctionFromString "clashi> "
+default_prompt_cont = generatePromptFunctionFromString "clashi| "
+
+default_args :: [String]
+default_args = []
+
+interactiveUI :: GhciSettings -> [(FilePath, Maybe UnitId, Maybe Phase)] -> Maybe [String]
+              -> Ghc ()
+interactiveUI config srcs maybe_exprs = do
+   -- This is a HACK to make sure dynflags are not overwritten when setting
+   -- options. When GHCi is made properly multi component it should be removed.
+   modifySession (\env -> hscSetActiveUnitId (hscActiveUnitId env) env)
+   -- 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) <- runInternal initInterpBuffering
+
+   -- The initial set of DynFlags used for interactive evaluation is the same
+   -- as the global DynFlags, plus -XExtendedDefaultRules and
+   -- -XNoMonomorphismRestriction.
+   -- See Note [Changing language extensions for interactive evaluation] #10857
+   dflags <- getDynFlags
+   let dflags' = (xopt_set_unlessExplSpec
+                      LangExt.ExtendedDefaultRules xopt_set)
+               . (xopt_set_unlessExplSpec
+                      LangExt.MonomorphismRestriction xopt_unset)
+               $ dflags
+   GHC.setInteractiveDynFlags dflags'
+   _ <- GHC.setProgramDynFlags
+               -- Set Opt_KeepGoing so that :reload loads as much as
+               -- possible
+               (gopt_set dflags Opt_KeepGoing)
+
+   -- Update the LogAction. Ensure we don't override the user's log action lest
+   -- we break -ddump-json (#14078)
+   lastErrLocationsRef <- liftIO $ newIORef []
+   pushLogHookM (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
+   let prelude_import =
+         case simpleImportDecl preludeModuleName of
+           -- Set to True because Prelude is implicitly imported.
+           impDecl@ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}}
+   hsc_env <- GHC.getSession
+   let in_multi = length (hsc_all_home_unit_ids hsc_env) > 1
+   empty_cache <- liftIO newIfaceCache
+   startGHCi (runGHCi srcs maybe_exprs)
+        GHCiState{ progname           = default_progname,
+                   args               = default_args,
+                   evalWrapper        = eval_wrapper,
+                   prompt             = defPrompt config,
+                   prompt_cont        = defPromptCont config,
+                   stop               = default_stop,
+                   editor             = default_editor,
+                   options            = [],
+                   multiMode          = in_multi,
+                   localConfig        = SourceLocalConfig,
+                   -- 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             = IntMap.empty,
+                   tickarrays         = emptyModuleEnv,
+                   ghci_commands      = availableCommands config,
+                   ghci_macros        = [],
+                   last_command       = Nothing,
+                   cmd_wrapper        = (cmdSuccess =<<),
+                   cmdqueue           = [],
+                   remembered_ctx     = [],
+                   transient_ctx      = [],
+                   extra_imports      = [],
+                   prelude_imports    = [prelude_import],
+                   ghc_e              = isJust maybe_exprs,
+                   short_help         = shortHelpText config,
+                   long_help          = fullHelpText config,
+                   lastErrorLocations = lastErrLocationsRef,
+                   mod_infos          = M.empty,
+                   flushStdHandles    = flush,
+                   noBuffering        = nobuffering,
+                   ifaceCache = empty_cache
+                 }
+
+   return ()
+
+{-
+Note [Changing language extensions for interactive evaluation]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+GHCi maintains two sets of options:
+
+- The "loading options" apply when loading modules
+- The "interactive options" apply when evaluating expressions and commands
+    typed at the GHCi prompt.
+
+The loading options are mostly created in ghc/Main.hs:main' from the command
+line flags. In the function ghc/GHCi/UI.hs:interactiveUI the loading options
+are copied to the interactive options.
+
+These interactive options (but not the loading options!) are supplemented
+unconditionally by setting ExtendedDefaultRules ON and
+MonomorphismRestriction OFF. The unconditional setting of these options
+eventually overwrite settings already specified at the command line.
+
+Therefore instead of unconditionally setting ExtendedDefaultRules and
+NoMonomorphismRestriction for the interactive options, we use the function
+'xopt_set_unlessExplSpec' to first check whether the extension has already
+specified at the command line.
+
+The ghci config file has not yet been processed.
+-}
+
+resetLastErrorLocations :: GhciMonad m => m ()
+resetLastErrorLocations = do
+    st <- getGHCiState
+    liftIO $ writeIORef (lastErrorLocations st) []
+
+ghciLogAction :: IORef [(FastString, Int)] -> LogAction -> LogAction
+ghciLogAction lastErrLocations old_log_action
+              dflags msg_class srcSpan msg = do
+    old_log_action dflags msg_class srcSpan msg
+    case msg_class of
+        MCDiagnostic SevError _reason _code -> case srcSpan of
+            RealSrcSpan rsp _ -> modifyIORef lastErrLocations
+                (++ [(srcLocFile (realSrcSpanStart rsp), srcLocLine (realSrcSpanStart rsp))])
+            _ -> return ()
+        _ -> return ()
+
+-- | Takes a file name and prefixes it with the appropriate GHC appdir.
+-- ~/.ghc (getAppUserDataDirectory) is used if it exists, or XDG directories
+-- are used to respect the XDG specification.
+-- As a migration strategy, currently we will only create new directories in
+-- the appropriate XDG location.
+getAppDataFile :: XdgDirectory -> FilePath -> IO (Maybe FilePath)
+getAppDataFile xdgDir file = do
+  xdgAppDir <-
+    tryIO (getXdgDirectory xdgDir "clash") >>= \case
+      Left _ -> pure Nothing
+      Right dir -> flip catchIO (const $ pure Nothing) $ do
+        createDirectoryIfMissing False dir
+        pure $ Just dir
+  appDir <-
+    tryIO (getAppUserDataDirectory "clash") >>= \case
+      Right dir ->
+        doesDirectoryExist dir >>= \case
+          True -> pure $ Just dir
+          False -> pure xdgAppDir
+      Left _ -> pure xdgAppDir
+  pure $ appDir >>= \dir -> Just $ dir </> file
+
+
+runGHCi :: [(FilePath, Maybe UnitId, Maybe Phase)] -> Maybe [String] -> GHCi ()
+runGHCi paths maybe_exprs = do
+  dflags <- getDynFlags
+  let
+   ignore_dot_ghci = gopt Opt_IgnoreDotGhci dflags
+
+   appDataCfg = liftIO $ getAppDataFile XdgConfig "clashi.conf"
+
+   homeCfg = do
+    liftIO $ tryIO (getEnv "HOME") >>= \case
+      Right home -> pure $ Just $ home </> ".clashi"
+      _ -> pure 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
+
+  processedCfgs <- if ignore_dot_ghci
+    then pure []
+    else do
+      userCfgs <- do
+        paths <- catMaybes <$> sequence [ appDataCfg, homeCfg ]
+        checkedPaths <- liftIO $ filterM checkFileAndDirPerms paths
+        liftIO . fmap (nub . catMaybes) $ mapM canonicalizePath' checkedPaths
+
+      localCfg <- do
+        let path = ".clashi"
+        ok <- liftIO $ checkFileAndDirPerms path
+        if ok then liftIO $ canonicalizePath' path else pure Nothing
+
+      mapM_ sourceConfigFile userCfgs
+        -- Process the global and user .ghci
+        -- (but not $CWD/.ghci or CLI args, yet)
+
+      behaviour <- localConfig <$> getGHCiState
+
+      processedLocalCfg <- case localCfg of
+        Just path | path `notElem` userCfgs ->
+          -- don't read .ghci twice if CWD is $HOME
+          case behaviour of
+            SourceLocalConfig -> localCfg <$ sourceConfigFile path
+            IgnoreLocalConfig -> pure Nothing
+        _ -> pure Nothing
+
+      pure $ maybe id (:) processedLocalCfg userCfgs
+
+  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 arg_cfgs \\ processedCfgs
+    -- Dedup, and remove any configs we already processed.
+    -- Importantly, if $PWD/.ghci was ignored due to configuration,
+    -- explicitly specifying it does cause it to be processed.
+
+  -- Perform a :reload for files given on the GHCi command line
+  -- The appropriate targets will already be set
+  -- 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) $
+                    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
+            -- Set different defaulting rules (See #280)
+            runGHCiExpressions
+              ["default ((), [], Prelude.Integer, Prelude.Int, Prelude.Double, Prelude.String)"]
+
+            -- enter the interactive loop
+            runGHCiInput $ runCommands $ nextInputLine show_prompt is_tty
+        Just exprs -> do
+            -- just evaluate the expression we were given
+            runGHCiExpressions exprs
+
+  -- and finally, exit
+  liftIO $ when (verbosity dflags > 0) $ putStrLn "Leaving Clashi."
+
+runGHCiExpressions :: [String] -> GHCi ()
+runGHCiExpressions exprs = do
+            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 failure, see #7962, #9916, #17560, #18441
+                _ <- runCommands' hdle
+                     (Just $ hdle (toException $ ExitFailure 1) >> return ())
+                     (return Nothing)
+                return ()
+
+runGHCiInput :: InputT GHCi a -> GHCi a
+runGHCiInput f = do
+    dflags <- getDynFlags
+    let ghciHistory = gopt Opt_GhciHistory dflags
+    let localGhciHistory = gopt Opt_LocalGhciHistory dflags
+    currentDirectory <- liftIO getCurrentDirectory
+
+    histFile <- case (ghciHistory, localGhciHistory) of
+      (True, True) -> pure $ Just $ currentDirectory </> ".clashi_history"
+      (True, _) -> liftIO $ getAppDataFile XdgData "clashi_history"
+      _ -> pure 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
+#if defined(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 :: GhciMonad m => m ()
+incrementLineNo = modifyGHCiState incLineNo
+  where
+    incLineNo st = st { line_number = line_number st + 1 }
+
+fileLoop :: GhciMonad m => Handle -> m (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')
+
+formatCurrentTime :: String -> IO String
+formatCurrentTime format =
+  getZonedTime >>= return . (formatTime defaultTimeLocale format)
+
+getUserName :: IO String
+getUserName = do
+#if defined(mingw32_HOST_OS)
+  getEnv "USERNAME"
+    `catchIO` \e -> do
+      putStrLn $ show e
+      return ""
+#else
+  getLoginName
+#endif
+
+getInfoForPrompt :: GhciMonad m => m (SDoc, [String], Int)
+getInfoForPrompt = 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
+
+        myIdeclName d | Just m <- ideclAs d = unLoc m
+                      | otherwise           = unLoc (ideclName d)
+
+        modules_names =
+             ['*':(moduleNameString m) | IIModule m <- rev_imports] ++
+             [moduleNameString (myIdeclName d) | IIDecl d <- rev_imports]
+        line = 1 + line_number st
+
+  return (dots <> context_bit, modules_names, line)
+
+-- | Takes a string, presumably following "%call", and tries to parse
+-- a command and arguments in parentheses:
+--
+-- > parseCallEscape "  (cmd arg1 arg2)rest" = Just ("cmd" :| ["arg1", "arg2"], "rest")
+-- > parseCallEscape "( )rest" = Nothing
+--
+parseCallEscape :: String -> Maybe (NE.NonEmpty String, String)
+parseCallEscape s = case dropWhile isSpace s of
+  '(' : sinceOpen -> case span (/= ')') sinceOpen of
+    (call, ')' : sinceClosed)
+      | cmd : args <- words call -> Just (cmd NE.:| args, sinceClosed)
+    _ -> Nothing
+  _ -> Nothing
+
+checkPromptStringForErrors :: String -> Maybe String
+checkPromptStringForErrors ('%':'c':'a':'l':'l':xs) =
+  case parseCallEscape xs of
+    Nothing  -> Just ("Incorrect %call syntax. " ++
+                      "Should be %call(a command and arguments).")
+    Just (_, afterClosed) -> checkPromptStringForErrors afterClosed
+checkPromptStringForErrors ('%':'%':xs) = checkPromptStringForErrors xs
+checkPromptStringForErrors (_:xs) = checkPromptStringForErrors xs
+checkPromptStringForErrors "" = Nothing
+
+generatePromptFunctionFromString :: String -> PromptFunction
+generatePromptFunctionFromString promptS modules_names line =
+        processString promptS
+  where
+        processString :: String -> GHCi SDoc
+        processString ('%':'s':xs) =
+            liftM2 (<>) (return modules_list) (processString xs)
+            where
+              modules_list = hsep . map text . ordNub $ modules_names
+        processString ('%':'l':xs) =
+            liftM2 (<>) (return $ ppr line) (processString xs)
+        processString ('%':'d':xs) =
+            liftM2 (<>) (liftM text formatted_time) (processString xs)
+            where
+              formatted_time = liftIO $ formatCurrentTime "%a %b %d"
+        processString ('%':'t':xs) =
+            liftM2 (<>) (liftM text formatted_time) (processString xs)
+            where
+              formatted_time = liftIO $ formatCurrentTime "%H:%M:%S"
+        processString ('%':'T':xs) = do
+            liftM2 (<>) (liftM text formatted_time) (processString xs)
+            where
+              formatted_time = liftIO $ formatCurrentTime "%I:%M:%S"
+        processString ('%':'@':xs) = do
+            liftM2 (<>) (liftM text formatted_time) (processString xs)
+            where
+              formatted_time = liftIO $ formatCurrentTime "%I:%M %P"
+        processString ('%':'A':xs) = do
+            liftM2 (<>) (liftM text formatted_time) (processString xs)
+            where
+              formatted_time = liftIO $ formatCurrentTime "%H:%M"
+        processString ('%':'u':xs) =
+            liftM2 (<>) (liftM text user_name) (processString xs)
+            where
+              user_name = liftIO $ getUserName
+        processString ('%':'w':xs) =
+            liftM2 (<>) (liftM text current_directory) (processString xs)
+            where
+              current_directory = liftIO $ getCurrentDirectory
+        processString ('%':'o':xs) =
+            liftM ((text os) <>) (processString xs)
+        processString ('%':'a':xs) =
+            liftM ((text arch) <>) (processString xs)
+        processString ('%':'N':xs) =
+            liftM ((text compilerName) <>) (processString xs)
+        processString ('%':'V':xs) =
+            liftM ((text $ showVersion compilerVersion) <>) (processString xs)
+        processString ('%':'c':'a':'l':'l':xs) = do
+            -- Input has just been validated by parseCallEscape
+            let (cmd NE.:| args, afterClosed) = fromJust $ parseCallEscape xs
+            respond <- liftIO $ do
+                (code, out, err) <-
+                    readProcessWithExitCode
+                    cmd args ""
+                    `catchIO` \e -> return (ExitFailure 1, "", show e)
+                case code of
+                    ExitSuccess -> return out
+                    _ -> do
+                        hPutStrLn stderr err
+                        return ""
+            liftM ((text respond) <>) (processString afterClosed)
+        processString ('%':'%':xs) =
+            liftM ((char '%') <>) (processString xs)
+        processString (x:xs) =
+            liftM (char x <>) (processString xs)
+        processString "" =
+            return empty
+
+mkPrompt :: GHCi String
+mkPrompt = do
+  st <- getGHCiState
+  dflags <- getDynFlags
+  (context, modules_names, line) <- getInfoForPrompt
+
+  prompt_string <- (prompt st) modules_names line
+  let prompt_doc = context <> prompt_string
+
+  return (showSDoc dflags prompt_doc)
+
+queryQueue :: GhciMonad m => m (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 :: GhciMonad m => Maybe String -> Bool -> m ()
+installInteractivePrint Nothing _  = return ()
+installInteractivePrint (Just ipFun) exprmode = do
+  ok <- trySuccess $ do
+                name NE.:| _ <- 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 ()
+runCommands' eh sourceErrorHandler gCmd = mask $ \unmask -> do
+    b <- handle (\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 ()
+      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 command was unsuccessful. GHCi will continue in either case.
+-- TODO: replace Bool with CmdExecOutcome
+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  -> do
+      st <- getGHCiState
+      ghciHandle (\e -> lift $ eh e >>= return . Just) $
+        handleSourceError printErrorAndFail $
+          cmd_wrapper st $ doCommand c
+               -- source error's are handled by runStmt
+               -- is the handler necessary here?
+  where
+    printErrorAndFail err = do
+        printGhciException 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 = prompt_cont st }
+      mb_cmd <- collectCommand q "" `MC.finally`
+                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 :{ .. :}"
+
+    cmdOutcome :: CmdExecOutcome -> Maybe Bool
+    cmdOutcome CleanExit = Nothing
+    cmdOutcome CmdSuccess = Just True
+    cmdOutcome CmdFailure = Just False
+
+    -- | Handle a line of input
+    doCommand :: String -> InputT GHCi CommandResult
+
+    -- command
+    doCommand stmt | stmt'@(':' : cmd) <- removeSpaces stmt = do
+      (stats, result) <- runWithStats (const Nothing) $ specialCommand cmd
+      return $ CommandComplete stmt' (cmdOutcome <$> result) stats
+
+    -- 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 CommandIncomplete
+            Just ml_stmt -> do
+              -- temporarily compensate line-number for multi-line input
+              (stats, result) <- runAndPrintStats runAllocs $ lift $
+                runStmtWithLineNum fst_line_num ml_stmt GHC.RunToCompletion
+              return $
+                CommandComplete ml_stmt (Just . runSuccess <$> result) stats
+        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
+          (stats, result) <- runAndPrintStats runAllocs $ lift $
+            runStmtWithLineNum fst_line_num stmt' GHC.RunToCompletion
+          return $ CommandComplete stmt' (Just . runSuccess <$> result) stats
+
+    -- 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
+  :: GhciMonad m => String -> m (Maybe String) -> m (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.initParserState (initParserOpts 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 = prompt_cont 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 :: GhciMonad m => [String] -> m ()
+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 :: GhciMonad m => String -> SingleStep -> m (Maybe GHC.ExecResult)
+runStmt input step = do
+  pflags <- initParserOpts <$> GHC.getInteractiveDynFlags
+  -- In GHCi, we disable `-fdefer-type-errors`, as well as `-fdefer-type-holes`
+  -- and `-fdefer-out-of-scope-variables` for **naked expressions**. The
+  -- declarations and statements are not affected.
+  -- See Note [Deferred type errors in GHCi] in GHC.Tc.Module
+  st <- getGHCiState
+  let source = progname st
+  let line = line_number st
+
+  -- Add any LANGUAGE/OPTIONS_GHC pragmas we find find.
+  set_pragmas pflags
+
+  if | GHC.isStmt pflags input -> do
+         hsc_env <- GHC.getSession
+         mb_stmt <- liftIO (runInteractiveHsc hsc_env (hscParseStmtWithLocation source line input))
+         case mb_stmt of
+           Nothing ->
+             -- empty statement / comment
+             return (Just exec_complete)
+           Just stmt ->
+             run_stmt stmt
+
+     -- Otherwise assume a declaration (or a list of declarations)
+     -- and/or import(s) (#20473).
+     -- Note: `GHC.isDecl` returns False on input like
+     -- `data Infix a b = a :@: b; infixl 4 :@:`
+     -- and should therefore not be used here.
+     | otherwise -> do
+         hsc_env <- GHC.getSession
+         let !ic = hsc_IC hsc_env  -- Bang-pattern to avoid space leaks
+         setDumpFilePrefix ic
+           -- `-ddump-to-file` must work for normal GHCi compilations /
+           --     evaluations. (#17500)
+         -- Use >>= \case instead of MonadFail desugaring to take into
+         -- consideration `instance XXModule p = DataConCantHappen`.
+         -- Tracked in #15681
+         liftIO (hscParseModuleWithLocation hsc_env source line input) >>= \case
+           HsModule { hsmodDecls = decls, hsmodImports = imports } -> do
+             run_imports imports
+             run_decls decls
+  where
+    exec_complete = GHC.ExecComplete (Right []) 0
+
+    run_imports imports = mapM_ (addImportToContext . unLoc) imports
+
+    set_pragmas pflags =
+      let stringbuf = stringToStringBuffer input
+          (_msgs, loc_opts) = Header.getOptions pflags stringbuf "<interactive>"
+          opts = unLoc <$> loc_opts
+      in setOptions opts
+
+    run_stmt :: GhciMonad m => GhciLStmt GhcPs -> m (Maybe GHC.ExecResult)
+    run_stmt stmt = do
+           m_result <- GhciMonad.runStmt stmt input step
+           case m_result of
+               Nothing     -> return Nothing
+               Just result -> Just <$> afterRunStmt (const True) result
+
+    -- `x = y` (a declaration) should be treated as `let x = y` (a statement).
+    -- The reason is because GHCi wasn't designed to support `x = y`, but then
+    -- b98ff3 (#7253) added support for it, except it did not do a good job and
+    -- caused problems like:
+    --
+    --  - not adding the binders defined this way in the necessary places caused
+    --    `x = y` to not work in some cases (#12091).
+    --  - some GHCi command crashed after `x = y` (#15721)
+    --  - warning generation did not work for `x = y` (#11606)
+    --  - because `x = y` is a declaration (instead of a statement) differences
+    --    in generated code caused confusion (#16089)
+    --
+    -- Instead of dealing with all these problems individually here we fix this
+    -- mess by just treating `x = y` as `let x = y`.
+    run_decls :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe GHC.ExecResult)
+    -- Only turn `FunBind` and `VarBind` into statements, other bindings
+    -- (e.g. `PatBind`) need to stay as decls.
+    run_decls [L l (ValD _ bind@FunBind{})] = run_stmt (mk_stmt (locA l) bind)
+    run_decls [L l (ValD _ bind@VarBind{})] = run_stmt (mk_stmt (locA l) bind)
+    -- Note that any `x = y` declarations below will be run as declarations
+    -- instead of statements (e.g. `...; x = y; ...`)
+    run_decls decls = 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.runDecls' decls
+      forM m_result $ \result ->
+        afterRunStmt (const True) (GHC.ExecComplete (Right result) 0)
+
+    mk_stmt :: SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs
+    mk_stmt loc bind =
+      let
+        la  = L (noAnnSrcSpan loc)
+        la' = L (noAnnSrcSpan loc)
+      in la (LetStmt noAnn (HsValBinds noAnn (ValBinds NoAnnSortKey (unitBag (la' bind)) [])))
+
+    setDumpFilePrefix :: GHC.GhcMonad m => InteractiveContext -> m () -- #17500
+    setDumpFilePrefix ic = do
+        dflags <- GHC.getInteractiveDynFlags
+        GHC.setInteractiveDynFlags dflags { dumpPrefix = modStr ++ "." }
+      where
+        modStr = moduleNameString $ moduleName $ icInteractiveModule $ ic
+
+-- | Clean up the GHCi environment after a statement has run
+afterRunStmt :: GhciMonad m
+             => (SrcSpan -> Bool) -> GHC.ExecResult -> m 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
+         | first_resume : _ <- resumes
+         , isNothing  mb_info ||
+           step_here (GHC.resumeSpan first_resume) -> do
+               mb_id_loc <- toBreakIdAndLocation mb_info
+               let bCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc
+               if (null bCmd)
+                 then printStoppedAtBreakInfo first_resume names
+                 else enqueueCommands [bCmd]
+               -- run the command set with ":set stop <cmd>"
+               st <- getGHCiState
+               enqueueCommands [stop st]
+               return ()
+         | otherwise -> resume step_here GHC.SingleStep Nothing >>=
+                        afterRunStmt step_here >> return ()
+
+  flushInterpBuffers
+  withSignalHandlers $ do
+     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 :: GhciMonad m
+                     => Maybe GHC.InternalBreakpointId -> m (Maybe (Int, BreakLocation))
+toBreakIdAndLocation Nothing = return Nothing
+toBreakIdAndLocation (Just inf) = do
+  st <- getGHCiState
+  return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
+                                  breakModule loc == ibi_tick_mod inf,
+                                  breakTick loc == ibi_tick_index inf ]
+
+printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
+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 :: GHC.GhcMonad m => [Name] -> m ()
+printTypeOfNames names
+ = mapM_ (printTypeOfName ) $ sortBy compareNames names
+
+compareNames :: Name -> Name -> Ordering
+compareNames = on compare getOccString S.<> on SrcLoc.leftmost_smallest getSrcSpan
+
+printTypeOfName :: GHC.GhcMonad m => Name -> m ()
+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 CmdExecOutcome
+specialCommand ('!':str) = lift $ shellEscape (dropWhile isSpace str)
+specialCommand str = do
+  let (cmd,rest) = break isSpace str
+  maybe_cmd <- lookupCommand cmd
+  htxt <- short_help <$> getGHCiState
+  case maybe_cmd of
+    GotCommand cmd -> (cmdAction cmd) (dropWhile isSpace rest)
+    BadCommand ->
+      do liftIO $ hPutStr stderr ("unknown command ':" ++ cmd ++ "'\n"
+                           ++ htxt)
+         return CmdFailure
+    NoLastCommand ->
+      do liftIO $ hPutStr stderr ("there is no last command to perform\n"
+                           ++ htxt)
+         return CmdFailure
+
+shellEscape :: MonadIO m => String -> m CmdExecOutcome
+shellEscape str = liftIO $ do
+  exitCode <- system str
+  case exitCode of
+    ExitSuccess -> return CmdSuccess
+    ExitFailure _ -> return CmdFailure
+
+lookupCommand :: GhciMonad m => String -> m (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' :: GhciMonad m => String -> m (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 `isPrefixOptOf`) . 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
+
+-- This predicate is for prefix match with a command-body and
+-- suffix match with an option, such as `!`.
+-- The current implementation assumes only the `!` character
+-- as the option delimiter.
+-- See also #17345
+isPrefixOptOf :: String -> String -> Bool
+isPrefixOptOf s x = let (body, opt) = break (== '!') s
+                    in  (body `isPrefixOf` x) && (opt `isSuffixOf` x)
+
+getCurrentBreakSpan :: GHC.GhcMonad m => m (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 :: GHC.GhcMonad m => m (Maybe [String])
+getCallStackAtCurrentBreakpoint = do
+  resumes <- GHC.getResumeContext
+  case resumes of
+    [] -> return Nothing
+    (r:_) -> do
+       interp <- hscInterp <$> GHC.getSession
+       Just <$> liftIO (costCentreStackInfo interp (GHC.resumeCCS r))
+
+getCurrentBreakModule :: GHC.GhcMonad m => m (Maybe Module)
+getCurrentBreakModule = do
+  resumes <- GHC.getResumeContext
+  return $ case resumes of
+    [] -> Nothing
+    (r:_) -> case GHC.resumeHistoryIx r of
+      0  -> ibi_tick_mod <$> GHC.resumeBreakpointId r
+      ix -> Just $ GHC.getHistoryModule $ GHC.resumeHistory r !! (ix-1)
+
+-----------------------------------------------------------------------------
+--
+-- Commands
+--
+-----------------------------------------------------------------------------
+
+noArgs :: MonadIO m => m () -> String -> m ()
+noArgs m "" = m
+noArgs _ _  = liftIO $ putStrLn "This command takes no arguments"
+
+withSandboxOnly :: GHC.GhcMonad m => String -> m () -> m ()
+withSandboxOnly cmd this = do
+   dflags <- getDynFlags
+   if not (gopt Opt_GhciSandbox dflags)
+      then printForUser (text cmd <+>
+                         text "is not supported with -fno-ghci-sandbox")
+      else this
+
+-----------------------------------------------------------------------------
+-- :help
+
+help :: GhciMonad m => String -> m ()
+help _ = do
+    txt <- long_help `fmap` getGHCiState
+    liftIO $ putStr txt
+
+-----------------------------------------------------------------------------
+-- :info
+
+info :: GHC.GhcMonad m => Bool -> String -> m ()
+info _ "" = throwGhcException (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
+info allInfo s  = handleSourceError printGhciException $ do
+    forM_ (words s) $ \thing -> do
+      sdoc <- infoThing allInfo thing
+      rendered <- showSDocForUser' sdoc
+      liftIO (putStrLn rendered)
+
+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,_sd) -> t)
+                                     (catMaybes (NE.toList 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) -> SDoc
+pprInfo (thing, fixity, cls_insts, fam_insts, docs)
+  =  docs
+  $$ pprTyThingInContextLoc thing
+  $$ showFixity thing fixity
+  $$ vcat (map GHC.pprInstance cls_insts)
+  $$ vcat (map GHC.pprFamInst  fam_insts)
+
+-----------------------------------------------------------------------------
+-- :main
+
+runMain :: GhciMonad m => String -> m ()
+runMain s = case toArgsNoLoc s of
+              Left err   -> liftIO (hPutStrLn stderr err)
+              Right args -> doWithMain (doWithArgs args)
+  where
+    doWithMain fun = do
+      dflags  <- getDynFlags
+      let main = fromMaybe "main" (mainFunIs dflags)
+      handleSourceError printErrAndMaybeExit $ do
+        -- doing this will prevent the main to run when it is not in scope
+        -- this might seem useless, but it doesn't suggest other functions
+        -- to be used, which is exactly what we want here. See #23996.
+        _ <- GHC.parseName main
+
+        -- Wrap the main function in 'void' to discard its value instead
+        -- of printing it (#9086). See Haskell 2010 report Chapter 5.
+        fun $ "Control.Monad.void (" ++ main ++ ")"
+
+
+
+
+-----------------------------------------------------------------------------
+-- :run
+
+runRun :: GhciMonad m => String -> m ()
+runRun s = case toCmdArgs s of
+           Left err          -> liftIO (hPutStrLn stderr err)
+           Right (cmd, args) -> doWithArgs args cmd
+
+doWithArgs :: GhciMonad m => [String] -> String -> m ()
+doWithArgs args cmd = enqueueCommands ["System.Environment.withArgs " ++
+                                       show args ++ " (" ++ cmd ++ ")"]
+
+{-
+Akin to @Prelude.words@, but acts like the Bourne shell, treating
+quoted strings as Haskell Strings, and also parses Haskell [String]
+syntax.
+-}
+
+getCmd :: String -> Either String             -- Error
+                           (String, String) -- (Cmd, Rest)
+getCmd s = case break isSpace $ dropWhile isSpace s of
+           ([], _) -> Left ("Couldn't find command in " ++ show s)
+           res -> Right res
+
+toCmdArgs :: String -> Either String             -- Error
+                              (String, [String]) -- (Cmd, Args)
+toCmdArgs s = case getCmd s of
+              Left err -> Left err
+              Right (cmd, s') -> case toArgsNoLoc s' of
+                                 Left err -> Left err
+                                 Right args -> Right (cmd, args)
+
+-- wrapper around GHC.Parser.Header.toArgs, but without locations
+toArgsNoLoc :: String -> Either String [String]
+toArgsNoLoc str = map unLoc <$> toArgs fake_loc str
+  where
+    fake_loc = mkRealSrcLoc (fsLit "<interactive>") 1 1
+    -- this should never be seen, because it's discarded with the `map unLoc`
+
+-----------------------------------------------------------------------------
+-- :cd
+
+changeDirectory :: GhciMonad m => String -> m ()
+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 $ GHC.mgModSummaries graph)) $
+        liftIO $ putStrLn "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed."
+  -- delete defined breakpoints and clear the interface file cache (#1620)
+  clearCaches
+  setContextAfterLoad False Nothing
+  GHC.workingDirectoryChanged
+  dir' <- expandPath dir
+  liftIO $ setCurrentDirectory dir'
+  -- With -fexternal-interpreter, we have to change the directory of the subprocess too.
+  -- (this gives consistent behaviour with and without -fexternal-interpreter)
+  interp <- hscInterp <$> GHC.getSession
+  case interpInstance interp of
+    ExternalInterp {} -> do
+      fhv <- compileGHCiExpr $
+        "System.Directory.setCurrentDirectory " ++ show dir'
+      liftIO $ evalIO interp fhv
+    _ -> pure ()
+
+trySuccess :: GhciMonad m => m SuccessFlag -> m SuccessFlag
+trySuccess act =
+    handleSourceError (\e -> do printErrAndMaybeExit e -- immediately exit fith failure if in ghc -e
+                                pure Failed) act
+
+-----------------------------------------------------------------------------
+-- :edit
+
+editFile :: GhciMonad m => String -> m ()
+editFile str =
+  do file <- if null str then 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 ""
+
+-- 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 dependency 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 occurred during the
+-- last load/reaload, then we could start the editor focused on the first
+-- of those.
+chooseEditFile :: GHC.GhcMonad m => m String
+chooseEditFile =
+  do let hasFailed (GHC.ModuleNode _deps x) = fmap not $ isLoadedModSummary x
+         hasFailed _ = return False
+
+     graph <- GHC.getModuleGraph
+     failed_graph <-
+       GHC.mkModuleGraph <$> filterM hasFailed (GHC.mgModSummaries' graph)
+     let order g  = flattenSCCs $ filterToposortToModules $
+           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 { targetId = GHC.TargetFile f _ } = Just f
+        fromTarget _ = Nothing -- when would we get a module target?
+
+
+-----------------------------------------------------------------------------
+-- :def
+
+defineMacro :: GhciMonad m => Bool{-overwrite-} -> String -> m ()
+defineMacro _ (':':_) = (liftIO $ hPutStrLn stderr
+                          "macro name cannot start with a colon")
+                            >> failIfExprEvalMode
+defineMacro _ ('!':_) = (liftIO $ hPutStrLn stderr
+                          "macro name cannot start with an exclamation mark")
+                            >> failIfExprEvalMode
+                          -- little code duplication allows to grep error msg
+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
+    isCommand <- isJust <$> lookupCommand' macro_name
+    let check_newname
+          | macro_name `elem` defined = throwGhcException (CmdLineError
+            ("macro '" ++ macro_name ++ "' is already defined. " ++ hint))
+          | isCommand = throwGhcException (CmdLineError
+            ("macro '" ++ macro_name ++ "' overwrites builtin command. " ++ hint))
+          | otherwise = return ()
+        hint = " Use ':def!' to overwrite."
+
+    unless overwrite check_newname
+    -- compile the expression
+    handleSourceError printErrAndMaybeExit $ do
+      step <- getGhciStepIO
+      expr <- GHC.parseExpr definition
+      -- > ghciStepIO . definition :: String -> IO String
+      let stringTy :: LHsType GhcPs
+          stringTy = nlHsTyVar NotPromoted stringTyCon_RDR
+          ioM :: LHsType GhcPs -- AZ
+          ioM = nlHsTyVar NotPromoted (getRdrName ioTyConName) `nlHsAppTy` stringTy
+          body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
+                                     `mkHsApp` (nlHsPar expr)
+          tySig = mkHsWildCardBndrs $ noLocA $ mkHsImplicitSigType $
+                  nlHsFunTy stringTy ioM
+          new_expr = L (getLoc expr) $ ExprWithTySig noAnn 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
+  :: GhciMonad m
+  => GHC.ForeignHValue  -- String -> IO String
+  -> String
+  -> m CmdExecOutcome
+runMacro fun s = do
+  interp <- hscInterp <$> GHC.getSession
+  str <- liftIO $ evalStringToIOString interp fun s
+  enqueueCommands (lines str)
+  return CmdSuccess
+
+
+-----------------------------------------------------------------------------
+-- :undef
+
+undefineMacro :: GhciMonad m => String -> m ()
+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 :: GhciMonad m => String -> m ()
+cmdCmd str = handleSourceError printErrAndMaybeExit $ do
+    step <- getGhciStepIO
+    expr <- GHC.parseExpr str
+    -- > ghciStepIO str :: IO String
+    let new_expr = step `mkHsApp` expr
+    hv <- GHC.compileParsedExprRemote new_expr
+
+    interp <- hscInterp <$> GHC.getSession
+    cmds <- liftIO $ evalString interp hv
+    enqueueCommands (lines cmds)
+
+-- | Generate a typed ghciStepIO expression
+-- @ghciStepIO :: Ty String -> IO String@.
+getGhciStepIO :: GHC.GhcMonad m => m (LHsExpr GhcPs)
+getGhciStepIO = do
+  ghciTyConName <- GHC.getGHCiMonad
+  let stringTy = nlHsTyVar NotPromoted stringTyCon_RDR
+      ghciM = nlHsTyVar NotPromoted (getRdrName ghciTyConName) `nlHsAppTy` stringTy
+      ioM = nlHsTyVar NotPromoted (getRdrName ioTyConName) `nlHsAppTy` stringTy
+      body = nlHsVar (getRdrName ghciStepIoMName)
+      tySig = mkHsWildCardBndrs $ noLocA $ mkHsImplicitSigType $
+              nlHsFunTy ghciM ioM
+  return $ noLocA $ ExprWithTySig noAnn body tySig
+
+-----------------------------------------------------------------------------
+-- :check
+
+checkModule :: GhciMonad m => String -> m ()
+checkModule m = do
+  let modl = GHC.mkModuleName m
+  ok <- handleSourceError (\e -> printErrAndMaybeExit 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) Check
+
+-----------------------------------------------------------------------------
+-- :doc
+
+docCmd :: GHC.GhcMonad m => String -> m ()
+docCmd "" =
+  throwGhcException (CmdLineError "syntax: ':doc <thing-you-want-docs-for>'")
+docCmd s  = do
+  -- TODO: Maybe also get module headers for module names
+  names <- GHC.parseName s
+
+  docs <- traverse (buildDocComponents s) names
+
+  let sdocs = pprDocs (NE.toList docs)
+      sdocs' = vcat (intersperse (text "") sdocs)
+  sdoc <- showSDocForUser' sdocs'
+  liftIO (putStrLn sdoc)
+
+data DocComponents =
+  DocComponents
+    { docs      :: Maybe [HsDoc GhcRn]   -- ^ subject's haddocks
+    , sigAndLoc :: Maybe SDoc          -- ^ type signature + category + location
+    , argDocs   :: IntMap (HsDoc GhcRn) -- ^ haddocks for arguments
+    }
+
+buildDocComponents :: GHC.GhcMonad m => String -> Name -> m DocComponents
+buildDocComponents str name = do
+  mbThing <- GHC.lookupName name
+  let sigAndLoc = sigAndLocDoc str <$> mbThing
+  (docs, argDocs)
+    <- either handleGetDocsFailure pure
+         =<< GHC.getDocs name
+
+  pure DocComponents{..}
+
+-- | Produce output containing the type/kind signature, category, and definition
+-- location of a TyThing.
+sigAndLocDoc :: String -> TyThing -> SDoc
+sigAndLocDoc str tyThing =
+  let tyThingTyDoc :: TyThing -> SDoc
+      tyThingTyDoc = \case
+        AnId i                      -> pprSigmaType $ varType i
+        AConLike (RealDataCon dc)   -> pprSigmaType $ dataConDisplayType False dc
+        AConLike (PatSynCon patSyn) -> pprPatSynType patSyn
+        ATyCon tyCon                -> pprSigmaType $ GHC.tyConKind tyCon
+        ACoAxiom _                  -> empty
+
+      tyDoc = tyThingTyDoc tyThing
+      sigDoc = text str <+> nest 2 (dcolon <+> tyDoc)
+      comment =
+        hsep [ char '\t' <> text "--"
+             , pprTyThingCategory tyThing
+             , text "defined" <+> pprNameDefnLoc (getName tyThing)
+             ]
+   in hang sigDoc 2 comment
+
+pprDocs :: [DocComponents] -> [SDoc]
+pprDocs docs
+  | null nonEmptyDocs = pprDoc <$> take 1 docs
+  -- elide <has no documentation> if there's at least one non-empty doc (#15784)
+  | otherwise = pprDoc <$> nonEmptyDocs
+  where
+    empty DocComponents{docs = mb_decl_docs, argDocs = arg_docs}
+      = maybe True null mb_decl_docs && null arg_docs
+    nonEmptyDocs = filter (not . empty) docs
+
+-- TODO: also print arg docs.
+pprDoc :: DocComponents -> SDoc
+pprDoc DocComponents{sigAndLoc = mb_sig_loc, docs = mb_decl_docs} =
+  maybe
+    (text "<has no documentation>")
+    formatDoc
+    mb_decl_docs
+  where
+    formatDoc doc =
+      vcat [ fromMaybe empty mb_sig_loc -- print contextual info (#19055)
+           , pprHsDocStrings $ map hsDocString doc
+           ]
+
+handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m a
+handleGetDocsFailure no_docs = do
+  dflags <- getDynFlags
+  let msg = showPpr dflags no_docs
+  throwGhcException $ case no_docs of
+    NameHasNoModule {} -> Sorry msg
+    NoDocsInIface {} -> InstallationError msg
+    InteractiveName -> ProgramError msg
+
+-----------------------------------------------------------------------------
+-- :instances
+
+instancesCmd :: String -> InputT GHCi ()
+instancesCmd "" =
+  throwGhcException (CmdLineError "syntax: ':instances <type-you-want-instances-for>'")
+instancesCmd s = do
+  handleSourceError printGhciException $ do
+    ty <- GHC.parseInstanceHead s
+    res <- GHC.getInstancesForType ty
+
+    printForUser $ vcat $ map ppr res
+
+-----------------------------------------------------------------------------
+-- :load, :add, :unadd, :reload
+
+-- these are mainly used for displaying a more informative response
+data LoadType = Add !Int | Unadd !Int | Load | Reload | Check
+
+isReload :: LoadType -> Bool
+isReload Reload = True
+isReload _      = False
+
+-- | Sets '-fdefer-type-errors' if 'defer' is true, executes 'load' and unsets
+-- '-fdefer-type-errors' again if it has not been set before.
+wrapDeferTypeErrors :: GHC.GhcMonad m => m a -> m a
+wrapDeferTypeErrors load =
+  MC.bracket
+    (do
+      -- Force originalFlags to avoid leaking the associated HscEnv
+      !originalFlags <- getDynFlags
+      void $ GHC.setProgramDynFlags $
+         setGeneralFlag' Opt_DeferTypeErrors originalFlags
+      return originalFlags)
+    (\originalFlags -> void $ GHC.setProgramDynFlags originalFlags)
+    (\_ -> load)
+
+loadModule :: GhciMonad m => [(FilePath, Maybe UnitId, Maybe Phase)] -> m SuccessFlag
+loadModule fs = do
+  (_, result) <- runAndPrintStats (const Nothing) (loadModule' fs)
+  either (liftIO . Exception.throwIO) return result
+
+-- | @:load@ command
+loadModule_ :: GhciMonad m => [FilePath] -> m ()
+loadModule_ fs = void $ loadModule (zip3 fs (repeat Nothing) (repeat Nothing))
+
+loadModuleDefer :: GhciMonad m => [FilePath] -> m ()
+loadModuleDefer = wrapDeferTypeErrors . loadModule_
+
+loadModule' :: GhciMonad m => [(FilePath, Maybe UnitId, Maybe Phase)] -> m SuccessFlag
+loadModule' files = do
+  let (filenames, uids, phases) = unzip3 files
+  exp_filenames <- mapM expandPath filenames
+  let files' = zip3 exp_filenames uids phases
+  targets <- mapM (\(file, uid, phase) -> GHC.guessTarget file uid phase) 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.
+
+  hsc_env <- GHC.getSession
+  let !dflags = hsc_dflags hsc_env
+
+  let load_module = do
+        -- unload first
+        _ <- GHC.abandonAll
+        clearCaches
+
+        GHC.setTargets targets
+        doLoadAndCollectInfo Load LoadAllTargets
+
+  if gopt Opt_GhciLeakCheck dflags
+    then do
+      -- Grab references to the currently loaded modules so that we can see if
+      -- they leak.
+      leak_indicators <- liftIO $ getLeakIndicators hsc_env
+      success <- load_module
+      liftIO $ checkLeakIndicators dflags leak_indicators
+      return success
+    else
+      load_module
+
+-- | @:add@ command
+addModule :: GhciMonad m => [FilePath] -> m ()
+addModule files = do
+  revertCAFs -- always revert CAFs on load/add.
+  files' <- mapM expandPath files
+  targets <- mapM (\m -> GHC.guessTarget m Nothing Nothing) files'
+  targets' <- filterM checkTarget targets
+  -- remove old targets with the same id; e.g. for :add *M
+  mapM_ GHC.removeTarget [ tid | Target { targetId = tid } <- targets' ]
+  mapM_ GHC.addTarget targets'
+  _ <- doLoadAndCollectInfo (Add $ length targets') LoadAllTargets
+  return ()
+  where
+    checkTarget :: GhciMonad m => Target -> m Bool
+    checkTarget Target { targetId = TargetModule m } = checkTargetModule m
+    checkTarget Target { targetId = TargetFile f _ } = checkTargetFile f
+
+    checkTargetModule :: GhciMonad m => ModuleName -> m Bool
+    checkTargetModule m = do
+      hsc_env <- GHC.getSession
+      let home_unit = hsc_home_unit hsc_env
+      result <- liftIO $
+        Finder.findImportedModule hsc_env m (ThisPkg (homeUnitId home_unit))
+      case result of
+        Found _ _ -> return True
+        _ -> do liftIO $ hPutStrLn stderr ("Module " ++ moduleNameString m ++ " not found")
+                failIfExprEvalMode
+                return False
+
+    checkTargetFile :: GhciMonad m => String -> m Bool
+    checkTargetFile f = do
+      exists <- liftIO (doesFileExist f)
+      unless exists $ do
+        liftIO $ hPutStrLn stderr $ "File " ++ f ++ " not found"
+        failIfExprEvalMode
+      return exists
+
+-- | @:unadd@ command
+unAddModule :: GhciMonad m => [FilePath] -> m ()
+unAddModule files = do
+  files' <- mapM expandPath files
+  targets <- mapM (\m -> GHC.guessTarget m Nothing Nothing) files'
+  let removals = [ tid | Target { targetId = tid } <- targets ]
+  mapM_ GHC.removeTarget removals
+  _ <- doLoadAndCollectInfo (Unadd $ length removals) LoadAllTargets
+  return ()
+
+-- | @:reload@ command
+reloadModule :: GhciMonad m => String -> m ()
+reloadModule m = do
+  session <- GHC.getSession
+  let home_unit = homeUnitId (hsc_home_unit session)
+  ok <- doLoadAndCollectInfo Reload (loadTargets home_unit)
+  when (failed ok) failIfExprEvalMode
+  where
+    loadTargets hu | null m    = LoadAllTargets
+                   | otherwise = LoadUpTo (mkModule hu (GHC.mkModuleName m))
+
+reloadModuleDefer :: GhciMonad m => String -> m ()
+reloadModuleDefer = wrapDeferTypeErrors . reloadModule
+
+-- | 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 :: GhciMonad m => LoadType -> LoadHowMuch -> m SuccessFlag
+doLoadAndCollectInfo load_type howmuch = do
+  doCollectInfo <- isOptionSet CollectInfo
+
+  doLoad load_type howmuch >>= \case
+    Succeeded | doCollectInfo -> do
+      mod_summaries <- GHC.mgModSummaries <$> getModuleGraph
+      -- MP: :set +c code path only works in single package mode atm, hence
+      -- this call to isLoaded is ok. collectInfo needs to be modified further to
+      -- work with :set +c so I have punted on that for now.
+      loaded <- filterM GHC.isLoaded (map ms_mod_name mod_summaries)
+      v <- mod_infos <$> getGHCiState
+      !newInfos <- collectInfo v loaded
+      modifyGHCiState (\st -> st { mod_infos = newInfos })
+      pure Succeeded
+    flag -> pure flag
+
+doLoad :: GhciMonad m => LoadType -> LoadHowMuch -> m SuccessFlag
+doLoad load_type howmuch = do
+  -- turn off breakpoints before we load: we can't turn them off later, because
+  -- the ModBreaks will have gone away.
+  discardActiveBreakPoints
+
+  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.
+  let setBuffering t = liftIO $ do
+        hSetBuffering stdout t
+        hSetBuffering stderr t
+  MC.bracket_ (setBuffering LineBuffering) (setBuffering NoBuffering) $ do
+      hmis <- ifaceCache <$> getGHCiState
+      -- If GHCi message gets its own configuration at some stage then this will need to be
+      -- modified to 'embedUnknownDiagnostic'.
+      ok <- trySuccess $ GHC.loadWithCache (Just hmis) (mkUnknownDiagnostic . GHCiMessage) howmuch
+      afterLoad ok load_type
+      pure ok
+
+
+
+afterLoad
+  :: GhciMonad m
+  => SuccessFlag
+  -> LoadType
+  -> m ()
+afterLoad ok load_type = do
+  revertCAFs  -- always revert CAFs on load.
+  discardTickArrays
+  loaded_mods <- getLoadedModules
+  modulesLoadedMsg ok loaded_mods load_type
+  graph <- GHC.getModuleGraph
+  setContextAfterLoad (isReload load_type) (Just graph)
+
+setContextAfterLoad :: GhciMonad m => Bool -> Maybe GHC.ModuleGraph -> m ()
+setContextAfterLoad keep_ctxt Nothing = do
+  setContextKeepingPackageModules keep_ctxt []
+setContextAfterLoad keep_ctxt (Just graph) = do
+  -- load a target if one is available, otherwise load the topmost module.
+  targets <- GHC.getTargets
+  loaded_graph <- filterM is_loaded $ GHC.mgModSummaries' graph
+  case [ m | Just m <- map (findTarget loaded_graph) targets ] of
+        []    ->
+          let graph' = flattenSCCs $ filterToposortToModules $
+                GHC.topSortModuleGraph True (GHC.mkModuleGraph loaded_graph) Nothing
+          in case graph' of
+              [] -> setContextKeepingPackageModules keep_ctxt []
+              xs -> load_this (last xs)
+        (m:_) ->
+          load_this m
+ where
+   is_loaded (GHC.ModuleNode _ ms) = isLoadedModSummary ms
+   is_loaded _ = return False
+
+   findTarget mds t
+    = case mapMaybe (`matches` t) mds of
+        []    -> Nothing
+        (m:_) -> Just m
+
+   (GHC.ModuleNode _ summary) `matches` Target { targetId = TargetModule m }
+        = if GHC.ms_mod_name summary == m then Just summary else Nothing
+   (GHC.ModuleNode _ summary) `matches` Target { targetId = TargetFile f _ }
+        | Just f' <- GHC.ml_hs_file (GHC.ms_location summary)   =
+          if f == f' then Just summary else Nothing
+   _ `matches` _ = Nothing
+
+   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
+  :: GhciMonad m
+  => Bool                 -- True  <=> keep all of remembered_ctx
+                          -- False <=> just keep package imports
+  -> [InteractiveImport]  -- new context
+  -> m ()
+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
+  :: GHC.GhcMonad m => [InteractiveImport] -> m [InteractiveImport]
+keepPackageImports = filterM is_pkg_import
+  where
+     is_pkg_import :: GHC.GhcMonad m => InteractiveImport -> m Bool
+     is_pkg_import (IIModule _) = return False
+     is_pkg_import (IIDecl d)
+         = do pkgqual <- GHC.renameRawPkgQualM mod_name (ideclPkgQual d)
+              e <- MC.try $ GHC.findQualifiedModule pkgqual mod_name
+              case e :: Either SomeException Module of
+                Left _  -> return False
+                Right m -> return (not (isMainUnitModule m))
+        where
+          mod_name = unLoc (ideclName d)
+
+{- Note [GHCi and local Preludes]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+GHC's compilation manager has no issues when the package being compiled
+defines its own local Prelude module. It'll just shadow the Prelude from base.
+
+GHCi however must check this condition, when it calls setContext ["Prelude"]
+to prepopulate the interactive session's scope. This is because of two facts.
+
+1. setContext must use previously compiled .hi interfaces only; it cannot
+recurse into compiling .hs modules (even with LinkIntoMemory), simply because
+it's not the right phase to do it. Import resolution happens way before GHC
+properly "loads" modules (GHC.Linker.Loader.loadModule, GHC.load & siblings);
+or in other words, at time of setContext the linker isn't even initialized yet.
+
+2. The local Prelude.hs (or .lhs) may've never been compiled before, so its
+interface file Prelude.hi can be outdated or altogether missing.
+
+Thankfully, there's a simple solution: just let CM load the local Prelude normally
+(either as a :load target, or as a dependency of another target) later. To do that,
+detect if the implicit `import Prelude` resolves to the "home unit" (i.e. not base),
+and if so, omit it from the early setContext call.
+
+If we don't, a HomeModError will be (correctly) thrown. See #10920.
+-}
+
+modulesLoadedMsg :: GHC.GhcMonad m => SuccessFlag -> [GHC.ModSummary] -> LoadType -> m ()
+modulesLoadedMsg ok mods load_type = do
+  dflags <- getDynFlags
+  when (verbosity dflags > 0) $ do
+     mod_names <- mapM mod_name mods
+     rendered_msg <- showSDocForUser' $
+       if gopt Opt_ShowLoadedModules dflags
+         then loaded_msg mod_names
+         else msg
+     liftIO $ putStrLn rendered_msg
+  where
+    num_mods = length mods
+    none_loaded = num_mods == 0
+
+    loaded_msg names =
+      let mod_commas
+           | null mods = text "none."
+           | otherwise = hsep (punctuate comma names) <> text "."
+      in status <> text ", modules loaded:" <+> mod_commas
+
+    msg  = status <> comma <+> msg' <> dot
+    msg' = case load_type of
+      Reload  -> if none_loaded
+                   then "no modules to be reloaded"
+                   else n_mods num_mods "reloaded"
+      Load    -> if none_loaded
+                   then "unloaded all modules"
+                   else n_mods num_mods "loaded"
+      Check   -> n_mods 1 "checked"
+      Add   n -> n_mods n "added"
+      Unadd n -> n_mods n "unadded"
+    n_mods amount action = speakNOf amount "module" <+> action
+
+    status | Succeeded <- ok = "Ok"
+           | otherwise       = "Failed"
+
+    mod_name mod = do
+        is_interpreted <- GHC.moduleIsBootOrNotObjectLinkable mod
+        pure $ if is_interpreted
+               then ppr (GHC.ms_mod mod)
+               else ppr (GHC.ms_mod mod)
+                    <+> parens (text $ normalise $ msObjFilePath mod)
+                    -- Fix #9887
+
+-- | Run an 'ExceptT' wrapped 'GhcMonad' while handling source errors
+-- and printing 'throwE' strings to 'stderr'. If in expression
+-- evaluation mode - throw GhcException and exit.
+runExceptGhciMonad :: GhciMonad m => ExceptT SDoc m () -> m ()
+runExceptGhciMonad act = handleSourceError printGhciException $
+                         either handleErr pure =<<
+                         runExceptT act
+  where
+    handleErr sdoc = do
+        rendered <- showSDocForUserQualify sdoc
+        liftIO $ hPutStrLn stderr rendered
+        failIfExprEvalMode
+
+-- | 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'
+  :: forall backend
+   . Backend backend
+  => Proxy backend
+  -> IORef ClashOpts
+  -> [FilePath]
+  -> InputT GHCi ()
+makeHDL' backend opts lst = go =<< case lst of
+  srcs@(_:_) -> return srcs
+  []         -> do
+    modGraph <- GHC.getModuleGraph
+    let sortedGraph =
+          -- TODO: this might break backpack
+          filterToposortToModules $
+          GHC.topSortModuleGraph False modGraph Nothing
+    return $ case (reverse sortedGraph) of
+      ((AcyclicSCC top) : _) -> maybeToList $ (GHC.ml_hs_file . GHC.ms_location) top
+      _                      -> []
+ where
+  go srcs = do
+    dflags <- GHC.getSessionDynFlags
+    goX dflags srcs `MC.finally` recover dflags
+
+  goX dflags srcs = do
+    -- Issue #439 step 1
+    (dflagsX,_,_) <- parseDynamicFlagsCmdLine dflags
+                       [ noLoc "-fobject-code"   -- For #439
+                       , noLoc "-fforce-recomp"  -- Actually compile to object-code
+                       , noLoc "-keep-tmp-files" -- To prevent linker errors from
+                                                 -- multiple calls to :hdl command
+                       ]
+    _ <- GHC.setSessionDynFlags dflagsX
+    reloadModule ""
+    -- Issue #439 step 2
+    -- Unload any object files
+    -- This fixes: https://github.com/clash-lang/clash-compiler/issues/439#issuecomment-522015868
+    env <- GHC.getSession
+    liftIO (Loader.unload (hscInterp env) env [])
+    -- Finally generate the HDL
+    makeHDL backend (return ()) opts srcs
+
+  recover dflags = do
+    _ <- GHC.setSessionDynFlags dflags
+    reloadModule ""
+
+makeHDL
+  :: forall backend m
+   . (GHC.GhcMonad m, Backend backend)
+  => Proxy backend
+  -> Ghc ()
+  -> IORef ClashOpts
+  -> [FilePath]
+  -> m ()
+makeHDL Proxy startAction optsRef srcs = do
+  dflags <- GHC.getSessionDynFlags
+  liftIO $ do startTime <- Clock.getCurrentTime
+              opts0  <- readIORef optsRef
+              let opts1  = opts0 { opt_color = fromGhcOverridingBool (useColor dflags) }
+              let iw     = opt_intWidth opts1
+                  hdl    = hdlKind backend
+                  -- 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
+                  idirs = importPaths dflags
+                  opts2 = opts1 { opt_hdlDir = maybe outputDir Just (opt_hdlDir opts1)
+                                , opt_importPaths = idirs}
+                  backend = initBackend @backend opts2
+
+              checkMonoLocalBinds dflags
+              checkImportDirs opts0 idirs
+
+              primDirs_ <- primDirs backend
+
+              forM_ srcs $ \src -> do
+                -- Generate bindings:
+                let dbs = reverse [p | PackageDB (PkgDbPath p) <- packageDBFlags dflags]
+                (clashEnv, clashDesign) <- generateBindings opts2 startAction primDirs_ idirs dbs hdl src (Just dflags)
+
+                let getMain = getMainTopEntity src clashDesign
+                mainTopEntity <- traverse getMain (GHC.mainFunIs dflags)
+                prepTime <- startTime `deepseq` designBindings clashDesign `deepseq` envTyConMap clashEnv `deepseq` Clock.getCurrentTime
+                let prepStartDiff = reportTimeDiff prepTime startTime
+                putStrLn $ "GHC+Clash: Loading modules cumulatively took " ++ prepStartDiff
+
+                -- Generate HDL:
+                Clash.Driver.generateHDL
+                  clashEnv
+                  clashDesign
+                  (Just backend)
+                  (ghcTypeToHWType iw)
+                  ghcEvaluator
+                  evaluator
+                  mainTopEntity
+                  startTime
+
+makeVHDL :: IORef ClashOpts -> [FilePath] -> InputT GHCi ()
+makeVHDL = makeHDL' (Proxy @VHDLState)
+
+makeVerilog :: IORef ClashOpts -> [FilePath] -> InputT GHCi ()
+makeVerilog = makeHDL' (Proxy @VerilogState)
+
+makeSystemVerilog :: IORef ClashOpts -> [FilePath] -> InputT GHCi ()
+makeSystemVerilog = makeHDL' (Proxy @SystemVerilogState)
+
+-----------------------------------------------------------------------------
+-- | @:type@ command. See also Note [TcRnExprMode] in GHC.Tc.Module.
+
+typeOfExpr :: GhciMonad m => String -> m ()
+typeOfExpr str = handleSourceError printErrAndMaybeExit $
+    case break isSpace str of
+      ("+v", _)    -> printForUser (text "`:type +v' has gone; use `:type' instead")
+      ("+d", rest) -> do_it GHC.TM_Default (dropWhile isSpace rest)
+      _            -> do_it GHC.TM_Inst    str
+  where
+    do_it mode expr_str
+      = do { ty <- GHC.exprType mode expr_str
+           ;    printForUser $ sep [ text expr_str
+                                   , nest 2 (dcolon <+> pprSigmaType ty)] }
+
+-----------------------------------------------------------------------------
+-- | @:type-at@ command
+
+typeAtCmd :: GhciMonad m => String -> m ()
+typeAtCmd str = runExceptGhciMonad $ do
+    (span',sample) <- exceptT $ parseSpanArg str
+    infos      <- lift $ mod_infos <$> getGHCiState
+    (info, ty) <- findType infos span' sample
+    let mb_rdr_env = case modinfoRdrEnv info of
+          Strict.Just rdrs -> Just rdrs
+          Strict.Nothing   -> Nothing
+    lift $ printForUserGlobalRdrEnv
+              mb_rdr_env
+              (sep [text sample,nest 2 (dcolon <+> ppr ty)])
+
+-----------------------------------------------------------------------------
+-- | @:uses@ command
+
+usesCmd :: GhciMonad m => String -> m ()
+usesCmd str = runExceptGhciMonad $ do
+    (span',sample) <- exceptT $ parseSpanArg str
+    infos  <- lift $ mod_infos <$> getGHCiState
+    uses   <- findNameUses infos span' sample
+    forM_ uses (liftIO . putStrLn . showSrcSpan)
+
+-----------------------------------------------------------------------------
+-- | @:loc-at@ command
+
+locAtCmd :: GhciMonad m => String -> m ()
+locAtCmd str = runExceptGhciMonad $ do
+    (span',sample) <- exceptT $ parseSpanArg str
+    infos    <- lift $ mod_infos <$> getGHCiState
+    (_,_,sp) <- findLoc infos span' sample
+    liftIO . putStrLn . showSrcSpan $ sp
+
+-----------------------------------------------------------------------------
+-- | @:all-types@ command
+
+allTypesCmd :: GhciMonad m => String -> m ()
+allTypesCmd _ = runExceptGhciMonad $ do
+    infos <- lift $ mod_infos <$> getGHCiState
+    forM_ (M.elems infos) $ \mi ->
+        forM_ (modinfoSpans mi) (lift . printSpan)
+  where
+    printSpan span'
+      | Just ty <- spaninfoType span' = do
+        tyInfo <- (unwords . words) <$>
+                  showSDocForUserQualify (pprSigmaType 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)
+                              -- End column of RealSrcSpan is the column
+                              -- after the end of the span.
+                              (mkRealSrcLoc fs el (ec + 1))
+
+    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 (unhelpfulSpanFS 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
+    -- The end column is the column after the end of the span see the
+    -- RealSrcSpan module
+    ec = let ec' = srcSpanEndCol    spn in if ec' == 0 then 0 else ec' - 1
+
+-----------------------------------------------------------------------------
+-- | @:kind@ command
+
+kindOfType :: GhciMonad m => Bool -> String -> m ()
+kindOfType norm str = handleSourceError printErrAndMaybeExit $ do
+    (ty, kind) <- GHC.typeKind norm str
+    printForUser $ vcat [ text str <+> dcolon <+> pprSigmaType kind
+                        , ppWhen norm $ equals <+> pprSigmaType ty ]
+
+-----------------------------------------------------------------------------
+-- :quit
+
+quit :: Monad m => String -> m CmdExecOutcome
+quit _ = return CleanExit
+
+
+-----------------------------------------------------------------------------
+-- :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>")
+
+-- | A version of 'words' that treats sequences enclosed in double quotes as
+-- single words and that does not break on backslash-escaped spaces.
+-- E.g., 'words\' "\"lorem ipsum\" dolor"' and 'words\' "lorem\\ ipsum dolor"'
+-- yield '["lorem ipsum", "dolor"]'.
+-- Used to scan for file paths in 'scriptCmd'.
+words' :: String -> [String]
+words' s = case dropWhile isSpace s of
+  "" -> []
+  s'@('\"' : _) | [(w, s'')] <- reads s' -> w : words' s''
+  s' -> go id s'
+ where
+  go acc []                          = [acc []]
+  go acc ('\\' : c : cs) | isSpace c = go (acc . (c :)) cs
+  go acc (c : cs) | isSpace c = acc [] : words' cs
+                  | otherwise = go (acc . (c :)) cs
+
+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 :: GHC.GhcMonad m => String -> m ()
+isSafeCmd m =
+    case words m of
+        [s] | looksLikeModuleName s -> do
+            md <- lookupModule s
+            isSafeModule md
+        [] -> do md <- guessCurrentModule "issafe"
+                 isSafeModule md
+        _ -> throwGhcException (CmdLineError "syntax:  :issafe <module>")
+
+isSafeModule :: GHC.GhcMonad m => Module -> m ()
+isSafeModule m = do
+    mb_mod_info <- GHC.getModuleInfo m
+    when (isNothing mb_mod_info)
+         (throwGhcException $ CmdLineError $ "unknown module: " ++ mname)
+
+    dflags <- getDynFlags
+    hsc_env <- GHC.getSession
+    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  = show $ getSafeMode $ GHC.mi_trust $ fromJust iface
+        pkg    = if packageTrusted hsc_env m then "trusted" else "untrusted"
+        (good, bad) = tallyPkgs hsc_env 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 $ S.null good)
+         (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++
+                        (intercalate ", " $ map (showPpr dflags) (S.toList good)))
+    case msafe && S.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) (S.toList bad)))
+            liftIO $ putStrLn $ mname ++ " is NOT trusted!"
+
+  where
+    mname = GHC.moduleNameString $ GHC.moduleName m
+
+    packageTrusted hsc_env md
+        | isHomeModule (hsc_home_unit hsc_env) md = True
+        | otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md)
+
+    tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (S.empty, S.empty)
+                          | otherwise = S.partition part deps
+        where part pkg   = unitIsTrusted $ unsafeLookupUnitId unit_state pkg
+              unit_state = hsc_units hsc_env
+              dflags     = hsc_dflags hsc_env
+
+-----------------------------------------------------------------------------
+-- :browse
+
+-- Browsing a module's contents
+
+browseCmd :: GHC.GhcMonad m => Bool -> String -> m ()
+browseCmd bang m =
+  case words m of
+    ['*':s] | looksLikeModuleName s -> do
+        md <- wantInterpretedModule s
+        browseModule bang md False
+    [s] | looksLikeModuleName s -> do
+        md <- lookupModule s
+        browseModule bang md True
+    [] -> do md <- guessCurrentModule ("browse" ++ if bang then "!" else "")
+             browseModule bang md True
+    _ -> throwGhcException (CmdLineError "syntax:  :browse <module>")
+
+guessCurrentModule :: GHC.GhcMonad m => String -> m 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
+  case imports of
+    [] -> throwGhcException $ CmdLineError (':' : cmd ++ ": no current module")
+    IIModule m : _ -> GHC.findQualifiedModule NoPkgQual m
+    IIDecl d : _ -> do
+      pkgqual <- GHC.renameRawPkgQualM (unLoc $ ideclName d) (ideclPkgQual d)
+      GHC.findQualifiedModule pkgqual (unLoc (ideclName 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 :: GHC.GhcMonad m => Bool -> Module -> Bool -> m ()
+browseModule bang modl exports_only = do
+  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
+        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 (SrcLoc.leftmost_smallest `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 showToHeader
+                   | otherwise = pprTyThingInContext showToHeader
+
+            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.. (#1799)
+            annotate mts = concatMap (\(m,ts)->labels m:ts)
+                         $ sortBy cmpQualifiers $ grp mts
+              where cmpQualifiers =
+                      compare `on` (map (fmap (map (unpackFS . 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
+
+        -- :browse reports qualifiers wrt current context
+        rendered_things <- showSDocForUser' (vcat prettyThings')
+        liftIO $ putStrLn rendered_things
+        -- 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 :: GhciMonad m => String -> m ()
+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 :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
+addModulesToContext starred unstarred = restoreContextOnFailure $ do
+   addModulesToContext_ starred unstarred
+
+addModulesToContext_ :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
+addModulesToContext_ starred unstarred = do
+   mapM_ addII (map mkIIModule starred ++ map mkIIDecl unstarred)
+   setGHCContextFromGHCiState
+
+remModulesFromContext :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
+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 :: GhciMonad m => ModuleName -> m ()
+   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 :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
+setContext starred unstarred = restoreContextOnFailure $ do
+  modifyGHCiState $ \st -> st { remembered_ctx = [], transient_ctx = [] }
+                                -- delete the transient context
+  addModulesToContext_ starred unstarred
+
+addImportToContext :: GhciMonad m => ImportDecl GhcPs -> m ()
+addImportToContext idecl = restoreContextOnFailure $ do
+  addII (IIDecl idecl)   -- #5836
+  setGHCContextFromGHCiState
+
+-- Util used by addImportToContext and addModulesToContext
+addII :: GhciMonad m => InteractiveImport -> m ()
+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 :: GhciMonad m => m a -> m a
+restoreContextOnFailure do_this = do
+  st <- getGHCiState
+  let rc = remembered_ctx st; tc = transient_ctx st
+  do_this `MC.onException` (modifyGHCiState $ \st' ->
+     st' { remembered_ctx = rc, transient_ctx = tc })
+
+-- -----------------------------------------------------------------------------
+-- Validate a module that we want to add to the context
+
+checkAdd :: GHC.GhcMonad m => InteractiveImport -> m ()
+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 <- GHC.renameRawPkgQualM modname (ideclPkgQual d)
+       m <- GHC.lookupQualifiedModule pkgqual modname
+       when safe $ do
+           t <- GHC.isModuleTrusted m
+           unless 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 :: GhciMonad m => m ()
+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)
+
+  prel_iidecls <- getImplicitPreludeImports iidecls
+  valid_prel_iidecls <- filterM (tryBool . checkAdd) prel_iidecls
+
+  extra_imports <- filterM (tryBool . checkAdd) (map IIDecl (extra_imports st))
+
+  GHC.setContext $ iidecls ++ extra_imports ++ valid_prel_iidecls
+
+
+getImplicitPreludeImports :: GhciMonad m
+                          => [InteractiveImport] -> m [InteractiveImport]
+getImplicitPreludeImports iidecls = do
+     -- allow :seti to override -XNoImplicitPrelude
+  st <- getGHCiState
+
+  -- We add the prelude imports if there are no *-imports, and we also
+  -- allow each prelude import to be subsumed by another explicit import
+  -- of the same module.  This means that you can override the prelude import
+  -- with "import Prelude hiding (map)", for example.
+  let prel_iidecls =
+         if not (any isIIModule iidecls)
+            then [ IIDecl imp
+                 | imp <- prelude_imports st
+                 , not (any (sameImpModule imp) iidecls) ]
+            else []
+
+  -- See Note [GHCi and local Preludes]
+  keepPackageImports prel_iidecls
+
+-- -----------------------------------------------------------------------------
+-- Utils on InteractiveImport
+
+mkIIModule :: ModuleName -> InteractiveImport
+mkIIModule = IIModule
+
+mkIIDecl :: ModuleName -> InteractiveImport
+mkIIDecl = IIDecl . simpleImportDecl
+
+iiModules :: [InteractiveImport] -> [ModuleName]
+iiModules is = [m | IIModule m <- is]
+
+isIIModule :: InteractiveImport -> Bool
+isIIModule (IIModule _) = True
+isIIModule _ = False
+
+iiModuleName :: InteractiveImport -> ModuleName
+iiModuleName (IIModule m) = m
+iiModuleName (IIDecl d)   = unLoc (ideclName d)
+
+preludeModuleName :: ModuleName
+preludeModuleName = GHC.mkModuleName "Clash.Prelude"
+
+sameImpModule :: ImportDecl GhcPs -> InteractiveImport -> Bool
+sameImpModule _ (IIModule _) = False -- we only care about imports here
+sameImpModule imp (IIDecl d) = unLoc (ideclName d) == unLoc (ideclName imp)
+
+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 (isImportDeclQualified (ideclQualified d1)) || isImportDeclQualified (ideclQualified d2))
+     && (ideclImportList d1 `hidingSubsumes` ideclImportList d2)
+  where
+     _                    `hidingSubsumes` Just (Exactly,L _ []) = True
+     Just (Exactly, L _ xs) `hidingSubsumes` Just (Exactly,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 :: GhciMonad m => String -> m ()
+setCmd ""   = showOptions False
+setCmd "-a" = showOptions True
+setCmd str
+  = case getCmd str of
+    Right ("args",    rest) ->
+        case toArgsNoLoc rest of
+            Left err -> liftIO (hPutStrLn stderr err)
+            Right args -> setArgs args
+    Right ("prog",    rest) ->
+        case toArgsNoLoc rest of
+            Right [prog] -> setProg prog
+            _ -> liftIO (hPutStrLn stderr "syntax: :set prog <progname>")
+
+    Right ("prompt",           rest) ->
+        setPromptString setPrompt (dropWhile isSpace rest)
+                        "syntax: set prompt <string>"
+    Right ("prompt-function",  rest) ->
+        setPromptFunc setPrompt $ dropWhile isSpace rest
+    Right ("prompt-cont",          rest) ->
+        setPromptString setPromptCont (dropWhile isSpace rest)
+                        "syntax: :set prompt-cont <string>"
+    Right ("prompt-cont-function", rest) ->
+        setPromptFunc setPromptCont $ dropWhile isSpace rest
+
+    Right ("editor",  rest) -> setEditor  $ dropWhile isSpace rest
+    Right ("stop",    rest) -> setStop    $ dropWhile isSpace rest
+    Right ("local-config", rest) ->
+        setLocalConfigBehaviour $ dropWhile isSpace rest
+    _ -> case toArgsNoLoc str of
+         Left err -> liftIO (hPutStrLn stderr err)
+         Right wds -> () <$ keepGoing' setOptions wds
+
+setiCmd :: GhciMonad m => String -> m ()
+setiCmd ""   = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags False
+setiCmd "-a" = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags True
+setiCmd str  =
+  case toArgsNoLoc str of
+    Left err -> liftIO (hPutStrLn stderr err)
+    Right wds -> newDynFlags True wds
+
+showOptions :: GhciMonad m => Bool -> m ()
+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)
+           ))
+       liftIO $ showDynFlags show_all dflags
+
+
+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 :: String -> String -> (flag -> DynFlags -> Bool) -> FlagSpec flag -> SDoc
+        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 :: GhciMonad m => [String] -> m ()
+setProg, setEditor, setStop :: GhciMonad m => String -> m ()
+setLocalConfigBehaviour :: GhciMonad m => String -> m ()
+
+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 })
+
+setLocalConfigBehaviour s
+  | s == "source" =
+      modifyGHCiState (\st -> st { localConfig = SourceLocalConfig })
+  | s == "ignore" =
+      modifyGHCiState (\st -> st { localConfig = IgnoreLocalConfig })
+  | otherwise = throwGhcException
+      (CmdLineError "syntax:  :set local-config { source | ignore }")
+
+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
+       case IntMap.lookup nm old_breaks of
+         Nothing ->  printForUser (text "Breakpoint" <+> ppr nm <+>
+                                   text "does not exist")
+         Just loc -> do
+            let new_breaks = IntMap.insert nm
+                                loc { onBreakCmd = dropWhile isSpace rest }
+                                old_breaks
+            setGHCiState st{ breaks = new_breaks }
+setStop cmd = modifyGHCiState (\st -> st { stop = cmd })
+
+setPrompt :: GhciMonad m => PromptFunction -> m ()
+setPrompt v = modifyGHCiState (\st -> st {prompt = v})
+
+setPromptCont :: GhciMonad m => PromptFunction -> m ()
+setPromptCont v = modifyGHCiState (\st -> st {prompt_cont = v})
+
+setPromptFunc :: GHC.GhcMonad m => (PromptFunction -> m ()) -> String -> m ()
+setPromptFunc fSetPrompt s = do
+    -- We explicitly annotate the type of the expression to ensure
+    -- that unsafeCoerce# is passed the exact type necessary rather
+    -- than a more general one
+    let exprStr = "(" ++ s ++ ") :: [String] -> Int -> IO String"
+    (HValue funValue) <- GHC.compileExpr exprStr
+    fSetPrompt (convertToPromptFunction $ unsafeCoerce funValue)
+    where
+      convertToPromptFunction :: ([String] -> Int -> IO String)
+                              -> PromptFunction
+      convertToPromptFunction func = (\mods line -> liftIO $
+                                       liftM text (func mods line))
+
+setPromptString :: MonadIO m
+                => (PromptFunction -> m ()) -> String -> String -> m ()
+setPromptString fSetPrompt value err = do
+  if null value
+    then liftIO $ hPutStrLn stderr $ err
+    else case value of
+           ('\"':_) ->
+             case reads value of
+               [(value', xs)] | all isSpace xs ->
+                 setParsedPromptString fSetPrompt value'
+               _ -> liftIO $ hPutStrLn stderr
+                             "Can't parse prompt string. Use Haskell syntax."
+           _ ->
+             setParsedPromptString fSetPrompt value
+
+setParsedPromptString :: MonadIO m
+                      => (PromptFunction -> m ()) ->  String -> m ()
+setParsedPromptString fSetPrompt s = do
+  case (checkPromptStringForErrors s) of
+    Just err ->
+      liftIO $ hPutStrLn stderr err
+    Nothing ->
+      fSetPrompt $ generatePromptFunctionFromString s
+
+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
+      when (not (null minus_opts)) $ newDynFlags False minus_opts
+
+-- | newDynFlags will *not* read package environment files, therefore we
+-- use 'parseDynamicFlagsCmdLine' rather than 'parseDynamicFlags'. This
+-- function is called very often and results in repeatedly loading
+-- environment files (see #19650)
+newDynFlags :: GhciMonad m => Bool -> [String] -> m ()
+newDynFlags interactive_only minus_opts = do
+      let lopts = map noLoc minus_opts
+
+      logger <- getLogger
+      idflags0 <- GHC.getInteractiveDynFlags
+      (idflags1, leftovers, warns) <- DynFlags.parseDynamicFlagsCmdLine idflags0 lopts
+
+      liftIO $ printOrThrowDiagnostics logger (initPrintConfig idflags1) (initDiagOpts idflags1) (GhcDriverMessage <$> warns)
+      when (not $ null leftovers) (unknownFlagsErr $ 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 $ DynFlags.parseDynamicFlagsCmdLine dflags0 lopts
+        must_reload <- 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
+        let interp  = hscInterp hsc_env
+        when (packageFlagsChanged dflags2 dflags0) $ do
+          when (verbosity dflags2 > 0) $
+            liftIO . putStrLn $
+              "package flags have changed, resetting and loading new packages..."
+          -- Clear caches and eventually defined breakpoints. (#1620)
+          clearCaches
+          when must_reload $ do
+            let units = preloadUnits (hsc_units hsc_env)
+            liftIO $ Loader.loadPackages interp hsc_env units
+          -- package flags changed, we can't re-use any of the old context
+          setContextAfterLoad False Nothing
+          -- and copy the package flags to the interactive DynFlags
+          idflags <- GHC.getInteractiveDynFlags
+          GHC.setInteractiveDynFlags
+              idflags{ packageFlags = packageFlags dflags2 }
+
+        let ld0length   = length $ ldInputs dflags0
+            fmrk0length = length $ cmdlineFrameworks dflags0
+
+            newLdInputs     = drop ld0length (ldInputs dflags2)
+            newCLFrameworks = drop fmrk0length (cmdlineFrameworks dflags2)
+
+            dflags'  = dflags2 { ldInputs = newLdInputs
+                               , cmdlineFrameworks = newCLFrameworks
+                               }
+            hsc_env' = hscSetFlags dflags' hsc_env
+
+        when (not (null newLdInputs && null newCLFrameworks)) $
+          liftIO $ Loader.loadCmdLineLibs (hscInterp hsc_env') hsc_env'
+
+      return ()
+
+unknownFlagsErr :: [String] -> a
+unknownFlagsErr fs = throwGhcException $ CmdLineError $ concatMap oneError fs
+  where
+    oneError f =
+        "unrecognised flag: " ++ f ++ "\n" ++
+        (case flagSuggestions ghciFlags f of
+            [] -> ""
+            suggs -> "did you mean one of:\n" ++ unlines (map ("  " ++) suggs))
+    ghciFlags = nubSort $ flagsForCompletion True
+
+unsetOptions :: GhciMonad m => String -> m ()
+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)
+           , ("prompt-cont", setPromptCont default_prompt_cont)
+           , ("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 case rest3 of
+          opt:_ -> liftIO (putStrLn ("unknown option: '" ++ opt ++ "'"))
+          [] -> do
+             mapM_ (fromJust.flip lookup defaulters) other_opts
+
+             mapM_ unsetOpt plus_opts
+
+             no_flags <- mapM no_flag minus_opts
+             when (not (null no_flags)) $ 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 :: GhciMonad m => String -> m ()
+
+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 :: forall m. GhciMonad m => String -> m ()
+showCmd ""   = showOptions False
+showCmd "-a" = showOptions True
+showCmd str = do
+    st <- getGHCiState
+    dflags <- getDynFlags
+    hsc_env <- GHC.getSession
+
+    let lookupCmd :: String -> Maybe (m ())
+        lookupCmd name = lookup name $ map (\(_,b,c) -> (b,c)) cmds
+
+        -- (show in help?, command name, action)
+        action :: String -> m () -> (Bool, String, m ())
+        action name m = (True, name, m)
+
+        hidden :: String -> m () -> (Bool, String, m ())
+        hidden name m = (False, name, m)
+
+        cmds =
+            [ action "args"       $ liftIO $ putStrLn (show (GhciMonad.args st))
+            , action "prog"       $ liftIO $ putStrLn (show (progname 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"     $ do
+               msg <- liftIO $ Loader.showLoaderState (hscInterp hsc_env)
+               dflags <- getDynFlags
+               liftIO $ putStrLn $ showSDoc dflags msg
+            , action "breaks"     $ showBkptTable
+            , action "context"    $ showContext
+            , action "packages"   $ showUnits
+            , action "paths"      $ showPaths
+            , action "language"   $ showLanguages
+            , hidden "languages"  $ showLanguages -- backwards compat
+            , hidden "lang"       $ showLanguages -- useful abbreviation
+            , action "targets"    $ showTargets
+            ]
+
+    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 :: GHC.GhcMonad m => String -> m ()
+showiCmd str = do
+  case words str of
+        ["languages"]  -> showiLanguages -- backwards compat
+        ["language"]   -> showiLanguages
+        ["lang"]       -> showiLanguages -- useful abbreviation
+        _ -> throwGhcException (CmdLineError ("syntax:  :showi language"))
+
+showImports :: GhciMonad m => m ()
+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_iidecls <- getImplicitPreludeImports (rem_ctx ++ trans_ctx)
+
+  let show_prel p = show_one p ++ " -- implicit"
+      show_extra p = show_one (IIDecl p) ++ " -- fixed"
+
+      trans_comment s = s ++ " -- added automatically" :: String
+  --
+  liftIO $ mapM_ putStrLn (map show_one rem_ctx ++
+                           map (trans_comment . show_one) trans_ctx ++
+                           map show_prel prel_iidecls ++
+                           map show_extra (extra_imports st))
+
+showModules :: GHC.GhcMonad m => m ()
+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 isLoadedModSummary (GHC.mgModSummaries graph)
+
+showBindings :: GHC.GhcMonad m => m ()
+showBindings = do
+    bindings <- GHC.getBindings
+    (insts, finsts) <- GHC.getInsts
+    let idocs  = map GHC.pprInstanceHdr insts
+        fidocs = map GHC.pprFamInst finsts
+        binds = filter (not . isDerivedOccName . getOccName) bindings -- #12525
+        -- See Note [Filter bindings]
+    docs <- mapM makeDoc (reverse binds)
+                  -- reverse so the new ones come last
+    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) -> SDoc
+    pprTT (thing, fixity, _cls_insts, _fam_insts, _docs)
+      = pprTyThing showToHeader thing
+        $$ showFixity thing fixity
+
+
+printTyThing :: GHC.GhcMonad m => TyThing -> m ()
+printTyThing tyth = printForUser (pprTyThing showToHeader tyth)
+
+isLoadedModSummary :: GHC.GhcMonad m => ModSummary -> m Bool
+isLoadedModSummary ms = GHC.isLoadedModule (ms_unitid ms) (ms_mod_name ms)
+
+{-
+Note [Filter bindings]
+~~~~~~~~~~~~~~~~~~~~~~
+If we don't filter the bindings returned by the function GHC.getBindings,
+then the :show bindings command will also show unwanted bound names,
+internally generated by GHC, eg:
+    $tcFoo :: GHC.Types.TyCon = _
+    $trModule :: GHC.Unit.Module = _ .
+
+The filter was introduced as a fix for #12525 [1]. Comment:1 [2] to this
+ticket contains an analysis of the situation and suggests the solution
+implemented above.
+
+The same filter was also implemented to fix #11051 [3]. See the
+Note [What to show to users] in GHC.Runtime.Eval
+
+[1] https://gitlab.haskell.org/ghc/ghc/issues/12525
+[2] https://gitlab.haskell.org/ghc/ghc/issues/12525#note_123489
+[3] https://gitlab.haskell.org/ghc/ghc/issues/11051
+-}
+
+
+showBkptTable :: GhciMonad m => m ()
+showBkptTable = do
+  st <- getGHCiState
+  printForUser $ prettyLocations (breaks st)
+
+showContext :: GHC.GhcMonad m => m ()
+showContext = do
+   resumes <- GHC.getResumeContext
+   printForUser $ vcat (map pp_resume (reverse resumes))
+  where
+   pp_resume res =
+        text "--> " <> text (GHC.resumeStmt res)
+        $$ nest 2 (pprStopped res)
+
+pprStopped :: GHC.Resume -> SDoc
+pprStopped res =
+  text "Stopped in"
+    <+> ((case mb_mod_name of
+           Nothing -> empty
+           Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
+         <> text (GHC.resumeDecl res))
+    <> char ',' <+> ppr (GHC.resumeSpan res)
+ where
+  mb_mod_name = moduleName <$> ibi_tick_mod <$> GHC.resumeBreakpointId res
+
+showUnits :: GHC.GhcMonad m => m ()
+showUnits = 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 :: GHC.GhcMonad m => m ()
+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 :: GHC.GhcMonad m => m ()
+showLanguages = getDynFlags >>= liftIO . showLanguages' False
+
+showiLanguages :: GHC.GhcMonad m => m ()
+showiLanguages = GHC.getInteractiveDynFlags >>= liftIO . showLanguages' False
+
+showLanguages' :: Bool -> DynFlags -> IO ()
+showLanguages' show_all dflags =
+  putStrLn $ showSDoc dflags $ vcat
+     [ text "base language is: " <>
+         case lang of
+           Haskell98   -> text "Haskell98"
+           Haskell2010 -> text "Haskell2010"
+           GHC2021     -> text "GHC2021"
+           GHC2024     -> text "GHC2024"
+     , (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` Just lang
+
+   lang = fromMaybe defaultLanguage (language dflags)
+
+
+showTargets :: GHC.GhcMonad m => m ()
+showTargets = mapM_ showTarget =<< GHC.getTargets
+  where
+    showTarget :: GHC.GhcMonad m => Target -> m ()
+    showTarget Target { targetId = TargetFile f _ } = liftIO (putStrLn f)
+    showTarget Target { targetId = TargetModule m } =
+      liftIO (putStrLn $ moduleNameString m)
+
+-- -----------------------------------------------------------------------------
+-- 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 [] = Nothing
+    parseLine argLine = case breakSpace argLine of
+      (_, []) -> Nothing
+      (dom, rest1@('"' : _)) -> (dom,,) <$> parseRange "" <*> (readMaybe rest1 :: Maybe String)
+      (dom, rest1) -> (dom,,) <$> parseRange rng <*> readMaybe rest2
+        where
+          (rng, rest2) = breakSpace rest1
+
+    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, completeBreakpoint
+    :: GhciMonad m => CompletionFunc m
+
+-- | 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 `isPrefixOptOf`) 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
+    ('.':_)  -> wrapCompleter (specials ++ spaces) complete line
+               -- operator or qualification
+    (x:_) | isSymbolChar x -> wrapCompleter' (\c -> c `elem` (specials ++ spaces) || not (isSymbolChar c))
+                                 complete line         -- operator
+    _                      -> wrapIdentCompleter complete line
+  where
+    complete w = do
+      rdrs <- GHC.getRdrNamesInScope
+      dflags <- GHC.getSessionDynFlags
+      return (filter (w `isPrefixOf`) (map (showPpr dflags) rdrs))
+
+-- TAB-completion for the :break command.
+-- Build and return a list of breakpoint identifiers with a given prefix.
+-- See Note [Tab-completion for :break]
+completeBreakpoint = wrapCompleter spaces $ \w -> do          -- #3000
+    -- bid ~ breakpoint identifier = a name of a function that is
+    --       eligible to set a breakpoint.
+    let (mod_str, _, _) = splitIdent w
+    bids_mod_breaks <- bidsFromModBreaks mod_str
+    bids_inscopes <- bidsFromInscopes
+    pure $ nub $ filter (isPrefixOf w) $ bids_mod_breaks ++ bids_inscopes
+  where
+    -- Extract all bids from ModBreaks for a given module name prefix
+    bidsFromModBreaks :: GhciMonad m => String -> m [String]
+    bidsFromModBreaks mod_pref = do
+        imods <- interpretedHomeMods
+        let pmods = filter ((isPrefixOf mod_pref) . showModule) imods
+        nonquals <- case null mod_pref of
+          -- If the prefix is empty, then for functions declared in a module
+          -- in scope, don't qualify the function name.
+          -- (eg: `main` instead of `Main.main`)
+            True -> do
+                imports <- GHC.getContext
+                pure [ m | IIModule m <- imports]
+            False -> return []
+        bidss <- mapM (bidsByModule nonquals) pmods
+        pure $ concat bidss
+
+    -- Return a list of interpreted home modules
+    interpretedHomeMods :: GhciMonad m => m [Module]
+    interpretedHomeMods = do
+        graph <- GHC.getModuleGraph
+        let hmods = ms_mod <$> GHC.mgModSummaries graph
+        filterM GHC.moduleIsInterpreted hmods
+
+    -- Return all possible bids for a given Module
+    bidsByModule :: GhciMonad m => [ModuleName] -> Module -> m [String]
+    bidsByModule nonquals mod = do
+      (_, decls) <- getModBreak mod
+      let bids = nub $ declPath <$> elems decls
+      pure $ case (moduleName mod) `elem` nonquals of
+              True  -> bids
+              False -> (combineModIdent (showModule mod)) <$> bids
+
+    -- Extract all bids from all top-level identifiers in scope.
+    bidsFromInscopes :: GhciMonad m => m [String]
+    bidsFromInscopes = do
+        dflags <- getDynFlags
+        rdrs <- GHC.getRdrNamesInScope
+        inscopess <- mapM createInscope $ (showSDoc dflags . ppr) <$> rdrs
+        imods <- interpretedHomeMods
+        let topLevels = filter ((`elem` imods) . snd) $ concat inscopess
+        bidss <- mapM (addNestedDecls) topLevels
+        pure $ concat bidss
+
+    -- Return a list of (bid,module) for a single top-level in-scope identifier
+    createInscope :: GhciMonad m => String -> m [(String, Module)]
+    createInscope str_rdr = do
+        names <- GHC.parseName str_rdr
+        pure $ map (str_rdr, ) $ NE.toList $ GHC.nameModule <$> names
+
+    -- For every top-level identifier in scope, add the bids of the nested
+    -- declarations. See Note [Field modBreaks_decls] in GHC.ByteCode.Types
+    addNestedDecls :: GhciMonad m => (String, Module) -> m [String]
+    addNestedDecls (ident, mod) = do
+        (_, decls) <- getModBreak mod
+        let (mod_str, topLvl, _) = splitIdent ident
+            ident_decls = [ elm | elm@(el : _) <- elems decls, el == topLvl ]
+            bids = nub $ declPath <$> ident_decls
+        pure $ map (combineModIdent mod_str) bids
+
+completeModule = wrapIdentCompleterMod $ \w -> do
+  hsc_env <- GHC.getSession
+  let pkg_mods = allVisibleModules (hsc_units hsc_env)
+  loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
+  return $ filter (w `isPrefixOf`)
+        $ map (showPpr (hsc_dflags hsc_env)) $ loaded_mods ++ pkg_mods
+
+completeSetModule = wrapIdentCompleterWithModifier "+-" $ \m w -> do
+  hsc_env <- GHC.getSession
+  modules <- case m of
+    Just '-' -> do
+      imports <- GHC.getContext
+      return $ map iiModuleName imports
+    _ -> do
+      let pkg_mods = allVisibleModules (hsc_units hsc_env)
+      loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
+      return $ loaded_mods ++ pkg_mods
+  return $ filter (w `isPrefixOf`) $ map (showPpr (hsc_dflags hsc_env)) modules
+
+completeHomeModule = wrapIdentCompleterMod listHomeModules
+
+listHomeModules :: GHC.GhcMonad m => String -> m [String]
+listHomeModules w = do
+    g <- GHC.getModuleGraph
+    let home_mods = map GHC.ms_mod_name (GHC.mgModSummaries 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":"prompt-cont":"prompt-function":
+                 "prompt-cont-function":"editor":"stop":flagList
+          flagList = map NE.head $ NE.group $ sort allNonDeprecatedFlags
+
+completeSeti = wrapCompleter flagWordBreakChars $ \w -> do
+  return (filter (w `isPrefixOf`) flagList)
+    where flagList = map NE.head $ NE.group $ sort allNonDeprecatedFlags
+
+completeShowOptions = wrapCompleter flagWordBreakChars $ \w -> do
+  return (filter (w `isPrefixOf`) opts)
+    where opts = ["args", "prog", "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 :: Monad m => String -> (String -> m [String]) -> CompletionFunc m
+wrapCompleter breakChars = wrapCompleter' (`elem` breakChars)
+
+wrapCompleter' :: Monad m => (Char -> Bool) -> (String -> m [String]) -> CompletionFunc m
+wrapCompleter' breakPred fun = completeWord' Nothing breakPred
+    $ fmap (map simpleCompletion . nubSort) . fun
+
+wrapIdentCompleter :: Monad m => (String -> m [String]) -> CompletionFunc m
+wrapIdentCompleter = wrapCompleter' word_break_chars_pred
+
+wrapIdentCompleterMod :: Monad m => (String -> m [String]) -> CompletionFunc m
+wrapIdentCompleterMod = wrapCompleter' go
+  where
+    go '.' = False -- Treated specially since it is a separator for module qualifiers
+    go c = word_break_chars_pred c
+
+wrapIdentCompleterWithModifier
+  :: Monad m
+  => String -> (Maybe Char -> String -> m [String]) -> CompletionFunc m
+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 :: UnitState -> [ModuleName]
+allVisibleModules unit_state = listVisibleModuleNames unit_state
+
+completeExpression = completeQuotedWord (Just '\\') "\"" listFiles
+                        completeIdentifier
+
+
+{-
+Note [Tab-completion for :break]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In tab-completion for the `:break` command, only those
+identifiers should be shown, that are accepted in the
+`:break` command. Hence these identifiers must be
+
+- defined in an interpreted module
+- listed in a `ModBreaks` value as a possible breakpoint.
+
+The identifiers may be qualified or unqualified.
+
+To get all possible top-level breakpoints for tab-completion
+with the correct qualification do:
+
+1. Build a list called `bids_mod_breaks` of identifier names eligible
+for setting breakpoints: For every interpreted module with the
+correct module prefix read all identifier names from the `decls` field
+of the `ModBreaks` array.
+
+2. Build a list called `bids_inscopess` of identifiers in scope:
+Take all RdrNames in scope, and filter by interpreted modules.
+Fore each of these top-level identifiers add from the `ModBreaks`
+arrays the available identifiers of the nested functions.
+
+3.) Combine both lists, filter by the given prefix, and remove duplicates.
+-}
+
+-- -----------------------------------------------------------------------------
+-- commands for debugger
+
+sprintCmd, printCmd, forceCmd :: GHC.GhcMonad m => String -> m ()
+sprintCmd = pprintClosureCommand False False
+printCmd  = pprintClosureCommand True False
+forceCmd  = pprintClosureCommand False True
+
+stepCmd :: GhciMonad m => String -> m ()
+stepCmd arg = withSandboxOnly ":step" $ step arg
+  where
+  step []         = doContinue (const True) GHC.SingleStep
+  step expression = runStmt expression GHC.SingleStep >> return ()
+
+stepLocalCmd :: GhciMonad m => String -> m ()
+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 (UnhelpfulSpan _) -> liftIO $ putStrLn (            -- #14690
+           ":steplocal is not possible." ++
+           "\nCannot determine current top-level binding after " ++
+           "a break on error / exception.\nUse :stepmodule.")
+        Just loc -> do
+           md <- fromMaybe (panic "stepLocalCmd") <$> getCurrentBreakModule
+           current_toplevel_decl <- enclosingTickSpan md loc
+           doContinue (`isSubspanOf` RealSrcSpan current_toplevel_decl Strict.Nothing) GHC.SingleStep
+
+stepModuleCmd :: GhciMonad m => String -> m ()
+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 :: GhciMonad m => Module -> SrcSpan -> m RealSrcSpan
+enclosingTickSpan _ (UnhelpfulSpan _) = panic "enclosingTickSpan UnhelpfulSpan"
+enclosingTickSpan md (RealSrcSpan src _) = do
+  ticks <- getTickArray md
+  let line = srcSpanStartLine src
+  massert (inRange (bounds ticks) line)
+  let enclosing_spans = [ pan | (_,pan) <- ticks ! line
+                               , realSrcSpanEnd pan >= realSrcSpanEnd src]
+  return . minimumBy leftmostLargestRealSrcSpan $ enclosing_spans
+ where
+
+leftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering
+leftmostLargestRealSrcSpan = on compare realSrcSpanStart S.<> on (flip compare) realSrcSpanEnd
+
+traceCmd :: GhciMonad m => String -> m ()
+traceCmd arg
+  = withSandboxOnly ":trace" $ tr arg
+  where
+  tr []         = doContinue (const True) GHC.RunAndLogSteps
+  tr expression = runStmt expression GHC.RunAndLogSteps >> return ()
+
+continueCmd :: GhciMonad m => String -> m ()                  -- #19157
+continueCmd argLine = withSandboxOnly ":continue" $
+  case contSwitch (words argLine) of
+    Left sdoc   -> printForUser sdoc
+    Right mbCnt -> doContinue' (const True) GHC.RunToCompletion mbCnt
+    where
+      contSwitch :: [String] -> Either SDoc (Maybe Int)
+      contSwitch [ ] = Right Nothing
+      contSwitch [x] = Just <$> getIgnoreCount x
+      contSwitch  _  = Left $
+          text "After ':continue' only one ignore count is allowed"
+
+doContinue :: GhciMonad m => (SrcSpan -> Bool) -> SingleStep -> m ()
+doContinue pre step = doContinue' pre step Nothing
+
+doContinue' :: GhciMonad m => (SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ()
+doContinue' pre step mbCnt= do
+  runResult <- resume pre step mbCnt
+  _ <- afterRunStmt pre runResult
+  return ()
+
+abandonCmd :: GhciMonad m => String -> m ()
+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 :: GhciMonad m => String -> m ()
+deleteCmd argLine = withSandboxOnly ":delete" $ do
+   deleteSwitch $ words argLine
+   where
+   deleteSwitch :: GhciMonad m => [String] -> m ()
+   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 :: GhciMonad m => String -> m ()
+      deleteOneBreak str
+         | all isDigit str = deleteBreak (read str)
+         | otherwise = return ()
+
+enableCmd :: GhciMonad m => String -> m ()
+enableCmd argLine = withSandboxOnly ":enable" $ do
+    enaDisaSwitch True $ words argLine
+
+disableCmd :: GhciMonad m => String -> m ()
+disableCmd argLine = withSandboxOnly ":disable" $ do
+    enaDisaSwitch False $ words argLine
+
+enaDisaSwitch :: GhciMonad m => Bool -> [String] -> m ()
+enaDisaSwitch enaDisa [] =
+    printForUser (text "The" <+> text strCmd <+>
+                  text "command requires at least one argument.")
+  where
+    strCmd = if enaDisa then ":enable" else ":disable"
+enaDisaSwitch enaDisa ("*" : _) = enaDisaAllBreaks enaDisa
+enaDisaSwitch enaDisa idents = do
+    mapM_ (enaDisaOneBreak enaDisa) idents
+  where
+    enaDisaOneBreak :: GhciMonad m => Bool -> String -> m ()
+    enaDisaOneBreak enaDisa strId = do
+      sdoc_loc <- checkEnaDisa enaDisa strId
+      case sdoc_loc of
+        Left sdoc -> printForUser sdoc
+        Right loc -> enaDisaAssoc enaDisa (read strId, loc)
+
+checkEnaDisa :: GhciMonad m => Bool -> String -> m (Either SDoc BreakLocation)
+checkEnaDisa enaDisa strId = do
+    sdoc_loc <- getBreakLoc strId
+    pure $ sdoc_loc >>= checkEnaDisaState enaDisa strId
+
+getBreakLoc :: GhciMonad m => String -> m (Either SDoc BreakLocation)
+getBreakLoc strId = do
+    st <- getGHCiState
+    case readMaybe strId >>= flip IntMap.lookup (breaks st) of
+      Nothing -> return $ Left (text "Breakpoint" <+> text strId <+>
+                                text "not found")
+      Just loc -> return $ Right loc
+
+checkEnaDisaState :: Bool -> String -> BreakLocation -> Either SDoc BreakLocation
+checkEnaDisaState enaDisa strId loc = do
+    if breakEnabled loc == enaDisa
+    then Left $
+        text "Breakpoint" <+> text strId <+> text "already in desired state"
+    else Right loc
+
+enaDisaAssoc :: GhciMonad m => Bool -> (Int, BreakLocation) -> m ()
+enaDisaAssoc enaDisa (intId, loc) = do
+    st <- getGHCiState
+    newLoc <- turnBreakOnOff enaDisa loc
+    let new_breaks = IntMap.insert intId newLoc (breaks st)
+    setGHCiState $ st { breaks = new_breaks }
+
+enaDisaAllBreaks :: GhciMonad m => Bool -> m()
+enaDisaAllBreaks enaDisa = do
+    st <- getGHCiState
+    mapM_ (enaDisaAssoc enaDisa) $ IntMap.assocs $ breaks st
+
+historyCmd :: GHC.GhcMonad m => String -> m ()
+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
+
+ignoreCmd  :: GhciMonad m => String -> m ()                     -- #19157
+ignoreCmd argLine = withSandboxOnly ":ignore" $ do
+    result <- ignoreSwitch (words argLine)
+    case result of
+      Left sdoc -> printForUser sdoc
+      Right (loc, count)   -> do
+        let bi = GHC.BreakpointId
+                  { bi_tick_mod   = breakModule loc
+                  , bi_tick_index = breakTick loc
+                  }
+        setupBreakpoint bi count
+
+ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
+ignoreSwitch [break, count] = do
+    sdoc_loc <- getBreakLoc break
+    pure $ (,) <$> sdoc_loc <*> getIgnoreCount count
+ignoreSwitch _ = pure $ Left $ text "Syntax:  :ignore <breaknum> <count>"
+
+getIgnoreCount :: String -> Either SDoc Int
+getIgnoreCount str =
+    case readMaybe str of
+      Nothing              -> Left $ sdocIgnore <+> "is not numeric"
+      Just cnt | cnt < 0   -> Left $ sdocIgnore <+> "must be >= 0"
+               | otherwise -> Right cnt
+    where
+      sdocIgnore = text "Ignore count" <+> quotes (text str)
+
+setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m()
+setupBreakpoint loc count = do
+    hsc_env <- GHC.getSession
+    GHC.setupBreakpoint hsc_env loc count
+
+backCmd :: GhciMonad m => String -> m ()
+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 $ text "Logged breakpoint at" <+> ppr pan
+      printTypeOfNames names
+       -- run the command set with ":set stop <cmd>"
+      st <- getGHCiState
+      enqueueCommands [stop st]
+
+forwardCmd :: GhciMonad m => String -> m ()
+forwardCmd arg
+  | null arg        = forward 1
+  | all isDigit arg = forward (read arg)
+  | otherwise       = liftIO $ putStrLn "Syntax:  :forward [num]"
+  where
+  forward num = withSandboxOnly ":forward" $ do
+      (names, ix, pan, _) <- GHC.forward num
+      printForUser $ (if (ix == 0)
+                        then text "Stopped at"
+                        else text "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 :: GhciMonad m => String -> m ()
+breakCmd argLine = withSandboxOnly ":break" $ breakSwitch $ words argLine
+
+breakSwitch :: GhciMonad m => [String] -> m ()
+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
+        breakById arg1
+
+breakByModule :: GhciMonad m => Module -> [String] -> m ()
+breakByModule md (arg1:rest)
+   | all isDigit arg1 = do  -- looks like a line number
+        breakByModuleLine md (read arg1) rest
+breakByModule _ _
+   = breakSyntax
+
+breakByModuleLine :: GhciMonad m => Module -> Int -> [String] -> m ()
+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
+
+-- Set a breakpoint for an identifier
+-- See Note [Setting Breakpoints by Id]
+breakById :: GhciMonad m => String -> m ()                          -- #3000
+breakById inp = do
+    let (mod_str, top_level, fun_str) = splitIdent inp
+        mod_top_lvl = combineModIdent mod_str top_level
+    mb_mod <- catch (lookupModuleInscope mod_top_lvl)
+                    (\(_ :: SomeException) -> lookupModuleInGraph mod_str)
+      -- If the top-level name is not in scope, `lookupModuleInscope` will
+      -- throw an exception, then lookup the module name in the module graph.
+    mb_err_msg <- validateBP mod_str fun_str mb_mod
+    case mb_err_msg of
+        Just err_msg -> printForUser $
+          text "Cannot set breakpoint on" <+> quotes (text inp)
+          <> text ":" <+> err_msg
+        Nothing -> do
+          -- No errors found, go and set the breakpoint
+          mb_mod_info  <- GHC.getModuleInfo $ fromJust mb_mod
+          let modBreaks = case mb_mod_info of
+                (Just mod_info) -> GHC.modInfoModBreaks mod_info
+                Nothing         -> emptyModBreaks
+          findBreakAndSet (fromJust mb_mod) $ findBreakForBind fun_str modBreaks
+  where
+    -- Try to lookup the module for an identifier that is in scope.
+    -- `parseName` throws an exception, if the identifier is not in scope
+    lookupModuleInscope :: GhciMonad m => String -> m (Maybe Module)
+    lookupModuleInscope mod_top_lvl = do
+        names <- GHC.parseName mod_top_lvl
+        pure $ Just $ NE.head $ GHC.nameModule <$> names
+
+    -- Lookup the Module of a module name in the module graph
+    lookupModuleInGraph :: GhciMonad m => String -> m (Maybe Module)
+    lookupModuleInGraph mod_str = do
+        graph <- GHC.getModuleGraph
+        let hmods = ms_mod <$> GHC.mgModSummaries graph
+        pure $ find ((== mod_str) . showModule) hmods
+
+    -- Check validity of an identifier to set a breakpoint:
+    --  1. The module of the identifier must exist
+    --  2. the identifier must be in an interpreted module
+    --  3. the ModBreaks array for module `mod` must have an entry
+    --     for the function
+    validateBP :: GhciMonad m => String -> String -> Maybe Module
+                       -> m (Maybe SDoc)
+    validateBP mod_str fun_str Nothing = pure $ Just $ quotes (text
+        (combineModIdent mod_str (Prelude.takeWhile (/= '.') fun_str)))
+        <+> text "not in scope"
+    validateBP _ "" (Just _) = pure $ Just $ text "Function name is missing"
+    validateBP _ fun_str (Just modl) = do
+        isInterpr <- GHC.moduleIsInterpreted modl
+        (_, decls) <- getModBreak modl
+        mb_err_msg <- case isInterpr of
+          False -> pure $ Just $ text "Module" <+> quotes (ppr modl)
+                        <+> text "is not interpreted"
+          True -> case fun_str `elem` (declPath <$> elems decls) of
+                False -> pure $ Just $
+                   text "No breakpoint found for" <+> quotes (text fun_str)
+                   <+> "in module" <+> quotes (ppr modl)
+                True  -> pure Nothing
+        pure mb_err_msg
+
+breakSyntax :: a
+breakSyntax = throwGhcException $ CmdLineError ("Syntax: :break [<mod>.]<func>[.<func>]\n"
+                                             ++ "        :break [<mod>] <line> [<column>]")
+
+findBreakAndSet :: GhciMonad m
+                => Module -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
+findBreakAndSet md lookupTickTree = do
+   tickArray <- getTickArray md
+   case lookupTickTree tickArray of
+      []  -> liftIO $ putStrLn $ "No breakpoints found at that location."
+      some -> mapM_ breakAt some
+ where
+   breakAt (tick, pan) = do
+         setBreakFlag md tick True
+         (alreadySet, nm) <-
+               recordBreak $ BreakLocation
+                       { breakModule = md
+                       , breakLoc = RealSrcSpan pan Strict.Nothing
+                       , breakTick = tick
+                       , onBreakCmd = ""
+                       , breakEnabled = True
+                       }
+         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 breakpoints for all the RHSs of the
+-- equations corresponding to a binding.  So we find all breakpoints
+-- for
+--   (a) this binder only (it maybe a top-level or a nested declaration)
+--   (b) that do not have an enclosing breakpoint
+findBreakForBind :: String -> GHC.ModBreaks -> TickArray
+                 -> [(BreakIndex,RealSrcSpan)]
+findBreakForBind str_name modbreaks _ = filter (not . enclosed) ticks
+  where
+    ticks = [ (index, span)
+            | (index, decls) <- assocs (GHC.modBreaks_decls modbreaks),
+              str_name == declPath decls,
+              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 Strict.Nothing `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"
+
+{-
+Note [Setting Breakpoints by Id]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+To set a breakpoint first check whether a ModBreaks array contains a
+breakpoint with the given function name:
+In `:break M.foo` `M` may be a module name or a local alias of an import
+statement. To lookup a breakpoint in the ModBreaks, the effective module
+name is needed. Even if a module called `M` exists, `M` may still be
+a local alias. To get the module name, parse the top-level identifier with
+`GHC.parseName`. If this succeeds, extract the module name from the
+returned value. If it fails, catch the exception and assume `M` is a real
+module name.
+
+The names of nested functions are stored in `ModBreaks.modBreaks_decls`.
+-}
+
+-----------------------------------------------------------------------------
+-- :where
+
+whereCmd :: GHC.GhcMonad m => String -> m ()
+whereCmd = noArgs $ do
+  mstrs <- getCallStackAtCurrentBreakpoint
+  case mstrs of
+    Nothing -> return ()
+    Just strs -> liftIO $ putStrLn (renderStack strs)
+
+-----------------------------------------------------------------------------
+-- :list
+
+listCmd :: GhciMonad m => String -> m ()
+listCmd "" = do
+   mb_span <- 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 :: GhciMonad m => [String] -> m ()
+list2 [arg] | all isDigit arg = do
+    imports <- GHC.getContext
+    case iiModules imports of
+        [] -> liftIO $ putStrLn "No module to list"
+        (mn : _) -> do
+          md <- 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) $
+                               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 :: GHC.GhcMonad m => Module -> Int -> m ()
+listModuleLine modl line = do
+   graph <- GHC.getModuleGraph
+   let this = GHC.mgLookupModule graph modl
+   case this of
+     Nothing -> panic "listModuleLine"
+     Just 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 -> 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
+
+      let utf8Decoded = utf8DecodeByteString output
+      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 :: GhciMonad m => Module -> m TickArray
+getTickArray modl = do
+   st <- getGHCiState
+   let arrmap = tickarrays st
+   case lookupModuleEnv arrmap modl of
+      Just arr -> return arr
+      Nothing  -> do
+        (ticks, _) <- getModBreak modl
+        let arr = mkTickArray (assocs ticks)
+        setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}
+        return arr
+
+discardTickArrays :: GhciMonad m => m ()
+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 :: GhciMonad m => m ()
+discardActiveBreakPoints = do
+   st <- getGHCiState
+   mapM_ (turnBreakOnOff False) $ breaks st
+   setGHCiState $ st { breaks = IntMap.empty }
+
+discardInterfaceCache :: GhciMonad m => m ()
+discardInterfaceCache =
+   void (liftIO . iface_clearCache . ifaceCache =<< getGHCiState)
+
+clearHPTs :: GhciMonad m => m ()
+clearHPTs = do
+  let pruneHomeUnitEnv hme = hme { homeUnitEnv_hpt = emptyHomePackageTable }
+      discardMG hsc = hsc { hsc_mod_graph = GHC.emptyMG }
+  modifySession (discardMG . discardIC . hscUpdateHUG (unitEnv_map pruneHomeUnitEnv))
+
+
+-- The unused package warning doesn't make sense once the targets get out of
+-- sync with the package flags. See #21110
+-- Therefore if it's turned on, the warnings are issued until the module context
+-- changes (via :load or :cd), at which stage the package flags are not going to change
+-- but the loaded modules will probably not use all the specified packages so the
+-- warning becomes spurious. At that point the warning is silently disabled.
+disableUnusedPackages :: GhciMonad m => m ()
+disableUnusedPackages = newDynFlags False ["-Wno-unused-packages"]
+
+deleteBreak :: GhciMonad m => Int -> m ()
+deleteBreak identity = do
+   st <- getGHCiState
+   let oldLocations = breaks st
+   case IntMap.lookup identity oldLocations of
+       Nothing -> printForUser (text "Breakpoint" <+> ppr identity <+>
+                                text "does not exist")
+       Just loc -> do
+           _ <- (turnBreakOnOff False) loc
+           let rest = IntMap.delete identity oldLocations
+           setGHCiState $ st { breaks = rest }
+
+turnBreakOnOff :: GhciMonad m => Bool -> BreakLocation -> m BreakLocation
+turnBreakOnOff onOff loc
+  | onOff == breakEnabled loc = return loc
+  | otherwise = do
+      setBreakFlag (breakModule loc) (breakTick loc)  onOff
+      return loc { breakEnabled = onOff }
+
+getModBreak :: GHC.GhcMonad m
+            => Module -> m (Array Int SrcSpan, Array Int [String])
+getModBreak m = do
+   mod_info      <- fromMaybe (panic "getModBreak") <$> GHC.getModuleInfo m
+   let modBreaks  = GHC.modInfoModBreaks mod_info
+   let ticks      = GHC.modBreaks_locs  modBreaks
+   let decls      = GHC.modBreaks_decls modBreaks
+   return (ticks, decls)
+
+setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
+setBreakFlag  md ix enaDisa = do
+  let enaDisaToCount True = breakOn
+      enaDisaToCount False = breakOff
+  setupBreakpoint (GHC.BreakpointId md ix) $ enaDisaToCount enaDisa
+
+-- ---------------------------------------------------------------------------
+-- 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 around the flushing operation, so if stderr is closed
+-- GHCi will just die gracefully rather than going into an infinite loop.
+handler :: GhciMonad m => SomeException -> m Bool
+handler exception = do
+  flushInterpBuffers
+  withSignalHandlers $
+     ghciHandle handler (showException exception >> return False)
+
+showException :: MonadIO m => SomeException -> m ()
+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
+
+failIfExprEvalMode :: GhciMonad m => m ()
+failIfExprEvalMode = do
+  s <- getGHCiState
+  when (ghc_e s) $
+    liftIO (exitWith (ExitFailure 1))
+
+-- | When in expression evaluation mode (ghc -e), we want to exit immediately.
+-- Otherwis, just print out the message.
+printErrAndMaybeExit :: (GhciMonad m, MonadIO m, HasLogger m) => SourceError -> m ()
+printErrAndMaybeExit = (>> failIfExprEvalMode) . printGhciException
+
+-----------------------------------------------------------------------------
+-- 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 :: (HasLogger m, ExceptionMonad m) => (SomeException -> m a) -> m a -> m a
+ghciHandle h m = mask $ \restore -> do
+                 -- Force dflags to avoid leaking the associated HscEnv
+                 !log <- getLogger
+                 catch (restore (GHC.prettyPrintGhcErrors log m)) $ \e -> restore (h e)
+
+ghciTry :: ExceptionMonad m => m a -> m (Either SomeException a)
+ghciTry m = fmap Right m `catch` \e -> return $ Left e
+
+tryBool :: ExceptionMonad m => m a -> m 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.lookupQualifiedModule NoPkgQual mName
+
+isMainUnitModule :: Module -> Bool
+isMainUnitModule m = GHC.moduleUnit m == mainUnit
+
+showModule :: Module -> String
+showModule = moduleNameString . moduleName
+
+-- Return a String with the declPath of the function of a breakpoint.
+-- See Note [Field modBreaks_decls] in GHC.ByteCode.Types
+declPath :: [String] -> String
+declPath = intercalate "."
+
+-- | Optionally show a fixity declaration like @infixr 4 #@
+--
+-- We always display the fixity of terms with symbolic names (like <$>).
+-- For other terms we only display the fixity if it has been set to a
+-- value other than the default infixl 9.
+--
+-- We have no way of distinguishing between a fixity that has been
+-- manually set to infixl 9 and a fixity that has assumed infixl 9 as
+-- the default, so we choose to not display the fixity in both cases
+-- (for terms with non-symbolic names).
+--
+-- See #19200.
+showFixity :: TyThing -> Fixity -> SDoc
+showFixity thing fixity
+    | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)
+        = ppr fixity <+> pprInfixName (GHC.getName thing)
+    | otherwise = empty
+
+-- TODO: won't work if home dir is encoded.
+-- (changeDirectory may not work either in that case.)
+expandPath :: MonadIO m => String -> 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
+   home_unit <- hsc_home_unit <$> GHC.getSession
+   unless (isHomeModule home_unit modl) $
+      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 printGhciException $ do
+    n NE.:| _ <- GHC.parseName str
+    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
+
+clearCaches :: GhciMonad m => m ()
+clearCaches = discardActiveBreakPoints
+              >> discardInterfaceCache
+              >> disableUnusedPackages
+              >> clearHPTs
+
+
+
+-- Split up a string with an eventually qualified declaration name into 3 components
+--   1. module name
+--   2. top-level decl
+--   3. full-name of the eventually nested decl, but without module qualification
+-- eg  "foo"           = ("", "foo", "foo")
+--     "A.B.C.foo"     = ("A.B.C", "foo", "foo")
+--     "M.N.foo.bar"   = ("M.N", "foo", "foo.bar")
+splitIdent :: String -> (String, String, String)
+splitIdent [] = ("", "", "")
+splitIdent inp@(a : _)
+    | (isUpper a) = case fixs of
+        []            -> (inp, "", "")
+        (i1 : [] )    -> (upto i1, from i1, from i1)
+        (i1 : i2 : _) -> (upto i1, take (i2 - i1 - 1) (from i1), from i1)
+    | otherwise = case ixs of
+        []            -> ("", inp, inp)
+        (i1 : _)      -> ("", upto i1, inp)
+  where
+    ixs = elemIndices '.' inp        -- indices of '.' in whole input
+    fixs = dropWhile isNextUc ixs    -- indices of '.' in function names              --
+    isNextUc ix = isUpper $ safeInp !! (ix+1)
+    safeInp = inp ++ " "
+    upto i = take i inp
+    from i = drop (i + 1) inp
+
+-- Qualify an identifier name with a module name
+-- combineModIdent "A" "foo"  =  "A.foo"
+-- combineModIdent ""  "foo"  =  "foo"
+combineModIdent :: String -> String -> String
+combineModIdent mod ident
+          | null mod   = ident
+          | null ident = mod
+          | otherwise  = mod ++ "." ++ ident
diff --git a/src-bin-9.10.2/Clash/GHCi/UI/Exception.hs b/src-bin-9.10.2/Clash/GHCi/UI/Exception.hs
new file mode 100644
--- /dev/null
+++ b/src-bin-9.10.2/Clash/GHCi/UI/Exception.hs
@@ -0,0 +1,142 @@
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Clash.GHCi.UI.Exception(printGhciException, GHCiMessage(..)) where
+
+import GHC.Prelude
+
+import GHC.Driver.Config.Diagnostic
+import GHC.Driver.Errors
+import GHC.Driver.Errors.Types
+import GHC.Driver.Session
+
+import GHC.Iface.Errors.Ppr
+import GHC.Iface.Errors.Types
+
+import qualified GHC.LanguageExtensions as LangExt
+
+import GHC.Tc.Errors.Ppr
+import GHC.Tc.Errors.Types
+
+import GHC.Types.Error
+import GHC.Types.SourceError
+
+import GHC.Unit.State
+
+import GHC.Utils.Logger
+import GHC.Utils.Outputable
+
+import Control.Monad.IO.Class
+
+
+-- | Print the all diagnostics in a 'SourceError'.  Specialised for GHCi error reporting
+-- for some error messages.
+printGhciException :: (HasLogger m, MonadIO m, HasDynFlags m) => SourceError -> m ()
+printGhciException err = do
+  dflags <- getDynFlags
+  logger <- getLogger
+  let !diag_opts = initDiagOpts dflags
+      !print_config = initPrintConfig dflags
+  liftIO $ printMessages logger print_config diag_opts (GHCiMessage <$> (srcErrorMessages err))
+
+
+newtype GHCiMessage = GHCiMessage { _getGhciMessage :: GhcMessage }
+
+instance Diagnostic GHCiMessage where
+  type DiagnosticOpts GHCiMessage = DiagnosticOpts GhcMessage
+
+  diagnosticMessage opts (GHCiMessage msg) = ghciDiagnosticMessage opts msg
+
+  diagnosticReason (GHCiMessage msg) = diagnosticReason msg
+
+  diagnosticHints (GHCiMessage msg) = ghciDiagnosticHints msg
+
+  diagnosticCode (GHCiMessage msg)  = diagnosticCode msg
+
+
+-- | Modifications to hint messages which we want to display in GHCi.
+ghciDiagnosticHints :: GhcMessage -> [GhcHint]
+ghciDiagnosticHints msg = map modifyHintForGHCi (diagnosticHints msg)
+  where
+    modifyHintForGHCi :: GhcHint -> GhcHint
+    modifyHintForGHCi = \case
+      SuggestExtension extHint -> SuggestExtension $ modifyExtHintForGHCi extHint
+      hint -> hint
+    modifyExtHintForGHCi :: LanguageExtensionHint -> LanguageExtensionHint
+    modifyExtHintForGHCi = \case
+      SuggestSingleExtension    doc ext  -> SuggestSingleExtension    (suggestSetExt [ext] doc False) ext
+      SuggestExtensionInOrderTo doc ext  -> SuggestExtensionInOrderTo (suggestSetExt [ext] doc False) ext
+      SuggestAnyExtension       doc exts -> SuggestAnyExtension       (suggestSetExt exts  doc True ) exts
+      SuggestExtensions         doc exts -> SuggestExtensions         (suggestSetExt exts  doc False) exts
+    -- Suggest enabling extension with :set -X<ext>
+    -- SuggestAnyExtension will be on multiple lines so the user can select which to enable without editing
+    suggestSetExt :: [LangExt.Extension] -> SDoc -> Bool -> SDoc
+    suggestSetExt exts doc enable_any = doc $$ hang header 2 exts_cmds
+      where
+        header = text "You may enable" <+> which <+> text "language extension" <> plural exts <+> text "in GHCi with:"
+        which
+          | [ _ext ] <- exts
+          = text "this"
+          | otherwise
+          = if enable_any
+            then text "these"
+            else text "all of these"
+        exts_cmds
+          | enable_any
+          = vcat $ map (\ext -> text ":set -X" <> ppr ext) exts
+          | otherwise
+          = text ":set" <> hcat (map (\ext -> text " -X" <> ppr ext) exts)
+
+-- Modifications to error messages which we want to display in GHCi
+ghciDiagnosticMessage :: GhcMessageOpts -> GhcMessage -> DecoratedSDoc
+ghciDiagnosticMessage ghc_opts msg =
+  case msg of
+    GhcTcRnMessage tc_msg ->
+      case tcRnMessage (tcMessageOpts ghc_opts) tc_msg of
+        Nothing -> diagnosticMessage ghc_opts msg
+        Just sdoc -> sdoc
+    GhcDriverMessage  (DriverInterfaceError err) ->
+      case ghciInterfaceError err of
+        Just sdoc -> mkSimpleDecorated sdoc
+        Nothing -> diagnosticMessage ghc_opts msg
+    GhcDriverMessage {} -> diagnosticMessage ghc_opts msg
+    GhcPsMessage  {} -> diagnosticMessage ghc_opts msg
+    GhcDsMessage  {} -> diagnosticMessage ghc_opts msg
+    GhcUnknownMessage  {} -> diagnosticMessage ghc_opts msg
+  where
+    tcRnMessage tc_opts tc_msg =
+      case tc_msg of
+        TcRnInterfaceError err -> mkSimpleDecorated <$> (ghciInterfaceError err)
+        TcRnMessageWithInfo unit_state msg_with_info ->
+          case msg_with_info of
+           TcRnMessageDetailed err_info wrapped_msg
+             -> messageWithInfoDiagnosticMessage unit_state err_info
+                  (tcOptsShowContext tc_opts)
+                  <$> tcRnMessage tc_opts wrapped_msg
+        TcRnWithHsDocContext ctxt wrapped_msg ->
+          messageWithHsDocContext tc_opts ctxt <$> tcRnMessage tc_opts wrapped_msg
+        _ -> Nothing
+
+    opts = tcOptsIfaceOpts (tcMessageOpts ghc_opts)
+
+    ghciInterfaceError (Can'tFindInterface err looking_for) =
+      hangNotEmpty (lookingForHerald looking_for) 2 <$> ghciMissingInterfaceErrorDiagnostic err
+    ghciInterfaceError _ = Nothing
+
+    ghciMissingInterfaceErrorDiagnostic reason =
+      case reason of
+        CantFindErr us module_or_interface cfi -> Just (pprWithUnitState us $ cantFindErrorX pkg_hidden_hint may_show_locations module_or_interface cfi)
+        _ -> Nothing
+      where
+
+        may_show_locations = mayShowLocations ":set -v" (ifaceShowTriedFiles opts)
+
+        pkg_hidden_hint = pkgHiddenHint hidden_msg (ifaceBuildingCabalPackage opts)
+          where
+            hidden_msg pkg =
+              text "You can run" <+>
+              quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
+              text "to expose it." $$
+              text "(Note: this unloads all the modules in the current scope.)"
diff --git a/src-bin-9.10.2/Clash/GHCi/UI/Info.hs b/src-bin-9.10.2/Clash/GHCi/UI/Info.hs
new file mode 100644
--- /dev/null
+++ b/src-bin-9.10.2/Clash/GHCi/UI/Info.hs
@@ -0,0 +1,409 @@
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns        #-}
+
+{-# OPTIONS -fno-warn-name-shadowing #-}
+
+-- | Get information on modules, expressions, and identifiers
+module Clash.GHCi.UI.Info
+    ( ModInfo(..)
+    , SpanInfo(..)
+    , spanInfoFromRealSrcSpan
+    , collectInfo
+    , findLoc
+    , findNameUses
+    , findType
+    , getModInfo
+    ) where
+
+import           Control.Exception
+import           Control.Monad
+import           Control.Monad.Catch as MC
+import           Control.Monad.Trans.Class
+import           Control.Monad.Trans.Except
+import           Control.Monad.Trans.Maybe
+import           Data.Data
+import           Data.Function
+import           Data.List (find, sortBy)
+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           GHC.Hs.Syn.Type
+import           GHC.Driver.Session (HasDynFlags(..))
+import           GHC.Data.FastString
+import           GHC
+import           GHC.Driver.Monad
+import           GHC.Driver.Env
+import           GHC.Driver.Ppr
+import           GHC.Types.Name
+import           GHC.Types.Name.Reader
+import           GHC.Types.Name.Set
+import           GHC.Utils.Outputable
+import           GHC.Types.SrcLoc
+import           GHC.Types.Var
+import qualified GHC.Data.Strict as Strict
+
+-- | 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.
+    , modinfoRdrEnv     :: !(Strict.Maybe IfGlobalRdrEnv)
+      -- ^ What's in scope in the module.
+    , modinfoLastUpdate :: !UTCTime
+      -- ^ The timestamp of the file used to generate this record.
+    }
+
+-- | 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.
+    }
+
+instance Outputable SpanInfo where
+  ppr (SpanInfo s t i) = ppr s <+> ppr t <+> ppr i
+
+-- | 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 s = RealSrcSpan (spaninfoSrcSpan s) Strict.Nothing
+        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
+    rdrs = modInfo_rdrs mi
+    tryExternalModuleResolution =
+      case find (matchName $ mkFastString string) rdrs 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 (moduleUnit modL) <> ":" <>
+                            ppr modL)) return $
+             M.lookup (moduleName modL) infos
+
+     let all_names = modInfo_rdrs info
+
+     maybe (throwE "No matching export in any local modules.") return $
+         find (matchName name) all_names
+  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 TM_Inst 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 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 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
+    unit_state <- hsc_units <$> getSession
+    liftIO (filterM cacheInvalid loaded) >>= \case
+        [] -> return ms
+        invalidated -> do
+            liftIO (putStrLn ("Collecting type info for " ++
+                              show (length invalidated) ++
+                              " module(s) ... "))
+
+            foldM (go df unit_state) ms invalidated
+  where
+    go df unit_state m name = do { info <- getModInfo name; return (M.insert name info m) }
+                   `MC.catch`
+                   (\(e :: SomeException) -> do
+                         liftIO $ putStrLn
+                                $ showSDocForUser df unit_state 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 = srcFilePath (modinfoSummary mi)
+                last' = modinfoLastUpdate mi
+            current <- getModificationTime fp
+            exists <- doesFileExist fp
+            if exists
+                then return $ current /= last'
+                else return True
+
+-- | Get the source file path from a ModSummary.
+-- If the .hs file is missing, and the .o file exists,
+-- we return the .o file path.
+srcFilePath :: ModSummary -> FilePath
+srcFilePath modSum = fromMaybe obj_fp src_fp
+    where
+        src_fp = ml_hs_file ms_loc
+        obj_fp = ml_obj_file ms_loc
+        ms_loc = ms_location modSum
+
+-- | 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
+    let allTypes = processAllTypeCheckedModule typechecked
+        module_info = tm_checked_module_info typechecked
+        !rdr_env = case modInfoRdrEnv module_info of
+          Just rdrs -> Strict.Just rdrs
+            -- NB: this has already been deeply forced; no need to do that again.
+            -- See test case T15369 and Note [Forcing GREInfo] in GHC.Types.GREInfo.
+          Nothing   -> Strict.Nothing
+    ts <- liftIO $ getModificationTime $ srcFilePath m
+    return $
+      ModInfo
+        { modinfoSummary    = m
+        , modinfoSpans      = allTypes
+        , modinfoRdrEnv     = rdr_env
+        , modinfoLastUpdate = ts
+        }
+
+-- | Get the 'Name's from the 'GlobalRdrEnv' of the 'ModInfo', if any.
+modInfo_rdrs :: ModInfo -> [Name]
+modInfo_rdrs mi =
+  case modinfoRdrEnv mi of
+    Strict.Nothing  -> []
+    Strict.Just env -> map greName $ globalRdrEnvElts env
+
+-- | Get ALL source spans in the module.
+processAllTypeCheckedModule :: TypecheckedModule -> [SpanInfo]
+processAllTypeCheckedModule tcm
+  = mapMaybe toSpanInfo
+  $ sortBy cmpSpan
+  $ catMaybes (bts ++ ets ++ pts)
+  where
+    bts = map getTypeLHsBind $ listifyAllSpans tcs
+    ets = map getTypeLHsExpr $ listifyAllSpans tcs
+    pts = map getTypeLPat    $ listifyAllSpans tcs
+
+    tcs = tm_typechecked_source tcm
+
+    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsBind's
+    getTypeLHsBind :: LHsBind GhcTc -> Maybe (Maybe Id,SrcSpan,Type)
+    getTypeLHsBind (L _spn FunBind{fun_id = pid,fun_matches = MG _ _})
+        = Just (Just (unLoc pid), getLocA pid,varType (unLoc pid))
+    getTypeLHsBind _ = Nothing
+
+    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsExpr's
+    getTypeLHsExpr :: LHsExpr GhcTc -> Maybe (Maybe Id,SrcSpan,Type)
+    getTypeLHsExpr e = Just (mid, getLocA e, lhsExprType e)
+      where
+        mid :: Maybe Id
+        mid | HsVar _ (L _ i) <- unwrapVar (unLoc e) = Just i
+            | otherwise                              = Nothing
+
+        unwrapVar (XExpr (WrapExpr (HsWrap _ var))) = var
+        unwrapVar e'                                = e'
+
+    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LPats's
+    getTypeLPat :: LPat GhcTc -> Maybe (Maybe Id,SrcSpan,Type)
+    getTypeLPat (L spn pat) = Just (getMaybeId pat,locA spn,hsPatType pat)
+      where
+        getMaybeId :: Pat GhcTc -> Maybe Id
+        getMaybeId (VarPat _ (L _ vid)) = Just vid
+        getMaybeId _                        = Nothing
+
+    -- | Get ALL source spans in the source.
+    listifyAllSpans :: Typeable a => TypecheckedSource -> [LocatedA a]
+    listifyAllSpans = everythingAllSpans (++) [] ([] `mkQ` (\x -> [x | p x]))
+      where
+        p (L spn _) = isGoodSrcSpan (locA spn)
+
+    -- | Variant of @syb@'s @everything@ (which summarises all nodes
+    -- in top-down, left-to-right order) with a stop-condition on 'NameSet's
+    -- and 'OverLitTc'
+    everythingAllSpans :: (r -> r -> r) -> r -> GenericQ r -> GenericQ r
+    everythingAllSpans k z f x
+      | (False `mkQ` (const True :: NameSet -> Bool)) x = z
+      -- Exception for OverLitTc: we have SrcSpans in the ol_witness field,
+      -- but it's there only for HIE file info (see Note [Source locations for implicit function calls]).
+      -- T16804 fails without this.
+      | (False `mkQ` (const True :: OverLitTc -> 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-9.10.2/Clash/GHCi/UI/Monad.hs b/src-bin-9.10.2/Clash/GHCi/UI/Monad.hs
new file mode 100644
--- /dev/null
+++ b/src-bin-9.10.2/Clash/GHCi/UI/Monad.hs
@@ -0,0 +1,575 @@
+{-# LANGUAGE FlexibleInstances, DeriveFunctor, DerivingVia #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-----------------------------------------------------------------------------
+--
+-- Monadery code used in InteractiveUI
+--
+-- (c) The GHC Team 2005-2006
+--
+-----------------------------------------------------------------------------
+
+module Clash.GHCi.UI.Monad (
+        GHCi(..), startGHCi,
+        GHCiState(..), GhciMonad(..),
+        GHCiOption(..), isOptionSet, setOption, unsetOption,
+        Command(..), CommandResult(..), cmdSuccess,
+        CmdExecOutcome(..),
+        LocalConfigBehaviour(..),
+        PromptFunction,
+        BreakLocation(..),
+        TickArray,
+        extractDynFlags, getDynFlags,
+
+        runStmt, runDecls, runDecls', resume, recordBreak, revertCAFs,
+        ActionStats(..), runAndPrintStats, runWithStats, printStats,
+
+        printForUserNeverQualify,
+        printForUserModInfo, printForUserGlobalRdrEnv,
+        printForUser, printForUserPartWay, prettyLocations,
+
+        compileGHCiExpr,
+        initInterpBuffering,
+        turnOffBuffering, turnOffBuffering_,
+        flushInterpBuffers,
+        runInternal,
+        mkEvalWrapper
+    ) where
+
+import Clash.GHCi.UI.Info (ModInfo)
+import qualified GHC
+import GHC.Driver.Monad hiding (liftIO)
+import GHC.Utils.Outputable
+import qualified GHC.Driver.Ppr as Ppr
+import GHC.Types.Name.Occurrence
+import GHC.Types.Name.Reader
+import GHC.Driver.Session
+import GHC.Data.FastString
+import GHC.Driver.Env
+import GHC.Types.SrcLoc
+import GHC.Types.SafeHaskell
+import GHC.Driver.Make (ModIfaceCache(..))
+import GHC.Unit
+import GHC.Types.Name.Reader as RdrName (mkOrig)
+import qualified GHC.Types.Name.Ppr as Ppr (mkNamePprCtx)
+import GHC.Builtin.Names (gHC_INTERNAL_GHCI_HELPERS)
+import GHC.Runtime.Interpreter
+import GHC.Runtime.Context
+import GHCi.RemoteTypes
+import Clash.GHCi.UI.Exception (printGhciException)
+import GHC.Hs (ImportDecl, GhcPs, GhciLStmt, LHsDecl)
+import GHC.Hs.Utils
+import GHC.Utils.Misc
+import GHC.Utils.Logger
+
+import GHC.Utils.Exception hiding (uninterruptibleMask, mask, catch)
+import Numeric
+import Data.Array
+import Data.IORef
+import Data.Time
+import System.Environment
+import System.IO
+import Control.Monad
+import Prelude hiding ((<>))
+
+import System.Console.Haskeline (CompletionFunc, InputT)
+import Control.Monad.Catch as MC
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Reader
+import Control.Monad.IO.Class
+import Data.Map.Strict (Map)
+import qualified Data.IntMap.Strict as IntMap
+import qualified GHC.Data.EnumSet as EnumSet
+import qualified GHC.LanguageExtensions as LangExt
+
+-----------------------------------------------------------------------------
+-- GHCi monad
+
+data GHCiState = GHCiState
+     {
+        progname       :: String,
+        args           :: [String],
+        evalWrapper    :: ForeignHValue, -- ^ of type @IO a -> IO a@
+        prompt         :: PromptFunction,
+        prompt_cont    :: PromptFunction,
+        editor         :: String,
+        stop           :: String,
+        multiMode      :: Bool,
+        localConfig    :: LocalConfigBehaviour,
+        options        :: [GHCiOption],
+        line_number    :: !Int,         -- ^ input line
+        break_ctr      :: !Int,
+        breaks         :: !(IntMap.IntMap 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
+        cmd_wrapper    :: InputT GHCi CommandResult -> InputT GHCi (Maybe Bool),
+            -- ^ The command wrapper is run for each command or statement.
+            -- The 'Bool' value denotes whether the command is successful and
+            -- 'Nothing' means to exit GHCi.
+        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.
+
+        extra_imports  :: [ImportDecl GhcPs],
+            -- ^ These are "always-on" imports, added to the
+            -- context regardless of what other imports we have.
+            -- This is useful for adding imports that are required
+            -- by setGHCiMonad.  Be careful adding things here:
+            -- you can create ambiguities if these imports overlap
+            -- with other things in scope.
+            --
+            -- NB. although this is not currently used by GHCi itself,
+            -- it was added to support other front-ends that are based
+            -- on the GHCi code.  Potentially we could also expose
+            -- this functionality via GHCi commands.
+
+        prelude_imports :: [ImportDecl GhcPs],
+            -- ^ These imports are added to the context when
+            -- -XImplicitPrelude is on and we don't have a *-module
+            -- in the context.  They can also be overridden by another
+            -- import for the same module, e.g.
+            -- "import Prelude hiding (map)"
+
+        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
+        ifaceCache :: ModIfaceCache
+     }
+
+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 CmdExecOutcome
+     -- ^ The 'CmdExecOutcome' value denotes whether to exit GHCi cleanly or error out
+   , 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
+   }
+
+-- | Used to denote GHCi command execution result. Specifically, used to
+-- distinguish between two ghci execution modes - "REPL" and "Expression
+-- evaluation mode (ghc -e)". When in "REPL" mode, we don't want to exit
+-- GHCi session when error occurs, (which is when we use "CmdSuccess").
+-- Otherwise, when in expression evaluation mode, all command failures
+-- should lead to GHCi session termination (with ExitFailure 1) which is
+-- when "CmdFailure" is used(this is useful when executing scripts).
+-- "CleanExit" is used to signal end of GHCi session (for example, when
+-- ":quit" command is called).
+data CmdExecOutcome
+  = CleanExit
+  | CmdSuccess
+  | CmdFailure
+
+data CommandResult
+   = CommandComplete
+   { cmdInput :: String
+   , cmdResult :: Either SomeException (Maybe Bool)
+   , cmdStats :: ActionStats
+   }
+   | CommandIncomplete
+     -- ^ Unterminated multiline command
+   deriving Show
+
+cmdSuccess :: MonadThrow m => CommandResult -> m (Maybe Bool)
+cmdSuccess CommandComplete{ cmdResult = Left e } = throwM e
+cmdSuccess CommandComplete{ cmdResult = Right r } = return r
+cmdSuccess CommandIncomplete = return $ Just True
+
+type PromptFunction = [String]
+                   -> Int
+                   -> GHCi SDoc
+
+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
+
+-- | Treatment of ./.ghci files.  For now we either load or
+-- ignore.  But later we could implement a "safe mode" where
+-- only safe operations are performed.
+--
+data LocalConfigBehaviour
+  = SourceLocalConfig
+  | IgnoreLocalConfig
+  deriving (Eq)
+
+data BreakLocation
+   = BreakLocation
+   { breakModule :: !GHC.Module
+   , breakLoc    :: !SrcSpan
+   , breakTick   :: {-# UNPACK #-} !Int
+   , breakEnabled:: !Bool
+   , onBreakCmd  :: String
+   }
+
+instance Eq BreakLocation where
+  loc1 == loc2 = breakModule loc1 == breakModule loc2 &&
+                 breakTick loc1   == breakTick loc2
+
+prettyLocations :: IntMap.IntMap BreakLocation -> SDoc
+prettyLocations  locs =
+    case  IntMap.null locs of
+      True  -> text "No active breakpoints."
+      False -> vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ IntMap.toAscList locs
+
+instance Outputable BreakLocation where
+   ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
+                if null (onBreakCmd loc)
+                   then empty
+                   else doubleQuotes (text (onBreakCmd loc))
+      where pprEnaDisa = case breakEnabled loc of
+                True  -> text "enabled"
+                False -> text "disabled"
+
+recordBreak
+  :: GhciMonad m => BreakLocation -> m (Bool{- was already present -}, Int)
+recordBreak brkLoc = do
+   st <- getGHCiState
+   let oldmap = breaks st
+       oldActiveBreaks = IntMap.assocs oldmap
+   -- 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 = IntMap.insert oldCounter brkLoc oldmap
+                        }
+      return (False, oldCounter)
+
+newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> Ghc a }
+    deriving (Functor)
+    deriving (MonadThrow, MonadCatch, MonadMask) via (ReaderT (IORef GHCiState) Ghc)
+
+reflectGHCi :: (Session, IORef GHCiState) -> GHCi a -> IO a
+reflectGHCi (s, gs) m = unGhc (unGHCi m gs) s
+
+startGHCi :: GHCi a -> GHCiState -> Ghc a
+startGHCi g state = do ref <- liftIO $ newIORef state; unGHCi g ref
+
+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 GhcMonad m => GhciMonad m where
+  getGHCiState    :: m GHCiState
+  setGHCiState    :: GHCiState -> m ()
+  modifyGHCiState :: (GHCiState -> GHCiState) -> m ()
+  reifyGHCi       :: ((Session, IORef GHCiState) -> IO a) -> m a
+
+instance GhciMonad GHCi where
+  getGHCiState      = GHCi $ \r -> liftIO $ readIORef r
+  setGHCiState s    = GHCi $ \r -> liftIO $ writeIORef r s
+  modifyGHCiState f = GHCi $ \r -> liftIO $ modifyIORef' r f
+  reifyGHCi f       = GHCi $ \r -> reifyGhc $ \s -> f (s, r)
+
+instance GhciMonad (InputT GHCi) where
+  getGHCiState    = lift getGHCiState
+  setGHCiState    = lift . setGHCiState
+  modifyGHCiState = lift . modifyGHCiState
+  reifyGHCi       = lift . reifyGHCi
+
+liftGhc :: Ghc a -> GHCi a
+liftGhc m = GHCi $ \_ -> m
+
+instance MonadIO GHCi where
+  liftIO = liftGhc . liftIO
+
+instance HasDynFlags GHCi where
+  getDynFlags = getSessionDynFlags
+
+instance HasLogger GHCi where
+  getLogger = hsc_logger <$> getSession
+
+instance GhcMonad GHCi where
+  setSession s' = liftGhc $ setSession s'
+  getSession    = liftGhc $ getSession
+
+
+instance HasDynFlags (InputT GHCi) where
+  getDynFlags = lift getDynFlags
+
+instance HasLogger (InputT GHCi) where
+  getLogger = lift getLogger
+
+instance GhcMonad (InputT GHCi) where
+  setSession = lift . setSession
+  getSession = lift getSession
+
+isOptionSet :: GhciMonad m => GHCiOption -> m Bool
+isOptionSet opt
+ = do st <- getGHCiState
+      return $! (opt `elem` options st)
+
+setOption :: GhciMonad m => GHCiOption -> m ()
+setOption opt
+ = do st <- getGHCiState
+      setGHCiState (st{ options = opt : filter (/= opt) (options st) })
+
+unsetOption :: GhciMonad m => GHCiOption -> m ()
+unsetOption opt
+ = do st <- getGHCiState
+      setGHCiState (st{ options = filter (/= opt) (options st) })
+
+printForUserNeverQualify :: GhcMonad m => SDoc -> m ()
+printForUserNeverQualify doc = do
+  dflags <- GHC.getInteractiveDynFlags
+  liftIO $ Ppr.printForUser dflags stdout neverQualify AllTheWay doc
+
+printForUserModInfo :: GhcMonad m => GHC.ModuleInfo -> SDoc -> m ()
+printForUserModInfo info = printForUserGlobalRdrEnv (GHC.modInfoRdrEnv info)
+
+printForUserGlobalRdrEnv :: (GhcMonad m, Outputable info)
+                         => Maybe (GlobalRdrEnvX info) -> SDoc -> m ()
+printForUserGlobalRdrEnv mb_rdr_env doc = do
+  dflags <- GHC.getInteractiveDynFlags
+  name_ppr_ctx <- mkNamePprCtxFromGlobalRdrEnv dflags mb_rdr_env
+  liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx AllTheWay doc
+    where
+      mkNamePprCtxFromGlobalRdrEnv _ Nothing = GHC.getNamePprCtx
+      mkNamePprCtxFromGlobalRdrEnv dflags (Just rdr_env) =
+        withSession $ \ hsc_env ->
+        let unit_env = hsc_unit_env hsc_env
+            ptc = initPromotionTickContext dflags
+        in  return $ Ppr.mkNamePprCtx ptc unit_env rdr_env
+
+printForUser :: GhcMonad m => SDoc -> m ()
+printForUser doc = do
+  name_ppr_ctx <- GHC.getNamePprCtx
+  dflags <- GHC.getInteractiveDynFlags
+  liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx AllTheWay doc
+
+printForUserPartWay :: GhcMonad m => SDoc -> m ()
+printForUserPartWay doc = do
+  name_ppr_ctx <- GHC.getNamePprCtx
+  dflags <- GHC.getInteractiveDynFlags
+  liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx DefaultDepth doc
+
+-- | Run a single Haskell expression
+runStmt
+  :: GhciMonad m
+  => GhciLStmt GhcPs -> String -> GHC.SingleStep -> m (Maybe GHC.ExecResult)
+runStmt stmt stmt_text step = do
+  st <- getGHCiState
+  GHC.handleSourceError (\e -> do printGhciException 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' stmt stmt_text opts
+
+runDecls :: GhciMonad m => String -> m (Maybe [GHC.Name])
+runDecls decls = do
+  st <- getGHCiState
+  reifyGHCi $ \x ->
+    withProgName (progname st) $
+    withArgs (args st) $
+      reflectGHCi x $ do
+        GHC.handleSourceError (\e -> do printGhciException e
+                                        return Nothing) $ do
+          r <- GHC.runDeclsWithLocation (progname st) (line_number st) decls
+          return (Just r)
+
+runDecls' :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe [GHC.Name])
+runDecls' decls = do
+  st <- getGHCiState
+  reifyGHCi $ \x ->
+    withProgName (progname st) $
+    withArgs (args st) $
+    reflectGHCi x $
+      GHC.handleSourceError
+        (\e -> do printGhciException e
+                  return Nothing)
+        (Just <$> GHC.runParsedDecls decls)
+
+resume :: GhciMonad m => (SrcSpan -> Bool) -> GHC.SingleStep -> Maybe Int -> m GHC.ExecResult
+resume canLogSpan step mbIgnoreCnt = do
+  st <- getGHCiState
+  reifyGHCi $ \x ->
+    withProgName (progname st) $
+    withArgs (args st) $
+      reflectGHCi x $ do
+        GHC.resumeExec canLogSpan step mbIgnoreCnt
+
+-- --------------------------------------------------------------------------
+-- timing & statistics
+
+data ActionStats = ActionStats
+  { actionAllocs :: Maybe Integer
+  , actionElapsedTime :: Double
+  } deriving Show
+
+runAndPrintStats
+  :: GhciMonad m
+  => (a -> Maybe Integer)
+  -> m a
+  -> m (ActionStats, Either SomeException a)
+runAndPrintStats getAllocs action = do
+  result <- runWithStats getAllocs action
+  case result of
+    (stats, Right{}) -> do
+      showTiming <- isOptionSet ShowTiming
+      when showTiming $ do
+        dflags  <- getDynFlags
+        liftIO $ printStats dflags stats
+    _ -> return ()
+  return result
+
+runWithStats
+  :: ExceptionMonad m
+  => (a -> Maybe Integer) -> m a -> m (ActionStats, Either SomeException a)
+runWithStats getAllocs action = do
+  t0 <- liftIO getCurrentTime
+  result <- MC.try action
+  let allocs = either (const Nothing) getAllocs result
+  t1 <- liftIO getCurrentTime
+  let elapsedTime = realToFrac $ t1 `diffUTCTime` t0
+  return (ActionStats allocs elapsedTime, result)
+
+printStats :: DynFlags -> ActionStats -> IO ()
+printStats dflags ActionStats{actionAllocs = mallocs, actionElapsedTime = secs}
+   = do let secs_str = showFFloat (Just 2) secs
+        putStrLn (Ppr.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 . separate . reverse . show $ n
+      where separate n'
+              | n' `lengthAtMost` 3 = n'
+              | otherwise           = take 3 n' ++ "," ++ separate (drop 3 n')
+
+-----------------------------------------------------------------------------
+-- reverting CAFs
+
+revertCAFs :: GhciMonad m => m ()
+revertCAFs = do
+  interp <- hscInterp <$> GHC.getSession
+  liftIO $ interpCmd interp RtsRevertCAFs
+  s <- getGHCiState
+  when (not (ghc_e s)) turnOffBuffering
+     -- Have to turn off buffering again, because we just
+     -- reverted stdout, stderr & stdin to their defaults.
+
+
+-----------------------------------------------------------------------------
+-- 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
+  let mkHelperExpr :: OccName -> Ghc ForeignHValue
+      mkHelperExpr occ =
+        GHC.compileParsedExprRemote
+        $ GHC.nlHsVar $ RdrName.mkOrig gHC_INTERNAL_GHCI_HELPERS occ
+  nobuf <- mkHelperExpr $ mkVarOccFS (fsLit "disableBuffering")
+  flush <- mkHelperExpr $ mkVarOccFS (fsLit "flushAll")
+  return (nobuf, flush)
+
+-- | Invoke "hFlush stdout; hFlush stderr" in the interpreter
+flushInterpBuffers :: GhciMonad m => m ()
+flushInterpBuffers = do
+  st <- getGHCiState
+  interp <- hscInterp <$> GHC.getSession
+  liftIO $ evalIO interp (flushStdHandles st)
+
+-- | Turn off buffering for stdin, stdout, and stderr in the interpreter
+turnOffBuffering :: GhciMonad m => m ()
+turnOffBuffering = do
+  st <- getGHCiState
+  turnOffBuffering_ (noBuffering st)
+
+turnOffBuffering_ :: GhcMonad m => ForeignHValue -> m ()
+turnOffBuffering_ fhv = do
+  interp <- hscInterp <$> getSession
+  liftIO $ evalIO interp fhv
+
+mkEvalWrapper :: GhcMonad m => String -> [String] ->  m ForeignHValue
+mkEvalWrapper progname' args' =
+  runInternal $ GHC.compileParsedExprRemote
+  $ evalWrapper' `GHC.mkHsApp` nlHsString progname'
+                 `GHC.mkHsApp` nlList (map nlHsString args')
+  where
+    nlHsString = nlHsLit . mkHsString
+    evalWrapper' =
+      GHC.nlHsVar $ RdrName.mkOrig gHC_INTERNAL_GHCI_HELPERS (mkVarOccFS (fsLit "evalWrapper"))
+
+-- | Run a 'GhcMonad' action to compile an expression for internal usage.
+runInternal :: GhcMonad m => m a -> m a
+runInternal =
+    withTempSession mkTempSession
+  where
+    mkTempSession = hscUpdateFlags (\dflags -> dflags
+      { -- Running GHCi's internal expression is incompatible with -XSafe.
+          -- We temporarily disable any Safe Haskell settings while running
+          -- GHCi internal expressions. (see #12509)
+        safeHaskell = Sf_None,
+          -- Disable dumping of any data during evaluation of GHCi's internal
+          -- expressions. (#17500)
+        dumpFlags = EnumSet.empty
+      }
+        -- RebindableSyntax can wreak havoc with GHCi in several ways
+          -- (see #13385 and #14342 for examples), so we temporarily
+          -- disable it too.
+          `xopt_unset` LangExt.RebindableSyntax
+          -- We heavily depend on -fimplicit-import-qualified to compile expr
+          -- with fully qualified names without imports.
+          `gopt_set` Opt_ImplicitImportQualified
+      )
+
+compileGHCiExpr :: GhcMonad m => String -> m ForeignHValue
+compileGHCiExpr expr = runInternal $ GHC.compileExprRemote expr
diff --git a/src-bin-9.10.2/Clash/GHCi/Util.hs b/src-bin-9.10.2/Clash/GHCi/Util.hs
new file mode 100644
--- /dev/null
+++ b/src-bin-9.10.2/Clash/GHCi/Util.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+-- | Utilities for GHCi.
+module Clash.GHCi.Util where
+
+-- NOTE: Avoid importing GHC modules here, because the primary purpose
+-- of this module is to not use UnboxedTuples in a module that imports
+-- lots of other modules.  See issue#13101 for more info.
+
+import GHC.Exts
+import GHC.Types
+
+anyToPtr :: a -> IO (Ptr ())
+anyToPtr x =
+  IO (\s -> case anyToAddr# x s of
+              (# s', addr #) -> (# s', Ptr addr #)) :: IO (Ptr ())
diff --git a/src-bin-9.10.2/Clash/Main.hs b/src-bin-9.10.2/Clash/Main.hs
new file mode 100644
--- /dev/null
+++ b/src-bin-9.10.2/Clash/Main.hs
@@ -0,0 +1,1240 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NondecreasingIndentation #-}
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
+
+-----------------------------------------------------------------------------
+--
+-- GHC Driver program
+--
+-- (c) The University of Glasgow 2005
+--
+-----------------------------------------------------------------------------
+
+module Clash.Main (defaultMain, defaultMainWithAction) where
+
+-- The official GHC API
+import qualified GHC
+import GHC              (parseTargetFiles,  Ghc, GhcMonad(..),
+                          LoadHowMuch(..) )
+
+import GHC.Driver.Backend
+import GHC.Driver.CmdLine
+import GHC.Driver.Env
+import GHC.Driver.Errors
+import GHC.Driver.Errors.Types
+import GHC.Driver.Phases
+import GHC.Driver.Session
+import GHC.Driver.Ppr
+import GHC.Driver.Pipeline  ( oneShot, compileFile )
+import GHC.Driver.MakeFile  ( doMkDependHS )
+import GHC.Driver.Backpack  ( doBackpack )
+import GHC.Driver.Plugins
+import GHC.Driver.Config.Logger (initLogFlags)
+import GHC.Driver.Config.Diagnostic
+
+import GHC.Platform
+import GHC.Platform.Ways
+import GHC.Platform.Host
+
+#if defined(HAVE_INTERNAL_INTERPRETER)
+import Clash.GHCi.UI        ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )
+#endif
+
+import GHC.Runtime.Loader   ( loadFrontendPlugin, initializeSessionPlugins )
+
+import GHC.Unit.Env
+import GHC.Unit (UnitId, homeUnitDepends)
+import GHC.Unit.Home.ModInfo (emptyHomePackageTable)
+import GHC.Unit.Module ( ModuleName, mkModuleName )
+import GHC.Unit.Module.ModIface
+import GHC.Unit.State  ( pprUnits, pprUnitsSimple )
+import GHC.Unit.Finder ( findImportedModule, FindResult(..) )
+import qualified GHC.Unit.State as State
+import GHC.Unit.Types  ( IsBootInterface(..) )
+
+import GHC.Types.Basic     ( failed )
+import GHC.Types.SrcLoc
+import GHC.Types.SourceError
+import GHC.Types.Unique.Supply
+import GHC.Types.PkgQual
+
+import GHC.Utils.Error
+import GHC.Utils.Misc
+import GHC.Utils.Panic
+import GHC.Utils.Outputable as Outputable
+import GHC.Utils.Monad       ( liftIO, mapMaybeM )
+import GHC.Utils.Binary        ( openBinMem, put_ )
+import GHC.Utils.Logger
+
+import GHC.Settings.Config
+import GHC.Settings.Constants
+import GHC.Settings.IO
+
+import GHC.HandleEncoding
+import GHC.Data.FastString
+import GHC.SysTools.BaseDir
+
+import GHC.Iface.Load
+import GHC.Iface.Recomp.Binary ( fingerprintBinMem )
+
+import GHC.Tc.Utils.Monad      ( initIfaceCheck )
+import GHC.Iface.Errors.Ppr
+
+-- Standard Haskell libraries
+import System.IO
+import System.Environment
+import System.Exit
+import System.FilePath
+import Control.Monad
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except (throwE, runExceptT)
+import Data.Char
+import Data.List ( partition, intercalate, (\\) )
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Data.Maybe
+import Prelude
+import GHC.ResponseFile (expandResponse)
+import Data.Bifunctor
+import GHC.Data.Graph.Directed
+import qualified Data.List.NonEmpty as NE
+
+-- clash additions
+import           Paths_clash_ghc
+import           Clash.GHCi.UI (makeHDL)
+import           Control.Monad.Catch (catch)
+import           Data.List (nub)
+import           Data.Proxy
+import           Data.IORef (IORef, newIORef, readIORef, modifyIORef')
+import qualified Data.Version (showVersion)
+import           GHC.Data.EnumSet as EnumSet
+import           GHC.Driver.Session as Session
+
+import           Clash.Backend (Backend)
+import           Clash.Backend.SystemVerilog (SystemVerilogState)
+import           Clash.Backend.VHDL    (VHDLState)
+import           Clash.Backend.Verilog (VerilogState)
+import           Clash.Driver.Types
+  (ClashOpts (..), defClashOpts)
+import           Clash.GHC.ClashFlags
+import           Clash.Util (clashLibVersion)
+import           Clash.GHC.LoadModules (ghcLibDir, setWantedLanguageExtensions)
+import           Clash.GHC.Util (handleClashException)
+
+-----------------------------------------------------------------------------
+-- ToDo:
+
+-- time commands when run with -v
+-- user ways
+-- Win32 support: proper signal handling
+-- reading the package configuration file is too slow
+-- -K<size>
+
+-----------------------------------------------------------------------------
+-- GHC's command-line interface
+
+defaultMain :: [String] -> IO ()
+defaultMain = defaultMainWithAction (return ())
+
+defaultMainWithAction :: Ghc () -> [String] -> IO ()
+defaultMainWithAction startAction = flip withArgs $ do
+   hSetBuffering stdout LineBuffering
+   hSetBuffering stderr LineBuffering
+
+   configureHandleEncoding
+   GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
+    -- 1. extract the -B flag from the args
+    argv0 <- getArgs
+
+    let argv1 = map (mkGeneralLocated "on the commandline") argv0
+    libDir <- ghcLibDir
+
+    r <- newIORef defClashOpts
+    (argv2, clashFlagWarnings) <- parseClashFlags r argv1
+
+    -- 2. Parse the "mode" flags (--make, --interactive etc.)
+    (mode, units, argv3, modeFlagWarnings) <- parseModeFlags argv2
+    let flagWarnings = modeFlagWarnings ++ clashFlagWarnings
+
+    -- If all we want to do is something like showing the version number
+    -- then do it now, before we start a GHC session etc. This makes
+    -- getting basic information much more resilient.
+
+    -- In particular, if we wait until later before giving the version
+    -- number then bootstrapping gets confused, as it tries to find out
+    -- what version of GHC it's using before package.conf exists, so
+    -- starting the session fails.
+    case mode of
+        Left preStartupMode ->
+            do case preStartupMode of
+                   ShowSupportedExtensions   -> showSupportedExtensions (Just libDir)
+                   ShowVersion               -> showVersion
+                   ShowNumVersion            -> putStrLn cProjectVersion
+                   ShowOptions isInteractive -> showOptions isInteractive r
+        Right postStartupMode ->
+            -- start our GHC session
+            GHC.runGhc (Just libDir) $ do
+
+            dflags <- GHC.getSessionDynFlags
+            let dflagsExtra = setWantedLanguageExtensions dflags
+
+                ghcTyLitNormPlugin = GHC.mkModuleName "GHC.TypeLits.Normalise"
+                ghcTyLitExtrPlugin = GHC.mkModuleName "GHC.TypeLits.Extra.Solver"
+                ghcTyLitKNPlugin   = GHC.mkModuleName "GHC.TypeLits.KnownNat.Solver"
+                dflagsExtra1 = dflagsExtra
+                                  { Session.pluginModNames = nub $
+                                      ghcTyLitNormPlugin : ghcTyLitExtrPlugin :
+                                      ghcTyLitKNPlugin :
+                                      Session.pluginModNames dflagsExtra
+                                  }
+
+            case postStartupMode of
+                Left preLoadMode ->
+                    liftIO $ do
+                        case preLoadMode of
+                            ShowInfo               -> showInfo dflagsExtra1
+                            ShowGhcUsage           -> showGhcUsage  dflagsExtra1
+                            ShowGhciUsage          -> showGhciUsage dflagsExtra1
+                            PrintWithDynFlags f    -> putStrLn (f dflagsExtra1)
+                Right postLoadMode ->
+                    main' postLoadMode units dflagsExtra1 argv3 flagWarnings startAction r
+
+main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn]
+      -> Ghc () -> IORef ClashOpts
+      -> Ghc ()
+main' postLoadMode units dflags0 args flagWarnings startAction clashOpts = do
+  let args' = case postLoadMode of
+                DoRun -> takeWhile (\arg -> unLoc arg /= "--") args
+                _     -> args
+
+  -- set the default GhcMode, backend and GhcLink.  The backend
+  -- can be further adjusted on a module by module basis, using only
+  -- the -fllvm and -fasm flags.  If the default backend is not
+  -- LLVM or NCG, -fllvm and -fasm have no effect.
+  let dflt_backend = backend dflags0
+      (mode, bcknd, link)
+         = case postLoadMode of
+               DoInteractive   -> (CompManager, interpreterBackend,  LinkInMemory)
+               DoEval _        -> (CompManager, interpreterBackend,  LinkInMemory)
+               DoRun           -> (CompManager, interpreterBackend,  LinkInMemory)
+               DoMake          -> (CompManager, dflt_backend, LinkBinary)
+               DoBackpack      -> (CompManager, dflt_backend, LinkBinary)
+               DoMkDependHS    -> (MkDepend,    dflt_backend, LinkBinary)
+               DoAbiHash       -> (OneShot,     dflt_backend, LinkBinary)
+               DoVHDL          -> (CompManager, noBackend,     NoLink)
+               DoVerilog       -> (CompManager, noBackend,     NoLink)
+               DoSystemVerilog -> (CompManager, noBackend,     NoLink)
+               _               -> (OneShot,     dflt_backend, LinkBinary)
+
+  let dflags1 = dflags0{ ghcMode   = mode,
+                         backend   = bcknd,
+                         ghcLink   = link,
+                         verbosity = case postLoadMode of
+                                         DoEval _ -> 0
+                                         DoRun    -> 0
+                                         _other   -> 1
+                        }
+
+      -- turn on -fimplicit-import-qualified for GHCi now, so that it
+      -- can be overridden from the command-line
+      -- XXX: this should really be in the interactive DynFlags, but
+      -- we don't set that until later in interactiveUI
+      -- We also set -fignore-optim-changes and -fignore-hpc-changes,
+      -- which are program-level options. Again, this doesn't really
+      -- feel like the right place to handle this, but we don't have
+      -- a great story for the moment.
+      dflags2  | DoInteractive <- postLoadMode = def_ghci_flags
+               | DoEval _      <- postLoadMode = def_ghci_flags
+               | DoRun         <- postLoadMode = def_ghci_flags
+               | otherwise                     = dflags1
+        where def_ghci_flags = dflags1 `gopt_set` Opt_ImplicitImportQualified
+                                       `gopt_set` Opt_IgnoreOptimChanges
+                                       `gopt_set` Opt_IgnoreHpcChanges
+                                       -- Setting this by default has the nice effect that
+                                       -- -fno-code and --interactive falls back to interpreter rather than
+                                       -- object code but has little other effect unless you are also using
+                                       -- fat interface files.
+                                       `gopt_set` Opt_UseBytecodeRatherThanObjects
+                                       -- By default enable the debugger by inserting breakpoints
+                                       `gopt_set` Opt_InsertBreakpoints
+
+  logger1 <- getLogger
+  let logger2 = setLogFlags logger1 (initLogFlags dflags2)
+
+        -- The rest of the arguments are "dynamic"
+        -- Leftover ones are presumably files
+  (dflags3, fileish_args, dynamicFlagWarnings) <-
+      GHC.parseDynamicFlags logger2 dflags2 args'
+
+  -- Propagate -Werror to Clash
+  liftIO . modifyIORef' clashOpts $ \opts ->
+    opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) }
+
+  let dflags4 = if backendNeedsFullWays bcknd &&
+                   not (gopt Opt_ExternalInterpreter dflags3)
+                then
+                    let platform = targetPlatform dflags3
+                        dflags3a = dflags3 { targetWays_ = hostFullWays }
+                        dflags3b = foldl gopt_set dflags3a
+                                 $ concatMap (wayGeneralFlags platform)
+                                             hostFullWays
+                        dflags3c = foldl gopt_unset dflags3b
+                                 $ concatMap (wayUnsetGeneralFlags platform)
+                                             hostFullWays
+                    in dflags3c
+                else
+                    dflags3
+
+  let logger4 = setLogFlags logger2 (initLogFlags dflags4)
+
+  GHC.prettyPrintGhcErrors logger4 $ do
+
+  let diag_opts = initDiagOpts dflags4
+  let flagWarnings' = GhcDriverMessage <$> mconcat [warnsToMessages diag_opts flagWarnings, dynamicFlagWarnings]
+
+  handleSourceError (\e -> do
+       GHC.printException e
+       liftIO $ exitWith (ExitFailure 1)) $ do
+         liftIO $ printOrThrowDiagnostics logger4 (initPrintConfig dflags4) diag_opts flagWarnings'
+
+  liftIO $ showBanner postLoadMode dflags4
+
+  let (dflags5, srcs, objs) = parseTargetFiles dflags4 (map unLoc fileish_args)
+
+  -- we've finished manipulating the DynFlags, update the session
+  _ <- GHC.setSessionDynFlags dflags5
+  dflags6 <- GHC.getSessionDynFlags
+
+  -- Must do this before loading plugins
+  liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6)
+
+  -- Initialise plugins here because the plugin author might already expect this
+  -- subsequent call to `getLogger` to be affected by a plugin.
+  initializeSessionPlugins
+  hsc_env <- getSession
+  logger <- getLogger
+
+
+        ---------------- Display configuration -----------
+  case verbosity dflags6 of
+    v | v == 4 -> liftIO $ dumpUnitsSimple hsc_env
+      | v >= 5 -> liftIO $ dumpUnits       hsc_env
+      | otherwise -> return ()
+
+        ---------------- Final sanity checking -----------
+  liftIO $ checkOptions postLoadMode dflags6 srcs objs units
+
+  ---------------- Do the business -----------
+  handleSourceError (\e -> do
+       GHC.printException e
+       liftIO $ exitWith (ExitFailure 1)) $ do
+    clashOpts' <- liftIO (readIORef clashOpts)
+    let clash fun = catch (fun startAction clashOpts srcs) (handleClashException dflags6 clashOpts')
+    case postLoadMode of
+       ShowInterface f        -> liftIO $ showIface logger
+                                                    (hsc_dflags hsc_env)
+                                                    (hsc_units  hsc_env)
+                                                    (hsc_NC     hsc_env)
+                                                    f
+       DoMake                 -> doMake units srcs
+       DoMkDependHS           -> doMkDependHS (map fst srcs)
+       StopBefore p           -> liftIO (oneShot hsc_env p srcs)
+       DoInteractive          -> ghciUI clashOpts units srcs Nothing
+       DoEval exprs           -> ghciUI clashOpts units srcs $ Just $ reverse exprs
+       DoRun                  -> doRun clashOpts units srcs args
+       DoAbiHash              -> abiHash (map fst srcs)
+       ShowPackages           -> liftIO $ showUnits hsc_env
+       DoFrontend f           -> doFrontend f srcs
+       DoBackpack             -> doBackpack (map fst srcs)
+       DoVHDL                 -> clash makeVHDL
+       DoVerilog              -> clash makeVerilog
+       DoSystemVerilog        -> clash makeSystemVerilog
+
+  liftIO $ dumpFinalStats logger
+
+doRun :: IORef ClashOpts -> [String] -> [(FilePath, Maybe Phase)] -> [Located String] -> Ghc ()
+doRun clashOpts units srcs args = do
+    dflags <- getDynFlags
+    let mainFun = fromMaybe "main" (mainFunIs dflags)
+    ghciUI clashOpts units srcs (Just ["System.Environment.withArgs " ++ show args' ++ " (Control.Monad.void " ++ mainFun ++ ")"])
+  where
+    args' = drop 1 $ dropWhile (/= "--") $ map unLoc args
+
+ghciUI :: IORef ClashOpts -> [String] -> [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc ()
+#if !defined(HAVE_INTERNAL_INTERPRETER)
+ghciUI _ _ _ _ =
+  throwGhcException (CmdLineError "not built for interactive use")
+#else
+ghciUI clashOpts units srcs maybe_expr = do
+  hs_srcs <- case NE.nonEmpty units of
+    Just ne_units -> do
+      initMulti ne_units
+    Nothing -> do
+      case srcs of
+        [] -> return []
+        _  -> do
+          s <- initMake srcs
+          return $ map (uncurry (,Nothing,)) s
+  interactiveUI (defaultGhciSettings clashOpts) hs_srcs maybe_expr
+#endif
+
+
+-- -----------------------------------------------------------------------------
+-- Option sanity checks
+
+-- | Ensure sanity of options.
+--
+-- Throws 'UsageError' or 'CmdLineError' if not.
+checkOptions :: PostLoadMode -> DynFlags -> [(String,Maybe Phase)] -> [String] -> [String] -> IO ()
+     -- Final sanity checking before kicking off a compilation (pipeline).
+checkOptions mode dflags srcs objs units = do
+     -- Complain about any unknown flags
+   let unknown_opts = [ f | (f@('-':_), _) <- srcs ]
+   when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
+
+   when (not (Set.null (rtsWays (ways dflags)))
+         && isInterpretiveMode mode) $
+        hPutStrLn stderr ("Warning: -debug, -threaded and -ticky are ignored by GHCi")
+
+        -- -prof and --interactive are not a good combination
+   when ((fullWays (ways dflags) /= hostFullWays)
+         && isInterpretiveMode mode
+         && not (gopt Opt_ExternalInterpreter dflags)) $
+      do throwGhcException (UsageError
+              "-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))
+        then throwGhcException (UsageError "-ohi can only be used when compiling a single source file")
+        else do
+
+   if (isJust (dynOutputHi dflags) &&
+      (isCompManagerMode mode || srcs `lengthExceeds` 1))
+     then throwGhcException (UsageError "-dynohi can only be used when compiling a single source file")
+     else do
+
+        -- -o sanity checking
+   if (srcs `lengthExceeds` 1 && isJust (outputFile dflags)
+         && not (isLinkMode mode))
+        then throwGhcException (UsageError "can't apply -o to multiple source files")
+        else do
+
+   let not_linking = not (isLinkMode mode) || isNoLink (ghcLink dflags)
+
+   when (not_linking && not (null objs)) $
+        hPutStrLn stderr ("Warning: the following files would be used as linker inputs, but linking is not being done: " ++ unwords objs)
+
+        -- Check that there are some input files
+        -- (except in the interactive case)
+   if null srcs && (null objs || not_linking) && needsInputsMode mode && null units
+        then throwGhcException (UsageError "no input files" )
+        else do
+
+   case mode of
+      StopBefore StopC | not (backendGeneratesHc (backend dflags))
+        -> throwGhcException $ UsageError $
+           "the option -C is only available with an unregisterised GHC"
+      StopBefore StopAs | ghcLink dflags == NoLink
+        -> throwGhcException $ UsageError $
+           "the options -S and -fno-code are incompatible. Please omit -S"
+
+      _ -> return ()
+
+     -- Verify that output files point somewhere sensible.
+   verifyOutputFiles dflags
+
+-- Compiler output options
+
+-- Called to verify that the output files point somewhere valid.
+--
+-- The assumption is that the directory portion of these output
+-- options will have to exist by the time 'verifyOutputFiles'
+-- is invoked.
+--
+-- We create the directories for -odir, -hidir, -outputdir etc. ourselves if
+-- they don't exist, so don't check for those here (#2278).
+verifyOutputFiles :: DynFlags -> IO ()
+verifyOutputFiles dflags = do
+  let ofile = outputFile dflags
+  when (isJust ofile) $ do
+     let fn = fromJust ofile
+     flg <- doesDirNameExist fn
+     when (not flg) (nonExistentDir "-o" fn)
+  let ohi = outputHi dflags
+  when (isJust ohi) $ do
+     let hi = fromJust ohi
+     flg <- doesDirNameExist hi
+     when (not flg) (nonExistentDir "-ohi" hi)
+ where
+   nonExistentDir flg dir =
+     throwGhcException (CmdLineError ("error: directory portion of " ++
+                             show dir ++ " does not exist (used with " ++
+                             show flg ++ " option.)"))
+
+-----------------------------------------------------------------------------
+-- GHC modes of operation
+
+type Mode = Either PreStartupMode PostStartupMode
+type PostStartupMode = Either PreLoadMode PostLoadMode
+
+data PreStartupMode
+  = ShowVersion                          -- ghc -V/--version
+  | ShowNumVersion                       -- ghc --numeric-version
+  | ShowSupportedExtensions              -- ghc --supported-extensions
+  | ShowOptions Bool {- isInteractive -} -- ghc --show-options
+
+showVersionMode, showNumVersionMode, showSupportedExtensionsMode, showOptionsMode :: Mode
+showVersionMode             = mkPreStartupMode ShowVersion
+showNumVersionMode          = mkPreStartupMode ShowNumVersion
+showSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions
+showOptionsMode             = mkPreStartupMode (ShowOptions False)
+
+mkPreStartupMode :: PreStartupMode -> Mode
+mkPreStartupMode = Left
+
+isShowVersionMode :: Mode -> Bool
+isShowVersionMode (Left ShowVersion) = True
+isShowVersionMode _ = False
+
+isShowNumVersionMode :: Mode -> Bool
+isShowNumVersionMode (Left ShowNumVersion) = True
+isShowNumVersionMode _ = False
+
+data PreLoadMode
+  = ShowGhcUsage                           -- ghc -?
+  | ShowGhciUsage                          -- ghci -?
+  | ShowInfo                               -- ghc --info
+  | PrintWithDynFlags (DynFlags -> String) -- ghc --print-foo
+
+showGhcUsageMode, showGhciUsageMode, showInfoMode :: Mode
+showGhcUsageMode = mkPreLoadMode ShowGhcUsage
+showGhciUsageMode = mkPreLoadMode ShowGhciUsage
+showInfoMode = mkPreLoadMode ShowInfo
+
+printSetting :: String -> Mode
+printSetting k = mkPreLoadMode (PrintWithDynFlags f)
+    where f dflags = fromMaybe (panic ("Setting not found: " ++ show k))
+                   $ lookup k (compilerInfo dflags)
+
+mkPreLoadMode :: PreLoadMode -> Mode
+mkPreLoadMode = Right . Left
+
+isShowGhcUsageMode :: Mode -> Bool
+isShowGhcUsageMode (Right (Left ShowGhcUsage)) = True
+isShowGhcUsageMode _ = False
+
+isShowGhciUsageMode :: Mode -> Bool
+isShowGhciUsageMode (Right (Left ShowGhciUsage)) = True
+isShowGhciUsageMode _ = False
+
+data PostLoadMode
+  = ShowInterface FilePath  -- ghc --show-iface
+  | DoMkDependHS            -- ghc -M
+  | StopBefore StopPhase    -- ghc -E | -C | -S
+                            -- StopBefore StopLn is the default
+  | DoMake                  -- ghc --make
+  | DoBackpack              -- ghc --backpack foo.bkp
+  | DoInteractive           -- ghc --interactive
+  | DoEval [String]         -- ghc -e foo -e bar => DoEval ["bar", "foo"]
+  | DoRun                   -- ghc --run
+  | DoAbiHash               -- ghc --abi-hash
+  | ShowPackages            -- ghc --show-packages
+  | DoFrontend ModuleName   -- ghc --frontend Plugin.Module
+  | DoVHDL                  -- ghc --vhdl
+  | DoVerilog               -- ghc --verilog
+  | DoSystemVerilog         -- ghc --systemverilog
+
+doMkDependHSMode, doMakeMode, doInteractiveMode, doRunMode,
+  doAbiHashMode, showUnitsMode, doVHDLMode, doVerilogMode,
+  doSystemVerilogMode :: Mode
+doMkDependHSMode = mkPostLoadMode DoMkDependHS
+doMakeMode = mkPostLoadMode DoMake
+doInteractiveMode = mkPostLoadMode DoInteractive
+doRunMode = mkPostLoadMode DoRun
+doAbiHashMode = mkPostLoadMode DoAbiHash
+showUnitsMode = mkPostLoadMode ShowPackages
+doVHDLMode = mkPostLoadMode DoVHDL
+doVerilogMode = mkPostLoadMode DoVerilog
+doSystemVerilogMode = mkPostLoadMode DoSystemVerilog
+
+showInterfaceMode :: FilePath -> Mode
+showInterfaceMode fp = mkPostLoadMode (ShowInterface fp)
+
+stopBeforeMode :: StopPhase -> Mode
+stopBeforeMode phase = mkPostLoadMode (StopBefore phase)
+
+doEvalMode :: String -> Mode
+doEvalMode str = mkPostLoadMode (DoEval [str])
+
+doFrontendMode :: String -> Mode
+doFrontendMode str = mkPostLoadMode (DoFrontend (mkModuleName str))
+
+doBackpackMode :: Mode
+doBackpackMode = mkPostLoadMode DoBackpack
+
+mkPostLoadMode :: PostLoadMode -> Mode
+mkPostLoadMode = Right . Right
+
+isDoInteractiveMode :: Mode -> Bool
+isDoInteractiveMode (Right (Right DoInteractive)) = True
+isDoInteractiveMode _ = False
+
+isStopLnMode :: Mode -> Bool
+isStopLnMode (Right (Right (StopBefore NoStop))) = True
+isStopLnMode _ = False
+
+isDoMakeMode :: Mode -> Bool
+isDoMakeMode (Right (Right DoMake)) = True
+isDoMakeMode _ = False
+
+isDoEvalMode :: Mode -> Bool
+isDoEvalMode (Right (Right (DoEval _))) = True
+isDoEvalMode _ = False
+
+#if defined(HAVE_INTERNAL_INTERPRETER)
+isInteractiveMode :: PostLoadMode -> Bool
+isInteractiveMode DoInteractive = True
+isInteractiveMode _             = False
+#endif
+
+-- isInterpretiveMode: byte-code compiler involved
+isInterpretiveMode :: PostLoadMode -> Bool
+isInterpretiveMode DoInteractive = True
+isInterpretiveMode (DoEval _)    = True
+isInterpretiveMode _             = False
+
+needsInputsMode :: PostLoadMode -> Bool
+needsInputsMode DoMkDependHS    = True
+needsInputsMode (StopBefore _)  = True
+needsInputsMode DoMake          = True
+needsInputsMode DoVHDL          = True
+needsInputsMode DoVerilog       = True
+needsInputsMode DoSystemVerilog = True
+needsInputsMode _               = False
+
+-- True if we are going to attempt to link in this mode.
+-- (we might not actually link, depending on the GhcLink flag)
+isLinkMode :: PostLoadMode -> Bool
+isLinkMode (StopBefore NoStop) = True
+isLinkMode DoMake              = True
+isLinkMode DoRun               = True
+isLinkMode DoInteractive       = True
+isLinkMode (DoEval _)          = True
+isLinkMode _                   = False
+
+isCompManagerMode :: PostLoadMode -> Bool
+isCompManagerMode DoRun         = True
+isCompManagerMode DoMake        = True
+isCompManagerMode DoInteractive = True
+isCompManagerMode (DoEval _)    = True
+isCompManagerMode DoVHDL        = True
+isCompManagerMode DoVerilog     = True
+isCompManagerMode DoSystemVerilog = True
+isCompManagerMode _             = False
+
+-- -----------------------------------------------------------------------------
+-- Parsing the mode flag
+
+parseModeFlags :: [Located String]
+               -> IO (Mode, [String],
+                      [Located String],
+                      [Warn])
+parseModeFlags args = do
+  ((leftover, errs1, warns), (mModeFlag, units, errs2, flags')) <-
+        processCmdLineP mode_flags (Nothing, [], [], []) args
+  let mode = case mModeFlag of
+             Nothing     -> doMakeMode
+             Just (m, _) -> m
+
+  -- See Note [Handling errors when parsing command-line flags]
+  unless (null errs1 && null errs2) $ throwGhcException $ errorsToGhcException $
+      map (("on the commandline", )) $ map (unLoc . errMsg) errs1 ++ errs2
+
+  return (mode, units, flags' ++ leftover, warns)
+
+type ModeM = CmdLineP (Maybe (Mode, String), [String], [String], [Located String])
+  -- mode flags sometimes give rise to new DynFlags (eg. -C, see below)
+  -- so we collect the new ones and return them.
+
+mode_flags :: [Flag ModeM]
+mode_flags =
+  [  ------- help / version ----------------------------------------------
+    defFlag "?"                     (PassFlag (setMode showGhcUsageMode))
+  , defFlag "-help"                 (PassFlag (setMode showGhcUsageMode))
+  , defFlag "V"                     (PassFlag (setMode showVersionMode))
+  , defFlag "-version"              (PassFlag (setMode showVersionMode))
+  , defFlag "-numeric-version"      (PassFlag (setMode showNumVersionMode))
+  , defFlag "-info"                 (PassFlag (setMode showInfoMode))
+  , defFlag "-show-options"         (PassFlag (setMode showOptionsMode))
+  , defFlag "-supported-languages"  (PassFlag (setMode showSupportedExtensionsMode))
+  , defFlag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
+  , defFlag "-show-packages"        (PassFlag (setMode showUnitsMode))
+  ] ++
+  [ defFlag k'                      (PassFlag (setMode (printSetting k)))
+  | k <- ["Project version",
+          "Project Git commit id",
+          "Booter version",
+          "Stage",
+          "Build platform",
+          "Host platform",
+          "Target platform",
+          "Have interpreter",
+          "Object splitting supported",
+          "Have native code generator",
+          "Support SMP",
+          "Unregisterised",
+          "Tables next to code",
+          "RTS ways",
+          "Leading underscore",
+          "Debug on",
+          "LibDir",
+          "Global Package DB",
+          "C compiler flags",
+          "C compiler link flags"
+          ],
+    let k' = "-print-" ++ map (replaceSpace . toLower) k
+        replaceSpace ' ' = '-'
+        replaceSpace c   = c
+  ] ++
+      ------- interfaces ----------------------------------------------------
+  [ defFlag "-show-iface"  (HasArg (\f -> setMode (showInterfaceMode f)
+                                               "--show-iface"))
+
+      ------- primary modes ------------------------------------------------
+  , defFlag "c"            (PassFlag (\f -> do setMode (stopBeforeMode NoStop) f
+                                               addFlag "-no-link" f))
+  , defFlag "M"            (PassFlag (setMode doMkDependHSMode))
+  , defFlag "E"            (PassFlag (setMode (stopBeforeMode StopPreprocess )))
+  , defFlag "C"            (PassFlag (setMode (stopBeforeMode StopC)))
+  , defFlag "S"            (PassFlag (setMode (stopBeforeMode StopAs)))
+  , defFlag "-run"         (PassFlag (setMode doRunMode))
+  , defFlag "-make"        (PassFlag (setMode doMakeMode))
+  , defFlag "unit"         (SepArg   (\s -> addUnit s "-unit"))
+  , defFlag "-backpack"    (PassFlag (setMode doBackpackMode))
+  , 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))
+  ]
+
+addUnit :: String -> String -> EwM ModeM ()
+addUnit unit_str _arg = liftEwM $ do
+  (mModeFlag, units, errs, flags') <- getCmdLineState
+  putCmdLineState (mModeFlag, unit_str:units, errs, flags')
+
+setMode :: Mode -> String -> EwM ModeM ()
+setMode newMode newFlag = liftEwM $ do
+    (mModeFlag, units, errs, flags') <- getCmdLineState
+    let (modeFlag', errs') =
+            case mModeFlag of
+            Nothing -> ((newMode, newFlag), errs)
+            Just (oldMode, oldFlag) ->
+                case (oldMode, newMode) of
+                    -- -c/--make are allowed together, and mean --make -no-link
+                    _ |  isStopLnMode oldMode && isDoMakeMode newMode
+                      || isStopLnMode newMode && isDoMakeMode oldMode ->
+                      ((doMakeMode, "--make"), [])
+
+                    -- If we have both --help and --interactive then we
+                    -- want showGhciUsage
+                    _ | isShowGhcUsageMode oldMode &&
+                        isDoInteractiveMode newMode ->
+                            ((showGhciUsageMode, oldFlag), [])
+                      | 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), [])
+                    -- We need to accumulate eval flags like "-e foo -e bar"
+                    (Right (Right (DoEval esOld)),
+                     Right (Right (DoEval [eNew]))) ->
+                        ((Right (Right (DoEval (eNew : esOld))), oldFlag),
+                         errs)
+                    -- Saying e.g. --interactive --interactive is OK
+                    _ | oldFlag == newFlag -> ((oldMode, oldFlag), errs)
+
+                    -- --interactive and --show-options are used together
+                    (Right (Right DoInteractive), Left (ShowOptions _)) ->
+                      ((Left (ShowOptions True),
+                        "--interactive --show-options"), errs)
+                    (Left (ShowOptions _), (Right (Right DoInteractive))) ->
+                      ((Left (ShowOptions True),
+                        "--show-options --interactive"), errs)
+                    -- Otherwise, complain
+                    _ -> let err = flagMismatchErr oldFlag newFlag
+                         in ((oldMode, oldFlag), err : errs)
+    putCmdLineState (Just modeFlag', units, errs', flags')
+  where isDominantFlag f = isShowGhcUsageMode   f ||
+                           isShowGhciUsageMode  f ||
+                           isShowVersionMode    f ||
+                           isShowNumVersionMode f
+
+flagMismatchErr :: String -> String -> String
+flagMismatchErr oldFlag newFlag
+    = "cannot use `" ++ oldFlag ++  "' with `" ++ newFlag ++ "'"
+
+addFlag :: String -> String -> EwM ModeM ()
+addFlag s flag = liftEwM $ do
+  (m, units, e, flags') <- getCmdLineState
+  putCmdLineState (m, units, e, mkGeneralLocated loc s : flags')
+    where loc = "addFlag by " ++ flag ++ " on the commandline"
+
+-- ----------------------------------------------------------------------------
+-- Run --make mode
+
+doMake :: [String] -> [(String, Maybe Phase)] -> Ghc ()
+doMake units targets = do
+  hs_srcs <- case NE.nonEmpty units of
+    Just ne_units -> do
+      initMulti ne_units
+    Nothing -> do
+      s <- initMake targets
+      return $ map (uncurry (,Nothing,)) s
+  case hs_srcs of
+    [] -> return ()
+    _  -> do
+      targets' <- mapM (\(src, uid, phase) -> GHC.guessTarget src uid phase) hs_srcs
+      GHC.setTargets targets'
+      ok_flag <- GHC.load LoadAllTargets
+      when (failed ok_flag) (liftIO $ exitWith (ExitFailure 1))
+
+initMake :: [(String,Maybe Phase)] -> Ghc [(String, Maybe Phase)]
+initMake srcs  = do
+    let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs
+
+    hsc_env <- GHC.getSession
+
+    -- if we have no haskell sources from which to do a dependency
+    -- analysis, then just do one-shot compilation and/or linking.
+    -- This means that "ghc Foo.o Bar.o -o baz" links the program as
+    -- we expect.
+    if (null hs_srcs)
+       then liftIO (oneShot hsc_env NoStop srcs) >> return []
+       else do
+
+    o_files <- mapMaybeM (\x -> liftIO $ compileFile hsc_env NoStop x)
+                 non_hs_srcs
+    dflags <- GHC.getSessionDynFlags
+    let dflags' = dflags { ldInputs = map (FileOption "") o_files
+                                      ++ ldInputs dflags }
+    _ <- GHC.setSessionDynFlags dflags'
+    return hs_srcs
+
+-- Strip out any ["+RTS", ..., "-RTS"] sequences in the command string list.
+removeRTS :: [String] -> [String]
+removeRTS ("+RTS" : xs)  =
+  case dropWhile (/= "-RTS") xs of
+    [] -> []
+    (_ : ys) -> removeRTS ys
+removeRTS (y:ys)         = y : removeRTS ys
+removeRTS []             = []
+
+initMulti :: NE.NonEmpty String -> Ghc ([(String, Maybe UnitId, Maybe Phase)])
+initMulti unitArgsFiles  = do
+  hsc_env <- GHC.getSession
+  let logger = hsc_logger hsc_env
+  initial_dflags <- GHC.getSessionDynFlags
+
+  dynFlagsAndSrcs <- forM unitArgsFiles $ \f -> do
+    when (verbosity initial_dflags > 2) (liftIO $ print f)
+    args <- liftIO $ expandResponse [f]
+    (dflags2, fileish_args, warns) <- parseDynamicFlagsCmdLine initial_dflags (map (mkGeneralLocated f) (removeRTS args))
+    handleSourceError (\e -> do
+       GHC.printException e
+       liftIO $ exitWith (ExitFailure 1)) $ do
+         liftIO $ printOrThrowDiagnostics logger (initPrintConfig dflags2) (initDiagOpts dflags2) (GhcDriverMessage <$> warns)
+
+    let (dflags3, srcs, objs) = parseTargetFiles dflags2 (map unLoc fileish_args)
+        dflags4 = offsetDynFlags dflags3
+
+    let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs
+
+    -- This is dubious as the whole unit environment won't be set-up correctly, but
+    -- that doesn't matter for what we use it for (linking and oneShot)
+    let dubious_hsc_env = hscSetFlags dflags4 hsc_env
+    -- if we have no haskell sources from which to do a dependency
+    -- analysis, then just do one-shot compilation and/or linking.
+    -- This means that "ghc Foo.o Bar.o -o baz" links the program as
+    -- we expect.
+    if (null hs_srcs)
+       then liftIO (oneShot dubious_hsc_env NoStop srcs) >> return (dflags4, [])
+       else do
+
+    o_files <- mapMaybeM (\x -> liftIO $ compileFile dubious_hsc_env NoStop x)
+                 non_hs_srcs
+    let dflags5 = dflags4 { ldInputs = map (FileOption "") o_files
+                                      ++ ldInputs dflags4 }
+
+    liftIO $ checkOptions DoMake dflags5 srcs objs []
+
+    pure (dflags5, hs_srcs)
+
+  let
+    unitDflags = NE.map fst dynFlagsAndSrcs
+    srcs = NE.map (\(dflags, lsrcs) -> map (uncurry (,Just $ homeUnitId_ dflags,)) lsrcs) dynFlagsAndSrcs
+    (hs_srcs, _non_hs_srcs) = unzip (map (partition (\(file, _uid, phase) -> isHaskellishTarget (file, phase))) (NE.toList srcs))
+
+  checkDuplicateUnits initial_dflags (NE.toList (NE.zip unitArgsFiles unitDflags))
+
+  let (initial_home_graph, mainUnitId) = createUnitEnvFromFlags unitDflags
+      home_units = unitEnv_keys initial_home_graph
+
+  home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do
+    let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv
+        hue_flags = homeUnitEnv_dflags homeUnitEnv
+        dflags = homeUnitEnv_dflags homeUnitEnv
+    (dbs,unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger hue_flags cached_unit_dbs home_units
+
+    updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants
+    pure $ HomeUnitEnv
+      { homeUnitEnv_units = unit_state
+      , homeUnitEnv_unit_dbs = Just dbs
+      , homeUnitEnv_dflags = updated_dflags
+      , homeUnitEnv_hpt = emptyHomePackageTable
+      , homeUnitEnv_home_unit = Just home_unit
+      }
+
+  checkUnitCycles initial_dflags home_unit_graph
+
+  let dflags = homeUnitEnv_dflags $ unitEnv_lookup mainUnitId home_unit_graph
+  unitEnv <- assertUnitEnvInvariant <$> (liftIO $ initUnitEnv mainUnitId home_unit_graph (ghcNameVersion dflags) (targetPlatform dflags))
+  let final_hsc_env = hsc_env { hsc_unit_env = unitEnv }
+
+  GHC.setSession final_hsc_env
+
+  -- if we have no haskell sources from which to do a dependency
+  -- analysis, then just do one-shot compilation and/or linking.
+  -- This means that "ghc Foo.o Bar.o -o baz" links the program as
+  -- we expect.
+  if (null hs_srcs)
+      then do
+        liftIO $ hPutStrLn stderr $ "Multi Mode can not be used for one-shot mode."
+        liftIO $ exitWith (ExitFailure 1)
+      else do
+
+{-
+  o_files <- liftIO $ mapMaybeM
+                (\(src, uid, mphase) ->
+                  compileFile (hscSetActiveHomeUnit (ue_unitHomeUnit (fromJust uid) unitEnv) final_hsc_env) NoStop (src, mphase)
+                )
+                (concat non_hs_srcs)
+                -}
+
+  -- MP: This should probably modify dflags for each unit?
+  --let dflags' = dflags { ldInputs = map (FileOption "") o_files
+  --                                  ++ ldInputs dflags }
+  return $ concat hs_srcs
+
+-- | Check that we don't have multiple units with the same UnitId.
+
+checkUnitCycles :: DynFlags -> UnitEnvGraph HomeUnitEnv -> Ghc ()
+checkUnitCycles dflags graph = processSCCs sccs
+  where
+    mkNode :: (UnitId, HomeUnitEnv) -> Node UnitId UnitId
+    mkNode (uid, hue) = DigraphNode uid uid (homeUnitDepends (homeUnitEnv_units hue))
+    nodes = map mkNode (unitEnv_elts graph)
+
+    sccs = stronglyConnCompFromEdgedVerticesOrd nodes
+
+    processSCCs [] = return ()
+    processSCCs (AcyclicSCC _: other_sccs) = processSCCs other_sccs
+    processSCCs (CyclicSCC uids: _) = throwGhcException $ CmdLineError $ showSDoc dflags (cycle_err uids)
+
+
+    cycle_err uids =
+      hang (text "Units form a dependency cycle:")
+           2
+           (one_err uids)
+
+    one_err uids = vcat $
+                    (map (\uid -> text "-" <+> ppr uid <+> text "depends on") start)
+                    ++ [text "-" <+> ppr final]
+      where
+        start = init uids
+        final = last uids
+
+checkDuplicateUnits :: DynFlags -> [(FilePath, DynFlags)] -> Ghc ()
+checkDuplicateUnits dflags flags =
+  unless (null duplicate_ids)
+         (throwGhcException $ CmdLineError $ showSDoc dflags multi_err)
+
+  where
+    uids = map (second homeUnitId_) flags
+    deduplicated_uids = ordNubOn snd uids
+    duplicate_ids = Set.fromList (map snd uids \\ map snd deduplicated_uids)
+
+    duplicate_flags = filter (flip Set.member duplicate_ids . snd) uids
+
+    one_err (fp, home_uid) = text "-" <+> ppr home_uid <+> text "defined in" <+> text fp
+
+    multi_err =
+      hang (text "Multiple units with the same unit-id:")
+           2
+           (vcat (map one_err duplicate_flags))
+
+
+offsetDynFlags :: DynFlags -> DynFlags
+offsetDynFlags dflags =
+  dflags { hiDir = c hiDir
+         , objectDir  = c objectDir
+         , stubDir = c stubDir
+         , hieDir  = c hieDir
+         , dumpDir = c dumpDir  }
+
+  where
+    c f = augment_maybe (f dflags)
+
+    augment_maybe Nothing = Nothing
+    augment_maybe (Just f) = Just (augment f)
+    augment f | isRelative f, Just offset <- workingDirectory dflags = offset </> f
+              | otherwise = f
+
+
+createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> (HomeUnitGraph, UnitId)
+createUnitEnvFromFlags unitDflags =
+  let
+    newInternalUnitEnv dflags = mkHomeUnitEnv dflags emptyHomePackageTable Nothing
+    unitEnvList = NE.map (\dflags -> (homeUnitId_ dflags, newInternalUnitEnv dflags)) unitDflags
+    activeUnit = fst $ NE.head unitEnvList
+  in
+    (unitEnv_new (Map.fromList (NE.toList (unitEnvList))), activeUnit)
+
+-- ---------------------------------------------------------------------------
+-- Various banners and verbosity output.
+
+showBanner :: PostLoadMode -> DynFlags -> IO ()
+showBanner _postLoadMode dflags = do
+   let verb = verbosity dflags
+
+#if defined(HAVE_INTERNAL_INTERPRETER)
+   -- Show the GHCi banner
+   when (isInteractiveMode _postLoadMode && verb >= 1) $ putStrLn ghciWelcomeMsg
+#endif
+
+   -- Display details of the configuration in verbose mode
+   when (verb >= 2) $
+    do hPutStr stderr "Glasgow Haskell Compiler, Version "
+       hPutStr stderr cProjectVersion
+       hPutStr stderr ", stage "
+       hPutStr stderr cStage
+       hPutStr stderr " booted by GHC version "
+       hPutStrLn stderr cBooterVersion
+
+-- We print out a Read-friendly string, but a prettier one than the
+-- Show instance gives us
+showInfo :: DynFlags -> IO ()
+showInfo dflags = do
+        let sq x = " [" ++ x ++ "\n ]"
+        putStrLn $ sq $ intercalate "\n ," $ map show $ compilerInfo dflags
+
+-- TODO use GHC.Utils.Error once that is disentangled from all the other GhcMonad stuff?
+showSupportedExtensions :: Maybe String -> IO ()
+showSupportedExtensions m_top_dir = do
+  res <- runExceptT $ do
+    top_dir <- lift (tryFindTopDir m_top_dir) >>= \case
+      Nothing -> throwE $ SettingsError_MissingData "Could not find the top directory, missing -B flag"
+      Just dir -> pure dir
+    initSettings top_dir
+  arch_os <- case res of
+    Right s -> pure $ platformArchOS $ sTargetPlatform s
+    Left (SettingsError_MissingData msg) -> do
+      hPutStrLn stderr $ "WARNING: " ++ show msg
+      hPutStrLn stderr $ "cannot know target platform so guessing target == host (native compiler)."
+      pure hostPlatformArchOS
+    Left (SettingsError_BadData msg) -> do
+      hPutStrLn stderr msg
+      exitWith $ ExitFailure 1
+  mapM_ putStrLn $ supportedLanguagesAndExtensions arch_os
+
+showVersion :: IO ()
+showVersion = putStrLn $ concat [ "Clash, version "
+                                , Data.Version.showVersion Paths_clash_ghc.version
+                                , " (using clash-lib, version: "
+                                , Data.Version.showVersion clashLibVersion
+                                , ")"
+                                ]
+
+showOptions :: Bool -> IORef ClashOpts -> IO ()
+showOptions isInteractive = putStr . unlines . availableOptions
+    where
+      availableOptions opts = concat [
+        flagsForCompletion isInteractive,
+        map ('-':) (getFlagNames mode_flags),
+        map ('-':) (getFlagNames (flagsClash opts))
+        ]
+      getFlagNames opts         = map flagName opts
+
+showGhcUsage :: DynFlags -> IO ()
+showGhcUsage = showUsage False
+
+showGhciUsage :: DynFlags -> IO ()
+showGhciUsage = showUsage True
+
+showUsage :: Bool -> DynFlags -> IO ()
+showUsage ghci dflags = do
+  let usage_path = if ghci then ghciUsagePath dflags
+                           else ghcUsagePath dflags
+  usage <- readFile usage_path
+  progName <- getProgName
+  dump progName usage
+  where
+    dump progName xs = case xs of
+      ""        -> return ()
+      '$':'$':s -> putStr progName >> dump progName s
+      c:s       -> putChar c >> dump progName s
+
+dumpFinalStats :: Logger -> IO ()
+dumpFinalStats logger = do
+  when (logHasDumpFlag logger Opt_D_faststring_stats) $ dumpFastStringStats logger
+
+  when (logHasDumpFlag logger Opt_D_dump_faststrings) $ do
+    fss <- getFastStringTable
+    let ppr_table         = fmap ppr_segment (fss `zip` [0..])
+        ppr_segment (s,n) = hang (text "Segment" <+> int n) 2 (vcat (fmap ppr_bucket (s `zip` [0..])))
+        ppr_bucket  (b,n) = hang (text "Bucket" <+> int n) 2 (vcat (fmap ftext b))
+    putDumpFileMaybe logger Opt_D_dump_faststrings "FastStrings" FormatText (vcat ppr_table)
+
+dumpFastStringStats :: Logger -> IO ()
+dumpFastStringStats logger = do
+  segments <- getFastStringTable
+  hasZ <- getFastStringZEncCounter
+  let buckets = concat segments
+      bucketsPerSegment = map length segments
+      entriesPerBucket = map length buckets
+      entries = sum entriesPerBucket
+      msg = text "FastString stats:" $$ nest 4 (vcat
+        [ text "segments:         " <+> int (length segments)
+        , text "buckets:          " <+> int (sum bucketsPerSegment)
+        , text "entries:          " <+> int entries
+        , text "largest segment:  " <+> int (maximum bucketsPerSegment)
+        , text "smallest segment: " <+> int (minimum bucketsPerSegment)
+        , text "longest bucket:   " <+> int (maximum entriesPerBucket)
+        , text "has z-encoding:   " <+> (hasZ `pcntOf` entries)
+        ])
+        -- we usually get more "has z-encoding" than "z-encoded", because
+        -- when we z-encode a string it might hash to the exact same string,
+        -- which is not counted as "z-encoded".  Only strings whose
+        -- Z-encoding is different from the original string are counted in
+        -- the "z-encoded" total.
+  putMsg logger msg
+  where
+   x `pcntOf` y = int ((x * 100) `quot` y) Outputable.<> char '%'
+
+showUnits, dumpUnits, dumpUnitsSimple :: HscEnv -> IO ()
+showUnits       hsc_env = putStrLn (showSDoc (hsc_dflags hsc_env) (pprUnits (hsc_units hsc_env)))
+dumpUnits       hsc_env = putMsg (hsc_logger hsc_env) (pprUnits (hsc_units hsc_env))
+dumpUnitsSimple hsc_env = putMsg (hsc_logger hsc_env) (pprUnitsSimple (hsc_units hsc_env))
+
+-- -----------------------------------------------------------------------------
+-- Frontend plugin support
+
+doFrontend :: ModuleName -> [(String, Maybe Phase)] -> Ghc ()
+doFrontend modname srcs = do
+    hsc_env <- getSession
+    (frontend_plugin, _pkgs, _deps) <- liftIO $ loadFrontendPlugin hsc_env modname -- TODO do these need to recorded?
+    frontend frontend_plugin
+      (reverse $ frontendPluginOpts (hsc_dflags hsc_env)) srcs
+
+-- -----------------------------------------------------------------------------
+-- ABI hash support
+
+{-
+        ghc --abi-hash Data.Foo System.Bar
+
+Generates a combined hash of the ABI for modules Data.Foo and
+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 ComponentId for a
+package.  The ComponentId must change when the visible ABI of
+the package changes, so during registration Cabal calls ghc --abi-hash
+to get a hash of the package's ABI.
+-}
+
+-- | Print ABI hash of input modules.
+--
+-- The resulting hash is the MD5 of the GHC version used (#5328,
+-- see 'hiVersion') and of the existing ABI hash from each module (see
+-- 'mi_mod_hash').
+abiHash :: [String] -- ^ List of module names
+        -> Ghc ()
+abiHash strs = do
+  hsc_env <- getSession
+  let dflags    = hsc_dflags hsc_env
+
+  liftIO $ do
+
+  let find_it str = do
+         let modname = mkModuleName str
+         r <- findImportedModule hsc_env modname NoPkgQual
+         case r of
+           Found _ m -> return m
+           _error    ->
+            let opts   = initIfaceMessageOpts dflags
+                err_txt = missingInterfaceErrorDiagnostic opts
+                        $ cannotFindModule hsc_env modname r
+            in throwGhcException . CmdLineError $ showSDoc dflags err_txt
+
+  mods <- mapM find_it strs
+
+  let get_iface modl = loadUserInterface NotBoot (text "abiHash") modl
+  ifaces <- initIfaceCheck (text "abiHash") hsc_env $ mapM get_iface mods
+
+  bh <- openBinMem (3*1024) -- just less than a block
+  put_ bh hiVersion
+    -- package hashes change when the compiler version changes (for now)
+    -- see #5328
+  mapM_ (put_ bh . mi_mod_hash . mi_final_exts) ifaces
+  f <- fingerprintBinMem bh
+
+  putStrLn (showPpr dflags f)
+
+-----------------------------------------------------------------------------
+-- HDL Generation
+
+makeHDL'
+  :: forall backend
+   . Clash.Backend.Backend backend
+  => Proxy backend
+  -> Ghc ()
+  -> IORef ClashOpts
+  -> [(String,Maybe Phase)]
+  -> Ghc ()
+makeHDL' _     _           _ []   = throwGhcException (CmdLineError "No input files")
+makeHDL' proxy startAction r srcs = makeHDL proxy startAction r $ fmap fst srcs
+
+makeVHDL :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
+makeVHDL = makeHDL' (Proxy @VHDLState)
+
+makeVerilog :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
+makeVerilog = makeHDL' (Proxy @VerilogState)
+
+makeSystemVerilog :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
+makeSystemVerilog = makeHDL' (Proxy @SystemVerilogState)
+
+-- -----------------------------------------------------------------------------
+-- Util
+
+unknownFlagsErr :: [String] -> a
+unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs
+  where
+    oneError f =
+        "unrecognised flag: " ++ f ++ "\n" ++
+        (case flagSuggestions (nubSort allNonDeprecatedFlags) f of
+            [] -> ""
+            suggs -> "did you mean one of:\n" ++ unlines (map ("  " ++) suggs))
diff --git a/src-bin-9.10/Clash/GHCi/Leak.hs b/src-bin-9.10/Clash/GHCi/Leak.hs
deleted file mode 100644
--- a/src-bin-9.10/Clash/GHCi/Leak.hs
+++ /dev/null
@@ -1,85 +0,0 @@
-{-# LANGUAGE RecordWildCards, LambdaCase #-}
-module Clash.GHCi.Leak
-  ( LeakIndicators
-  , getLeakIndicators
-  , checkLeakIndicators
-  ) where
-
-import Control.Monad
-import Data.Bits
-import Foreign.Ptr (ptrToIntPtr, intPtrToPtr)
-import GHC
-import GHC.Ptr (Ptr (..))
-import Clash.GHCi.Util
-import GHC.Driver.Env
-import GHC.Driver.Ppr
-import GHC.Utils.Outputable
-import GHC.Unit.Module.ModDetails
-import GHC.Unit.Home.ModInfo
-import GHC.Platform (target32Bit)
-import GHC.Linker.Types
-import Prelude
-import System.Mem
-import System.Mem.Weak
-import GHC.Types.Unique.DFM
-import Control.Exception
-
--- Checking for space leaks in GHCi. See #15111, and the
--- -fghci-leak-check flag.
-
-data LeakIndicators = LeakIndicators [LeakModIndicators]
-
-data LeakModIndicators = LeakModIndicators
-  { leakMod :: Weak HomeModInfo
-  , leakIface :: Weak ModIface
-  , leakDetails :: Weak ModDetails
-  , leakLinkable :: [Maybe (Weak Linkable)]
-  }
-
--- | Grab weak references to some of the data structures representing
--- the currently loaded modules.
-getLeakIndicators :: HscEnv -> IO LeakIndicators
-getLeakIndicators hsc_env =
-  fmap LeakIndicators $
-    forM (eltsUDFM (hsc_HPT hsc_env)) $ \hmi@HomeModInfo{..} -> do
-      leakMod <- mkWeakPtr hmi Nothing
-      leakIface <- mkWeakPtr hm_iface Nothing
-      leakDetails <- mkWeakPtr hm_details Nothing
-      leakLinkable <-  mkWeakLinkables hm_linkable
-      return $ LeakModIndicators{..}
-  where
-    mkWeakLinkables :: HomeModLinkable -> IO [Maybe (Weak Linkable)]
-    mkWeakLinkables (HomeModLinkable mbc mo) =
-      mapM (\ln -> traverse (flip mkWeakPtr Nothing <=< evaluate) ln) [mbc, mo]
-
--- | Look at the LeakIndicators collected by an earlier call to
--- `getLeakIndicators`, and print messasges if any of them are still
--- alive.
-checkLeakIndicators :: DynFlags -> LeakIndicators -> IO ()
-checkLeakIndicators dflags (LeakIndicators leakmods)  = do
-  performGC
-  forM_ leakmods $ \LeakModIndicators{..} -> do
-    deRefWeak leakMod >>= \case
-      Nothing -> return ()
-      Just hmi ->
-        report ("HomeModInfo for " ++
-          showSDoc dflags (ppr (mi_module (hm_iface hmi)))) (Just hmi)
-    deRefWeak leakIface >>= \case
-      Nothing -> return ()
-      Just miface -> report ("ModIface:" ++ moduleNameString (moduleName (mi_module miface))) (Just miface)
-    deRefWeak leakDetails >>= report "ModDetails"
-    forM_ leakLinkable $ \l -> forM_ l $ \l' -> deRefWeak l' >>= report "Linkable"
- where
-  report :: String -> Maybe a -> IO ()
-  report _ Nothing = return ()
-  report msg (Just a) = do
-    addr <- anyToPtr a
-    putStrLn ("-fghci-leak-check: " ++ msg ++ " is still alive at " ++
-              show (maskTagBits addr))
-
-  tagBits
-    | target32Bit (targetPlatform dflags) = 2
-    | otherwise = 3
-
-  maskTagBits :: Ptr a -> Ptr a
-  maskTagBits p = intPtrToPtr (ptrToIntPtr p .&. complement (shiftL 1 tagBits - 1))
diff --git a/src-bin-9.10/Clash/GHCi/UI.hs b/src-bin-9.10/Clash/GHCi/UI.hs
deleted file mode 100644
--- a/src-bin-9.10/Clash/GHCi/UI.hs
+++ /dev/null
@@ -1,4883 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE NondecreasingIndentation #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE TypeFamilies #-}
-
-{-# OPTIONS -fno-warn-name-shadowing #-}
--- This module does a lot of it
-
------------------------------------------------------------------------------
---
--- GHC Interactive User Interface
---
--- (c) The GHC Team 2005-2006
---
------------------------------------------------------------------------------
-
-module Clash.GHCi.UI (
-        interactiveUI,
-        GhciSettings(..),
-        defaultGhciSettings,
-        ghciCommands,
-        ghciWelcomeMsg,
-        makeHDL
-    ) where
-
--- GHCi
-import qualified Clash.GHCi.UI.Monad as GhciMonad ( args, runStmt, runDecls' )
-import Clash.GHCi.UI.Monad hiding ( args, runStmt )
-import Clash.GHCi.UI.Info
-import Clash.GHCi.UI.Exception
-import GHC.Runtime.Debugger
-
--- The GHC interface
-import GHC.Runtime.Interpreter
-import GHCi.RemoteTypes
-import GHCi.BreakArray( breakOn, breakOff )
-import GHC.ByteCode.Types
-import GHC.Core.DataCon
-import GHC.Core.ConLike
-import GHC.Core.PatSyn
-import GHC.Driver.Flags
-import GHC.Driver.Errors
-import GHC.Driver.Errors.Types
-import GHC.Driver.Phases
-import GHC.Driver.Session as DynFlags
-import GHC.Driver.Ppr hiding (printForUser)
-import GHC.Utils.Error hiding (traceCmd)
-import GHC.Driver.Monad ( modifySession )
-import GHC.Driver.Make ( newIfaceCache, ModIfaceCache(..) )
-import GHC.Driver.Config.Parser (initParserOpts)
-import GHC.Driver.Config.Diagnostic
-import qualified GHC
-import GHC ( LoadHowMuch(..), Target(..),  TargetId(..),
-             Resume, SingleStep, Ghc,
-             GetDocsFailure(..), pushLogHookM,
-             getModuleGraph, handleSourceError, ms_mod )
-import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation)
-import GHC.Hs.ImpExp
-import GHC.Hs
-import GHC.Driver.Env
-import GHC.Runtime.Context
-import GHC.Types.TyThing
-import GHC.Types.TyThing.Ppr
-import GHC.Core.TyCo.Ppr
-import GHC.Types.SafeHaskell ( getSafeMode )
-import GHC.Types.SourceError ( SourceError )
-import GHC.Types.Name
-import GHC.Types.Var ( varType )
-import GHC.Iface.Syntax ( showToHeader )
-import GHC.Builtin.Names
-import GHC.Builtin.Types( stringTyCon_RDR )
-import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrName )
-import GHC.Types.SrcLoc as SrcLoc
-import qualified GHC.Parser.Lexer as Lexer
-import GHC.Parser.Header ( toArgs )
-import qualified GHC.Parser.Header as Header
-import GHC.Types.PkgQual
-
-import GHC.Unit
-import GHC.Unit.Finder as Finder
-import GHC.Unit.Module.Graph (filterToposortToModules)
-import GHC.Unit.Module.ModSummary
-
-import GHC.Data.StringBuffer
-import GHC.Utils.Outputable
-import GHC.Utils.Logger
-
--- Other random utilities
-import GHC.Types.Basic hiding ( isTopLevel )
-import GHC.Data.Graph.Directed
-import GHC.Utils.Encoding
-import GHC.Data.FastString
-import qualified GHC.Linker.Loader as Loader
-import GHC.Data.Maybe ( orElse, expectJust )
-import GHC.Types.Name.Set
-import GHC.Utils.Panic hiding ( showException, try )
-import GHC.Utils.Misc
-import qualified GHC.LanguageExtensions as LangExt
-import GHC.Data.Bag (unitBag)
-import qualified GHC.Data.Strict as Strict
-import GHC.Types.Error
-
--- 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.Catch as MC
-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 ( elemIndices, find, intercalate, intersperse, minimumBy,
-                   isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
-import qualified Data.List.NonEmpty as NE
-import qualified Data.Set as S
-import Data.Maybe
-import qualified Data.Map as M
-import Data.IntMap.Strict (IntMap)
-import qualified Data.IntMap.Strict as IntMap
-import Data.Time.LocalTime ( getZonedTime )
-import Data.Time.Format ( formatTime, defaultTimeLocale )
-import Data.Version ( showVersion )
-import qualified Data.Semigroup as S
-import Prelude hiding ((<>))
-
-import GHC.Utils.Exception as Exception hiding (catch, mask, handle)
-import Foreign hiding (void)
-import GHC.Stack hiding (SrcLoc(..))
-import GHC.Unit.Env
-import GHC.Unit.Home.ModInfo
-
-import System.Directory
-import System.Environment
-import System.Exit ( exitWith, ExitCode(..) )
-import System.FilePath
-import System.Info
-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)
-
-import Unsafe.Coerce
-
-#if !defined(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 Clash.GHCi.Leak
-import qualified GHC.Unit.Module.Graph as GHC
-
--- clash additions
-import           Clash.Backend (Backend(initBackend, hdlKind, primDirs))
-import           Clash.Backend.SystemVerilog (SystemVerilogState)
-import           Clash.Backend.VHDL (VHDLState)
-import           Clash.Backend.Verilog (VerilogState)
-import qualified Clash.Driver
-import           Clash.Driver.Bool (fromGhcOverridingBool)
-import           Clash.Driver.Types (ClashOpts(..), ClashEnv(..), ClashDesign(..))
-import           Clash.GHC.Evaluator
-import           Clash.GHC.GenerateBindings
-import           Clash.GHC.NetlistTypes
-import           Clash.GHC.PartialEval
-import           Clash.GHCi.Common
-import           Clash.Util (clashLibVersion, reportTimeDiff)
-import           Data.Proxy
-import qualified Data.Time.Clock as Clock
-import qualified Paths_clash_ghc
-
------------------------------------------------------------------------------
-
-data GhciSettings = GhciSettings {
-        availableCommands :: [Command],
-        shortHelpText     :: String,
-        fullHelpText      :: String,
-        defPrompt         :: PromptFunction,
-        defPromptCont     :: PromptFunction
-    }
-
-defaultGhciSettings :: IORef ClashOpts -> GhciSettings
-defaultGhciSettings opts =
-    GhciSettings {
-        availableCommands = ghciCommands opts,
-        shortHelpText     = defShortHelpText,
-        defPrompt         = default_prompt,
-        defPromptCont     = default_prompt_cont,
-        fullHelpText      = defFullHelpText
-    }
-
-ghciWelcomeMsg :: String
-ghciWelcomeMsg = "Clashi, version " ++ Data.Version.showVersion Paths_clash_ghc.version ++
-                 " (using clash-lib, version " ++ Data.Version.showVersion clashLibVersion ++
-                 "):\nhttps://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,             completeBreakpoint),
-  ("back",      keepGoing backCmd,              noCompletion),
-  ("browse",    keepGoing' (browseCmd False),   completeModule),
-  ("browse!",   keepGoing' (browseCmd True),    completeModule),
-  ("cd",        keepGoingMulti' changeDirectory,     completeFilename),
-  ("check",     keepGoing' checkModule,         completeHomeModule),
-  ("continue",  keepGoing continueCmd,          noCompletion),
-  ("cmd",       keepGoing cmdCmd,               completeExpression),
-  ("def",       keepGoing (defineMacro False),  completeExpression),
-  ("def!",      keepGoing (defineMacro True),   completeExpression),
-  ("delete",    keepGoing deleteCmd,            noCompletion),
-  ("disable",   keepGoing disableCmd,           noCompletion),
-  ("doc",       keepGoing' docCmd,              completeIdentifier),
-  ("edit",      keepGoingMulti' editFile,            completeFilename),
-  ("enable",    keepGoing enableCmd,            noCompletion),
-  ("force",     keepGoing forceCmd,             completeExpression),
-  ("forward",   keepGoing forwardCmd,           noCompletion),
-  ("help",      keepGoingMulti help,                 noCompletion),
-  ("history",   keepGoingMulti historyCmd,           noCompletion),
-  ("info",      keepGoingMulti' (info False),        completeIdentifier),
-  ("info!",     keepGoingMulti' (info True),         completeIdentifier),
-  ("issafe",    keepGoing' isSafeCmd,           completeModule),
-  ("ignore",    keepGoing ignoreCmd,            noCompletion),
-  ("kind",      keepGoingMulti' (kindOfType False),  completeIdentifier),
-  ("kind!",     keepGoingMulti' (kindOfType True),   completeIdentifier),
-  ("load",      keepGoingPaths loadModule_,     completeHomeModuleOrFile),
-  ("load!",     keepGoingPaths loadModuleDefer, completeHomeModuleOrFile),
-  ("list",      keepGoing' listCmd,             noCompletion),
-  ("module",    keepGoing moduleCmd,            completeSetModule),
-  ("main",      keepGoing runMain,              completeFilename),
-  ("print",     keepGoing printCmd,             completeExpression),
-  ("quit",      quit,                           noCompletion),
-  ("reload",    keepGoingMulti' reloadModule,   noCompletion),
-  ("reload!",   keepGoingMulti' reloadModuleDefer,   noCompletion),
-  ("run",       keepGoing runRun,               completeFilename),
-  ("script",    keepGoing' scriptCmd,           completeFilename),
-  ("set",       keepGoingMulti setCmd,          completeSetOptions),
-  ("seti",      keepGoingMulti setiCmd,         completeSeti),
-  ("show",      keepGoingMulti' showCmd,        completeShowOptions),
-  ("showi",     keepGoing showiCmd,             completeShowiOptions),
-  ("sprint",    keepGoing sprintCmd,            completeExpression),
-  ("step",      keepGoing stepCmd,              completeIdentifier),
-  ("steplocal", keepGoing stepLocalCmd,         completeIdentifier),
-  ("stepmodule",keepGoing stepModuleCmd,        completeIdentifier),
-  ("type",      keepGoingMulti' typeOfExpr,          completeExpression),
-  ("trace",     keepGoing traceCmd,             completeExpression),
-  ("unadd",     keepGoingPaths unAddModule,     completeFilename),
-  ("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),
-  ("instances", keepGoing' instancesCmd,        completeExpression)
-  ] ++ 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
-
-word_break_chars_pred :: Char -> Bool
-word_break_chars_pred '.' = False
-word_break_chars_pred c = c `elem` (spaces ++ specials) || isSymbolChar c
-
-symbols, specials, spaces :: String
-symbols = "!#$%&*+/<=>?@\\^|-~"
-specials = "(),;[]`{}"
-spaces = " \t\n"
-
-flagWordBreakChars :: String
-flagWordBreakChars = " \t\n"
-
-
-showSDocForUser' :: GHC.GhcMonad m => SDoc -> m String
-showSDocForUser' doc = do
-    dflags <- getDynFlags
-    unit_state <- hsc_units <$> GHC.getSession
-    name_ppr_ctx <- GHC.getNamePprCtx
-    pure $ showSDocForUser dflags unit_state name_ppr_ctx doc
-
-showSDocForUserQualify :: GHC.GhcMonad m => SDoc -> m String
-showSDocForUserQualify doc = do
-    dflags <- getDynFlags
-    unit_state <- hsc_units <$> GHC.getSession
-    pure $ showSDocForUser dflags unit_state alwaysQualify doc
-
-
-keepGoing :: (String -> GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
-keepGoing a str = keepGoing' (lift . a) str
-
-keepGoingMulti :: (String -> GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
-keepGoingMulti a str = keepGoingMulti' (lift . a) str
-
-keepGoing' :: GhciMonad m => (a -> m ()) -> a -> m CmdExecOutcome
-keepGoing' a str = do
-  in_multi <- inMultiMode
-  if in_multi
-    then
-      liftIO $ hPutStrLn stderr "Command is not supported (yet) in multi-mode"
-    else
-      a str
-  return CmdSuccess
-
--- For commands which are actually support in multi-mode, initially just :reload
-keepGoingMulti' :: GhciMonad m => (String -> m ()) -> String -> m CmdExecOutcome
-keepGoingMulti' a str = a str >> return CmdSuccess
-
-inMultiMode :: GhciMonad m => m Bool
-inMultiMode = multiMode <$> getGHCiState
-
-keepGoingPaths :: ([FilePath] -> InputT GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
-keepGoingPaths a str
- = do case toArgsNoLoc str of
-          Left err -> liftIO $ hPutStrLn stderr err >> return CmdSuccess
-          Right args -> keepGoing' a args
-
-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" ++
-  "   :def[!] <cmd> <expr>        define command :<cmd> (later defined command has\n" ++
-  "                               precedence, ::<cmd> is always a builtin command)\n" ++
-  "                               (!: redefine an existing command name)\n" ++
-  "   :doc <name>                 display docs for the given name (experimental)\n" ++
-  "   :edit <file>                edit file\n" ++
-  "   :edit                       edit last module\n" ++
-  "   :help, :?                   display this list of commands\n" ++
-  "   :info[!] [<name> ...]       display information about the given names\n" ++
-  "                               (!: do not filter instances)\n" ++
-  "   :instances <type>           display the class instances available for <type>\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" ++
-  "   :type +d <expr>             show the type of <expr>, defaulting type variables\n" ++
-  "   :unadd <module> ...         remove module(s) from the current target set\n" ++
-  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
-  "   ::<cmd>                     run the builtin command\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 [<count>]         resume after a breakpoint [and set break ignore count]\n" ++
-  "   :delete <number> ...        delete the specified breakpoints\n" ++
-  "   :delete *                   delete all breakpoints\n" ++
-  "   :disable <number> ...       disable the specified breakpoints\n" ++
-  "   :disable *                  disable all breakpoints\n" ++
-  "   :enable <number> ...        enable the specified breakpoints\n" ++
-  "   :enable *                   enable 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" ++
-  "   :ignore <breaknum> <count>  for break <breaknum> set break ignore <count>\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 local-config { source | ignore }\n" ++
-  "                               set whether to source .ghci in current dir\n" ++
-  "                               (loading untrusted config is a security issue)\n" ++
-  "   :set args <arg> ...         set the arguments returned by System.Environment.getArgs\n" ++
-  "   :set prog <progname>        set the value returned by System.Environment.getProgName\n" ++
-  "   :set prompt <prompt>        set the prompt used in GHCi\n" ++
-  "   :set prompt-cont <prompt>   set the continuation prompt used in GHCi\n" ++
-  "   :set prompt-function <expr> set the function to handle the prompt\n" ++
-  "   :set prompt-cont-function <expr>\n" ++
-  "                               set the function to handle the continuation prompt\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 targets               show the current set of targets\n" ++
-  "   :show <setting>             show value of <setting>, which is one of\n" ++
-  "                                  [args, prog, editor, stop]\n" ++
-  "   :showi language             show language flags for interactive evaluation\n" ++
-  "\n" ++
-  " The User's Guide has more information. An online copy can be found here:\n" ++
-  "\n" ++
-  "   https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html\n" ++
-  "\n"
-
-findEditor :: IO String
-findEditor = do
-    getEnv "VISUAL" <|> getEnv "EDITOR" <|> defaultEditor
-  where
-    defaultEditor = do
-#if defined(mingw32_HOST_OS)
-      win <- System.Win32.getWindowsDirectory
-      return (win </> "notepad.exe")
-#else
-      return ""
-#endif
-
-default_progname, default_stop :: String
-default_progname = "<interactive>"
-default_stop = ""
-
-default_prompt, default_prompt_cont :: PromptFunction
-default_prompt = generatePromptFunctionFromString "clashi> "
-default_prompt_cont = generatePromptFunctionFromString "clashi| "
-
-default_args :: [String]
-default_args = []
-
-interactiveUI :: GhciSettings -> [(FilePath, Maybe UnitId, Maybe Phase)] -> Maybe [String]
-              -> Ghc ()
-interactiveUI config srcs maybe_exprs = do
-   -- This is a HACK to make sure dynflags are not overwritten when setting
-   -- options. When GHCi is made properly multi component it should be removed.
-   modifySession (\env -> hscSetActiveUnitId (hscActiveUnitId env) env)
-   -- 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) <- runInternal initInterpBuffering
-
-   -- The initial set of DynFlags used for interactive evaluation is the same
-   -- as the global DynFlags, plus -XExtendedDefaultRules and
-   -- -XNoMonomorphismRestriction.
-   -- See Note [Changing language extensions for interactive evaluation] #10857
-   dflags <- getDynFlags
-   let dflags' = (xopt_set_unlessExplSpec
-                      LangExt.ExtendedDefaultRules xopt_set)
-               . (xopt_set_unlessExplSpec
-                      LangExt.MonomorphismRestriction xopt_unset)
-               $ dflags
-   GHC.setInteractiveDynFlags dflags'
-   _ <- GHC.setProgramDynFlags
-               -- Set Opt_KeepGoing so that :reload loads as much as
-               -- possible
-               (gopt_set dflags Opt_KeepGoing)
-
-   -- Update the LogAction. Ensure we don't override the user's log action lest
-   -- we break -ddump-json (#14078)
-   lastErrLocationsRef <- liftIO $ newIORef []
-   pushLogHookM (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
-   let prelude_import =
-         case simpleImportDecl preludeModuleName of
-           -- Set to True because Prelude is implicitly imported.
-           impDecl@ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}}
-   hsc_env <- GHC.getSession
-   let in_multi = length (hsc_all_home_unit_ids hsc_env) > 1
-   empty_cache <- liftIO newIfaceCache
-   startGHCi (runGHCi srcs maybe_exprs)
-        GHCiState{ progname           = default_progname,
-                   args               = default_args,
-                   evalWrapper        = eval_wrapper,
-                   prompt             = defPrompt config,
-                   prompt_cont        = defPromptCont config,
-                   stop               = default_stop,
-                   editor             = default_editor,
-                   options            = [],
-                   multiMode          = in_multi,
-                   localConfig        = SourceLocalConfig,
-                   -- 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             = IntMap.empty,
-                   tickarrays         = emptyModuleEnv,
-                   ghci_commands      = availableCommands config,
-                   ghci_macros        = [],
-                   last_command       = Nothing,
-                   cmd_wrapper        = (cmdSuccess =<<),
-                   cmdqueue           = [],
-                   remembered_ctx     = [],
-                   transient_ctx      = [],
-                   extra_imports      = [],
-                   prelude_imports    = [prelude_import],
-                   ghc_e              = isJust maybe_exprs,
-                   short_help         = shortHelpText config,
-                   long_help          = fullHelpText config,
-                   lastErrorLocations = lastErrLocationsRef,
-                   mod_infos          = M.empty,
-                   flushStdHandles    = flush,
-                   noBuffering        = nobuffering,
-                   ifaceCache = empty_cache
-                 }
-
-   return ()
-
-{-
-Note [Changing language extensions for interactive evaluation]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-GHCi maintains two sets of options:
-
-- The "loading options" apply when loading modules
-- The "interactive options" apply when evaluating expressions and commands
-    typed at the GHCi prompt.
-
-The loading options are mostly created in ghc/Main.hs:main' from the command
-line flags. In the function ghc/GHCi/UI.hs:interactiveUI the loading options
-are copied to the interactive options.
-
-These interactive options (but not the loading options!) are supplemented
-unconditionally by setting ExtendedDefaultRules ON and
-MonomorphismRestriction OFF. The unconditional setting of these options
-eventually overwrite settings already specified at the command line.
-
-Therefore instead of unconditionally setting ExtendedDefaultRules and
-NoMonomorphismRestriction for the interactive options, we use the function
-'xopt_set_unlessExplSpec' to first check whether the extension has already
-specified at the command line.
-
-The ghci config file has not yet been processed.
--}
-
-resetLastErrorLocations :: GhciMonad m => m ()
-resetLastErrorLocations = do
-    st <- getGHCiState
-    liftIO $ writeIORef (lastErrorLocations st) []
-
-ghciLogAction :: IORef [(FastString, Int)] -> LogAction -> LogAction
-ghciLogAction lastErrLocations old_log_action
-              dflags msg_class srcSpan msg = do
-    old_log_action dflags msg_class srcSpan msg
-    case msg_class of
-        MCDiagnostic SevError _reason _code -> case srcSpan of
-            RealSrcSpan rsp _ -> modifyIORef lastErrLocations
-                (++ [(srcLocFile (realSrcSpanStart rsp), srcLocLine (realSrcSpanStart rsp))])
-            _ -> return ()
-        _ -> return ()
-
--- | Takes a file name and prefixes it with the appropriate
--- GHC appdir.
--- Uses ~/.ghc (getAppUserDataDirectory) if it exists
--- If it doesn't, then it uses $XDG_DATA_HOME/ghc
--- Earlier we always used to use ~/.ghc, but we want
--- to gradually move to $XDG_DATA_HOME to respect the XDG specification
---
--- As a migration strategy, we will only create new directories in
--- the appropriate XDG location. However, we will use the old directory
--- if it already exists.
-getAppDataFile :: FilePath -> IO (Maybe FilePath)
-getAppDataFile file = do
-    let new_path = tryIO (getXdgDirectory XdgConfig "clash") >>= \case
-          Left _ -> pure Nothing
-          Right dir -> flip catchIO (const $ return Nothing) $ do
-            createDirectoryIfMissing False dir
-            pure $ Just $ dir </> file
-
-    e_old_path <- tryIO (getAppUserDataDirectory "clash")
-    case e_old_path of
-      Right old_path -> doesDirectoryExist old_path >>= \case
-        True -> pure $ Just $ old_path </> file
-        False -> new_path
-      Left _ -> new_path
-
-runGHCi :: [(FilePath, Maybe UnitId, Maybe Phase)] -> Maybe [String] -> GHCi ()
-runGHCi paths maybe_exprs = do
-  dflags <- getDynFlags
-  let
-   ignore_dot_ghci = gopt Opt_IgnoreDotGhci dflags
-
-   app_user_dir = liftIO $ getAppDataFile "clashi.conf"
-
-   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
-
-  processedCfgs <- if ignore_dot_ghci
-    then pure []
-    else do
-      userCfgs <- do
-        paths <- catMaybes <$> sequence [ app_user_dir, home_dir ]
-        checkedPaths <- liftIO $ filterM checkFileAndDirPerms paths
-        liftIO . fmap (nub . catMaybes) $ mapM canonicalizePath' checkedPaths
-
-      localCfg <- do
-        let path = ".clashi"
-        ok <- liftIO $ checkFileAndDirPerms path
-        if ok then liftIO $ canonicalizePath' path else pure Nothing
-
-      mapM_ sourceConfigFile userCfgs
-        -- Process the global and user .ghci
-        -- (but not $CWD/.ghci or CLI args, yet)
-
-      behaviour <- localConfig <$> getGHCiState
-
-      processedLocalCfg <- case localCfg of
-        Just path | path `notElem` userCfgs ->
-          -- don't read .ghci twice if CWD is $HOME
-          case behaviour of
-            SourceLocalConfig -> localCfg <$ sourceConfigFile path
-            IgnoreLocalConfig -> pure Nothing
-        _ -> pure Nothing
-
-      pure $ maybe id (:) processedLocalCfg userCfgs
-
-  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 arg_cfgs \\ processedCfgs
-    -- Dedup, and remove any configs we already processed.
-    -- Importantly, if $PWD/.ghci was ignored due to configuration,
-    -- explicitly specifying it does cause it to be processed.
-
-  -- Perform a :reload for files given on the GHCi command line
-  -- The appropriate targets will already be set
-  -- 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) $
-                    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
-            -- Set different defaulting rules (See #280)
-            runGHCiExpressions
-              ["default ((), [], Prelude.Integer, Prelude.Int, Prelude.Double, Prelude.String)"]
-
-            -- enter the interactive loop
-            runGHCiInput $ runCommands $ nextInputLine show_prompt is_tty
-        Just exprs -> do
-            -- just evaluate the expression we were given
-            runGHCiExpressions exprs
-
-  -- and finally, exit
-  liftIO $ when (verbosity dflags > 0) $ putStrLn "Leaving Clashi."
-
-runGHCiExpressions :: [String] -> GHCi ()
-runGHCiExpressions exprs = do
-            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 failure, see #7962, #9916, #17560, #18441
-                _ <- runCommands' hdle
-                     (Just $ hdle (toException $ ExitFailure 1) >> return ())
-                     (return Nothing)
-                return ()
-
-runGHCiInput :: InputT GHCi a -> GHCi a
-runGHCiInput f = do
-    dflags <- getDynFlags
-    let ghciHistory = gopt Opt_GhciHistory dflags
-    let localGhciHistory = gopt Opt_LocalGhciHistory dflags
-    currentDirectory <- liftIO $ getCurrentDirectory
-
-    histFile <- case (ghciHistory, localGhciHistory) of
-      (True, True) -> return (Just (currentDirectory </> ".clashi_history"))
-      (True, _) -> liftIO $ getAppDataFile "clashi_history"
-      _ -> 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
-#if defined(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 :: GhciMonad m => m ()
-incrementLineNo = modifyGHCiState incLineNo
-  where
-    incLineNo st = st { line_number = line_number st + 1 }
-
-fileLoop :: GhciMonad m => Handle -> m (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')
-
-formatCurrentTime :: String -> IO String
-formatCurrentTime format =
-  getZonedTime >>= return . (formatTime defaultTimeLocale format)
-
-getUserName :: IO String
-getUserName = do
-#if defined(mingw32_HOST_OS)
-  getEnv "USERNAME"
-    `catchIO` \e -> do
-      putStrLn $ show e
-      return ""
-#else
-  getLoginName
-#endif
-
-getInfoForPrompt :: GhciMonad m => m (SDoc, [String], Int)
-getInfoForPrompt = 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
-
-        myIdeclName d | Just m <- ideclAs d = unLoc m
-                      | otherwise           = unLoc (ideclName d)
-
-        modules_names =
-             ['*':(moduleNameString m) | IIModule m <- rev_imports] ++
-             [moduleNameString (myIdeclName d) | IIDecl d <- rev_imports]
-        line = 1 + line_number st
-
-  return (dots <> context_bit, modules_names, line)
-
--- | Takes a string, presumably following "%call", and tries to parse
--- a command and arguments in parentheses:
---
--- > parseCallEscape "  (cmd arg1 arg2)rest" = Just ("cmd" :| ["arg1", "arg2"], "rest")
--- > parseCallEscape "( )rest" = Nothing
---
-parseCallEscape :: String -> Maybe (NE.NonEmpty String, String)
-parseCallEscape s = case dropWhile isSpace s of
-  '(' : sinceOpen -> case span (/= ')') sinceOpen of
-    (call, ')' : sinceClosed)
-      | cmd : args <- words call -> Just (cmd NE.:| args, sinceClosed)
-    _ -> Nothing
-  _ -> Nothing
-
-checkPromptStringForErrors :: String -> Maybe String
-checkPromptStringForErrors ('%':'c':'a':'l':'l':xs) =
-  case parseCallEscape xs of
-    Nothing  -> Just ("Incorrect %call syntax. " ++
-                      "Should be %call(a command and arguments).")
-    Just (_, afterClosed) -> checkPromptStringForErrors afterClosed
-checkPromptStringForErrors ('%':'%':xs) = checkPromptStringForErrors xs
-checkPromptStringForErrors (_:xs) = checkPromptStringForErrors xs
-checkPromptStringForErrors "" = Nothing
-
-generatePromptFunctionFromString :: String -> PromptFunction
-generatePromptFunctionFromString promptS modules_names line =
-        processString promptS
-  where
-        processString :: String -> GHCi SDoc
-        processString ('%':'s':xs) =
-            liftM2 (<>) (return modules_list) (processString xs)
-            where
-              modules_list = hsep . map text . ordNub $ modules_names
-        processString ('%':'l':xs) =
-            liftM2 (<>) (return $ ppr line) (processString xs)
-        processString ('%':'d':xs) =
-            liftM2 (<>) (liftM text formatted_time) (processString xs)
-            where
-              formatted_time = liftIO $ formatCurrentTime "%a %b %d"
-        processString ('%':'t':xs) =
-            liftM2 (<>) (liftM text formatted_time) (processString xs)
-            where
-              formatted_time = liftIO $ formatCurrentTime "%H:%M:%S"
-        processString ('%':'T':xs) = do
-            liftM2 (<>) (liftM text formatted_time) (processString xs)
-            where
-              formatted_time = liftIO $ formatCurrentTime "%I:%M:%S"
-        processString ('%':'@':xs) = do
-            liftM2 (<>) (liftM text formatted_time) (processString xs)
-            where
-              formatted_time = liftIO $ formatCurrentTime "%I:%M %P"
-        processString ('%':'A':xs) = do
-            liftM2 (<>) (liftM text formatted_time) (processString xs)
-            where
-              formatted_time = liftIO $ formatCurrentTime "%H:%M"
-        processString ('%':'u':xs) =
-            liftM2 (<>) (liftM text user_name) (processString xs)
-            where
-              user_name = liftIO $ getUserName
-        processString ('%':'w':xs) =
-            liftM2 (<>) (liftM text current_directory) (processString xs)
-            where
-              current_directory = liftIO $ getCurrentDirectory
-        processString ('%':'o':xs) =
-            liftM ((text os) <>) (processString xs)
-        processString ('%':'a':xs) =
-            liftM ((text arch) <>) (processString xs)
-        processString ('%':'N':xs) =
-            liftM ((text compilerName) <>) (processString xs)
-        processString ('%':'V':xs) =
-            liftM ((text $ showVersion compilerVersion) <>) (processString xs)
-        processString ('%':'c':'a':'l':'l':xs) = do
-            -- Input has just been validated by parseCallEscape
-            let (cmd NE.:| args, afterClosed) = fromJust $ parseCallEscape xs
-            respond <- liftIO $ do
-                (code, out, err) <-
-                    readProcessWithExitCode
-                    cmd args ""
-                    `catchIO` \e -> return (ExitFailure 1, "", show e)
-                case code of
-                    ExitSuccess -> return out
-                    _ -> do
-                        hPutStrLn stderr err
-                        return ""
-            liftM ((text respond) <>) (processString afterClosed)
-        processString ('%':'%':xs) =
-            liftM ((char '%') <>) (processString xs)
-        processString (x:xs) =
-            liftM (char x <>) (processString xs)
-        processString "" =
-            return empty
-
-mkPrompt :: GHCi String
-mkPrompt = do
-  st <- getGHCiState
-  dflags <- getDynFlags
-  (context, modules_names, line) <- getInfoForPrompt
-
-  prompt_string <- (prompt st) modules_names line
-  let prompt_doc = context <> prompt_string
-
-  return (showSDoc dflags prompt_doc)
-
-queryQueue :: GhciMonad m => m (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 :: GhciMonad m => Maybe String -> Bool -> m ()
-installInteractivePrint Nothing _  = return ()
-installInteractivePrint (Just ipFun) exprmode = do
-  ok <- trySuccess $ do
-                name NE.:| _ <- 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 ()
-runCommands' eh sourceErrorHandler gCmd = mask $ \unmask -> do
-    b <- handle (\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 ()
-      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 command was unsuccessful. GHCi will continue in either case.
--- TODO: replace Bool with CmdExecOutcome
-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  -> do
-      st <- getGHCiState
-      ghciHandle (\e -> lift $ eh e >>= return . Just) $
-        handleSourceError printErrorAndFail $
-          cmd_wrapper st $ doCommand c
-               -- source error's are handled by runStmt
-               -- is the handler necessary here?
-  where
-    printErrorAndFail err = do
-        printGhciException 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 = prompt_cont st }
-      mb_cmd <- collectCommand q "" `MC.finally`
-                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 :{ .. :}"
-
-    cmdOutcome :: CmdExecOutcome -> Maybe Bool
-    cmdOutcome CleanExit = Nothing
-    cmdOutcome CmdSuccess = Just True
-    cmdOutcome CmdFailure = Just False
-
-    -- | Handle a line of input
-    doCommand :: String -> InputT GHCi CommandResult
-
-    -- command
-    doCommand stmt | stmt'@(':' : cmd) <- removeSpaces stmt = do
-      (stats, result) <- runWithStats (const Nothing) $ specialCommand cmd
-      return $ CommandComplete stmt' (cmdOutcome <$> result) stats
-
-    -- 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 CommandIncomplete
-            Just ml_stmt -> do
-              -- temporarily compensate line-number for multi-line input
-              (stats, result) <- runAndPrintStats runAllocs $ lift $
-                runStmtWithLineNum fst_line_num ml_stmt GHC.RunToCompletion
-              return $
-                CommandComplete ml_stmt (Just . runSuccess <$> result) stats
-        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
-          (stats, result) <- runAndPrintStats runAllocs $ lift $
-            runStmtWithLineNum fst_line_num stmt' GHC.RunToCompletion
-          return $ CommandComplete stmt' (Just . runSuccess <$> result) stats
-
-    -- 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
-  :: GhciMonad m => String -> m (Maybe String) -> m (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.initParserState (initParserOpts 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 = prompt_cont 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 :: GhciMonad m => [String] -> m ()
-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 :: GhciMonad m => String -> SingleStep -> m (Maybe GHC.ExecResult)
-runStmt input step = do
-  pflags <- initParserOpts <$> GHC.getInteractiveDynFlags
-  -- In GHCi, we disable `-fdefer-type-errors`, as well as `-fdefer-type-holes`
-  -- and `-fdefer-out-of-scope-variables` for **naked expressions**. The
-  -- declarations and statements are not affected.
-  -- See Note [Deferred type errors in GHCi] in GHC.Tc.Module
-  st <- getGHCiState
-  let source = progname st
-  let line = line_number st
-
-  -- Add any LANGUAGE/OPTIONS_GHC pragmas we find find.
-  set_pragmas pflags
-
-  if | GHC.isStmt pflags input -> do
-         hsc_env <- GHC.getSession
-         mb_stmt <- liftIO (runInteractiveHsc hsc_env (hscParseStmtWithLocation source line input))
-         case mb_stmt of
-           Nothing ->
-             -- empty statement / comment
-             return (Just exec_complete)
-           Just stmt ->
-             run_stmt stmt
-
-     -- Otherwise assume a declaration (or a list of declarations)
-     -- and/or import(s) (#20473).
-     -- Note: `GHC.isDecl` returns False on input like
-     -- `data Infix a b = a :@: b; infixl 4 :@:`
-     -- and should therefore not be used here.
-     | otherwise -> do
-         hsc_env <- GHC.getSession
-         let !ic = hsc_IC hsc_env  -- Bang-pattern to avoid space leaks
-         setDumpFilePrefix ic
-           -- `-ddump-to-file` must work for normal GHCi compilations /
-           --     evaluations. (#17500)
-         -- Use >>= \case instead of MonadFail desugaring to take into
-         -- consideration `instance XXModule p = DataConCantHappen`.
-         -- Tracked in #15681
-         liftIO (hscParseModuleWithLocation hsc_env source line input) >>= \case
-           HsModule { hsmodDecls = decls, hsmodImports = imports } -> do
-             run_imports imports
-             run_decls decls
-  where
-    exec_complete = GHC.ExecComplete (Right []) 0
-
-    run_imports imports = mapM_ (addImportToContext . unLoc) imports
-
-    set_pragmas pflags =
-      let stringbuf = stringToStringBuffer input
-          (_msgs, loc_opts) = Header.getOptions pflags stringbuf "<interactive>"
-          opts = unLoc <$> loc_opts
-      in setOptions opts
-
-    run_stmt :: GhciMonad m => GhciLStmt GhcPs -> m (Maybe GHC.ExecResult)
-    run_stmt stmt = do
-           m_result <- GhciMonad.runStmt stmt input step
-           case m_result of
-               Nothing     -> return Nothing
-               Just result -> Just <$> afterRunStmt (const True) result
-
-    -- `x = y` (a declaration) should be treated as `let x = y` (a statement).
-    -- The reason is because GHCi wasn't designed to support `x = y`, but then
-    -- b98ff3 (#7253) added support for it, except it did not do a good job and
-    -- caused problems like:
-    --
-    --  - not adding the binders defined this way in the necessary places caused
-    --    `x = y` to not work in some cases (#12091).
-    --  - some GHCi command crashed after `x = y` (#15721)
-    --  - warning generation did not work for `x = y` (#11606)
-    --  - because `x = y` is a declaration (instead of a statement) differences
-    --    in generated code caused confusion (#16089)
-    --
-    -- Instead of dealing with all these problems individually here we fix this
-    -- mess by just treating `x = y` as `let x = y`.
-    run_decls :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe GHC.ExecResult)
-    -- Only turn `FunBind` and `VarBind` into statements, other bindings
-    -- (e.g. `PatBind`) need to stay as decls.
-    run_decls [L l (ValD _ bind@FunBind{})] = run_stmt (mk_stmt (locA l) bind)
-    run_decls [L l (ValD _ bind@VarBind{})] = run_stmt (mk_stmt (locA l) bind)
-    -- Note that any `x = y` declarations below will be run as declarations
-    -- instead of statements (e.g. `...; x = y; ...`)
-    run_decls decls = 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.runDecls' decls
-      forM m_result $ \result ->
-        afterRunStmt (const True) (GHC.ExecComplete (Right result) 0)
-
-    mk_stmt :: SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs
-    mk_stmt loc bind =
-      let
-        la  = L (noAnnSrcSpan loc)
-        la' = L (noAnnSrcSpan loc)
-      in la (LetStmt noAnn (HsValBinds noAnn (ValBinds NoAnnSortKey (unitBag (la' bind)) [])))
-
-    setDumpFilePrefix :: GHC.GhcMonad m => InteractiveContext -> m () -- #17500
-    setDumpFilePrefix ic = do
-        dflags <- GHC.getInteractiveDynFlags
-        GHC.setInteractiveDynFlags dflags { dumpPrefix = modStr ++ "." }
-      where
-        modStr = moduleNameString $ moduleName $ icInteractiveModule $ ic
-
--- | Clean up the GHCi environment after a statement has run
-afterRunStmt :: GhciMonad m
-             => (SrcSpan -> Bool) -> GHC.ExecResult -> m 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
-         | first_resume : _ <- resumes
-         , isNothing  mb_info ||
-           step_here (GHC.resumeSpan first_resume) -> do
-               mb_id_loc <- toBreakIdAndLocation mb_info
-               let bCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc
-               if (null bCmd)
-                 then printStoppedAtBreakInfo first_resume names
-                 else enqueueCommands [bCmd]
-               -- run the command set with ":set stop <cmd>"
-               st <- getGHCiState
-               enqueueCommands [stop st]
-               return ()
-         | otherwise -> resume step_here GHC.SingleStep Nothing >>=
-                        afterRunStmt step_here >> return ()
-
-  flushInterpBuffers
-  withSignalHandlers $ do
-     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 :: GhciMonad m
-                     => Maybe GHC.BreakInfo -> m (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) <- IntMap.assocs (breaks st),
-                                  breakModule loc == md,
-                                  breakTick loc == nm ]
-
-printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
-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 :: GHC.GhcMonad m => [Name] -> m ()
-printTypeOfNames names
- = mapM_ (printTypeOfName ) $ sortBy compareNames names
-
-compareNames :: Name -> Name -> Ordering
-compareNames = on compare getOccString S.<> on SrcLoc.leftmost_smallest getSrcSpan
-
-printTypeOfName :: GHC.GhcMonad m => Name -> m ()
-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 CmdExecOutcome
-specialCommand ('!':str) = lift $ shellEscape (dropWhile isSpace str)
-specialCommand str = do
-  let (cmd,rest) = break isSpace str
-  maybe_cmd <- lookupCommand cmd
-  htxt <- short_help <$> getGHCiState
-  case maybe_cmd of
-    GotCommand cmd -> (cmdAction cmd) (dropWhile isSpace rest)
-    BadCommand ->
-      do liftIO $ hPutStr stderr ("unknown command ':" ++ cmd ++ "'\n"
-                           ++ htxt)
-         return CmdFailure
-    NoLastCommand ->
-      do liftIO $ hPutStr stderr ("there is no last command to perform\n"
-                           ++ htxt)
-         return CmdFailure
-
-shellEscape :: MonadIO m => String -> m CmdExecOutcome
-shellEscape str = liftIO $ do
-  exitCode <- system str
-  case exitCode of
-    ExitSuccess -> return CmdSuccess
-    ExitFailure _ -> return CmdFailure
-
-lookupCommand :: GhciMonad m => String -> m (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' :: GhciMonad m => String -> m (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 `isPrefixOptOf`) . 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
-
--- This predicate is for prefix match with a command-body and
--- suffix match with an option, such as `!`.
--- The current implementation assumes only the `!` character
--- as the option delimiter.
--- See also #17345
-isPrefixOptOf :: String -> String -> Bool
-isPrefixOptOf s x = let (body, opt) = break (== '!') s
-                    in  (body `isPrefixOf` x) && (opt `isSuffixOf` x)
-
-getCurrentBreakSpan :: GHC.GhcMonad m => m (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 :: GHC.GhcMonad m => m (Maybe [String])
-getCallStackAtCurrentBreakpoint = do
-  resumes <- GHC.getResumeContext
-  case resumes of
-    [] -> return Nothing
-    (r:_) -> do
-       interp <- hscInterp <$> GHC.getSession
-       Just <$> liftIO (costCentreStackInfo interp (GHC.resumeCCS r))
-
-getCurrentBreakModule :: GHC.GhcMonad m => m (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 :: MonadIO m => m () -> String -> m ()
-noArgs m "" = m
-noArgs _ _  = liftIO $ putStrLn "This command takes no arguments"
-
-withSandboxOnly :: GHC.GhcMonad m => String -> m () -> m ()
-withSandboxOnly cmd this = do
-   dflags <- getDynFlags
-   if not (gopt Opt_GhciSandbox dflags)
-      then printForUser (text cmd <+>
-                         text "is not supported with -fno-ghci-sandbox")
-      else this
-
------------------------------------------------------------------------------
--- :help
-
-help :: GhciMonad m => String -> m ()
-help _ = do
-    txt <- long_help `fmap` getGHCiState
-    liftIO $ putStr txt
-
------------------------------------------------------------------------------
--- :info
-
-info :: GHC.GhcMonad m => Bool -> String -> m ()
-info _ "" = throwGhcException (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
-info allInfo s  = handleSourceError printGhciException $ do
-    forM_ (words s) $ \thing -> do
-      sdoc <- infoThing allInfo thing
-      rendered <- showSDocForUser' sdoc
-      liftIO (putStrLn rendered)
-
-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,_sd) -> t)
-                                     (catMaybes (NE.toList 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) -> SDoc
-pprInfo (thing, fixity, cls_insts, fam_insts, docs)
-  =  docs
-  $$ pprTyThingInContextLoc thing
-  $$ showFixity thing fixity
-  $$ vcat (map GHC.pprInstance cls_insts)
-  $$ vcat (map GHC.pprFamInst  fam_insts)
-
------------------------------------------------------------------------------
--- :main
-
-runMain :: GhciMonad m => String -> m ()
-runMain s = case toArgsNoLoc s of
-              Left err   -> liftIO (hPutStrLn stderr err)
-              Right args -> doWithMain (doWithArgs args)
-  where
-    doWithMain fun = do
-      dflags  <- getDynFlags
-      let main = fromMaybe "main" (mainFunIs dflags)
-      handleSourceError printErrAndMaybeExit $ do
-        -- doing this will prevent the main to run when it is not in scope
-        -- this might seem useless, but it doesn't suggest other functions
-        -- to be used, which is exactly what we want here. See #23996.
-        _ <- GHC.parseName main
-
-        -- Wrap the main function in 'void' to discard its value instead
-        -- of printing it (#9086). See Haskell 2010 report Chapter 5.
-        fun $ "Control.Monad.void (" ++ main ++ ")"
-
-
-
-
------------------------------------------------------------------------------
--- :run
-
-runRun :: GhciMonad m => String -> m ()
-runRun s = case toCmdArgs s of
-           Left err          -> liftIO (hPutStrLn stderr err)
-           Right (cmd, args) -> doWithArgs args cmd
-
-doWithArgs :: GhciMonad m => [String] -> String -> m ()
-doWithArgs args cmd = enqueueCommands ["System.Environment.withArgs " ++
-                                       show args ++ " (" ++ cmd ++ ")"]
-
-{-
-Akin to @Prelude.words@, but acts like the Bourne shell, treating
-quoted strings as Haskell Strings, and also parses Haskell [String]
-syntax.
--}
-
-getCmd :: String -> Either String             -- Error
-                           (String, String) -- (Cmd, Rest)
-getCmd s = case break isSpace $ dropWhile isSpace s of
-           ([], _) -> Left ("Couldn't find command in " ++ show s)
-           res -> Right res
-
-toCmdArgs :: String -> Either String             -- Error
-                              (String, [String]) -- (Cmd, Args)
-toCmdArgs s = case getCmd s of
-              Left err -> Left err
-              Right (cmd, s') -> case toArgsNoLoc s' of
-                                 Left err -> Left err
-                                 Right args -> Right (cmd, args)
-
--- wrapper around GHC.Parser.Header.toArgs, but without locations
-toArgsNoLoc :: String -> Either String [String]
-toArgsNoLoc str = map unLoc <$> toArgs fake_loc str
-  where
-    fake_loc = mkRealSrcLoc (fsLit "<interactive>") 1 1
-    -- this should never be seen, because it's discarded with the `map unLoc`
-
------------------------------------------------------------------------------
--- :cd
-
-changeDirectory :: GhciMonad m => String -> m ()
-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 $ GHC.mgModSummaries graph)) $
-        liftIO $ putStrLn "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed."
-  -- delete defined breakpoints and clear the interface file cache (#1620)
-  clearCaches
-  setContextAfterLoad False Nothing
-  GHC.workingDirectoryChanged
-  dir' <- expandPath dir
-  liftIO $ setCurrentDirectory dir'
-  -- With -fexternal-interpreter, we have to change the directory of the subprocess too.
-  -- (this gives consistent behaviour with and without -fexternal-interpreter)
-  interp <- hscInterp <$> GHC.getSession
-  case interpInstance interp of
-    ExternalInterp {} -> do
-      fhv <- compileGHCiExpr $
-        "System.Directory.setCurrentDirectory " ++ show dir'
-      liftIO $ evalIO interp fhv
-    _ -> pure ()
-
-trySuccess :: GhciMonad m => m SuccessFlag -> m SuccessFlag
-trySuccess act =
-    handleSourceError (\e -> do printErrAndMaybeExit e -- immediately exit fith failure if in ghc -e
-                                pure Failed) act
-
------------------------------------------------------------------------------
--- :edit
-
-editFile :: GhciMonad m => String -> m ()
-editFile str =
-  do file <- if null str then 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 ""
-
--- 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 dependency 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 occurred during the
--- last load/reaload, then we could start the editor focused on the first
--- of those.
-chooseEditFile :: GHC.GhcMonad m => m String
-chooseEditFile =
-  do let hasFailed (GHC.ModuleNode _deps x) = fmap not $ isLoadedModSummary x
-         hasFailed _ = return False
-
-     graph <- GHC.getModuleGraph
-     failed_graph <-
-       GHC.mkModuleGraph <$> filterM hasFailed (GHC.mgModSummaries' graph)
-     let order g  = flattenSCCs $ filterToposortToModules $
-           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 { targetId = GHC.TargetFile f _ } = Just f
-        fromTarget _ = Nothing -- when would we get a module target?
-
-
------------------------------------------------------------------------------
--- :def
-
-defineMacro :: GhciMonad m => Bool{-overwrite-} -> String -> m ()
-defineMacro _ (':':_) = (liftIO $ hPutStrLn stderr
-                          "macro name cannot start with a colon")
-                            >> failIfExprEvalMode
-defineMacro _ ('!':_) = (liftIO $ hPutStrLn stderr
-                          "macro name cannot start with an exclamation mark")
-                            >> failIfExprEvalMode
-                          -- little code duplication allows to grep error msg
-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
-    isCommand <- isJust <$> lookupCommand' macro_name
-    let check_newname
-          | macro_name `elem` defined = throwGhcException (CmdLineError
-            ("macro '" ++ macro_name ++ "' is already defined. " ++ hint))
-          | isCommand = throwGhcException (CmdLineError
-            ("macro '" ++ macro_name ++ "' overwrites builtin command. " ++ hint))
-          | otherwise = return ()
-        hint = " Use ':def!' to overwrite."
-
-    unless overwrite check_newname
-    -- compile the expression
-    handleSourceError printErrAndMaybeExit $ do
-      step <- getGhciStepIO
-      expr <- GHC.parseExpr definition
-      -- > ghciStepIO . definition :: String -> IO String
-      let stringTy :: LHsType GhcPs
-          stringTy = nlHsTyVar NotPromoted stringTyCon_RDR
-          ioM :: LHsType GhcPs -- AZ
-          ioM = nlHsTyVar NotPromoted (getRdrName ioTyConName) `nlHsAppTy` stringTy
-          body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
-                                     `mkHsApp` (nlHsPar expr)
-          tySig = mkHsWildCardBndrs $ noLocA $ mkHsImplicitSigType $
-                  nlHsFunTy stringTy ioM
-          new_expr = L (getLoc expr) $ ExprWithTySig noAnn 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
-  :: GhciMonad m
-  => GHC.ForeignHValue  -- String -> IO String
-  -> String
-  -> m CmdExecOutcome
-runMacro fun s = do
-  interp <- hscInterp <$> GHC.getSession
-  str <- liftIO $ evalStringToIOString interp fun s
-  enqueueCommands (lines str)
-  return CmdSuccess
-
-
------------------------------------------------------------------------------
--- :undef
-
-undefineMacro :: GhciMonad m => String -> m ()
-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 :: GhciMonad m => String -> m ()
-cmdCmd str = handleSourceError printErrAndMaybeExit $ do
-    step <- getGhciStepIO
-    expr <- GHC.parseExpr str
-    -- > ghciStepIO str :: IO String
-    let new_expr = step `mkHsApp` expr
-    hv <- GHC.compileParsedExprRemote new_expr
-
-    interp <- hscInterp <$> GHC.getSession
-    cmds <- liftIO $ evalString interp hv
-    enqueueCommands (lines cmds)
-
--- | Generate a typed ghciStepIO expression
--- @ghciStepIO :: Ty String -> IO String@.
-getGhciStepIO :: GHC.GhcMonad m => m (LHsExpr GhcPs)
-getGhciStepIO = do
-  ghciTyConName <- GHC.getGHCiMonad
-  let stringTy = nlHsTyVar NotPromoted stringTyCon_RDR
-      ghciM = nlHsTyVar NotPromoted (getRdrName ghciTyConName) `nlHsAppTy` stringTy
-      ioM = nlHsTyVar NotPromoted (getRdrName ioTyConName) `nlHsAppTy` stringTy
-      body = nlHsVar (getRdrName ghciStepIoMName)
-      tySig = mkHsWildCardBndrs $ noLocA $ mkHsImplicitSigType $
-              nlHsFunTy ghciM ioM
-  return $ noLocA $ ExprWithTySig noAnn body tySig
-
------------------------------------------------------------------------------
--- :check
-
-checkModule :: GhciMonad m => String -> m ()
-checkModule m = do
-  let modl = GHC.mkModuleName m
-  ok <- handleSourceError (\e -> printErrAndMaybeExit 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) Check
-
------------------------------------------------------------------------------
--- :doc
-
-docCmd :: GHC.GhcMonad m => String -> m ()
-docCmd "" =
-  throwGhcException (CmdLineError "syntax: ':doc <thing-you-want-docs-for>'")
-docCmd s  = do
-  -- TODO: Maybe also get module headers for module names
-  names <- GHC.parseName s
-
-  docs <- traverse (buildDocComponents s) names
-
-  let sdocs = pprDocs (NE.toList docs)
-      sdocs' = vcat (intersperse (text "") sdocs)
-  sdoc <- showSDocForUser' sdocs'
-  liftIO (putStrLn sdoc)
-
-data DocComponents =
-  DocComponents
-    { docs      :: Maybe [HsDoc GhcRn]   -- ^ subject's haddocks
-    , sigAndLoc :: Maybe SDoc          -- ^ type signature + category + location
-    , argDocs   :: IntMap (HsDoc GhcRn) -- ^ haddocks for arguments
-    }
-
-buildDocComponents :: GHC.GhcMonad m => String -> Name -> m DocComponents
-buildDocComponents str name = do
-  mbThing <- GHC.lookupName name
-  let sigAndLoc = sigAndLocDoc str <$> mbThing
-  (docs, argDocs)
-    <- either handleGetDocsFailure pure
-         =<< GHC.getDocs name
-
-  pure DocComponents{..}
-
--- | Produce output containing the type/kind signature, category, and definition
--- location of a TyThing.
-sigAndLocDoc :: String -> TyThing -> SDoc
-sigAndLocDoc str tyThing =
-  let tyThingTyDoc :: TyThing -> SDoc
-      tyThingTyDoc = \case
-        AnId i                      -> pprSigmaType $ varType i
-        AConLike (RealDataCon dc)   -> pprSigmaType $ dataConDisplayType False dc
-        AConLike (PatSynCon patSyn) -> pprPatSynType patSyn
-        ATyCon tyCon                -> pprSigmaType $ GHC.tyConKind tyCon
-        ACoAxiom _                  -> empty
-
-      tyDoc = tyThingTyDoc tyThing
-      sigDoc = text str <+> nest 2 (dcolon <+> tyDoc)
-      comment =
-        hsep [ char '\t' <> text "--"
-             , pprTyThingCategory tyThing
-             , text "defined" <+> pprNameDefnLoc (getName tyThing)
-             ]
-   in hang sigDoc 2 comment
-
-pprDocs :: [DocComponents] -> [SDoc]
-pprDocs docs
-  | null nonEmptyDocs = pprDoc <$> take 1 docs
-  -- elide <has no documentation> if there's at least one non-empty doc (#15784)
-  | otherwise = pprDoc <$> nonEmptyDocs
-  where
-    empty DocComponents{docs = mb_decl_docs, argDocs = arg_docs}
-      = maybe True null mb_decl_docs && null arg_docs
-    nonEmptyDocs = filter (not . empty) docs
-
--- TODO: also print arg docs.
-pprDoc :: DocComponents -> SDoc
-pprDoc DocComponents{sigAndLoc = mb_sig_loc, docs = mb_decl_docs} =
-  maybe
-    (text "<has no documentation>")
-    formatDoc
-    mb_decl_docs
-  where
-    formatDoc doc =
-      vcat [ fromMaybe empty mb_sig_loc -- print contextual info (#19055)
-           , pprHsDocStrings $ map hsDocString doc
-           ]
-
-handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m a
-handleGetDocsFailure no_docs = do
-  dflags <- getDynFlags
-  let msg = showPpr dflags no_docs
-  throwGhcException $ case no_docs of
-    NameHasNoModule {} -> Sorry msg
-    NoDocsInIface {} -> InstallationError msg
-    InteractiveName -> ProgramError msg
-
------------------------------------------------------------------------------
--- :instances
-
-instancesCmd :: String -> InputT GHCi ()
-instancesCmd "" =
-  throwGhcException (CmdLineError "syntax: ':instances <type-you-want-instances-for>'")
-instancesCmd s = do
-  handleSourceError printGhciException $ do
-    ty <- GHC.parseInstanceHead s
-    res <- GHC.getInstancesForType ty
-
-    printForUser $ vcat $ map ppr res
-
------------------------------------------------------------------------------
--- :load, :add, :unadd, :reload
-
--- these are mainly used for displaying a more informative response
-data LoadType = Add !Int | Unadd !Int | Load | Reload | Check
-
-isReload :: LoadType -> Bool
-isReload Reload = True
-isReload _      = False
-
--- | Sets '-fdefer-type-errors' if 'defer' is true, executes 'load' and unsets
--- '-fdefer-type-errors' again if it has not been set before.
-wrapDeferTypeErrors :: GHC.GhcMonad m => m a -> m a
-wrapDeferTypeErrors load =
-  MC.bracket
-    (do
-      -- Force originalFlags to avoid leaking the associated HscEnv
-      !originalFlags <- getDynFlags
-      void $ GHC.setProgramDynFlags $
-         setGeneralFlag' Opt_DeferTypeErrors originalFlags
-      return originalFlags)
-    (\originalFlags -> void $ GHC.setProgramDynFlags originalFlags)
-    (\_ -> load)
-
-loadModule :: GhciMonad m => [(FilePath, Maybe UnitId, Maybe Phase)] -> m SuccessFlag
-loadModule fs = do
-  (_, result) <- runAndPrintStats (const Nothing) (loadModule' fs)
-  either (liftIO . Exception.throwIO) return result
-
--- | @:load@ command
-loadModule_ :: GhciMonad m => [FilePath] -> m ()
-loadModule_ fs = void $ loadModule (zip3 fs (repeat Nothing) (repeat Nothing))
-
-loadModuleDefer :: GhciMonad m => [FilePath] -> m ()
-loadModuleDefer = wrapDeferTypeErrors . loadModule_
-
-loadModule' :: GhciMonad m => [(FilePath, Maybe UnitId, Maybe Phase)] -> m SuccessFlag
-loadModule' files = do
-  let (filenames, uids, phases) = unzip3 files
-  exp_filenames <- mapM expandPath filenames
-  let files' = zip3 exp_filenames uids phases
-  targets <- mapM (\(file, uid, phase) -> GHC.guessTarget file uid phase) 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.
-
-  hsc_env <- GHC.getSession
-  let !dflags = hsc_dflags hsc_env
-
-  let load_module = do
-        -- unload first
-        _ <- GHC.abandonAll
-        clearCaches
-
-        GHC.setTargets targets
-        doLoadAndCollectInfo Load LoadAllTargets
-
-  if gopt Opt_GhciLeakCheck dflags
-    then do
-      -- Grab references to the currently loaded modules so that we can see if
-      -- they leak.
-      leak_indicators <- liftIO $ getLeakIndicators hsc_env
-      success <- load_module
-      liftIO $ checkLeakIndicators dflags leak_indicators
-      return success
-    else
-      load_module
-
--- | @:add@ command
-addModule :: GhciMonad m => [FilePath] -> m ()
-addModule files = do
-  revertCAFs -- always revert CAFs on load/add.
-  files' <- mapM expandPath files
-  targets <- mapM (\m -> GHC.guessTarget m Nothing Nothing) files'
-  targets' <- filterM checkTarget targets
-  -- remove old targets with the same id; e.g. for :add *M
-  mapM_ GHC.removeTarget [ tid | Target { targetId = tid } <- targets' ]
-  mapM_ GHC.addTarget targets'
-  _ <- doLoadAndCollectInfo (Add $ length targets') LoadAllTargets
-  return ()
-  where
-    checkTarget :: GhciMonad m => Target -> m Bool
-    checkTarget Target { targetId = TargetModule m } = checkTargetModule m
-    checkTarget Target { targetId = TargetFile f _ } = checkTargetFile f
-
-    checkTargetModule :: GhciMonad m => ModuleName -> m Bool
-    checkTargetModule m = do
-      hsc_env <- GHC.getSession
-      let home_unit = hsc_home_unit hsc_env
-      result <- liftIO $
-        Finder.findImportedModule hsc_env m (ThisPkg (homeUnitId home_unit))
-      case result of
-        Found _ _ -> return True
-        _ -> do liftIO $ hPutStrLn stderr ("Module " ++ moduleNameString m ++ " not found")
-                failIfExprEvalMode
-                return False
-
-    checkTargetFile :: GhciMonad m => String -> m Bool
-    checkTargetFile f = do
-      exists <- liftIO (doesFileExist f)
-      unless exists $ do
-        liftIO $ hPutStrLn stderr $ "File " ++ f ++ " not found"
-        failIfExprEvalMode
-      return exists
-
--- | @:unadd@ command
-unAddModule :: GhciMonad m => [FilePath] -> m ()
-unAddModule files = do
-  files' <- mapM expandPath files
-  targets <- mapM (\m -> GHC.guessTarget m Nothing Nothing) files'
-  let removals = [ tid | Target { targetId = tid } <- targets ]
-  mapM_ GHC.removeTarget removals
-  _ <- doLoadAndCollectInfo (Unadd $ length removals) LoadAllTargets
-  return ()
-
--- | @:reload@ command
-reloadModule :: GhciMonad m => String -> m ()
-reloadModule m = do
-  session <- GHC.getSession
-  let home_unit = homeUnitId (hsc_home_unit session)
-  ok <- doLoadAndCollectInfo Reload (loadTargets home_unit)
-  when (failed ok) failIfExprEvalMode
-  where
-    loadTargets hu | null m    = LoadAllTargets
-                   | otherwise = LoadUpTo (mkModule hu (GHC.mkModuleName m))
-
-reloadModuleDefer :: GhciMonad m => String -> m ()
-reloadModuleDefer = wrapDeferTypeErrors . reloadModule
-
--- | 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 :: GhciMonad m => LoadType -> LoadHowMuch -> m SuccessFlag
-doLoadAndCollectInfo load_type howmuch = do
-  doCollectInfo <- isOptionSet CollectInfo
-
-  doLoad load_type howmuch >>= \case
-    Succeeded | doCollectInfo -> do
-      mod_summaries <- GHC.mgModSummaries <$> getModuleGraph
-      -- MP: :set +c code path only works in single package mode atm, hence
-      -- this call to isLoaded is ok. collectInfo needs to be modified further to
-      -- work with :set +c so I have punted on that for now.
-      loaded <- filterM GHC.isLoaded (map ms_mod_name mod_summaries)
-      v <- mod_infos <$> getGHCiState
-      !newInfos <- collectInfo v loaded
-      modifyGHCiState (\st -> st { mod_infos = newInfos })
-      pure Succeeded
-    flag -> pure flag
-
-doLoad :: GhciMonad m => LoadType -> LoadHowMuch -> m SuccessFlag
-doLoad load_type howmuch = do
-  -- turn off breakpoints before we load: we can't turn them off later, because
-  -- the ModBreaks will have gone away.
-  discardActiveBreakPoints
-
-  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.
-  let setBuffering t = liftIO $ do
-        hSetBuffering stdout t
-        hSetBuffering stderr t
-  MC.bracket_ (setBuffering LineBuffering) (setBuffering NoBuffering) $ do
-      hmis <- ifaceCache <$> getGHCiState
-      -- If GHCi message gets its own configuration at some stage then this will need to be
-      -- modified to 'embedUnknownDiagnostic'.
-      ok <- trySuccess $ GHC.loadWithCache (Just hmis) (mkUnknownDiagnostic . GHCiMessage) howmuch
-      afterLoad ok load_type
-      pure ok
-
-
-
-afterLoad
-  :: GhciMonad m
-  => SuccessFlag
-  -> LoadType
-  -> m ()
-afterLoad ok load_type = do
-  revertCAFs  -- always revert CAFs on load.
-  discardTickArrays
-  loaded_mods <- getLoadedModules
-  modulesLoadedMsg ok loaded_mods load_type
-  graph <- GHC.getModuleGraph
-  setContextAfterLoad (isReload load_type) (Just graph)
-
-setContextAfterLoad :: GhciMonad m => Bool -> Maybe GHC.ModuleGraph -> m ()
-setContextAfterLoad keep_ctxt Nothing = do
-  setContextKeepingPackageModules keep_ctxt []
-setContextAfterLoad keep_ctxt (Just graph) = do
-  -- load a target if one is available, otherwise load the topmost module.
-  targets <- GHC.getTargets
-  loaded_graph <- filterM is_loaded $ GHC.mgModSummaries' graph
-  case [ m | Just m <- map (findTarget loaded_graph) targets ] of
-        []    ->
-          let graph' = flattenSCCs $ filterToposortToModules $
-                GHC.topSortModuleGraph True (GHC.mkModuleGraph loaded_graph) Nothing
-          in case graph' of
-              [] -> setContextKeepingPackageModules keep_ctxt []
-              xs -> load_this (last xs)
-        (m:_) ->
-          load_this m
- where
-   is_loaded (GHC.ModuleNode _ ms) = isLoadedModSummary ms
-   is_loaded _ = return False
-
-   findTarget mds t
-    = case mapMaybe (`matches` t) mds of
-        []    -> Nothing
-        (m:_) -> Just m
-
-   (GHC.ModuleNode _ summary) `matches` Target { targetId = TargetModule m }
-        = if GHC.ms_mod_name summary == m then Just summary else Nothing
-   (GHC.ModuleNode _ summary) `matches` Target { targetId = TargetFile f _ }
-        | Just f' <- GHC.ml_hs_file (GHC.ms_location summary)   =
-          if f == f' then Just summary else Nothing
-   _ `matches` _ = Nothing
-
-   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
-  :: GhciMonad m
-  => Bool                 -- True  <=> keep all of remembered_ctx
-                          -- False <=> just keep package imports
-  -> [InteractiveImport]  -- new context
-  -> m ()
-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
-  :: GHC.GhcMonad m => [InteractiveImport] -> m [InteractiveImport]
-keepPackageImports = filterM is_pkg_import
-  where
-     is_pkg_import :: GHC.GhcMonad m => InteractiveImport -> m Bool
-     is_pkg_import (IIModule _) = return False
-     is_pkg_import (IIDecl d)
-         = do pkgqual <- GHC.renameRawPkgQualM (unLoc $ ideclName d) (ideclPkgQual d)
-              e <- MC.try $ GHC.findQualifiedModule pkgqual mod_name
-              case e :: Either SomeException Module of
-                Left _  -> return False
-                Right m -> return (not (isMainUnitModule m))
-        where
-          mod_name = unLoc (ideclName d)
-
-
-
-modulesLoadedMsg :: GHC.GhcMonad m => SuccessFlag -> [GHC.ModSummary] -> LoadType -> m ()
-modulesLoadedMsg ok mods load_type = do
-  dflags <- getDynFlags
-  when (verbosity dflags > 0) $ do
-     mod_names <- mapM mod_name mods
-     rendered_msg <- showSDocForUser' $
-       if gopt Opt_ShowLoadedModules dflags
-         then loaded_msg mod_names
-         else msg
-     liftIO $ putStrLn rendered_msg
-  where
-    num_mods = length mods
-    none_loaded = num_mods == 0
-
-    loaded_msg names =
-      let mod_commas
-           | null mods = text "none."
-           | otherwise = hsep (punctuate comma names) <> text "."
-      in status <> text ", modules loaded:" <+> mod_commas
-
-    msg  = status <> comma <+> msg' <> dot
-    msg' = case load_type of
-      Reload  -> if none_loaded
-                   then "no modules to be reloaded"
-                   else n_mods num_mods "reloaded"
-      Load    -> if none_loaded
-                   then "unloaded all modules"
-                   else n_mods num_mods "loaded"
-      Check   -> n_mods 1 "checked"
-      Add   n -> n_mods n "added"
-      Unadd n -> n_mods n "unadded"
-    n_mods amount action = speakNOf amount "module" <+> action
-
-    status | Succeeded <- ok = "Ok"
-           | otherwise       = "Failed"
-
-    mod_name mod = do
-        is_interpreted <- GHC.moduleIsBootOrNotObjectLinkable mod
-        pure $ if is_interpreted
-               then ppr (GHC.ms_mod mod)
-               else ppr (GHC.ms_mod mod)
-                    <+> parens (text $ normalise $ msObjFilePath mod)
-                    -- Fix #9887
-
--- | Run an 'ExceptT' wrapped 'GhcMonad' while handling source errors
--- and printing 'throwE' strings to 'stderr'. If in expression
--- evaluation mode - throw GhcException and exit.
-runExceptGhciMonad :: GhciMonad m => ExceptT SDoc m () -> m ()
-runExceptGhciMonad act = handleSourceError printGhciException $
-                         either handleErr pure =<<
-                         runExceptT act
-  where
-    handleErr sdoc = do
-        rendered <- showSDocForUserQualify sdoc
-        liftIO $ hPutStrLn stderr rendered
-        failIfExprEvalMode
-
--- | 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'
-  :: forall backend
-   . Backend backend
-  => Proxy backend
-  -> IORef ClashOpts
-  -> [FilePath]
-  -> InputT GHCi ()
-makeHDL' backend opts lst = go =<< case lst of
-  srcs@(_:_) -> return srcs
-  []         -> do
-    modGraph <- GHC.getModuleGraph
-    let sortedGraph =
-          -- TODO: this might break backpack
-          filterToposortToModules $
-          GHC.topSortModuleGraph False modGraph Nothing
-    return $ case (reverse sortedGraph) of
-      ((AcyclicSCC top) : _) -> maybeToList $ (GHC.ml_hs_file . GHC.ms_location) top
-      _                      -> []
- where
-  go srcs = do
-    dflags <- GHC.getSessionDynFlags
-    goX dflags srcs `MC.finally` recover dflags
-
-  goX dflags srcs = do
-    -- Issue #439 step 1
-    (dflagsX,_,_) <- parseDynamicFlagsCmdLine dflags
-                       [ noLoc "-fobject-code"   -- For #439
-                       , noLoc "-fforce-recomp"  -- Actually compile to object-code
-                       , noLoc "-keep-tmp-files" -- To prevent linker errors from
-                                                 -- multiple calls to :hdl command
-                       ]
-    _ <- GHC.setSessionDynFlags dflagsX
-    reloadModule ""
-    -- Issue #439 step 2
-    -- Unload any object files
-    -- This fixes: https://github.com/clash-lang/clash-compiler/issues/439#issuecomment-522015868
-    env <- GHC.getSession
-    liftIO (Loader.unload (hscInterp env) env [])
-    -- Finally generate the HDL
-    makeHDL backend (return ()) opts srcs
-
-  recover dflags = do
-    _ <- GHC.setSessionDynFlags dflags
-    reloadModule ""
-
-makeHDL
-  :: forall backend m
-   . (GHC.GhcMonad m, Backend backend)
-  => Proxy backend
-  -> Ghc ()
-  -> IORef ClashOpts
-  -> [FilePath]
-  -> m ()
-makeHDL Proxy startAction optsRef srcs = do
-  dflags <- GHC.getSessionDynFlags
-  liftIO $ do startTime <- Clock.getCurrentTime
-              opts0  <- readIORef optsRef
-              let opts1  = opts0 { opt_color = fromGhcOverridingBool (useColor dflags) }
-              let iw     = opt_intWidth opts1
-                  hdl    = hdlKind backend
-                  -- 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
-                  idirs = importPaths dflags
-                  opts2 = opts1 { opt_hdlDir = maybe outputDir Just (opt_hdlDir opts1)
-                                , opt_importPaths = idirs}
-                  backend = initBackend @backend opts2
-
-              checkMonoLocalBinds dflags
-              checkImportDirs opts0 idirs
-
-              primDirs_ <- primDirs backend
-
-              forM_ srcs $ \src -> do
-                -- Generate bindings:
-                let dbs = reverse [p | PackageDB (PkgDbPath p) <- packageDBFlags dflags]
-                (clashEnv, clashDesign) <- generateBindings opts2 startAction primDirs_ idirs dbs hdl src (Just dflags)
-
-                let getMain = getMainTopEntity src clashDesign
-                mainTopEntity <- traverse getMain (GHC.mainFunIs dflags)
-                prepTime <- startTime `deepseq` designBindings clashDesign `deepseq` envTyConMap clashEnv `deepseq` Clock.getCurrentTime
-                let prepStartDiff = reportTimeDiff prepTime startTime
-                putStrLn $ "GHC+Clash: Loading modules cumulatively took " ++ prepStartDiff
-
-                -- Generate HDL:
-                Clash.Driver.generateHDL
-                  clashEnv
-                  clashDesign
-                  (Just backend)
-                  (ghcTypeToHWType iw)
-                  ghcEvaluator
-                  evaluator
-                  mainTopEntity
-                  startTime
-
-makeVHDL :: IORef ClashOpts -> [FilePath] -> InputT GHCi ()
-makeVHDL = makeHDL' (Proxy @VHDLState)
-
-makeVerilog :: IORef ClashOpts -> [FilePath] -> InputT GHCi ()
-makeVerilog = makeHDL' (Proxy @VerilogState)
-
-makeSystemVerilog :: IORef ClashOpts -> [FilePath] -> InputT GHCi ()
-makeSystemVerilog = makeHDL' (Proxy @SystemVerilogState)
-
------------------------------------------------------------------------------
--- | @:type@ command. See also Note [TcRnExprMode] in GHC.Tc.Module.
-
-typeOfExpr :: GhciMonad m => String -> m ()
-typeOfExpr str = handleSourceError printErrAndMaybeExit $
-    case break isSpace str of
-      ("+v", _)    -> printForUser (text "`:type +v' has gone; use `:type' instead")
-      ("+d", rest) -> do_it GHC.TM_Default (dropWhile isSpace rest)
-      _            -> do_it GHC.TM_Inst    str
-  where
-    do_it mode expr_str
-      = do { ty <- GHC.exprType mode expr_str
-           ;    printForUser $ sep [ text expr_str
-                                   , nest 2 (dcolon <+> pprSigmaType ty)] }
-
------------------------------------------------------------------------------
--- | @:type-at@ command
-
-typeAtCmd :: GhciMonad m => String -> m ()
-typeAtCmd str = runExceptGhciMonad $ do
-    (span',sample) <- exceptT $ parseSpanArg str
-    infos      <- lift $ mod_infos <$> getGHCiState
-    (info, ty) <- findType infos span' sample
-    let mb_rdr_env = case modinfoRdrEnv info of
-          Strict.Just rdrs -> Just rdrs
-          Strict.Nothing   -> Nothing
-    lift $ printForUserGlobalRdrEnv
-              mb_rdr_env
-              (sep [text sample,nest 2 (dcolon <+> ppr ty)])
-
------------------------------------------------------------------------------
--- | @:uses@ command
-
-usesCmd :: GhciMonad m => String -> m ()
-usesCmd str = runExceptGhciMonad $ do
-    (span',sample) <- exceptT $ parseSpanArg str
-    infos  <- lift $ mod_infos <$> getGHCiState
-    uses   <- findNameUses infos span' sample
-    forM_ uses (liftIO . putStrLn . showSrcSpan)
-
------------------------------------------------------------------------------
--- | @:loc-at@ command
-
-locAtCmd :: GhciMonad m => String -> m ()
-locAtCmd str = runExceptGhciMonad $ do
-    (span',sample) <- exceptT $ parseSpanArg str
-    infos    <- lift $ mod_infos <$> getGHCiState
-    (_,_,sp) <- findLoc infos span' sample
-    liftIO . putStrLn . showSrcSpan $ sp
-
------------------------------------------------------------------------------
--- | @:all-types@ command
-
-allTypesCmd :: GhciMonad m => String -> m ()
-allTypesCmd _ = runExceptGhciMonad $ do
-    infos <- lift $ mod_infos <$> getGHCiState
-    forM_ (M.elems infos) $ \mi ->
-        forM_ (modinfoSpans mi) (lift . printSpan)
-  where
-    printSpan span'
-      | Just ty <- spaninfoType span' = do
-        tyInfo <- (unwords . words) <$>
-                  showSDocForUserQualify (pprSigmaType 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)
-                              -- End column of RealSrcSpan is the column
-                              -- after the end of the span.
-                              (mkRealSrcLoc fs el (ec + 1))
-
-    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 (unhelpfulSpanFS 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
-    -- The end column is the column after the end of the span see the
-    -- RealSrcSpan module
-    ec = let ec' = srcSpanEndCol    spn in if ec' == 0 then 0 else ec' - 1
-
------------------------------------------------------------------------------
--- | @:kind@ command
-
-kindOfType :: GhciMonad m => Bool -> String -> m ()
-kindOfType norm str = handleSourceError printErrAndMaybeExit $ do
-    (ty, kind) <- GHC.typeKind norm str
-    printForUser $ vcat [ text str <+> dcolon <+> pprSigmaType kind
-                        , ppWhen norm $ equals <+> pprSigmaType ty ]
-
------------------------------------------------------------------------------
--- :quit
-
-quit :: Monad m => String -> m CmdExecOutcome
-quit _ = return CleanExit
-
-
------------------------------------------------------------------------------
--- :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>")
-
--- | A version of 'words' that treats sequences enclosed in double quotes as
--- single words and that does not break on backslash-escaped spaces.
--- E.g., 'words\' "\"lorem ipsum\" dolor"' and 'words\' "lorem\\ ipsum dolor"'
--- yield '["lorem ipsum", "dolor"]'.
--- Used to scan for file paths in 'scriptCmd'.
-words' :: String -> [String]
-words' s = case dropWhile isSpace s of
-  "" -> []
-  s'@('\"' : _) | [(w, s'')] <- reads s' -> w : words' s''
-  s' -> go id s'
- where
-  go acc []                          = [acc []]
-  go acc ('\\' : c : cs) | isSpace c = go (acc . (c :)) cs
-  go acc (c : cs) | isSpace c = acc [] : words' cs
-                  | otherwise = go (acc . (c :)) cs
-
-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 :: GHC.GhcMonad m => String -> m ()
-isSafeCmd m =
-    case words m of
-        [s] | looksLikeModuleName s -> do
-            md <- lookupModule s
-            isSafeModule md
-        [] -> do md <- guessCurrentModule "issafe"
-                 isSafeModule md
-        _ -> throwGhcException (CmdLineError "syntax:  :issafe <module>")
-
-isSafeModule :: GHC.GhcMonad m => Module -> m ()
-isSafeModule m = do
-    mb_mod_info <- GHC.getModuleInfo m
-    when (isNothing mb_mod_info)
-         (throwGhcException $ CmdLineError $ "unknown module: " ++ mname)
-
-    dflags <- getDynFlags
-    hsc_env <- GHC.getSession
-    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  = show $ getSafeMode $ GHC.mi_trust $ fromJust iface
-        pkg    = if packageTrusted hsc_env m then "trusted" else "untrusted"
-        (good, bad) = tallyPkgs hsc_env 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 $ S.null good)
-         (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++
-                        (intercalate ", " $ map (showPpr dflags) (S.toList good)))
-    case msafe && S.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) (S.toList bad)))
-            liftIO $ putStrLn $ mname ++ " is NOT trusted!"
-
-  where
-    mname = GHC.moduleNameString $ GHC.moduleName m
-
-    packageTrusted hsc_env md
-        | isHomeModule (hsc_home_unit hsc_env) md = True
-        | otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md)
-
-    tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (S.empty, S.empty)
-                          | otherwise = S.partition part deps
-        where part pkg   = unitIsTrusted $ unsafeLookupUnitId unit_state pkg
-              unit_state = hsc_units hsc_env
-              dflags     = hsc_dflags hsc_env
-
------------------------------------------------------------------------------
--- :browse
-
--- Browsing a module's contents
-
-browseCmd :: GHC.GhcMonad m => Bool -> String -> m ()
-browseCmd bang m =
-  case words m of
-    ['*':s] | looksLikeModuleName s -> do
-        md <- wantInterpretedModule s
-        browseModule bang md False
-    [s] | looksLikeModuleName s -> do
-        md <- lookupModule s
-        browseModule bang md True
-    [] -> do md <- guessCurrentModule ("browse" ++ if bang then "!" else "")
-             browseModule bang md True
-    _ -> throwGhcException (CmdLineError "syntax:  :browse <module>")
-
-guessCurrentModule :: GHC.GhcMonad m => String -> m 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
-  case imports of
-    [] -> throwGhcException $ CmdLineError (':' : cmd ++ ": no current module")
-    IIModule m : _ -> GHC.findQualifiedModule NoPkgQual m
-    IIDecl d : _ -> do
-      pkgqual <- GHC.renameRawPkgQualM (unLoc $ ideclName d) (ideclPkgQual d)
-      GHC.findQualifiedModule pkgqual (unLoc (ideclName 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 :: GHC.GhcMonad m => Bool -> Module -> Bool -> m ()
-browseModule bang modl exports_only = do
-  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
-        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 (SrcLoc.leftmost_smallest `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 showToHeader
-                   | otherwise = pprTyThingInContext showToHeader
-
-            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.. (#1799)
-            annotate mts = concatMap (\(m,ts)->labels m:ts)
-                         $ sortBy cmpQualifiers $ grp mts
-              where cmpQualifiers =
-                      compare `on` (map (fmap (map (unpackFS . 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
-
-        -- :browse reports qualifiers wrt current context
-        rendered_things <- showSDocForUser' (vcat prettyThings')
-        liftIO $ putStrLn rendered_things
-        -- 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 :: GhciMonad m => String -> m ()
-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 :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
-addModulesToContext starred unstarred = restoreContextOnFailure $ do
-   addModulesToContext_ starred unstarred
-
-addModulesToContext_ :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
-addModulesToContext_ starred unstarred = do
-   mapM_ addII (map mkIIModule starred ++ map mkIIDecl unstarred)
-   setGHCContextFromGHCiState
-
-remModulesFromContext :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
-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 :: GhciMonad m => ModuleName -> m ()
-   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 :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
-setContext starred unstarred = restoreContextOnFailure $ do
-  modifyGHCiState $ \st -> st { remembered_ctx = [], transient_ctx = [] }
-                                -- delete the transient context
-  addModulesToContext_ starred unstarred
-
-addImportToContext :: GhciMonad m => ImportDecl GhcPs -> m ()
-addImportToContext idecl = restoreContextOnFailure $ do
-  addII (IIDecl idecl)   -- #5836
-  setGHCContextFromGHCiState
-
--- Util used by addImportToContext and addModulesToContext
-addII :: GhciMonad m => InteractiveImport -> m ()
-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 :: GhciMonad m => m a -> m a
-restoreContextOnFailure do_this = do
-  st <- getGHCiState
-  let rc = remembered_ctx st; tc = transient_ctx st
-  do_this `MC.onException` (modifyGHCiState $ \st' ->
-     st' { remembered_ctx = rc, transient_ctx = tc })
-
--- -----------------------------------------------------------------------------
--- Validate a module that we want to add to the context
-
-checkAdd :: GHC.GhcMonad m => InteractiveImport -> m ()
-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 <- GHC.renameRawPkgQualM modname (ideclPkgQual d)
-       m <- GHC.lookupQualifiedModule pkgqual modname
-       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 :: GhciMonad m => m ()
-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)
-
-  prel_iidecls <- getImplicitPreludeImports iidecls
-  valid_prel_iidecls <- filterM (tryBool . checkAdd) prel_iidecls
-
-  extra_imports <- filterM (tryBool . checkAdd) (map IIDecl (extra_imports st))
-
-  GHC.setContext $ iidecls ++ extra_imports ++ valid_prel_iidecls
-
-
-getImplicitPreludeImports :: GhciMonad m
-                          => [InteractiveImport] -> m [InteractiveImport]
-getImplicitPreludeImports iidecls = do
-     -- allow :seti to override -XNoImplicitPrelude
-  st <- getGHCiState
-
-  -- We add the prelude imports if there are no *-imports, and we also
-  -- allow each prelude import to be subsumed by another explicit import
-  -- of the same module.  This means that you can override the prelude import
-  -- with "import Prelude hiding (map)", for example.
-  let prel_iidecls =
-         if not (any isIIModule iidecls)
-            then [ IIDecl imp
-                 | imp <- prelude_imports st
-                 , not (any (sameImpModule imp) iidecls) ]
-            else []
-
-  return prel_iidecls
-
--- -----------------------------------------------------------------------------
--- Utils on InteractiveImport
-
-mkIIModule :: ModuleName -> InteractiveImport
-mkIIModule = IIModule
-
-mkIIDecl :: ModuleName -> InteractiveImport
-mkIIDecl = IIDecl . simpleImportDecl
-
-iiModules :: [InteractiveImport] -> [ModuleName]
-iiModules is = [m | IIModule m <- is]
-
-isIIModule :: InteractiveImport -> Bool
-isIIModule (IIModule _) = True
-isIIModule _ = False
-
-iiModuleName :: InteractiveImport -> ModuleName
-iiModuleName (IIModule m) = m
-iiModuleName (IIDecl d)   = unLoc (ideclName d)
-
-preludeModuleName :: ModuleName
-preludeModuleName = GHC.mkModuleName "Clash.Prelude"
-
-sameImpModule :: ImportDecl GhcPs -> InteractiveImport -> Bool
-sameImpModule _ (IIModule _) = False -- we only care about imports here
-sameImpModule imp (IIDecl d) = unLoc (ideclName d) == unLoc (ideclName imp)
-
-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 (isImportDeclQualified (ideclQualified d1)) || isImportDeclQualified (ideclQualified d2))
-     && (ideclImportList d1 `hidingSubsumes` ideclImportList d2)
-  where
-     _                    `hidingSubsumes` Just (Exactly,L _ []) = True
-     Just (Exactly, L _ xs) `hidingSubsumes` Just (Exactly,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 :: GhciMonad m => String -> m ()
-setCmd ""   = showOptions False
-setCmd "-a" = showOptions True
-setCmd str
-  = case getCmd str of
-    Right ("args",    rest) ->
-        case toArgsNoLoc rest of
-            Left err -> liftIO (hPutStrLn stderr err)
-            Right args -> setArgs args
-    Right ("prog",    rest) ->
-        case toArgsNoLoc rest of
-            Right [prog] -> setProg prog
-            _ -> liftIO (hPutStrLn stderr "syntax: :set prog <progname>")
-
-    Right ("prompt",           rest) ->
-        setPromptString setPrompt (dropWhile isSpace rest)
-                        "syntax: set prompt <string>"
-    Right ("prompt-function",  rest) ->
-        setPromptFunc setPrompt $ dropWhile isSpace rest
-    Right ("prompt-cont",          rest) ->
-        setPromptString setPromptCont (dropWhile isSpace rest)
-                        "syntax: :set prompt-cont <string>"
-    Right ("prompt-cont-function", rest) ->
-        setPromptFunc setPromptCont $ dropWhile isSpace rest
-
-    Right ("editor",  rest) -> setEditor  $ dropWhile isSpace rest
-    Right ("stop",    rest) -> setStop    $ dropWhile isSpace rest
-    Right ("local-config", rest) ->
-        setLocalConfigBehaviour $ dropWhile isSpace rest
-    _ -> case toArgsNoLoc str of
-         Left err -> liftIO (hPutStrLn stderr err)
-         Right wds -> () <$ keepGoing' setOptions wds
-
-setiCmd :: GhciMonad m => String -> m ()
-setiCmd ""   = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags False
-setiCmd "-a" = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags True
-setiCmd str  =
-  case toArgsNoLoc str of
-    Left err -> liftIO (hPutStrLn stderr err)
-    Right wds -> newDynFlags True wds
-
-showOptions :: GhciMonad m => Bool -> m ()
-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)
-           ))
-       liftIO $ showDynFlags show_all dflags
-
-
-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 :: String -> String -> (flag -> DynFlags -> Bool) -> FlagSpec flag -> SDoc
-        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 :: GhciMonad m => [String] -> m ()
-setProg, setEditor, setStop :: GhciMonad m => String -> m ()
-setLocalConfigBehaviour :: GhciMonad m => String -> m ()
-
-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 })
-
-setLocalConfigBehaviour s
-  | s == "source" =
-      modifyGHCiState (\st -> st { localConfig = SourceLocalConfig })
-  | s == "ignore" =
-      modifyGHCiState (\st -> st { localConfig = IgnoreLocalConfig })
-  | otherwise = throwGhcException
-      (CmdLineError "syntax:  :set local-config { source | ignore }")
-
-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
-       case IntMap.lookup nm old_breaks of
-         Nothing ->  printForUser (text "Breakpoint" <+> ppr nm <+>
-                                   text "does not exist")
-         Just loc -> do
-            let new_breaks = IntMap.insert nm
-                                loc { onBreakCmd = dropWhile isSpace rest }
-                                old_breaks
-            setGHCiState st{ breaks = new_breaks }
-setStop cmd = modifyGHCiState (\st -> st { stop = cmd })
-
-setPrompt :: GhciMonad m => PromptFunction -> m ()
-setPrompt v = modifyGHCiState (\st -> st {prompt = v})
-
-setPromptCont :: GhciMonad m => PromptFunction -> m ()
-setPromptCont v = modifyGHCiState (\st -> st {prompt_cont = v})
-
-setPromptFunc :: GHC.GhcMonad m => (PromptFunction -> m ()) -> String -> m ()
-setPromptFunc fSetPrompt s = do
-    -- We explicitly annotate the type of the expression to ensure
-    -- that unsafeCoerce# is passed the exact type necessary rather
-    -- than a more general one
-    let exprStr = "(" ++ s ++ ") :: [String] -> Int -> IO String"
-    (HValue funValue) <- GHC.compileExpr exprStr
-    fSetPrompt (convertToPromptFunction $ unsafeCoerce funValue)
-    where
-      convertToPromptFunction :: ([String] -> Int -> IO String)
-                              -> PromptFunction
-      convertToPromptFunction func = (\mods line -> liftIO $
-                                       liftM text (func mods line))
-
-setPromptString :: MonadIO m
-                => (PromptFunction -> m ()) -> String -> String -> m ()
-setPromptString fSetPrompt value err = do
-  if null value
-    then liftIO $ hPutStrLn stderr $ err
-    else case value of
-           ('\"':_) ->
-             case reads value of
-               [(value', xs)] | all isSpace xs ->
-                 setParsedPromptString fSetPrompt value'
-               _ -> liftIO $ hPutStrLn stderr
-                             "Can't parse prompt string. Use Haskell syntax."
-           _ ->
-             setParsedPromptString fSetPrompt value
-
-setParsedPromptString :: MonadIO m
-                      => (PromptFunction -> m ()) ->  String -> m ()
-setParsedPromptString fSetPrompt s = do
-  case (checkPromptStringForErrors s) of
-    Just err ->
-      liftIO $ hPutStrLn stderr err
-    Nothing ->
-      fSetPrompt $ generatePromptFunctionFromString s
-
-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
-      when (not (null minus_opts)) $ newDynFlags False minus_opts
-
--- | newDynFlags will *not* read package environment files, therefore we
--- use 'parseDynamicFlagsCmdLine' rather than 'parseDynamicFlags'. This
--- function is called very often and results in repeatedly loading
--- environment files (see #19650)
-newDynFlags :: GhciMonad m => Bool -> [String] -> m ()
-newDynFlags interactive_only minus_opts = do
-      let lopts = map noLoc minus_opts
-
-      logger <- getLogger
-      idflags0 <- GHC.getInteractiveDynFlags
-      (idflags1, leftovers, warns) <- DynFlags.parseDynamicFlagsCmdLine idflags0 lopts
-
-      liftIO $ printOrThrowDiagnostics logger (initPrintConfig idflags1) (initDiagOpts idflags1) (GhcDriverMessage <$> warns)
-      when (not $ null leftovers) (unknownFlagsErr $ 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 $ DynFlags.parseDynamicFlagsCmdLine dflags0 lopts
-        must_reload <- 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
-        let interp  = hscInterp hsc_env
-        when (packageFlagsChanged dflags2 dflags0) $ do
-          when (verbosity dflags2 > 0) $
-            liftIO . putStrLn $
-              "package flags have changed, resetting and loading new packages..."
-          -- Clear caches and eventually defined breakpoints. (#1620)
-          clearCaches
-          when must_reload $ do
-            let units = preloadUnits (hsc_units hsc_env)
-            liftIO $ Loader.loadPackages interp hsc_env units
-          -- package flags changed, we can't re-use any of the old context
-          setContextAfterLoad False Nothing
-          -- and copy the package flags to the interactive DynFlags
-          idflags <- GHC.getInteractiveDynFlags
-          GHC.setInteractiveDynFlags
-              idflags{ packageFlags = packageFlags dflags2 }
-
-        let ld0length   = length $ ldInputs dflags0
-            fmrk0length = length $ cmdlineFrameworks dflags0
-
-            newLdInputs     = drop ld0length (ldInputs dflags2)
-            newCLFrameworks = drop fmrk0length (cmdlineFrameworks dflags2)
-
-            dflags'  = dflags2 { ldInputs = newLdInputs
-                               , cmdlineFrameworks = newCLFrameworks
-                               }
-            hsc_env' = hscSetFlags dflags' hsc_env
-
-        when (not (null newLdInputs && null newCLFrameworks)) $
-          liftIO $ Loader.loadCmdLineLibs (hscInterp hsc_env') hsc_env'
-
-      return ()
-
-unknownFlagsErr :: [String] -> a
-unknownFlagsErr fs = throwGhcException $ CmdLineError $ concatMap oneError fs
-  where
-    oneError f =
-        "unrecognised flag: " ++ f ++ "\n" ++
-        (case flagSuggestions ghciFlags f of
-            [] -> ""
-            suggs -> "did you mean one of:\n" ++ unlines (map ("  " ++) suggs))
-    ghciFlags = nubSort $ flagsForCompletion True
-
-unsetOptions :: GhciMonad m => String -> m ()
-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)
-           , ("prompt-cont", setPromptCont default_prompt_cont)
-           , ("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 case rest3 of
-          opt:_ -> liftIO (putStrLn ("unknown option: '" ++ opt ++ "'"))
-          [] -> do
-             mapM_ (fromJust.flip lookup defaulters) other_opts
-
-             mapM_ unsetOpt plus_opts
-
-             no_flags <- mapM no_flag minus_opts
-             when (not (null no_flags)) $ 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 :: GhciMonad m => String -> m ()
-
-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 :: forall m. GhciMonad m => String -> m ()
-showCmd ""   = showOptions False
-showCmd "-a" = showOptions True
-showCmd str = do
-    st <- getGHCiState
-    dflags <- getDynFlags
-    hsc_env <- GHC.getSession
-
-    let lookupCmd :: String -> Maybe (m ())
-        lookupCmd name = lookup name $ map (\(_,b,c) -> (b,c)) cmds
-
-        -- (show in help?, command name, action)
-        action :: String -> m () -> (Bool, String, m ())
-        action name m = (True, name, m)
-
-        hidden :: String -> m () -> (Bool, String, m ())
-        hidden name m = (False, name, m)
-
-        cmds =
-            [ action "args"       $ liftIO $ putStrLn (show (GhciMonad.args st))
-            , action "prog"       $ liftIO $ putStrLn (show (progname 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"     $ do
-               msg <- liftIO $ Loader.showLoaderState (hscInterp hsc_env)
-               dflags <- getDynFlags
-               liftIO $ putStrLn $ showSDoc dflags msg
-            , action "breaks"     $ showBkptTable
-            , action "context"    $ showContext
-            , action "packages"   $ showUnits
-            , action "paths"      $ showPaths
-            , action "language"   $ showLanguages
-            , hidden "languages"  $ showLanguages -- backwards compat
-            , hidden "lang"       $ showLanguages -- useful abbreviation
-            , action "targets"    $ showTargets
-            ]
-
-    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 :: GHC.GhcMonad m => String -> m ()
-showiCmd str = do
-  case words str of
-        ["languages"]  -> showiLanguages -- backwards compat
-        ["language"]   -> showiLanguages
-        ["lang"]       -> showiLanguages -- useful abbreviation
-        _ -> throwGhcException (CmdLineError ("syntax:  :showi language"))
-
-showImports :: GhciMonad m => m ()
-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_iidecls <- getImplicitPreludeImports (rem_ctx ++ trans_ctx)
-
-  let show_prel p = show_one p ++ " -- implicit"
-      show_extra p = show_one (IIDecl p) ++ " -- fixed"
-
-      trans_comment s = s ++ " -- added automatically" :: String
-  --
-  liftIO $ mapM_ putStrLn (map show_one rem_ctx ++
-                           map (trans_comment . show_one) trans_ctx ++
-                           map show_prel prel_iidecls ++
-                           map show_extra (extra_imports st))
-
-showModules :: GHC.GhcMonad m => m ()
-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 isLoadedModSummary (GHC.mgModSummaries graph)
-
-showBindings :: GHC.GhcMonad m => m ()
-showBindings = do
-    bindings <- GHC.getBindings
-    (insts, finsts) <- GHC.getInsts
-    let idocs  = map GHC.pprInstanceHdr insts
-        fidocs = map GHC.pprFamInst finsts
-        binds = filter (not . isDerivedOccName . getOccName) bindings -- #12525
-        -- See Note [Filter bindings]
-    docs <- mapM makeDoc (reverse binds)
-                  -- reverse so the new ones come last
-    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) -> SDoc
-    pprTT (thing, fixity, _cls_insts, _fam_insts, _docs)
-      = pprTyThing showToHeader thing
-        $$ showFixity thing fixity
-
-
-printTyThing :: GHC.GhcMonad m => TyThing -> m ()
-printTyThing tyth = printForUser (pprTyThing showToHeader tyth)
-
-isLoadedModSummary :: GHC.GhcMonad m => ModSummary -> m Bool
-isLoadedModSummary ms = GHC.isLoadedModule (ms_unitid ms) (ms_mod_name ms)
-
-{-
-Note [Filter bindings]
-~~~~~~~~~~~~~~~~~~~~~~
-If we don't filter the bindings returned by the function GHC.getBindings,
-then the :show bindings command will also show unwanted bound names,
-internally generated by GHC, eg:
-    $tcFoo :: GHC.Types.TyCon = _
-    $trModule :: GHC.Unit.Module = _ .
-
-The filter was introduced as a fix for #12525 [1]. Comment:1 [2] to this
-ticket contains an analysis of the situation and suggests the solution
-implemented above.
-
-The same filter was also implemented to fix #11051 [3]. See the
-Note [What to show to users] in GHC.Runtime.Eval
-
-[1] https://gitlab.haskell.org/ghc/ghc/issues/12525
-[2] https://gitlab.haskell.org/ghc/ghc/issues/12525#note_123489
-[3] https://gitlab.haskell.org/ghc/ghc/issues/11051
--}
-
-
-showBkptTable :: GhciMonad m => m ()
-showBkptTable = do
-  st <- getGHCiState
-  printForUser $ prettyLocations (breaks st)
-
-showContext :: GHC.GhcMonad m => m ()
-showContext = do
-   resumes <- GHC.getResumeContext
-   printForUser $ vcat (map pp_resume (reverse resumes))
-  where
-   pp_resume res =
-        text "--> " <> text (GHC.resumeStmt res)
-        $$ nest 2 (pprStopped res)
-
-pprStopped :: GHC.Resume -> SDoc
-pprStopped res =
-  text "Stopped in"
-    <+> ((case mb_mod_name of
-           Nothing -> empty
-           Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
-         <> text (GHC.resumeDecl res))
-    <> char ',' <+> ppr (GHC.resumeSpan res)
- where
-  mb_mod_name = moduleName <$> GHC.breakInfo_module <$> GHC.resumeBreakInfo res
-
-showUnits :: GHC.GhcMonad m => m ()
-showUnits = 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 :: GHC.GhcMonad m => m ()
-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 :: GHC.GhcMonad m => m ()
-showLanguages = getDynFlags >>= liftIO . showLanguages' False
-
-showiLanguages :: GHC.GhcMonad m => m ()
-showiLanguages = GHC.getInteractiveDynFlags >>= liftIO . showLanguages' False
-
-showLanguages' :: Bool -> DynFlags -> IO ()
-showLanguages' show_all dflags =
-  putStrLn $ showSDoc dflags $ vcat
-     [ text "base language is: " <>
-         case lang of
-           Haskell98   -> text "Haskell98"
-           Haskell2010 -> text "Haskell2010"
-           GHC2021     -> text "GHC2021"
-           GHC2024     -> text "GHC2024"
-     , (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` Just lang
-
-   lang = fromMaybe defaultLanguage (language dflags)
-
-
-showTargets :: GHC.GhcMonad m => m ()
-showTargets = mapM_ showTarget =<< GHC.getTargets
-  where
-    showTarget :: GHC.GhcMonad m => Target -> m ()
-    showTarget Target { targetId = TargetFile f _ } = liftIO (putStrLn f)
-    showTarget Target { targetId = TargetModule m } =
-      liftIO (putStrLn $ moduleNameString m)
-
--- -----------------------------------------------------------------------------
--- 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 [] = Nothing
-    parseLine argLine = case breakSpace argLine of
-      (_, []) -> Nothing
-      (dom, rest1@('"' : _)) -> (dom,,) <$> parseRange "" <*> (readMaybe rest1 :: Maybe String)
-      (dom, rest1) -> (dom,,) <$> parseRange rng <*> readMaybe rest2
-        where
-          (rng, rest2) = breakSpace rest1
-
-    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, completeBreakpoint
-    :: GhciMonad m => CompletionFunc m
-
--- | 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 `isPrefixOptOf`) 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
-    ('.':_)  -> wrapCompleter (specials ++ spaces) complete line
-               -- operator or qualification
-    (x:_) | isSymbolChar x -> wrapCompleter' (\c -> c `elem` (specials ++ spaces) || not (isSymbolChar c))
-                                 complete line         -- operator
-    _                      -> wrapIdentCompleter complete line
-  where
-    complete w = do
-      rdrs <- GHC.getRdrNamesInScope
-      dflags <- GHC.getSessionDynFlags
-      return (filter (w `isPrefixOf`) (map (showPpr dflags) rdrs))
-
--- TAB-completion for the :break command.
--- Build and return a list of breakpoint identifiers with a given prefix.
--- See Note [Tab-completion for :break]
-completeBreakpoint = wrapCompleter spaces $ \w -> do          -- #3000
-    -- bid ~ breakpoint identifier = a name of a function that is
-    --       eligible to set a breakpoint.
-    let (mod_str, _, _) = splitIdent w
-    bids_mod_breaks <- bidsFromModBreaks mod_str
-    bids_inscopes <- bidsFromInscopes
-    pure $ nub $ filter (isPrefixOf w) $ bids_mod_breaks ++ bids_inscopes
-  where
-    -- Extract all bids from ModBreaks for a given module name prefix
-    bidsFromModBreaks :: GhciMonad m => String -> m [String]
-    bidsFromModBreaks mod_pref = do
-        imods <- interpretedHomeMods
-        let pmods = filter ((isPrefixOf mod_pref) . showModule) imods
-        nonquals <- case null mod_pref of
-          -- If the prefix is empty, then for functions declared in a module
-          -- in scope, don't qualify the function name.
-          -- (eg: `main` instead of `Main.main`)
-            True -> do
-                imports <- GHC.getContext
-                pure [ m | IIModule m <- imports]
-            False -> return []
-        bidss <- mapM (bidsByModule nonquals) pmods
-        pure $ concat bidss
-
-    -- Return a list of interpreted home modules
-    interpretedHomeMods :: GhciMonad m => m [Module]
-    interpretedHomeMods = do
-        graph <- GHC.getModuleGraph
-        let hmods = ms_mod <$> GHC.mgModSummaries graph
-        filterM GHC.moduleIsInterpreted hmods
-
-    -- Return all possible bids for a given Module
-    bidsByModule :: GhciMonad m => [ModuleName] -> Module -> m [String]
-    bidsByModule nonquals mod = do
-      (_, decls) <- getModBreak mod
-      let bids = nub $ declPath <$> elems decls
-      pure $ case (moduleName mod) `elem` nonquals of
-              True  -> bids
-              False -> (combineModIdent (showModule mod)) <$> bids
-
-    -- Extract all bids from all top-level identifiers in scope.
-    bidsFromInscopes :: GhciMonad m => m [String]
-    bidsFromInscopes = do
-        dflags <- getDynFlags
-        rdrs <- GHC.getRdrNamesInScope
-        inscopess <- mapM createInscope $ (showSDoc dflags . ppr) <$> rdrs
-        imods <- interpretedHomeMods
-        let topLevels = filter ((`elem` imods) . snd) $ concat inscopess
-        bidss <- mapM (addNestedDecls) topLevels
-        pure $ concat bidss
-
-    -- Return a list of (bid,module) for a single top-level in-scope identifier
-    createInscope :: GhciMonad m => String -> m [(String, Module)]
-    createInscope str_rdr = do
-        names <- GHC.parseName str_rdr
-        pure $ map (str_rdr, ) $ NE.toList $ GHC.nameModule <$> names
-
-    -- For every top-level identifier in scope, add the bids of the nested
-    -- declarations. See Note [Field modBreaks_decls] in GHC.ByteCode.Types
-    addNestedDecls :: GhciMonad m => (String, Module) -> m [String]
-    addNestedDecls (ident, mod) = do
-        (_, decls) <- getModBreak mod
-        let (mod_str, topLvl, _) = splitIdent ident
-            ident_decls = [ elm | elm@(el : _) <- elems decls, el == topLvl ]
-            bids = nub $ declPath <$> ident_decls
-        pure $ map (combineModIdent mod_str) bids
-
-completeModule = wrapIdentCompleterMod $ \w -> do
-  hsc_env <- GHC.getSession
-  let pkg_mods = allVisibleModules (hsc_units hsc_env)
-  loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
-  return $ filter (w `isPrefixOf`)
-        $ map (showPpr (hsc_dflags hsc_env)) $ loaded_mods ++ pkg_mods
-
-completeSetModule = wrapIdentCompleterWithModifier "+-" $ \m w -> do
-  hsc_env <- GHC.getSession
-  modules <- case m of
-    Just '-' -> do
-      imports <- GHC.getContext
-      return $ map iiModuleName imports
-    _ -> do
-      let pkg_mods = allVisibleModules (hsc_units hsc_env)
-      loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
-      return $ loaded_mods ++ pkg_mods
-  return $ filter (w `isPrefixOf`) $ map (showPpr (hsc_dflags hsc_env)) modules
-
-completeHomeModule = wrapIdentCompleterMod listHomeModules
-
-listHomeModules :: GHC.GhcMonad m => String -> m [String]
-listHomeModules w = do
-    g <- GHC.getModuleGraph
-    let home_mods = map GHC.ms_mod_name (GHC.mgModSummaries 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":"prompt-cont":"prompt-function":
-                 "prompt-cont-function":"editor":"stop":flagList
-          flagList = map NE.head $ NE.group $ sort allNonDeprecatedFlags
-
-completeSeti = wrapCompleter flagWordBreakChars $ \w -> do
-  return (filter (w `isPrefixOf`) flagList)
-    where flagList = map NE.head $ NE.group $ sort allNonDeprecatedFlags
-
-completeShowOptions = wrapCompleter flagWordBreakChars $ \w -> do
-  return (filter (w `isPrefixOf`) opts)
-    where opts = ["args", "prog", "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 :: Monad m => String -> (String -> m [String]) -> CompletionFunc m
-wrapCompleter breakChars = wrapCompleter' (`elem` breakChars)
-
-wrapCompleter' :: Monad m => (Char -> Bool) -> (String -> m [String]) -> CompletionFunc m
-wrapCompleter' breakPred fun = completeWord' Nothing breakPred
-    $ fmap (map simpleCompletion . nubSort) . fun
-
-wrapIdentCompleter :: Monad m => (String -> m [String]) -> CompletionFunc m
-wrapIdentCompleter = wrapCompleter' word_break_chars_pred
-
-wrapIdentCompleterMod :: Monad m => (String -> m [String]) -> CompletionFunc m
-wrapIdentCompleterMod = wrapCompleter' go
-  where
-    go '.' = False -- Treated specially since it is a separator for module qualifiers
-    go c = word_break_chars_pred c
-
-wrapIdentCompleterWithModifier
-  :: Monad m
-  => String -> (Maybe Char -> String -> m [String]) -> CompletionFunc m
-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 :: UnitState -> [ModuleName]
-allVisibleModules unit_state = listVisibleModuleNames unit_state
-
-completeExpression = completeQuotedWord (Just '\\') "\"" listFiles
-                        completeIdentifier
-
-
-{-
-Note [Tab-completion for :break]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In tab-completion for the `:break` command, only those
-identifiers should be shown, that are accepted in the
-`:break` command. Hence these identifiers must be
-
-- defined in an interpreted module
-- listed in a `ModBreaks` value as a possible breakpoint.
-
-The identifiers may be qualified or unqualified.
-
-To get all possible top-level breakpoints for tab-completion
-with the correct qualification do:
-
-1. Build a list called `bids_mod_breaks` of identifier names eligible
-for setting breakpoints: For every interpreted module with the
-correct module prefix read all identifier names from the `decls` field
-of the `ModBreaks` array.
-
-2. Build a list called `bids_inscopess` of identifiers in scope:
-Take all RdrNames in scope, and filter by interpreted modules.
-Fore each of these top-level identifiers add from the `ModBreaks`
-arrays the available identifiers of the nested functions.
-
-3.) Combine both lists, filter by the given prefix, and remove duplicates.
--}
-
--- -----------------------------------------------------------------------------
--- commands for debugger
-
-sprintCmd, printCmd, forceCmd :: GHC.GhcMonad m => String -> m ()
-sprintCmd = pprintClosureCommand False False
-printCmd  = pprintClosureCommand True False
-forceCmd  = pprintClosureCommand False True
-
-stepCmd :: GhciMonad m => String -> m ()
-stepCmd arg = withSandboxOnly ":step" $ step arg
-  where
-  step []         = doContinue (const True) GHC.SingleStep
-  step expression = runStmt expression GHC.SingleStep >> return ()
-
-stepLocalCmd :: GhciMonad m => String -> m ()
-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 (UnhelpfulSpan _) -> liftIO $ putStrLn (            -- #14690
-           ":steplocal is not possible." ++
-           "\nCannot determine current top-level binding after " ++
-           "a break on error / exception.\nUse :stepmodule.")
-        Just loc -> do
-           md <- fromMaybe (panic "stepLocalCmd") <$> getCurrentBreakModule
-           current_toplevel_decl <- enclosingTickSpan md loc
-           doContinue (`isSubspanOf` RealSrcSpan current_toplevel_decl Strict.Nothing) GHC.SingleStep
-
-stepModuleCmd :: GhciMonad m => String -> m ()
-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 :: GhciMonad m => Module -> SrcSpan -> m RealSrcSpan
-enclosingTickSpan _ (UnhelpfulSpan _) = panic "enclosingTickSpan UnhelpfulSpan"
-enclosingTickSpan md (RealSrcSpan src _) = do
-  ticks <- getTickArray md
-  let line = srcSpanStartLine src
-  massert (inRange (bounds ticks) line)
-  let enclosing_spans = [ pan | (_,pan) <- ticks ! line
-                               , realSrcSpanEnd pan >= realSrcSpanEnd src]
-  return . minimumBy leftmostLargestRealSrcSpan $ enclosing_spans
- where
-
-leftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering
-leftmostLargestRealSrcSpan = on compare realSrcSpanStart S.<> on (flip compare) realSrcSpanEnd
-
-traceCmd :: GhciMonad m => String -> m ()
-traceCmd arg
-  = withSandboxOnly ":trace" $ tr arg
-  where
-  tr []         = doContinue (const True) GHC.RunAndLogSteps
-  tr expression = runStmt expression GHC.RunAndLogSteps >> return ()
-
-continueCmd :: GhciMonad m => String -> m ()                  -- #19157
-continueCmd argLine = withSandboxOnly ":continue" $
-  case contSwitch (words argLine) of
-    Left sdoc   -> printForUser sdoc
-    Right mbCnt -> doContinue' (const True) GHC.RunToCompletion mbCnt
-    where
-      contSwitch :: [String] -> Either SDoc (Maybe Int)
-      contSwitch [ ] = Right Nothing
-      contSwitch [x] = Just <$> getIgnoreCount x
-      contSwitch  _  = Left $
-          text "After ':continue' only one ignore count is allowed"
-
-doContinue :: GhciMonad m => (SrcSpan -> Bool) -> SingleStep -> m ()
-doContinue pre step = doContinue' pre step Nothing
-
-doContinue' :: GhciMonad m => (SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ()
-doContinue' pre step mbCnt= do
-  runResult <- resume pre step mbCnt
-  _ <- afterRunStmt pre runResult
-  return ()
-
-abandonCmd :: GhciMonad m => String -> m ()
-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 :: GhciMonad m => String -> m ()
-deleteCmd argLine = withSandboxOnly ":delete" $ do
-   deleteSwitch $ words argLine
-   where
-   deleteSwitch :: GhciMonad m => [String] -> m ()
-   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 :: GhciMonad m => String -> m ()
-      deleteOneBreak str
-         | all isDigit str = deleteBreak (read str)
-         | otherwise = return ()
-
-enableCmd :: GhciMonad m => String -> m ()
-enableCmd argLine = withSandboxOnly ":enable" $ do
-    enaDisaSwitch True $ words argLine
-
-disableCmd :: GhciMonad m => String -> m ()
-disableCmd argLine = withSandboxOnly ":disable" $ do
-    enaDisaSwitch False $ words argLine
-
-enaDisaSwitch :: GhciMonad m => Bool -> [String] -> m ()
-enaDisaSwitch enaDisa [] =
-    printForUser (text "The" <+> text strCmd <+>
-                  text "command requires at least one argument.")
-  where
-    strCmd = if enaDisa then ":enable" else ":disable"
-enaDisaSwitch enaDisa ("*" : _) = enaDisaAllBreaks enaDisa
-enaDisaSwitch enaDisa idents = do
-    mapM_ (enaDisaOneBreak enaDisa) idents
-  where
-    enaDisaOneBreak :: GhciMonad m => Bool -> String -> m ()
-    enaDisaOneBreak enaDisa strId = do
-      sdoc_loc <- checkEnaDisa enaDisa strId
-      case sdoc_loc of
-        Left sdoc -> printForUser sdoc
-        Right loc -> enaDisaAssoc enaDisa (read strId, loc)
-
-checkEnaDisa :: GhciMonad m => Bool -> String -> m (Either SDoc BreakLocation)
-checkEnaDisa enaDisa strId = do
-    sdoc_loc <- getBreakLoc strId
-    pure $ sdoc_loc >>= checkEnaDisaState enaDisa strId
-
-getBreakLoc :: GhciMonad m => String -> m (Either SDoc BreakLocation)
-getBreakLoc strId = do
-    st <- getGHCiState
-    case readMaybe strId >>= flip IntMap.lookup (breaks st) of
-      Nothing -> return $ Left (text "Breakpoint" <+> text strId <+>
-                                text "not found")
-      Just loc -> return $ Right loc
-
-checkEnaDisaState :: Bool -> String -> BreakLocation -> Either SDoc BreakLocation
-checkEnaDisaState enaDisa strId loc = do
-    if breakEnabled loc == enaDisa
-    then Left $
-        text "Breakpoint" <+> text strId <+> text "already in desired state"
-    else Right loc
-
-enaDisaAssoc :: GhciMonad m => Bool -> (Int, BreakLocation) -> m ()
-enaDisaAssoc enaDisa (intId, loc) = do
-    st <- getGHCiState
-    newLoc <- turnBreakOnOff enaDisa loc
-    let new_breaks = IntMap.insert intId newLoc (breaks st)
-    setGHCiState $ st { breaks = new_breaks }
-
-enaDisaAllBreaks :: GhciMonad m => Bool -> m()
-enaDisaAllBreaks enaDisa = do
-    st <- getGHCiState
-    mapM_ (enaDisaAssoc enaDisa) $ IntMap.assocs $ breaks st
-
-historyCmd :: GHC.GhcMonad m => String -> m ()
-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
-
-ignoreCmd  :: GhciMonad m => String -> m ()                     -- #19157
-ignoreCmd argLine = withSandboxOnly ":ignore" $ do
-    result <- ignoreSwitch (words argLine)
-    case result of
-      Left sdoc -> printForUser sdoc
-      Right (loc, count)   -> do
-        let breakInfo = GHC.BreakInfo (breakModule loc) (breakTick loc)
-        setupBreakpoint breakInfo count
-
-ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
-ignoreSwitch [break, count] = do
-    sdoc_loc <- getBreakLoc break
-    pure $ (,) <$> sdoc_loc <*> getIgnoreCount count
-ignoreSwitch _ = pure $ Left $ text "Syntax:  :ignore <breaknum> <count>"
-
-getIgnoreCount :: String -> Either SDoc Int
-getIgnoreCount str =
-    case readMaybe str of
-      Nothing              -> Left $ sdocIgnore <+> "is not numeric"
-      Just cnt | cnt < 0   -> Left $ sdocIgnore <+> "must be >= 0"
-               | otherwise -> Right cnt
-    where
-      sdocIgnore = text "Ignore count" <+> quotes (text str)
-
-setupBreakpoint :: GhciMonad m => GHC.BreakInfo -> Int -> m()
-setupBreakpoint loc count = do
-    hsc_env <- GHC.getSession
-    GHC.setupBreakpoint hsc_env loc count
-
-backCmd :: GhciMonad m => String -> m ()
-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 $ text "Logged breakpoint at" <+> ppr pan
-      printTypeOfNames names
-       -- run the command set with ":set stop <cmd>"
-      st <- getGHCiState
-      enqueueCommands [stop st]
-
-forwardCmd :: GhciMonad m => String -> m ()
-forwardCmd arg
-  | null arg        = forward 1
-  | all isDigit arg = forward (read arg)
-  | otherwise       = liftIO $ putStrLn "Syntax:  :forward [num]"
-  where
-  forward num = withSandboxOnly ":forward" $ do
-      (names, ix, pan, _) <- GHC.forward num
-      printForUser $ (if (ix == 0)
-                        then text "Stopped at"
-                        else text "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 :: GhciMonad m => String -> m ()
-breakCmd argLine = withSandboxOnly ":break" $ breakSwitch $ words argLine
-
-breakSwitch :: GhciMonad m => [String] -> m ()
-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
-        breakById arg1
-
-breakByModule :: GhciMonad m => Module -> [String] -> m ()
-breakByModule md (arg1:rest)
-   | all isDigit arg1 = do  -- looks like a line number
-        breakByModuleLine md (read arg1) rest
-breakByModule _ _
-   = breakSyntax
-
-breakByModuleLine :: GhciMonad m => Module -> Int -> [String] -> m ()
-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
-
--- Set a breakpoint for an identifier
--- See Note [Setting Breakpoints by Id]
-breakById :: GhciMonad m => String -> m ()                          -- #3000
-breakById inp = do
-    let (mod_str, top_level, fun_str) = splitIdent inp
-        mod_top_lvl = combineModIdent mod_str top_level
-    mb_mod <- catch (lookupModuleInscope mod_top_lvl)
-                    (\(_ :: SomeException) -> lookupModuleInGraph mod_str)
-      -- If the top-level name is not in scope, `lookupModuleInscope` will
-      -- throw an exception, then lookup the module name in the module graph.
-    mb_err_msg <- validateBP mod_str fun_str mb_mod
-    case mb_err_msg of
-        Just err_msg -> printForUser $
-          text "Cannot set breakpoint on" <+> quotes (text inp)
-          <> text ":" <+> err_msg
-        Nothing -> do
-          -- No errors found, go and set the breakpoint
-          mb_mod_info  <- GHC.getModuleInfo $ fromJust mb_mod
-          let modBreaks = case mb_mod_info of
-                (Just mod_info) -> GHC.modInfoModBreaks mod_info
-                Nothing         -> emptyModBreaks
-          findBreakAndSet (fromJust mb_mod) $ findBreakForBind fun_str modBreaks
-  where
-    -- Try to lookup the module for an identifier that is in scope.
-    -- `parseName` throws an exception, if the identifier is not in scope
-    lookupModuleInscope :: GhciMonad m => String -> m (Maybe Module)
-    lookupModuleInscope mod_top_lvl = do
-        names <- GHC.parseName mod_top_lvl
-        pure $ Just $ NE.head $ GHC.nameModule <$> names
-
-    -- Lookup the Module of a module name in the module graph
-    lookupModuleInGraph :: GhciMonad m => String -> m (Maybe Module)
-    lookupModuleInGraph mod_str = do
-        graph <- GHC.getModuleGraph
-        let hmods = ms_mod <$> GHC.mgModSummaries graph
-        pure $ find ((== mod_str) . showModule) hmods
-
-    -- Check validity of an identifier to set a breakpoint:
-    --  1. The module of the identifier must exist
-    --  2. the identifier must be in an interpreted module
-    --  3. the ModBreaks array for module `mod` must have an entry
-    --     for the function
-    validateBP :: GhciMonad m => String -> String -> Maybe Module
-                       -> m (Maybe SDoc)
-    validateBP mod_str fun_str Nothing = pure $ Just $ quotes (text
-        (combineModIdent mod_str (Prelude.takeWhile (/= '.') fun_str)))
-        <+> text "not in scope"
-    validateBP _ "" (Just _) = pure $ Just $ text "Function name is missing"
-    validateBP _ fun_str (Just modl) = do
-        isInterpr <- GHC.moduleIsInterpreted modl
-        (_, decls) <- getModBreak modl
-        mb_err_msg <- case isInterpr of
-          False -> pure $ Just $ text "Module" <+> quotes (ppr modl)
-                        <+> text "is not interpreted"
-          True -> case fun_str `elem` (declPath <$> elems decls) of
-                False -> pure $ Just $
-                   text "No breakpoint found for" <+> quotes (text fun_str)
-                   <+> "in module" <+> quotes (ppr modl)
-                True  -> pure Nothing
-        pure mb_err_msg
-
-breakSyntax :: a
-breakSyntax = throwGhcException $ CmdLineError ("Syntax: :break [<mod>.]<func>[.<func>]\n"
-                                             ++ "        :break [<mod>] <line> [<column>]")
-
-findBreakAndSet :: GhciMonad m
-                => Module -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
-findBreakAndSet md lookupTickTree = do
-   tickArray <- getTickArray md
-   case lookupTickTree tickArray of
-      []  -> liftIO $ putStrLn $ "No breakpoints found at that location."
-      some -> mapM_ breakAt some
- where
-   breakAt (tick, pan) = do
-         setBreakFlag md tick True
-         (alreadySet, nm) <-
-               recordBreak $ BreakLocation
-                       { breakModule = md
-                       , breakLoc = RealSrcSpan pan Strict.Nothing
-                       , breakTick = tick
-                       , onBreakCmd = ""
-                       , breakEnabled = True
-                       }
-         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 breakpoints for all the RHSs of the
--- equations corresponding to a binding.  So we find all breakpoints
--- for
---   (a) this binder only (it maybe a top-level or a nested declaration)
---   (b) that do not have an enclosing breakpoint
-findBreakForBind :: String -> GHC.ModBreaks -> TickArray
-                 -> [(BreakIndex,RealSrcSpan)]
-findBreakForBind str_name modbreaks _ = filter (not . enclosed) ticks
-  where
-    ticks = [ (index, span)
-            | (index, decls) <- assocs (GHC.modBreaks_decls modbreaks),
-              str_name == declPath decls,
-              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 Strict.Nothing `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"
-
-{-
-Note [Setting Breakpoints by Id]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-To set a breakpoint first check whether a ModBreaks array contains a
-breakpoint with the given function name:
-In `:break M.foo` `M` may be a module name or a local alias of an import
-statement. To lookup a breakpoint in the ModBreaks, the effective module
-name is needed. Even if a module called `M` exists, `M` may still be
-a local alias. To get the module name, parse the top-level identifier with
-`GHC.parseName`. If this succeeds, extract the module name from the
-returned value. If it fails, catch the exception and assume `M` is a real
-module name.
-
-The names of nested functions are stored in `ModBreaks.modBreaks_decls`.
--}
-
------------------------------------------------------------------------------
--- :where
-
-whereCmd :: GHC.GhcMonad m => String -> m ()
-whereCmd = noArgs $ do
-  mstrs <- getCallStackAtCurrentBreakpoint
-  case mstrs of
-    Nothing -> return ()
-    Just strs -> liftIO $ putStrLn (renderStack strs)
-
------------------------------------------------------------------------------
--- :list
-
-listCmd :: GhciMonad m => String -> m ()
-listCmd "" = do
-   mb_span <- 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 :: GhciMonad m => [String] -> m ()
-list2 [arg] | all isDigit arg = do
-    imports <- GHC.getContext
-    case iiModules imports of
-        [] -> liftIO $ putStrLn "No module to list"
-        (mn : _) -> do
-          md <- 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) $
-                               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 :: GHC.GhcMonad m => Module -> Int -> m ()
-listModuleLine modl line = do
-   graph <- GHC.getModuleGraph
-   let this = GHC.mgLookupModule graph modl
-   case this of
-     Nothing -> panic "listModuleLine"
-     Just 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 -> 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
-
-      let utf8Decoded = utf8DecodeByteString output
-      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 :: GhciMonad m => Module -> m TickArray
-getTickArray modl = do
-   st <- getGHCiState
-   let arrmap = tickarrays st
-   case lookupModuleEnv arrmap modl of
-      Just arr -> return arr
-      Nothing  -> do
-        (ticks, _) <- getModBreak modl
-        let arr = mkTickArray (assocs ticks)
-        setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}
-        return arr
-
-discardTickArrays :: GhciMonad m => m ()
-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 :: GhciMonad m => m ()
-discardActiveBreakPoints = do
-   st <- getGHCiState
-   mapM_ (turnBreakOnOff False) $ breaks st
-   setGHCiState $ st { breaks = IntMap.empty }
-
-discardInterfaceCache :: GhciMonad m => m ()
-discardInterfaceCache =
-   void (liftIO . iface_clearCache . ifaceCache =<< getGHCiState)
-
-clearHPTs :: GhciMonad m => m ()
-clearHPTs = do
-  let pruneHomeUnitEnv hme = hme { homeUnitEnv_hpt = emptyHomePackageTable }
-      discardMG hsc = hsc { hsc_mod_graph = GHC.emptyMG }
-  modifySession (discardMG . discardIC . hscUpdateHUG (unitEnv_map pruneHomeUnitEnv))
-
-
--- The unused package warning doesn't make sense once the targets get out of
--- sync with the package flags. See #21110
--- Therefore if it's turned on, the warnings are issued until the module context
--- changes (via :load or :cd), at which stage the package flags are not going to change
--- but the loaded modules will probably not use all the specified packages so the
--- warning becomes spurious. At that point the warning is silently disabled.
-disableUnusedPackages :: GhciMonad m => m ()
-disableUnusedPackages = newDynFlags False ["-Wno-unused-packages"]
-
-deleteBreak :: GhciMonad m => Int -> m ()
-deleteBreak identity = do
-   st <- getGHCiState
-   let oldLocations = breaks st
-   case IntMap.lookup identity oldLocations of
-       Nothing -> printForUser (text "Breakpoint" <+> ppr identity <+>
-                                text "does not exist")
-       Just loc -> do
-           _ <- (turnBreakOnOff False) loc
-           let rest = IntMap.delete identity oldLocations
-           setGHCiState $ st { breaks = rest }
-
-turnBreakOnOff :: GhciMonad m => Bool -> BreakLocation -> m BreakLocation
-turnBreakOnOff onOff loc
-  | onOff == breakEnabled loc = return loc
-  | otherwise = do
-      setBreakFlag (breakModule loc) (breakTick loc)  onOff
-      return loc { breakEnabled = onOff }
-
-getModBreak :: GHC.GhcMonad m
-            => Module -> m (Array Int SrcSpan, Array Int [String])
-getModBreak m = do
-   mod_info      <- fromMaybe (panic "getModBreak") <$> GHC.getModuleInfo m
-   let modBreaks  = GHC.modInfoModBreaks mod_info
-   let ticks      = GHC.modBreaks_locs  modBreaks
-   let decls      = GHC.modBreaks_decls modBreaks
-   return (ticks, decls)
-
-setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
-setBreakFlag  md ix enaDisa = do
-  let enaDisaToCount True = breakOn
-      enaDisaToCount False = breakOff
-  setupBreakpoint (GHC.BreakInfo md ix) $ enaDisaToCount enaDisa
-
--- ---------------------------------------------------------------------------
--- 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 around the flushing operation, so if stderr is closed
--- GHCi will just die gracefully rather than going into an infinite loop.
-handler :: GhciMonad m => SomeException -> m Bool
-handler exception = do
-  flushInterpBuffers
-  withSignalHandlers $
-     ghciHandle handler (showException exception >> return False)
-
-showException :: MonadIO m => SomeException -> m ()
-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
-
-failIfExprEvalMode :: GhciMonad m => m ()
-failIfExprEvalMode = do
-  s <- getGHCiState
-  when (ghc_e s) $
-    liftIO (exitWith (ExitFailure 1))
-
--- | When in expression evaluation mode (ghc -e), we want to exit immediately.
--- Otherwis, just print out the message.
-printErrAndMaybeExit :: (GhciMonad m, MonadIO m, HasLogger m) => SourceError -> m ()
-printErrAndMaybeExit = (>> failIfExprEvalMode) . printGhciException
-
------------------------------------------------------------------------------
--- 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 :: (HasLogger m, ExceptionMonad m) => (SomeException -> m a) -> m a -> m a
-ghciHandle h m = mask $ \restore -> do
-                 -- Force dflags to avoid leaking the associated HscEnv
-                 !log <- getLogger
-                 catch (restore (GHC.prettyPrintGhcErrors log m)) $ \e -> restore (h e)
-
-ghciTry :: ExceptionMonad m => m a -> m (Either SomeException a)
-ghciTry m = fmap Right m `catch` \e -> return $ Left e
-
-tryBool :: ExceptionMonad m => m a -> m 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.lookupQualifiedModule NoPkgQual mName
-
-isMainUnitModule :: Module -> Bool
-isMainUnitModule m = GHC.moduleUnit m == mainUnit
-
-showModule :: Module -> String
-showModule = moduleNameString . moduleName
-
--- Return a String with the declPath of the function of a breakpoint.
--- See Note [Field modBreaks_decls] in GHC.ByteCode.Types
-declPath :: [String] -> String
-declPath = intercalate "."
-
--- | Optionally show a fixity declaration like @infixr 4 #@
---
--- We always display the fixity of terms with symbolic names (like <$>).
--- For other terms we only display the fixity if it has been set to a
--- value other than the default infixl 9.
---
--- We have no way of distinguishing between a fixity that has been
--- manually set to infixl 9 and a fixity that has assumed infixl 9 as
--- the default, so we choose to not display the fixity in both cases
--- (for terms with non-symbolic names).
---
--- See #19200.
-showFixity :: TyThing -> Fixity -> SDoc
-showFixity thing fixity
-    | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)
-        = ppr fixity <+> pprInfixName (GHC.getName thing)
-    | otherwise = empty
-
--- TODO: won't work if home dir is encoded.
--- (changeDirectory may not work either in that case.)
-expandPath :: MonadIO m => String -> 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
-   home_unit <- hsc_home_unit <$> GHC.getSession
-   unless (isHomeModule home_unit modl) $
-      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 printGhciException $ do
-    n NE.:| _ <- GHC.parseName str
-    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
-
-clearCaches :: GhciMonad m => m ()
-clearCaches = discardActiveBreakPoints
-              >> discardInterfaceCache
-              >> disableUnusedPackages
-              >> clearHPTs
-
-
-
--- Split up a string with an eventually qualified declaration name into 3 components
---   1. module name
---   2. top-level decl
---   3. full-name of the eventually nested decl, but without module qualification
--- eg  "foo"           = ("", "foo", "foo")
---     "A.B.C.foo"     = ("A.B.C", "foo", "foo")
---     "M.N.foo.bar"   = ("M.N", "foo", "foo.bar")
-splitIdent :: String -> (String, String, String)
-splitIdent [] = ("", "", "")
-splitIdent inp@(a : _)
-    | (isUpper a) = case fixs of
-        []            -> (inp, "", "")
-        (i1 : [] )    -> (upto i1, from i1, from i1)
-        (i1 : i2 : _) -> (upto i1, take (i2 - i1 - 1) (from i1), from i1)
-    | otherwise = case ixs of
-        []            -> ("", inp, inp)
-        (i1 : _)      -> ("", upto i1, inp)
-  where
-    ixs = elemIndices '.' inp        -- indices of '.' in whole input
-    fixs = dropWhile isNextUc ixs    -- indices of '.' in function names              --
-    isNextUc ix = isUpper $ safeInp !! (ix+1)
-    safeInp = inp ++ " "
-    upto i = take i inp
-    from i = drop (i + 1) inp
-
--- Qualify an identifier name with a module name
--- combineModIdent "A" "foo"  =  "A.foo"
--- combineModIdent ""  "foo"  =  "foo"
-combineModIdent :: String -> String -> String
-combineModIdent mod ident
-          | null mod   = ident
-          | null ident = mod
-          | otherwise  = mod ++ "." ++ ident
diff --git a/src-bin-9.10/Clash/GHCi/UI/Exception.hs b/src-bin-9.10/Clash/GHCi/UI/Exception.hs
deleted file mode 100644
--- a/src-bin-9.10/Clash/GHCi/UI/Exception.hs
+++ /dev/null
@@ -1,142 +0,0 @@
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-module Clash.GHCi.UI.Exception(printGhciException, GHCiMessage(..)) where
-
-import GHC.Prelude
-
-import GHC.Driver.Config.Diagnostic
-import GHC.Driver.Errors
-import GHC.Driver.Errors.Types
-import GHC.Driver.Session
-
-import GHC.Iface.Errors.Ppr
-import GHC.Iface.Errors.Types
-
-import qualified GHC.LanguageExtensions as LangExt
-
-import GHC.Tc.Errors.Ppr
-import GHC.Tc.Errors.Types
-
-import GHC.Types.Error
-import GHC.Types.SourceError
-
-import GHC.Unit.State
-
-import GHC.Utils.Logger
-import GHC.Utils.Outputable
-
-import Control.Monad.IO.Class
-
-
--- | Print the all diagnostics in a 'SourceError'.  Specialised for GHCi error reporting
--- for some error messages.
-printGhciException :: (HasLogger m, MonadIO m, HasDynFlags m) => SourceError -> m ()
-printGhciException err = do
-  dflags <- getDynFlags
-  logger <- getLogger
-  let !diag_opts = initDiagOpts dflags
-      !print_config = initPrintConfig dflags
-  liftIO $ printMessages logger print_config diag_opts (GHCiMessage <$> (srcErrorMessages err))
-
-
-newtype GHCiMessage = GHCiMessage { _getGhciMessage :: GhcMessage }
-
-instance Diagnostic GHCiMessage where
-  type DiagnosticOpts GHCiMessage = DiagnosticOpts GhcMessage
-
-  diagnosticMessage opts (GHCiMessage msg) = ghciDiagnosticMessage opts msg
-
-  diagnosticReason (GHCiMessage msg) = diagnosticReason msg
-
-  diagnosticHints (GHCiMessage msg) = ghciDiagnosticHints msg
-
-  diagnosticCode (GHCiMessage msg)  = diagnosticCode msg
-
-
--- | Modifications to hint messages which we want to display in GHCi.
-ghciDiagnosticHints :: GhcMessage -> [GhcHint]
-ghciDiagnosticHints msg = map modifyHintForGHCi (diagnosticHints msg)
-  where
-    modifyHintForGHCi :: GhcHint -> GhcHint
-    modifyHintForGHCi = \case
-      SuggestExtension extHint -> SuggestExtension $ modifyExtHintForGHCi extHint
-      hint -> hint
-    modifyExtHintForGHCi :: LanguageExtensionHint -> LanguageExtensionHint
-    modifyExtHintForGHCi = \case
-      SuggestSingleExtension    doc ext  -> SuggestSingleExtension    (suggestSetExt [ext] doc False) ext
-      SuggestExtensionInOrderTo doc ext  -> SuggestExtensionInOrderTo (suggestSetExt [ext] doc False) ext
-      SuggestAnyExtension       doc exts -> SuggestAnyExtension       (suggestSetExt exts  doc True ) exts
-      SuggestExtensions         doc exts -> SuggestExtensions         (suggestSetExt exts  doc False) exts
-    -- Suggest enabling extension with :set -X<ext>
-    -- SuggestAnyExtension will be on multiple lines so the user can select which to enable without editing
-    suggestSetExt :: [LangExt.Extension] -> SDoc -> Bool -> SDoc
-    suggestSetExt exts doc enable_any = doc $$ hang header 2 exts_cmds
-      where
-        header = text "You may enable" <+> which <+> text "language extension" <> plural exts <+> text "in GHCi with:"
-        which
-          | [ _ext ] <- exts
-          = text "this"
-          | otherwise
-          = if enable_any
-            then text "these"
-            else text "all of these"
-        exts_cmds
-          | enable_any
-          = vcat $ map (\ext -> text ":set -X" <> ppr ext) exts
-          | otherwise
-          = text ":set" <> hcat (map (\ext -> text " -X" <> ppr ext) exts)
-
--- Modifications to error messages which we want to display in GHCi
-ghciDiagnosticMessage :: GhcMessageOpts -> GhcMessage -> DecoratedSDoc
-ghciDiagnosticMessage ghc_opts msg =
-  case msg of
-    GhcTcRnMessage tc_msg ->
-      case tcRnMessage (tcMessageOpts ghc_opts) tc_msg of
-        Nothing -> diagnosticMessage ghc_opts msg
-        Just sdoc -> sdoc
-    GhcDriverMessage  (DriverInterfaceError err) ->
-      case ghciInterfaceError err of
-        Just sdoc -> mkSimpleDecorated sdoc
-        Nothing -> diagnosticMessage ghc_opts msg
-    GhcDriverMessage {} -> diagnosticMessage ghc_opts msg
-    GhcPsMessage  {} -> diagnosticMessage ghc_opts msg
-    GhcDsMessage  {} -> diagnosticMessage ghc_opts msg
-    GhcUnknownMessage  {} -> diagnosticMessage ghc_opts msg
-  where
-    tcRnMessage tc_opts tc_msg =
-      case tc_msg of
-        TcRnInterfaceError err -> mkSimpleDecorated <$> (ghciInterfaceError err)
-        TcRnMessageWithInfo unit_state msg_with_info ->
-          case msg_with_info of
-           TcRnMessageDetailed err_info wrapped_msg
-             -> messageWithInfoDiagnosticMessage unit_state err_info
-                  (tcOptsShowContext tc_opts)
-                  <$> tcRnMessage tc_opts wrapped_msg
-        TcRnWithHsDocContext ctxt wrapped_msg ->
-          messageWithHsDocContext tc_opts ctxt <$> tcRnMessage tc_opts wrapped_msg
-        _ -> Nothing
-
-    opts = tcOptsIfaceOpts (tcMessageOpts ghc_opts)
-
-    ghciInterfaceError (Can'tFindInterface err looking_for) =
-      hangNotEmpty (lookingForHerald looking_for) 2 <$> ghciMissingInterfaceErrorDiagnostic err
-    ghciInterfaceError _ = Nothing
-
-    ghciMissingInterfaceErrorDiagnostic reason =
-      case reason of
-        CantFindErr us module_or_interface cfi -> Just (pprWithUnitState us $ cantFindErrorX pkg_hidden_hint may_show_locations module_or_interface cfi)
-        _ -> Nothing
-      where
-
-        may_show_locations = mayShowLocations ":set -v" (ifaceShowTriedFiles opts)
-
-        pkg_hidden_hint = pkgHiddenHint hidden_msg (ifaceBuildingCabalPackage opts)
-          where
-            hidden_msg pkg =
-              text "You can run" <+>
-              quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
-              text "to expose it." $$
-              text "(Note: this unloads all the modules in the current scope.)"
diff --git a/src-bin-9.10/Clash/GHCi/UI/Info.hs b/src-bin-9.10/Clash/GHCi/UI/Info.hs
deleted file mode 100644
--- a/src-bin-9.10/Clash/GHCi/UI/Info.hs
+++ /dev/null
@@ -1,409 +0,0 @@
-{-# LANGUAGE LambdaCase          #-}
-{-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE ViewPatterns        #-}
-
-{-# OPTIONS -fno-warn-name-shadowing #-}
-
--- | Get information on modules, expressions, and identifiers
-module Clash.GHCi.UI.Info
-    ( ModInfo(..)
-    , SpanInfo(..)
-    , spanInfoFromRealSrcSpan
-    , collectInfo
-    , findLoc
-    , findNameUses
-    , findType
-    , getModInfo
-    ) where
-
-import           Control.Exception
-import           Control.Monad
-import           Control.Monad.Catch as MC
-import           Control.Monad.Trans.Class
-import           Control.Monad.Trans.Except
-import           Control.Monad.Trans.Maybe
-import           Data.Data
-import           Data.Function
-import           Data.List (find, sortBy)
-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           GHC.Hs.Syn.Type
-import           GHC.Driver.Session (HasDynFlags(..))
-import           GHC.Data.FastString
-import           GHC
-import           GHC.Driver.Monad
-import           GHC.Driver.Env
-import           GHC.Driver.Ppr
-import           GHC.Types.Name
-import           GHC.Types.Name.Reader
-import           GHC.Types.Name.Set
-import           GHC.Utils.Outputable
-import           GHC.Types.SrcLoc
-import           GHC.Types.Var
-import qualified GHC.Data.Strict as Strict
-
--- | 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.
-    , modinfoRdrEnv     :: !(Strict.Maybe IfGlobalRdrEnv)
-      -- ^ What's in scope in the module.
-    , modinfoLastUpdate :: !UTCTime
-      -- ^ The timestamp of the file used to generate this record.
-    }
-
--- | 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.
-    }
-
-instance Outputable SpanInfo where
-  ppr (SpanInfo s t i) = ppr s <+> ppr t <+> ppr i
-
--- | 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 s = RealSrcSpan (spaninfoSrcSpan s) Strict.Nothing
-        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
-    rdrs = modInfo_rdrs mi
-    tryExternalModuleResolution =
-      case find (matchName $ mkFastString string) rdrs 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 (moduleUnit modL) <> ":" <>
-                            ppr modL)) return $
-             M.lookup (moduleName modL) infos
-
-     let all_names = modInfo_rdrs info
-
-     maybe (throwE "No matching export in any local modules.") return $
-         find (matchName name) all_names
-  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 TM_Inst 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 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 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
-    unit_state <- hsc_units <$> getSession
-    liftIO (filterM cacheInvalid loaded) >>= \case
-        [] -> return ms
-        invalidated -> do
-            liftIO (putStrLn ("Collecting type info for " ++
-                              show (length invalidated) ++
-                              " module(s) ... "))
-
-            foldM (go df unit_state) ms invalidated
-  where
-    go df unit_state m name = do { info <- getModInfo name; return (M.insert name info m) }
-                   `MC.catch`
-                   (\(e :: SomeException) -> do
-                         liftIO $ putStrLn
-                                $ showSDocForUser df unit_state 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 = srcFilePath (modinfoSummary mi)
-                last' = modinfoLastUpdate mi
-            current <- getModificationTime fp
-            exists <- doesFileExist fp
-            if exists
-                then return $ current /= last'
-                else return True
-
--- | Get the source file path from a ModSummary.
--- If the .hs file is missing, and the .o file exists,
--- we return the .o file path.
-srcFilePath :: ModSummary -> FilePath
-srcFilePath modSum = fromMaybe obj_fp src_fp
-    where
-        src_fp = ml_hs_file ms_loc
-        obj_fp = ml_obj_file ms_loc
-        ms_loc = ms_location modSum
-
--- | 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
-    let allTypes = processAllTypeCheckedModule typechecked
-        module_info = tm_checked_module_info typechecked
-        !rdr_env = case modInfoRdrEnv module_info of
-          Just rdrs -> Strict.Just rdrs
-            -- NB: this has already been deeply forced; no need to do that again.
-            -- See test case T15369 and Note [Forcing GREInfo] in GHC.Types.GREInfo.
-          Nothing   -> Strict.Nothing
-    ts <- liftIO $ getModificationTime $ srcFilePath m
-    return $
-      ModInfo
-        { modinfoSummary    = m
-        , modinfoSpans      = allTypes
-        , modinfoRdrEnv     = rdr_env
-        , modinfoLastUpdate = ts
-        }
-
--- | Get the 'Name's from the 'GlobalRdrEnv' of the 'ModInfo', if any.
-modInfo_rdrs :: ModInfo -> [Name]
-modInfo_rdrs mi =
-  case modinfoRdrEnv mi of
-    Strict.Nothing  -> []
-    Strict.Just env -> map greName $ globalRdrEnvElts env
-
--- | Get ALL source spans in the module.
-processAllTypeCheckedModule :: TypecheckedModule -> [SpanInfo]
-processAllTypeCheckedModule tcm
-  = mapMaybe toSpanInfo
-  $ sortBy cmpSpan
-  $ catMaybes (bts ++ ets ++ pts)
-  where
-    bts = map getTypeLHsBind $ listifyAllSpans tcs
-    ets = map getTypeLHsExpr $ listifyAllSpans tcs
-    pts = map getTypeLPat    $ listifyAllSpans tcs
-
-    tcs = tm_typechecked_source tcm
-
-    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsBind's
-    getTypeLHsBind :: LHsBind GhcTc -> Maybe (Maybe Id,SrcSpan,Type)
-    getTypeLHsBind (L _spn FunBind{fun_id = pid,fun_matches = MG _ _})
-        = Just (Just (unLoc pid), getLocA pid,varType (unLoc pid))
-    getTypeLHsBind _ = Nothing
-
-    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsExpr's
-    getTypeLHsExpr :: LHsExpr GhcTc -> Maybe (Maybe Id,SrcSpan,Type)
-    getTypeLHsExpr e = Just (mid, getLocA e, lhsExprType e)
-      where
-        mid :: Maybe Id
-        mid | HsVar _ (L _ i) <- unwrapVar (unLoc e) = Just i
-            | otherwise                              = Nothing
-
-        unwrapVar (XExpr (WrapExpr (HsWrap _ var))) = var
-        unwrapVar e'                                = e'
-
-    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LPats's
-    getTypeLPat :: LPat GhcTc -> Maybe (Maybe Id,SrcSpan,Type)
-    getTypeLPat (L spn pat) = Just (getMaybeId pat,locA spn,hsPatType pat)
-      where
-        getMaybeId :: Pat GhcTc -> Maybe Id
-        getMaybeId (VarPat _ (L _ vid)) = Just vid
-        getMaybeId _                        = Nothing
-
-    -- | Get ALL source spans in the source.
-    listifyAllSpans :: Typeable a => TypecheckedSource -> [LocatedA a]
-    listifyAllSpans = everythingAllSpans (++) [] ([] `mkQ` (\x -> [x | p x]))
-      where
-        p (L spn _) = isGoodSrcSpan (locA spn)
-
-    -- | Variant of @syb@'s @everything@ (which summarises all nodes
-    -- in top-down, left-to-right order) with a stop-condition on 'NameSet's
-    -- and 'OverLitTc'
-    everythingAllSpans :: (r -> r -> r) -> r -> GenericQ r -> GenericQ r
-    everythingAllSpans k z f x
-      | (False `mkQ` (const True :: NameSet -> Bool)) x = z
-      -- Exception for OverLitTc: we have SrcSpans in the ol_witness field,
-      -- but it's there only for HIE file info (see Note [Source locations for implicit function calls]).
-      -- T16804 fails without this.
-      | (False `mkQ` (const True :: OverLitTc -> 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-9.10/Clash/GHCi/UI/Monad.hs b/src-bin-9.10/Clash/GHCi/UI/Monad.hs
deleted file mode 100644
--- a/src-bin-9.10/Clash/GHCi/UI/Monad.hs
+++ /dev/null
@@ -1,575 +0,0 @@
-{-# LANGUAGE FlexibleInstances, DeriveFunctor, DerivingVia #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
------------------------------------------------------------------------------
---
--- Monadery code used in InteractiveUI
---
--- (c) The GHC Team 2005-2006
---
------------------------------------------------------------------------------
-
-module Clash.GHCi.UI.Monad (
-        GHCi(..), startGHCi,
-        GHCiState(..), GhciMonad(..),
-        GHCiOption(..), isOptionSet, setOption, unsetOption,
-        Command(..), CommandResult(..), cmdSuccess,
-        CmdExecOutcome(..),
-        LocalConfigBehaviour(..),
-        PromptFunction,
-        BreakLocation(..),
-        TickArray,
-        extractDynFlags, getDynFlags,
-
-        runStmt, runDecls, runDecls', resume, recordBreak, revertCAFs,
-        ActionStats(..), runAndPrintStats, runWithStats, printStats,
-
-        printForUserNeverQualify,
-        printForUserModInfo, printForUserGlobalRdrEnv,
-        printForUser, printForUserPartWay, prettyLocations,
-
-        compileGHCiExpr,
-        initInterpBuffering,
-        turnOffBuffering, turnOffBuffering_,
-        flushInterpBuffers,
-        runInternal,
-        mkEvalWrapper
-    ) where
-
-import Clash.GHCi.UI.Info (ModInfo)
-import qualified GHC
-import GHC.Driver.Monad hiding (liftIO)
-import GHC.Utils.Outputable
-import qualified GHC.Driver.Ppr as Ppr
-import GHC.Types.Name.Occurrence
-import GHC.Types.Name.Reader
-import GHC.Driver.Session
-import GHC.Data.FastString
-import GHC.Driver.Env
-import GHC.Types.SrcLoc
-import GHC.Types.SafeHaskell
-import GHC.Driver.Make (ModIfaceCache(..))
-import GHC.Unit
-import GHC.Types.Name.Reader as RdrName (mkOrig)
-import qualified GHC.Types.Name.Ppr as Ppr (mkNamePprCtx)
-import GHC.Builtin.Names (gHC_INTERNAL_GHCI_HELPERS)
-import GHC.Runtime.Interpreter
-import GHC.Runtime.Context
-import GHCi.RemoteTypes
-import Clash.GHCi.UI.Exception (printGhciException)
-import GHC.Hs (ImportDecl, GhcPs, GhciLStmt, LHsDecl)
-import GHC.Hs.Utils
-import GHC.Utils.Misc
-import GHC.Utils.Logger
-
-import GHC.Utils.Exception hiding (uninterruptibleMask, mask, catch)
-import Numeric
-import Data.Array
-import Data.IORef
-import Data.Time
-import System.Environment
-import System.IO
-import Control.Monad
-import Prelude hiding ((<>))
-
-import System.Console.Haskeline (CompletionFunc, InputT)
-import Control.Monad.Catch as MC
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Reader
-import Control.Monad.IO.Class
-import Data.Map.Strict (Map)
-import qualified Data.IntMap.Strict as IntMap
-import qualified GHC.Data.EnumSet as EnumSet
-import qualified GHC.LanguageExtensions as LangExt
-
------------------------------------------------------------------------------
--- GHCi monad
-
-data GHCiState = GHCiState
-     {
-        progname       :: String,
-        args           :: [String],
-        evalWrapper    :: ForeignHValue, -- ^ of type @IO a -> IO a@
-        prompt         :: PromptFunction,
-        prompt_cont    :: PromptFunction,
-        editor         :: String,
-        stop           :: String,
-        multiMode      :: Bool,
-        localConfig    :: LocalConfigBehaviour,
-        options        :: [GHCiOption],
-        line_number    :: !Int,         -- ^ input line
-        break_ctr      :: !Int,
-        breaks         :: !(IntMap.IntMap 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
-        cmd_wrapper    :: InputT GHCi CommandResult -> InputT GHCi (Maybe Bool),
-            -- ^ The command wrapper is run for each command or statement.
-            -- The 'Bool' value denotes whether the command is successful and
-            -- 'Nothing' means to exit GHCi.
-        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.
-
-        extra_imports  :: [ImportDecl GhcPs],
-            -- ^ These are "always-on" imports, added to the
-            -- context regardless of what other imports we have.
-            -- This is useful for adding imports that are required
-            -- by setGHCiMonad.  Be careful adding things here:
-            -- you can create ambiguities if these imports overlap
-            -- with other things in scope.
-            --
-            -- NB. although this is not currently used by GHCi itself,
-            -- it was added to support other front-ends that are based
-            -- on the GHCi code.  Potentially we could also expose
-            -- this functionality via GHCi commands.
-
-        prelude_imports :: [ImportDecl GhcPs],
-            -- ^ These imports are added to the context when
-            -- -XImplicitPrelude is on and we don't have a *-module
-            -- in the context.  They can also be overridden by another
-            -- import for the same module, e.g.
-            -- "import Prelude hiding (map)"
-
-        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
-        ifaceCache :: ModIfaceCache
-     }
-
-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 CmdExecOutcome
-     -- ^ The 'CmdExecOutcome' value denotes whether to exit GHCi cleanly or error out
-   , 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
-   }
-
--- | Used to denote GHCi command execution result. Specifically, used to
--- distinguish between two ghci execution modes - "REPL" and "Expression
--- evaluation mode (ghc -e)". When in "REPL" mode, we don't want to exit
--- GHCi session when error occurs, (which is when we use "CmdSuccess").
--- Otherwise, when in expression evaluation mode, all command failures
--- should lead to GHCi session termination (with ExitFailure 1) which is
--- when "CmdFailure" is used(this is useful when executing scripts).
--- "CleanExit" is used to signal end of GHCi session (for example, when
--- ":quit" command is called).
-data CmdExecOutcome
-  = CleanExit
-  | CmdSuccess
-  | CmdFailure
-
-data CommandResult
-   = CommandComplete
-   { cmdInput :: String
-   , cmdResult :: Either SomeException (Maybe Bool)
-   , cmdStats :: ActionStats
-   }
-   | CommandIncomplete
-     -- ^ Unterminated multiline command
-   deriving Show
-
-cmdSuccess :: MonadThrow m => CommandResult -> m (Maybe Bool)
-cmdSuccess CommandComplete{ cmdResult = Left e } = throwM e
-cmdSuccess CommandComplete{ cmdResult = Right r } = return r
-cmdSuccess CommandIncomplete = return $ Just True
-
-type PromptFunction = [String]
-                   -> Int
-                   -> GHCi SDoc
-
-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
-
--- | Treatment of ./.ghci files.  For now we either load or
--- ignore.  But later we could implement a "safe mode" where
--- only safe operations are performed.
---
-data LocalConfigBehaviour
-  = SourceLocalConfig
-  | IgnoreLocalConfig
-  deriving (Eq)
-
-data BreakLocation
-   = BreakLocation
-   { breakModule :: !GHC.Module
-   , breakLoc    :: !SrcSpan
-   , breakTick   :: {-# UNPACK #-} !Int
-   , breakEnabled:: !Bool
-   , onBreakCmd  :: String
-   }
-
-instance Eq BreakLocation where
-  loc1 == loc2 = breakModule loc1 == breakModule loc2 &&
-                 breakTick loc1   == breakTick loc2
-
-prettyLocations :: IntMap.IntMap BreakLocation -> SDoc
-prettyLocations  locs =
-    case  IntMap.null locs of
-      True  -> text "No active breakpoints."
-      False -> vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ IntMap.toAscList locs
-
-instance Outputable BreakLocation where
-   ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
-                if null (onBreakCmd loc)
-                   then empty
-                   else doubleQuotes (text (onBreakCmd loc))
-      where pprEnaDisa = case breakEnabled loc of
-                True  -> text "enabled"
-                False -> text "disabled"
-
-recordBreak
-  :: GhciMonad m => BreakLocation -> m (Bool{- was already present -}, Int)
-recordBreak brkLoc = do
-   st <- getGHCiState
-   let oldmap = breaks st
-       oldActiveBreaks = IntMap.assocs oldmap
-   -- 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 = IntMap.insert oldCounter brkLoc oldmap
-                        }
-      return (False, oldCounter)
-
-newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> Ghc a }
-    deriving (Functor)
-    deriving (MonadThrow, MonadCatch, MonadMask) via (ReaderT (IORef GHCiState) Ghc)
-
-reflectGHCi :: (Session, IORef GHCiState) -> GHCi a -> IO a
-reflectGHCi (s, gs) m = unGhc (unGHCi m gs) s
-
-startGHCi :: GHCi a -> GHCiState -> Ghc a
-startGHCi g state = do ref <- liftIO $ newIORef state; unGHCi g ref
-
-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 GhcMonad m => GhciMonad m where
-  getGHCiState    :: m GHCiState
-  setGHCiState    :: GHCiState -> m ()
-  modifyGHCiState :: (GHCiState -> GHCiState) -> m ()
-  reifyGHCi       :: ((Session, IORef GHCiState) -> IO a) -> m a
-
-instance GhciMonad GHCi where
-  getGHCiState      = GHCi $ \r -> liftIO $ readIORef r
-  setGHCiState s    = GHCi $ \r -> liftIO $ writeIORef r s
-  modifyGHCiState f = GHCi $ \r -> liftIO $ modifyIORef' r f
-  reifyGHCi f       = GHCi $ \r -> reifyGhc $ \s -> f (s, r)
-
-instance GhciMonad (InputT GHCi) where
-  getGHCiState    = lift getGHCiState
-  setGHCiState    = lift . setGHCiState
-  modifyGHCiState = lift . modifyGHCiState
-  reifyGHCi       = lift . reifyGHCi
-
-liftGhc :: Ghc a -> GHCi a
-liftGhc m = GHCi $ \_ -> m
-
-instance MonadIO GHCi where
-  liftIO = liftGhc . liftIO
-
-instance HasDynFlags GHCi where
-  getDynFlags = getSessionDynFlags
-
-instance HasLogger GHCi where
-  getLogger = hsc_logger <$> getSession
-
-instance GhcMonad GHCi where
-  setSession s' = liftGhc $ setSession s'
-  getSession    = liftGhc $ getSession
-
-
-instance HasDynFlags (InputT GHCi) where
-  getDynFlags = lift getDynFlags
-
-instance HasLogger (InputT GHCi) where
-  getLogger = lift getLogger
-
-instance GhcMonad (InputT GHCi) where
-  setSession = lift . setSession
-  getSession = lift getSession
-
-isOptionSet :: GhciMonad m => GHCiOption -> m Bool
-isOptionSet opt
- = do st <- getGHCiState
-      return $! (opt `elem` options st)
-
-setOption :: GhciMonad m => GHCiOption -> m ()
-setOption opt
- = do st <- getGHCiState
-      setGHCiState (st{ options = opt : filter (/= opt) (options st) })
-
-unsetOption :: GhciMonad m => GHCiOption -> m ()
-unsetOption opt
- = do st <- getGHCiState
-      setGHCiState (st{ options = filter (/= opt) (options st) })
-
-printForUserNeverQualify :: GhcMonad m => SDoc -> m ()
-printForUserNeverQualify doc = do
-  dflags <- GHC.getInteractiveDynFlags
-  liftIO $ Ppr.printForUser dflags stdout neverQualify AllTheWay doc
-
-printForUserModInfo :: GhcMonad m => GHC.ModuleInfo -> SDoc -> m ()
-printForUserModInfo info = printForUserGlobalRdrEnv (GHC.modInfoRdrEnv info)
-
-printForUserGlobalRdrEnv :: (GhcMonad m, Outputable info)
-                         => Maybe (GlobalRdrEnvX info) -> SDoc -> m ()
-printForUserGlobalRdrEnv mb_rdr_env doc = do
-  dflags <- GHC.getInteractiveDynFlags
-  name_ppr_ctx <- mkNamePprCtxFromGlobalRdrEnv dflags mb_rdr_env
-  liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx AllTheWay doc
-    where
-      mkNamePprCtxFromGlobalRdrEnv _ Nothing = GHC.getNamePprCtx
-      mkNamePprCtxFromGlobalRdrEnv dflags (Just rdr_env) =
-        withSession $ \ hsc_env ->
-        let unit_env = hsc_unit_env hsc_env
-            ptc = initPromotionTickContext dflags
-        in  return $ Ppr.mkNamePprCtx ptc unit_env rdr_env
-
-printForUser :: GhcMonad m => SDoc -> m ()
-printForUser doc = do
-  name_ppr_ctx <- GHC.getNamePprCtx
-  dflags <- GHC.getInteractiveDynFlags
-  liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx AllTheWay doc
-
-printForUserPartWay :: GhcMonad m => SDoc -> m ()
-printForUserPartWay doc = do
-  name_ppr_ctx <- GHC.getNamePprCtx
-  dflags <- GHC.getInteractiveDynFlags
-  liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx DefaultDepth doc
-
--- | Run a single Haskell expression
-runStmt
-  :: GhciMonad m
-  => GhciLStmt GhcPs -> String -> GHC.SingleStep -> m (Maybe GHC.ExecResult)
-runStmt stmt stmt_text step = do
-  st <- getGHCiState
-  GHC.handleSourceError (\e -> do printGhciException 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' stmt stmt_text opts
-
-runDecls :: GhciMonad m => String -> m (Maybe [GHC.Name])
-runDecls decls = do
-  st <- getGHCiState
-  reifyGHCi $ \x ->
-    withProgName (progname st) $
-    withArgs (args st) $
-      reflectGHCi x $ do
-        GHC.handleSourceError (\e -> do printGhciException e
-                                        return Nothing) $ do
-          r <- GHC.runDeclsWithLocation (progname st) (line_number st) decls
-          return (Just r)
-
-runDecls' :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe [GHC.Name])
-runDecls' decls = do
-  st <- getGHCiState
-  reifyGHCi $ \x ->
-    withProgName (progname st) $
-    withArgs (args st) $
-    reflectGHCi x $
-      GHC.handleSourceError
-        (\e -> do printGhciException e
-                  return Nothing)
-        (Just <$> GHC.runParsedDecls decls)
-
-resume :: GhciMonad m => (SrcSpan -> Bool) -> GHC.SingleStep -> Maybe Int -> m GHC.ExecResult
-resume canLogSpan step mbIgnoreCnt = do
-  st <- getGHCiState
-  reifyGHCi $ \x ->
-    withProgName (progname st) $
-    withArgs (args st) $
-      reflectGHCi x $ do
-        GHC.resumeExec canLogSpan step mbIgnoreCnt
-
--- --------------------------------------------------------------------------
--- timing & statistics
-
-data ActionStats = ActionStats
-  { actionAllocs :: Maybe Integer
-  , actionElapsedTime :: Double
-  } deriving Show
-
-runAndPrintStats
-  :: GhciMonad m
-  => (a -> Maybe Integer)
-  -> m a
-  -> m (ActionStats, Either SomeException a)
-runAndPrintStats getAllocs action = do
-  result <- runWithStats getAllocs action
-  case result of
-    (stats, Right{}) -> do
-      showTiming <- isOptionSet ShowTiming
-      when showTiming $ do
-        dflags  <- getDynFlags
-        liftIO $ printStats dflags stats
-    _ -> return ()
-  return result
-
-runWithStats
-  :: ExceptionMonad m
-  => (a -> Maybe Integer) -> m a -> m (ActionStats, Either SomeException a)
-runWithStats getAllocs action = do
-  t0 <- liftIO getCurrentTime
-  result <- MC.try action
-  let allocs = either (const Nothing) getAllocs result
-  t1 <- liftIO getCurrentTime
-  let elapsedTime = realToFrac $ t1 `diffUTCTime` t0
-  return (ActionStats allocs elapsedTime, result)
-
-printStats :: DynFlags -> ActionStats -> IO ()
-printStats dflags ActionStats{actionAllocs = mallocs, actionElapsedTime = secs}
-   = do let secs_str = showFFloat (Just 2) secs
-        putStrLn (Ppr.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 . separate . reverse . show $ n
-      where separate n'
-              | n' `lengthAtMost` 3 = n'
-              | otherwise           = take 3 n' ++ "," ++ separate (drop 3 n')
-
------------------------------------------------------------------------------
--- reverting CAFs
-
-revertCAFs :: GhciMonad m => m ()
-revertCAFs = do
-  interp <- hscInterp <$> GHC.getSession
-  liftIO $ interpCmd interp RtsRevertCAFs
-  s <- getGHCiState
-  when (not (ghc_e s)) turnOffBuffering
-     -- Have to turn off buffering again, because we just
-     -- reverted stdout, stderr & stdin to their defaults.
-
-
------------------------------------------------------------------------------
--- 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
-  let mkHelperExpr :: OccName -> Ghc ForeignHValue
-      mkHelperExpr occ =
-        GHC.compileParsedExprRemote
-        $ GHC.nlHsVar $ RdrName.mkOrig gHC_INTERNAL_GHCI_HELPERS occ
-  nobuf <- mkHelperExpr $ mkVarOccFS (fsLit "disableBuffering")
-  flush <- mkHelperExpr $ mkVarOccFS (fsLit "flushAll")
-  return (nobuf, flush)
-
--- | Invoke "hFlush stdout; hFlush stderr" in the interpreter
-flushInterpBuffers :: GhciMonad m => m ()
-flushInterpBuffers = do
-  st <- getGHCiState
-  interp <- hscInterp <$> GHC.getSession
-  liftIO $ evalIO interp (flushStdHandles st)
-
--- | Turn off buffering for stdin, stdout, and stderr in the interpreter
-turnOffBuffering :: GhciMonad m => m ()
-turnOffBuffering = do
-  st <- getGHCiState
-  turnOffBuffering_ (noBuffering st)
-
-turnOffBuffering_ :: GhcMonad m => ForeignHValue -> m ()
-turnOffBuffering_ fhv = do
-  interp <- hscInterp <$> getSession
-  liftIO $ evalIO interp fhv
-
-mkEvalWrapper :: GhcMonad m => String -> [String] ->  m ForeignHValue
-mkEvalWrapper progname' args' =
-  runInternal $ GHC.compileParsedExprRemote
-  $ evalWrapper' `GHC.mkHsApp` nlHsString progname'
-                 `GHC.mkHsApp` nlList (map nlHsString args')
-  where
-    nlHsString = nlHsLit . mkHsString
-    evalWrapper' =
-      GHC.nlHsVar $ RdrName.mkOrig gHC_INTERNAL_GHCI_HELPERS (mkVarOccFS (fsLit "evalWrapper"))
-
--- | Run a 'GhcMonad' action to compile an expression for internal usage.
-runInternal :: GhcMonad m => m a -> m a
-runInternal =
-    withTempSession mkTempSession
-  where
-    mkTempSession = hscUpdateFlags (\dflags -> dflags
-      { -- Running GHCi's internal expression is incompatible with -XSafe.
-          -- We temporarily disable any Safe Haskell settings while running
-          -- GHCi internal expressions. (see #12509)
-        safeHaskell = Sf_None,
-          -- Disable dumping of any data during evaluation of GHCi's internal
-          -- expressions. (#17500)
-        dumpFlags = EnumSet.empty
-      }
-        -- RebindableSyntax can wreak havoc with GHCi in several ways
-          -- (see #13385 and #14342 for examples), so we temporarily
-          -- disable it too.
-          `xopt_unset` LangExt.RebindableSyntax
-          -- We heavily depend on -fimplicit-import-qualified to compile expr
-          -- with fully qualified names without imports.
-          `gopt_set` Opt_ImplicitImportQualified
-      )
-
-compileGHCiExpr :: GhcMonad m => String -> m ForeignHValue
-compileGHCiExpr expr = runInternal $ GHC.compileExprRemote expr
diff --git a/src-bin-9.10/Clash/GHCi/Util.hs b/src-bin-9.10/Clash/GHCi/Util.hs
deleted file mode 100644
--- a/src-bin-9.10/Clash/GHCi/Util.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-{-# LANGUAGE MagicHash, UnboxedTuples #-}
-
--- | Utilities for GHCi.
-module Clash.GHCi.Util where
-
--- NOTE: Avoid importing GHC modules here, because the primary purpose
--- of this module is to not use UnboxedTuples in a module that imports
--- lots of other modules.  See issue#13101 for more info.
-
-import GHC.Exts
-import GHC.Types
-
-anyToPtr :: a -> IO (Ptr ())
-anyToPtr x =
-  IO (\s -> case anyToAddr# x s of
-              (# s', addr #) -> (# s', Ptr addr #)) :: IO (Ptr ())
diff --git a/src-bin-9.10/Clash/Main.hs b/src-bin-9.10/Clash/Main.hs
deleted file mode 100644
--- a/src-bin-9.10/Clash/Main.hs
+++ /dev/null
@@ -1,1240 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NondecreasingIndentation #-}
-{-# LANGUAGE TupleSections #-}
-{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
-
------------------------------------------------------------------------------
---
--- GHC Driver program
---
--- (c) The University of Glasgow 2005
---
------------------------------------------------------------------------------
-
-module Clash.Main (defaultMain, defaultMainWithAction) where
-
--- The official GHC API
-import qualified GHC
-import GHC              (parseTargetFiles,  Ghc, GhcMonad(..),
-                          LoadHowMuch(..) )
-
-import GHC.Driver.Backend
-import GHC.Driver.CmdLine
-import GHC.Driver.Env
-import GHC.Driver.Errors
-import GHC.Driver.Errors.Types
-import GHC.Driver.Phases
-import GHC.Driver.Session
-import GHC.Driver.Ppr
-import GHC.Driver.Pipeline  ( oneShot, compileFile )
-import GHC.Driver.MakeFile  ( doMkDependHS )
-import GHC.Driver.Backpack  ( doBackpack )
-import GHC.Driver.Plugins
-import GHC.Driver.Config.Logger (initLogFlags)
-import GHC.Driver.Config.Diagnostic
-
-import GHC.Platform
-import GHC.Platform.Ways
-import GHC.Platform.Host
-
-#if defined(HAVE_INTERNAL_INTERPRETER)
-import Clash.GHCi.UI        ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )
-#endif
-
-import GHC.Runtime.Loader   ( loadFrontendPlugin, initializeSessionPlugins )
-
-import GHC.Unit.Env
-import GHC.Unit (UnitId, homeUnitDepends)
-import GHC.Unit.Home.ModInfo (emptyHomePackageTable)
-import GHC.Unit.Module ( ModuleName, mkModuleName )
-import GHC.Unit.Module.ModIface
-import GHC.Unit.State  ( pprUnits, pprUnitsSimple )
-import GHC.Unit.Finder ( findImportedModule, FindResult(..) )
-import qualified GHC.Unit.State as State
-import GHC.Unit.Types  ( IsBootInterface(..) )
-
-import GHC.Types.Basic     ( failed )
-import GHC.Types.SrcLoc
-import GHC.Types.SourceError
-import GHC.Types.Unique.Supply
-import GHC.Types.PkgQual
-
-import GHC.Utils.Error
-import GHC.Utils.Misc
-import GHC.Utils.Panic
-import GHC.Utils.Outputable as Outputable
-import GHC.Utils.Monad       ( liftIO, mapMaybeM )
-import GHC.Utils.Binary        ( openBinMem, put_ )
-import GHC.Utils.Logger
-
-import GHC.Settings.Config
-import GHC.Settings.Constants
-import GHC.Settings.IO
-
-import GHC.HandleEncoding
-import GHC.Data.FastString
-import GHC.SysTools.BaseDir
-
-import GHC.Iface.Load
-import GHC.Iface.Recomp.Binary ( fingerprintBinMem )
-
-import GHC.Tc.Utils.Monad      ( initIfaceCheck )
-import GHC.Iface.Errors.Ppr
-
--- Standard Haskell libraries
-import System.IO
-import System.Environment
-import System.Exit
-import System.FilePath
-import Control.Monad
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Except (throwE, runExceptT)
-import Data.Char
-import Data.List ( partition, intercalate, (\\) )
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import Data.Maybe
-import Prelude
-import GHC.ResponseFile (expandResponse)
-import Data.Bifunctor
-import GHC.Data.Graph.Directed
-import qualified Data.List.NonEmpty as NE
-
--- clash additions
-import           Paths_clash_ghc
-import           Clash.GHCi.UI (makeHDL)
-import           Control.Monad.Catch (catch)
-import           Data.List (nub)
-import           Data.Proxy
-import           Data.IORef (IORef, newIORef, readIORef, modifyIORef')
-import qualified Data.Version (showVersion)
-import           GHC.Data.EnumSet as EnumSet
-import           GHC.Driver.Session as Session
-
-import           Clash.Backend (Backend)
-import           Clash.Backend.SystemVerilog (SystemVerilogState)
-import           Clash.Backend.VHDL    (VHDLState)
-import           Clash.Backend.Verilog (VerilogState)
-import           Clash.Driver.Types
-  (ClashOpts (..), defClashOpts)
-import           Clash.GHC.ClashFlags
-import           Clash.Util (clashLibVersion)
-import           Clash.GHC.LoadModules (ghcLibDir, setWantedLanguageExtensions)
-import           Clash.GHC.Util (handleClashException)
-
------------------------------------------------------------------------------
--- ToDo:
-
--- time commands when run with -v
--- user ways
--- Win32 support: proper signal handling
--- reading the package configuration file is too slow
--- -K<size>
-
------------------------------------------------------------------------------
--- GHC's command-line interface
-
-defaultMain :: [String] -> IO ()
-defaultMain = defaultMainWithAction (return ())
-
-defaultMainWithAction :: Ghc () -> [String] -> IO ()
-defaultMainWithAction startAction = flip withArgs $ do
-   hSetBuffering stdout LineBuffering
-   hSetBuffering stderr LineBuffering
-
-   configureHandleEncoding
-   GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
-    -- 1. extract the -B flag from the args
-    argv0 <- getArgs
-
-    let argv1 = map (mkGeneralLocated "on the commandline") argv0
-    libDir <- ghcLibDir
-
-    r <- newIORef defClashOpts
-    (argv2, clashFlagWarnings) <- parseClashFlags r argv1
-
-    -- 2. Parse the "mode" flags (--make, --interactive etc.)
-    (mode, units, argv3, modeFlagWarnings) <- parseModeFlags argv2
-    let flagWarnings = modeFlagWarnings ++ clashFlagWarnings
-
-    -- If all we want to do is something like showing the version number
-    -- then do it now, before we start a GHC session etc. This makes
-    -- getting basic information much more resilient.
-
-    -- In particular, if we wait until later before giving the version
-    -- number then bootstrapping gets confused, as it tries to find out
-    -- what version of GHC it's using before package.conf exists, so
-    -- starting the session fails.
-    case mode of
-        Left preStartupMode ->
-            do case preStartupMode of
-                   ShowSupportedExtensions   -> showSupportedExtensions (Just libDir)
-                   ShowVersion               -> showVersion
-                   ShowNumVersion            -> putStrLn cProjectVersion
-                   ShowOptions isInteractive -> showOptions isInteractive r
-        Right postStartupMode ->
-            -- start our GHC session
-            GHC.runGhc (Just libDir) $ do
-
-            dflags <- GHC.getSessionDynFlags
-            let dflagsExtra = setWantedLanguageExtensions dflags
-
-                ghcTyLitNormPlugin = GHC.mkModuleName "GHC.TypeLits.Normalise"
-                ghcTyLitExtrPlugin = GHC.mkModuleName "GHC.TypeLits.Extra.Solver"
-                ghcTyLitKNPlugin   = GHC.mkModuleName "GHC.TypeLits.KnownNat.Solver"
-                dflagsExtra1 = dflagsExtra
-                                  { Session.pluginModNames = nub $
-                                      ghcTyLitNormPlugin : ghcTyLitExtrPlugin :
-                                      ghcTyLitKNPlugin :
-                                      Session.pluginModNames dflagsExtra
-                                  }
-
-            case postStartupMode of
-                Left preLoadMode ->
-                    liftIO $ do
-                        case preLoadMode of
-                            ShowInfo               -> showInfo dflagsExtra1
-                            ShowGhcUsage           -> showGhcUsage  dflagsExtra1
-                            ShowGhciUsage          -> showGhciUsage dflagsExtra1
-                            PrintWithDynFlags f    -> putStrLn (f dflagsExtra1)
-                Right postLoadMode ->
-                    main' postLoadMode units dflagsExtra1 argv3 flagWarnings startAction r
-
-main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn]
-      -> Ghc () -> IORef ClashOpts
-      -> Ghc ()
-main' postLoadMode units dflags0 args flagWarnings startAction clashOpts = do
-  let args' = case postLoadMode of
-                DoRun -> takeWhile (\arg -> unLoc arg /= "--") args
-                _     -> args
-
-  -- set the default GhcMode, backend and GhcLink.  The backend
-  -- can be further adjusted on a module by module basis, using only
-  -- the -fllvm and -fasm flags.  If the default backend is not
-  -- LLVM or NCG, -fllvm and -fasm have no effect.
-  let dflt_backend = backend dflags0
-      (mode, bcknd, link)
-         = case postLoadMode of
-               DoInteractive   -> (CompManager, interpreterBackend,  LinkInMemory)
-               DoEval _        -> (CompManager, interpreterBackend,  LinkInMemory)
-               DoRun           -> (CompManager, interpreterBackend,  LinkInMemory)
-               DoMake          -> (CompManager, dflt_backend, LinkBinary)
-               DoBackpack      -> (CompManager, dflt_backend, LinkBinary)
-               DoMkDependHS    -> (MkDepend,    dflt_backend, LinkBinary)
-               DoAbiHash       -> (OneShot,     dflt_backend, LinkBinary)
-               DoVHDL          -> (CompManager, noBackend,     NoLink)
-               DoVerilog       -> (CompManager, noBackend,     NoLink)
-               DoSystemVerilog -> (CompManager, noBackend,     NoLink)
-               _               -> (OneShot,     dflt_backend, LinkBinary)
-
-  let dflags1 = dflags0{ ghcMode   = mode,
-                         backend   = bcknd,
-                         ghcLink   = link,
-                         verbosity = case postLoadMode of
-                                         DoEval _ -> 0
-                                         DoRun    -> 0
-                                         _other   -> 1
-                        }
-
-      -- turn on -fimplicit-import-qualified for GHCi now, so that it
-      -- can be overridden from the command-line
-      -- XXX: this should really be in the interactive DynFlags, but
-      -- we don't set that until later in interactiveUI
-      -- We also set -fignore-optim-changes and -fignore-hpc-changes,
-      -- which are program-level options. Again, this doesn't really
-      -- feel like the right place to handle this, but we don't have
-      -- a great story for the moment.
-      dflags2  | DoInteractive <- postLoadMode = def_ghci_flags
-               | DoEval _      <- postLoadMode = def_ghci_flags
-               | DoRun         <- postLoadMode = def_ghci_flags
-               | otherwise                     = dflags1
-        where def_ghci_flags = dflags1 `gopt_set` Opt_ImplicitImportQualified
-                                       `gopt_set` Opt_IgnoreOptimChanges
-                                       `gopt_set` Opt_IgnoreHpcChanges
-                                       -- Setting this by default has the nice effect that
-                                       -- -fno-code and --interactive falls back to interpreter rather than
-                                       -- object code but has little other effect unless you are also using
-                                       -- fat interface files.
-                                       `gopt_set` Opt_UseBytecodeRatherThanObjects
-                                       -- By default enable the debugger by inserting breakpoints
-                                       `gopt_set` Opt_InsertBreakpoints
-
-  logger1 <- getLogger
-  let logger2 = setLogFlags logger1 (initLogFlags dflags2)
-
-        -- The rest of the arguments are "dynamic"
-        -- Leftover ones are presumably files
-  (dflags3, fileish_args, dynamicFlagWarnings) <-
-      GHC.parseDynamicFlags logger2 dflags2 args'
-
--- Propagate -Werror to Clash
-  liftIO . modifyIORef' clashOpts $ \opts ->
-    opts { opt_werror = EnumSet.member Opt_WarnIsError (generalFlags dflags3) }
-
-  let dflags4 = if backendNeedsFullWays bcknd &&
-                   not (gopt Opt_ExternalInterpreter dflags3)
-                then
-                    let platform = targetPlatform dflags3
-                        dflags3a = dflags3 { targetWays_ = hostFullWays }
-                        dflags3b = foldl gopt_set dflags3a
-                                 $ concatMap (wayGeneralFlags platform)
-                                             hostFullWays
-                        dflags3c = foldl gopt_unset dflags3b
-                                 $ concatMap (wayUnsetGeneralFlags platform)
-                                             hostFullWays
-                    in dflags3c
-                else
-                    dflags3
-
-  let logger4 = setLogFlags logger2 (initLogFlags dflags4)
-
-  GHC.prettyPrintGhcErrors logger4 $ do
-
-  let diag_opts = initDiagOpts dflags4
-  let flagWarnings' = GhcDriverMessage <$> mconcat [warnsToMessages diag_opts flagWarnings, dynamicFlagWarnings]
-
-  handleSourceError (\e -> do
-       GHC.printException e
-       liftIO $ exitWith (ExitFailure 1)) $ do
-         liftIO $ printOrThrowDiagnostics logger4 (initPrintConfig dflags4) diag_opts flagWarnings'
-
-  liftIO $ showBanner postLoadMode dflags4
-
-  let (dflags5, srcs, objs) = parseTargetFiles dflags4 (map unLoc fileish_args)
-
-  -- we've finished manipulating the DynFlags, update the session
-  _ <- GHC.setSessionDynFlags dflags5
-  dflags6 <- GHC.getSessionDynFlags
-
-  -- Must do this before loading plugins
-  liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6)
-
-  -- Initialise plugins here because the plugin author might already expect this
-  -- subsequent call to `getLogger` to be affected by a plugin.
-  initializeSessionPlugins
-  hsc_env <- getSession
-  logger <- getLogger
-
-
-        ---------------- Display configuration -----------
-  case verbosity dflags6 of
-    v | v == 4 -> liftIO $ dumpUnitsSimple hsc_env
-      | v >= 5 -> liftIO $ dumpUnits       hsc_env
-      | otherwise -> return ()
-
-        ---------------- Final sanity checking -----------
-  liftIO $ checkOptions postLoadMode dflags6 srcs objs units
-
-  ---------------- Do the business -----------
-  handleSourceError (\e -> do
-       GHC.printException e
-       liftIO $ exitWith (ExitFailure 1)) $ do
-    clashOpts' <- liftIO (readIORef clashOpts)
-    let clash fun = catch (fun startAction clashOpts srcs) (handleClashException dflags6 clashOpts')
-    case postLoadMode of
-       ShowInterface f        -> liftIO $ showIface logger
-                                                    (hsc_dflags hsc_env)
-                                                    (hsc_units  hsc_env)
-                                                    (hsc_NC     hsc_env)
-                                                    f
-       DoMake                 -> doMake units srcs
-       DoMkDependHS           -> doMkDependHS (map fst srcs)
-       StopBefore p           -> liftIO (oneShot hsc_env p srcs)
-       DoInteractive          -> ghciUI clashOpts units srcs Nothing
-       DoEval exprs           -> ghciUI clashOpts units srcs $ Just $ reverse exprs
-       DoRun                  -> doRun clashOpts units srcs args
-       DoAbiHash              -> abiHash (map fst srcs)
-       ShowPackages           -> liftIO $ showUnits hsc_env
-       DoFrontend f           -> doFrontend f srcs
-       DoBackpack             -> doBackpack (map fst srcs)
-       DoVHDL                 -> clash makeVHDL
-       DoVerilog              -> clash makeVerilog
-       DoSystemVerilog        -> clash makeSystemVerilog
-
-  liftIO $ dumpFinalStats logger
-
-doRun :: IORef ClashOpts -> [String] -> [(FilePath, Maybe Phase)] -> [Located String] -> Ghc ()
-doRun clashOpts units srcs args = do
-    dflags <- getDynFlags
-    let mainFun = fromMaybe "main" (mainFunIs dflags)
-    ghciUI clashOpts units srcs (Just ["System.Environment.withArgs " ++ show args' ++ " (Control.Monad.void " ++ mainFun ++ ")"])
-  where
-    args' = drop 1 $ dropWhile (/= "--") $ map unLoc args
-
-ghciUI :: IORef ClashOpts -> [String] -> [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc ()
-#if !defined(HAVE_INTERNAL_INTERPRETER)
-ghciUI _ _ _ _ =
-  throwGhcException (CmdLineError "not built for interactive use")
-#else
-ghciUI clashOpts units srcs maybe_expr = do
-  hs_srcs <- case NE.nonEmpty units of
-    Just ne_units -> do
-      initMulti ne_units
-    Nothing -> do
-      case srcs of
-        [] -> return []
-        _  -> do
-          s <- initMake srcs
-          return $ map (uncurry (,Nothing,)) s
-  interactiveUI (defaultGhciSettings clashOpts) hs_srcs maybe_expr
-#endif
-
-
--- -----------------------------------------------------------------------------
--- Option sanity checks
-
--- | Ensure sanity of options.
---
--- Throws 'UsageError' or 'CmdLineError' if not.
-checkOptions :: PostLoadMode -> DynFlags -> [(String,Maybe Phase)] -> [String] -> [String] -> IO ()
-     -- Final sanity checking before kicking off a compilation (pipeline).
-checkOptions mode dflags srcs objs units = do
-     -- Complain about any unknown flags
-   let unknown_opts = [ f | (f@('-':_), _) <- srcs ]
-   when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
-
-   when (not (Set.null (rtsWays (ways dflags)))
-         && isInterpretiveMode mode) $
-        hPutStrLn stderr ("Warning: -debug, -threaded and -ticky are ignored by GHCi")
-
-        -- -prof and --interactive are not a good combination
-   when ((fullWays (ways dflags) /= hostFullWays)
-         && isInterpretiveMode mode
-         && not (gopt Opt_ExternalInterpreter dflags)) $
-      do throwGhcException (UsageError
-              "-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))
-        then throwGhcException (UsageError "-ohi can only be used when compiling a single source file")
-        else do
-
-   if (isJust (dynOutputHi dflags) &&
-      (isCompManagerMode mode || srcs `lengthExceeds` 1))
-     then throwGhcException (UsageError "-dynohi can only be used when compiling a single source file")
-     else do
-
-        -- -o sanity checking
-   if (srcs `lengthExceeds` 1 && isJust (outputFile dflags)
-         && not (isLinkMode mode))
-        then throwGhcException (UsageError "can't apply -o to multiple source files")
-        else do
-
-   let not_linking = not (isLinkMode mode) || isNoLink (ghcLink dflags)
-
-   when (not_linking && not (null objs)) $
-        hPutStrLn stderr ("Warning: the following files would be used as linker inputs, but linking is not being done: " ++ unwords objs)
-
-        -- Check that there are some input files
-        -- (except in the interactive case)
-   if null srcs && (null objs || not_linking) && needsInputsMode mode && null units
-        then throwGhcException (UsageError "no input files" )
-        else do
-
-   case mode of
-      StopBefore StopC | not (backendGeneratesHc (backend dflags))
-        -> throwGhcException $ UsageError $
-           "the option -C is only available with an unregisterised GHC"
-      StopBefore StopAs | ghcLink dflags == NoLink
-        -> throwGhcException $ UsageError $
-           "the options -S and -fno-code are incompatible. Please omit -S"
-
-      _ -> return ()
-
-     -- Verify that output files point somewhere sensible.
-   verifyOutputFiles dflags
-
--- Compiler output options
-
--- Called to verify that the output files point somewhere valid.
---
--- The assumption is that the directory portion of these output
--- options will have to exist by the time 'verifyOutputFiles'
--- is invoked.
---
--- We create the directories for -odir, -hidir, -outputdir etc. ourselves if
--- they don't exist, so don't check for those here (#2278).
-verifyOutputFiles :: DynFlags -> IO ()
-verifyOutputFiles dflags = do
-  let ofile = outputFile dflags
-  when (isJust ofile) $ do
-     let fn = fromJust ofile
-     flg <- doesDirNameExist fn
-     when (not flg) (nonExistentDir "-o" fn)
-  let ohi = outputHi dflags
-  when (isJust ohi) $ do
-     let hi = fromJust ohi
-     flg <- doesDirNameExist hi
-     when (not flg) (nonExistentDir "-ohi" hi)
- where
-   nonExistentDir flg dir =
-     throwGhcException (CmdLineError ("error: directory portion of " ++
-                             show dir ++ " does not exist (used with " ++
-                             show flg ++ " option.)"))
-
------------------------------------------------------------------------------
--- GHC modes of operation
-
-type Mode = Either PreStartupMode PostStartupMode
-type PostStartupMode = Either PreLoadMode PostLoadMode
-
-data PreStartupMode
-  = ShowVersion                          -- ghc -V/--version
-  | ShowNumVersion                       -- ghc --numeric-version
-  | ShowSupportedExtensions              -- ghc --supported-extensions
-  | ShowOptions Bool {- isInteractive -} -- ghc --show-options
-
-showVersionMode, showNumVersionMode, showSupportedExtensionsMode, showOptionsMode :: Mode
-showVersionMode             = mkPreStartupMode ShowVersion
-showNumVersionMode          = mkPreStartupMode ShowNumVersion
-showSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions
-showOptionsMode             = mkPreStartupMode (ShowOptions False)
-
-mkPreStartupMode :: PreStartupMode -> Mode
-mkPreStartupMode = Left
-
-isShowVersionMode :: Mode -> Bool
-isShowVersionMode (Left ShowVersion) = True
-isShowVersionMode _ = False
-
-isShowNumVersionMode :: Mode -> Bool
-isShowNumVersionMode (Left ShowNumVersion) = True
-isShowNumVersionMode _ = False
-
-data PreLoadMode
-  = ShowGhcUsage                           -- ghc -?
-  | ShowGhciUsage                          -- ghci -?
-  | ShowInfo                               -- ghc --info
-  | PrintWithDynFlags (DynFlags -> String) -- ghc --print-foo
-
-showGhcUsageMode, showGhciUsageMode, showInfoMode :: Mode
-showGhcUsageMode = mkPreLoadMode ShowGhcUsage
-showGhciUsageMode = mkPreLoadMode ShowGhciUsage
-showInfoMode = mkPreLoadMode ShowInfo
-
-printSetting :: String -> Mode
-printSetting k = mkPreLoadMode (PrintWithDynFlags f)
-    where f dflags = fromMaybe (panic ("Setting not found: " ++ show k))
-                   $ lookup k (compilerInfo dflags)
-
-mkPreLoadMode :: PreLoadMode -> Mode
-mkPreLoadMode = Right . Left
-
-isShowGhcUsageMode :: Mode -> Bool
-isShowGhcUsageMode (Right (Left ShowGhcUsage)) = True
-isShowGhcUsageMode _ = False
-
-isShowGhciUsageMode :: Mode -> Bool
-isShowGhciUsageMode (Right (Left ShowGhciUsage)) = True
-isShowGhciUsageMode _ = False
-
-data PostLoadMode
-  = ShowInterface FilePath  -- ghc --show-iface
-  | DoMkDependHS            -- ghc -M
-  | StopBefore StopPhase    -- ghc -E | -C | -S
-                            -- StopBefore StopLn is the default
-  | DoMake                  -- ghc --make
-  | DoBackpack              -- ghc --backpack foo.bkp
-  | DoInteractive           -- ghc --interactive
-  | DoEval [String]         -- ghc -e foo -e bar => DoEval ["bar", "foo"]
-  | DoRun                   -- ghc --run
-  | DoAbiHash               -- ghc --abi-hash
-  | ShowPackages            -- ghc --show-packages
-  | DoFrontend ModuleName   -- ghc --frontend Plugin.Module
-  | DoVHDL                  -- ghc --vhdl
-  | DoVerilog               -- ghc --verilog
-  | DoSystemVerilog         -- ghc --systemverilog
-
-doMkDependHSMode, doMakeMode, doInteractiveMode, doRunMode,
-  doAbiHashMode, showUnitsMode, doVHDLMode, doVerilogMode,
-  doSystemVerilogMode :: Mode
-doMkDependHSMode = mkPostLoadMode DoMkDependHS
-doMakeMode = mkPostLoadMode DoMake
-doInteractiveMode = mkPostLoadMode DoInteractive
-doRunMode = mkPostLoadMode DoRun
-doAbiHashMode = mkPostLoadMode DoAbiHash
-showUnitsMode = mkPostLoadMode ShowPackages
-doVHDLMode = mkPostLoadMode DoVHDL
-doVerilogMode = mkPostLoadMode DoVerilog
-doSystemVerilogMode = mkPostLoadMode DoSystemVerilog
-
-showInterfaceMode :: FilePath -> Mode
-showInterfaceMode fp = mkPostLoadMode (ShowInterface fp)
-
-stopBeforeMode :: StopPhase -> Mode
-stopBeforeMode phase = mkPostLoadMode (StopBefore phase)
-
-doEvalMode :: String -> Mode
-doEvalMode str = mkPostLoadMode (DoEval [str])
-
-doFrontendMode :: String -> Mode
-doFrontendMode str = mkPostLoadMode (DoFrontend (mkModuleName str))
-
-doBackpackMode :: Mode
-doBackpackMode = mkPostLoadMode DoBackpack
-
-mkPostLoadMode :: PostLoadMode -> Mode
-mkPostLoadMode = Right . Right
-
-isDoInteractiveMode :: Mode -> Bool
-isDoInteractiveMode (Right (Right DoInteractive)) = True
-isDoInteractiveMode _ = False
-
-isStopLnMode :: Mode -> Bool
-isStopLnMode (Right (Right (StopBefore NoStop))) = True
-isStopLnMode _ = False
-
-isDoMakeMode :: Mode -> Bool
-isDoMakeMode (Right (Right DoMake)) = True
-isDoMakeMode _ = False
-
-isDoEvalMode :: Mode -> Bool
-isDoEvalMode (Right (Right (DoEval _))) = True
-isDoEvalMode _ = False
-
-#if defined(HAVE_INTERNAL_INTERPRETER)
-isInteractiveMode :: PostLoadMode -> Bool
-isInteractiveMode DoInteractive = True
-isInteractiveMode _             = False
-#endif
-
--- isInterpretiveMode: byte-code compiler involved
-isInterpretiveMode :: PostLoadMode -> Bool
-isInterpretiveMode DoInteractive = True
-isInterpretiveMode (DoEval _)    = True
-isInterpretiveMode _             = False
-
-needsInputsMode :: PostLoadMode -> Bool
-needsInputsMode DoMkDependHS    = True
-needsInputsMode (StopBefore _)  = True
-needsInputsMode DoMake          = True
-needsInputsMode DoVHDL          = True
-needsInputsMode DoVerilog       = True
-needsInputsMode DoSystemVerilog = True
-needsInputsMode _               = False
-
--- True if we are going to attempt to link in this mode.
--- (we might not actually link, depending on the GhcLink flag)
-isLinkMode :: PostLoadMode -> Bool
-isLinkMode (StopBefore NoStop) = True
-isLinkMode DoMake              = True
-isLinkMode DoRun               = True
-isLinkMode DoInteractive       = True
-isLinkMode (DoEval _)          = True
-isLinkMode _                   = False
-
-isCompManagerMode :: PostLoadMode -> Bool
-isCompManagerMode DoRun         = True
-isCompManagerMode DoMake        = True
-isCompManagerMode DoInteractive = True
-isCompManagerMode (DoEval _)    = True
-isCompManagerMode DoVHDL        = True
-isCompManagerMode DoVerilog     = True
-isCompManagerMode DoSystemVerilog = True
-isCompManagerMode _             = False
-
--- -----------------------------------------------------------------------------
--- Parsing the mode flag
-
-parseModeFlags :: [Located String]
-               -> IO (Mode, [String],
-                      [Located String],
-                      [Warn])
-parseModeFlags args = do
-  ((leftover, errs1, warns), (mModeFlag, units, errs2, flags')) <-
-        processCmdLineP mode_flags (Nothing, [], [], []) args
-  let mode = case mModeFlag of
-             Nothing     -> doMakeMode
-             Just (m, _) -> m
-
-  -- See Note [Handling errors when parsing command-line flags]
-  unless (null errs1 && null errs2) $ throwGhcException $ errorsToGhcException $
-      map (("on the commandline", )) $ map (unLoc . errMsg) errs1 ++ errs2
-
-  return (mode, units, flags' ++ leftover, warns)
-
-type ModeM = CmdLineP (Maybe (Mode, String), [String], [String], [Located String])
-  -- mode flags sometimes give rise to new DynFlags (eg. -C, see below)
-  -- so we collect the new ones and return them.
-
-mode_flags :: [Flag ModeM]
-mode_flags =
-  [  ------- help / version ----------------------------------------------
-    defFlag "?"                     (PassFlag (setMode showGhcUsageMode))
-  , defFlag "-help"                 (PassFlag (setMode showGhcUsageMode))
-  , defFlag "V"                     (PassFlag (setMode showVersionMode))
-  , defFlag "-version"              (PassFlag (setMode showVersionMode))
-  , defFlag "-numeric-version"      (PassFlag (setMode showNumVersionMode))
-  , defFlag "-info"                 (PassFlag (setMode showInfoMode))
-  , defFlag "-show-options"         (PassFlag (setMode showOptionsMode))
-  , defFlag "-supported-languages"  (PassFlag (setMode showSupportedExtensionsMode))
-  , defFlag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
-  , defFlag "-show-packages"        (PassFlag (setMode showUnitsMode))
-  ] ++
-  [ defFlag k'                      (PassFlag (setMode (printSetting k)))
-  | k <- ["Project version",
-          "Project Git commit id",
-          "Booter version",
-          "Stage",
-          "Build platform",
-          "Host platform",
-          "Target platform",
-          "Have interpreter",
-          "Object splitting supported",
-          "Have native code generator",
-          "Support SMP",
-          "Unregisterised",
-          "Tables next to code",
-          "RTS ways",
-          "Leading underscore",
-          "Debug on",
-          "LibDir",
-          "Global Package DB",
-          "C compiler flags",
-          "C compiler link flags"
-          ],
-    let k' = "-print-" ++ map (replaceSpace . toLower) k
-        replaceSpace ' ' = '-'
-        replaceSpace c   = c
-  ] ++
-      ------- interfaces ----------------------------------------------------
-  [ defFlag "-show-iface"  (HasArg (\f -> setMode (showInterfaceMode f)
-                                               "--show-iface"))
-
-      ------- primary modes ------------------------------------------------
-  , defFlag "c"            (PassFlag (\f -> do setMode (stopBeforeMode NoStop) f
-                                               addFlag "-no-link" f))
-  , defFlag "M"            (PassFlag (setMode doMkDependHSMode))
-  , defFlag "E"            (PassFlag (setMode (stopBeforeMode StopPreprocess )))
-  , defFlag "C"            (PassFlag (setMode (stopBeforeMode StopC)))
-  , defFlag "S"            (PassFlag (setMode (stopBeforeMode StopAs)))
-  , defFlag "-run"         (PassFlag (setMode doRunMode))
-  , defFlag "-make"        (PassFlag (setMode doMakeMode))
-  , defFlag "unit"         (SepArg   (\s -> addUnit s "-unit"))
-  , defFlag "-backpack"    (PassFlag (setMode doBackpackMode))
-  , 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))
-  ]
-
-addUnit :: String -> String -> EwM ModeM ()
-addUnit unit_str _arg = liftEwM $ do
-  (mModeFlag, units, errs, flags') <- getCmdLineState
-  putCmdLineState (mModeFlag, unit_str:units, errs, flags')
-
-setMode :: Mode -> String -> EwM ModeM ()
-setMode newMode newFlag = liftEwM $ do
-    (mModeFlag, units, errs, flags') <- getCmdLineState
-    let (modeFlag', errs') =
-            case mModeFlag of
-            Nothing -> ((newMode, newFlag), errs)
-            Just (oldMode, oldFlag) ->
-                case (oldMode, newMode) of
-                    -- -c/--make are allowed together, and mean --make -no-link
-                    _ |  isStopLnMode oldMode && isDoMakeMode newMode
-                      || isStopLnMode newMode && isDoMakeMode oldMode ->
-                      ((doMakeMode, "--make"), [])
-
-                    -- If we have both --help and --interactive then we
-                    -- want showGhciUsage
-                    _ | isShowGhcUsageMode oldMode &&
-                        isDoInteractiveMode newMode ->
-                            ((showGhciUsageMode, oldFlag), [])
-                      | 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), [])
-                    -- We need to accumulate eval flags like "-e foo -e bar"
-                    (Right (Right (DoEval esOld)),
-                     Right (Right (DoEval [eNew]))) ->
-                        ((Right (Right (DoEval (eNew : esOld))), oldFlag),
-                         errs)
-                    -- Saying e.g. --interactive --interactive is OK
-                    _ | oldFlag == newFlag -> ((oldMode, oldFlag), errs)
-
-                    -- --interactive and --show-options are used together
-                    (Right (Right DoInteractive), Left (ShowOptions _)) ->
-                      ((Left (ShowOptions True),
-                        "--interactive --show-options"), errs)
-                    (Left (ShowOptions _), (Right (Right DoInteractive))) ->
-                      ((Left (ShowOptions True),
-                        "--show-options --interactive"), errs)
-                    -- Otherwise, complain
-                    _ -> let err = flagMismatchErr oldFlag newFlag
-                         in ((oldMode, oldFlag), err : errs)
-    putCmdLineState (Just modeFlag', units, errs', flags')
-  where isDominantFlag f = isShowGhcUsageMode   f ||
-                           isShowGhciUsageMode  f ||
-                           isShowVersionMode    f ||
-                           isShowNumVersionMode f
-
-flagMismatchErr :: String -> String -> String
-flagMismatchErr oldFlag newFlag
-    = "cannot use `" ++ oldFlag ++  "' with `" ++ newFlag ++ "'"
-
-addFlag :: String -> String -> EwM ModeM ()
-addFlag s flag = liftEwM $ do
-  (m, units, e, flags') <- getCmdLineState
-  putCmdLineState (m, units, e, mkGeneralLocated loc s : flags')
-    where loc = "addFlag by " ++ flag ++ " on the commandline"
-
--- ----------------------------------------------------------------------------
--- Run --make mode
-
-doMake :: [String] -> [(String, Maybe Phase)] -> Ghc ()
-doMake units targets = do
-  hs_srcs <- case NE.nonEmpty units of
-    Just ne_units -> do
-      initMulti ne_units
-    Nothing -> do
-      s <- initMake targets
-      return $ map (uncurry (,Nothing,)) s
-  case hs_srcs of
-    [] -> return ()
-    _  -> do
-      targets' <- mapM (\(src, uid, phase) -> GHC.guessTarget src uid phase) hs_srcs
-      GHC.setTargets targets'
-      ok_flag <- GHC.load LoadAllTargets
-      when (failed ok_flag) (liftIO $ exitWith (ExitFailure 1))
-
-initMake :: [(String,Maybe Phase)] -> Ghc [(String, Maybe Phase)]
-initMake srcs  = do
-    let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs
-
-    hsc_env <- GHC.getSession
-
-    -- if we have no haskell sources from which to do a dependency
-    -- analysis, then just do one-shot compilation and/or linking.
-    -- This means that "ghc Foo.o Bar.o -o baz" links the program as
-    -- we expect.
-    if (null hs_srcs)
-       then liftIO (oneShot hsc_env NoStop srcs) >> return []
-       else do
-
-    o_files <- mapMaybeM (\x -> liftIO $ compileFile hsc_env NoStop x)
-                 non_hs_srcs
-    dflags <- GHC.getSessionDynFlags
-    let dflags' = dflags { ldInputs = map (FileOption "") o_files
-                                      ++ ldInputs dflags }
-    _ <- GHC.setSessionDynFlags dflags'
-    return hs_srcs
-
--- Strip out any ["+RTS", ..., "-RTS"] sequences in the command string list.
-removeRTS :: [String] -> [String]
-removeRTS ("+RTS" : xs)  =
-  case dropWhile (/= "-RTS") xs of
-    [] -> []
-    (_ : ys) -> removeRTS ys
-removeRTS (y:ys)         = y : removeRTS ys
-removeRTS []             = []
-
-initMulti :: NE.NonEmpty String -> Ghc ([(String, Maybe UnitId, Maybe Phase)])
-initMulti unitArgsFiles  = do
-  hsc_env <- GHC.getSession
-  let logger = hsc_logger hsc_env
-  initial_dflags <- GHC.getSessionDynFlags
-
-  dynFlagsAndSrcs <- forM unitArgsFiles $ \f -> do
-    when (verbosity initial_dflags > 2) (liftIO $ print f)
-    args <- liftIO $ expandResponse [f]
-    (dflags2, fileish_args, warns) <- parseDynamicFlagsCmdLine initial_dflags (map (mkGeneralLocated f) (removeRTS args))
-    handleSourceError (\e -> do
-       GHC.printException e
-       liftIO $ exitWith (ExitFailure 1)) $ do
-         liftIO $ printOrThrowDiagnostics logger (initPrintConfig dflags2) (initDiagOpts dflags2) (GhcDriverMessage <$> warns)
-
-    let (dflags3, srcs, objs) = parseTargetFiles dflags2 (map unLoc fileish_args)
-        dflags4 = offsetDynFlags dflags3
-
-    let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs
-
-    -- This is dubious as the whole unit environment won't be set-up correctly, but
-    -- that doesn't matter for what we use it for (linking and oneShot)
-    let dubious_hsc_env = hscSetFlags dflags4 hsc_env
-    -- if we have no haskell sources from which to do a dependency
-    -- analysis, then just do one-shot compilation and/or linking.
-    -- This means that "ghc Foo.o Bar.o -o baz" links the program as
-    -- we expect.
-    if (null hs_srcs)
-       then liftIO (oneShot dubious_hsc_env NoStop srcs) >> return (dflags4, [])
-       else do
-
-    o_files <- mapMaybeM (\x -> liftIO $ compileFile dubious_hsc_env NoStop x)
-                 non_hs_srcs
-    let dflags5 = dflags4 { ldInputs = map (FileOption "") o_files
-                                      ++ ldInputs dflags4 }
-
-    liftIO $ checkOptions DoMake dflags5 srcs objs []
-
-    pure (dflags5, hs_srcs)
-
-  let
-    unitDflags = NE.map fst dynFlagsAndSrcs
-    srcs = NE.map (\(dflags, lsrcs) -> map (uncurry (,Just $ homeUnitId_ dflags,)) lsrcs) dynFlagsAndSrcs
-    (hs_srcs, _non_hs_srcs) = unzip (map (partition (\(file, _uid, phase) -> isHaskellishTarget (file, phase))) (NE.toList srcs))
-
-  checkDuplicateUnits initial_dflags (NE.toList (NE.zip unitArgsFiles unitDflags))
-
-  let (initial_home_graph, mainUnitId) = createUnitEnvFromFlags unitDflags
-      home_units = unitEnv_keys initial_home_graph
-
-  home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do
-    let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv
-        hue_flags = homeUnitEnv_dflags homeUnitEnv
-        dflags = homeUnitEnv_dflags homeUnitEnv
-    (dbs,unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger hue_flags cached_unit_dbs home_units
-
-    updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants
-    pure $ HomeUnitEnv
-      { homeUnitEnv_units = unit_state
-      , homeUnitEnv_unit_dbs = Just dbs
-      , homeUnitEnv_dflags = updated_dflags
-      , homeUnitEnv_hpt = emptyHomePackageTable
-      , homeUnitEnv_home_unit = Just home_unit
-      }
-
-  checkUnitCycles initial_dflags home_unit_graph
-
-  let dflags = homeUnitEnv_dflags $ unitEnv_lookup mainUnitId home_unit_graph
-  unitEnv <- assertUnitEnvInvariant <$> (liftIO $ initUnitEnv mainUnitId home_unit_graph (ghcNameVersion dflags) (targetPlatform dflags))
-  let final_hsc_env = hsc_env { hsc_unit_env = unitEnv }
-
-  GHC.setSession final_hsc_env
-
-  -- if we have no haskell sources from which to do a dependency
-  -- analysis, then just do one-shot compilation and/or linking.
-  -- This means that "ghc Foo.o Bar.o -o baz" links the program as
-  -- we expect.
-  if (null hs_srcs)
-      then do
-        liftIO $ hPutStrLn stderr $ "Multi Mode can not be used for one-shot mode."
-        liftIO $ exitWith (ExitFailure 1)
-      else do
-
-{-
-  o_files <- liftIO $ mapMaybeM
-                (\(src, uid, mphase) ->
-                  compileFile (hscSetActiveHomeUnit (ue_unitHomeUnit (fromJust uid) unitEnv) final_hsc_env) NoStop (src, mphase)
-                )
-                (concat non_hs_srcs)
-                -}
-
-  -- MP: This should probably modify dflags for each unit?
-  --let dflags' = dflags { ldInputs = map (FileOption "") o_files
-  --                                  ++ ldInputs dflags }
-  return $ concat hs_srcs
-
--- | Check that we don't have multiple units with the same UnitId.
-
-checkUnitCycles :: DynFlags -> UnitEnvGraph HomeUnitEnv -> Ghc ()
-checkUnitCycles dflags graph = processSCCs sccs
-  where
-    mkNode :: (UnitId, HomeUnitEnv) -> Node UnitId UnitId
-    mkNode (uid, hue) = DigraphNode uid uid (homeUnitDepends (homeUnitEnv_units hue))
-    nodes = map mkNode (unitEnv_elts graph)
-
-    sccs = stronglyConnCompFromEdgedVerticesOrd nodes
-
-    processSCCs [] = return ()
-    processSCCs (AcyclicSCC _: other_sccs) = processSCCs other_sccs
-    processSCCs (CyclicSCC uids: _) = throwGhcException $ CmdLineError $ showSDoc dflags (cycle_err uids)
-
-
-    cycle_err uids =
-      hang (text "Units form a dependency cycle:")
-           2
-           (one_err uids)
-
-    one_err uids = vcat $
-                    (map (\uid -> text "-" <+> ppr uid <+> text "depends on") start)
-                    ++ [text "-" <+> ppr final]
-      where
-        start = init uids
-        final = last uids
-
-checkDuplicateUnits :: DynFlags -> [(FilePath, DynFlags)] -> Ghc ()
-checkDuplicateUnits dflags flags =
-  unless (null duplicate_ids)
-         (throwGhcException $ CmdLineError $ showSDoc dflags multi_err)
-
-  where
-    uids = map (second homeUnitId_) flags
-    deduplicated_uids = ordNubOn snd uids
-    duplicate_ids = Set.fromList (map snd uids \\ map snd deduplicated_uids)
-
-    duplicate_flags = filter (flip Set.member duplicate_ids . snd) uids
-
-    one_err (fp, home_uid) = text "-" <+> ppr home_uid <+> text "defined in" <+> text fp
-
-    multi_err =
-      hang (text "Multiple units with the same unit-id:")
-           2
-           (vcat (map one_err duplicate_flags))
-
-
-offsetDynFlags :: DynFlags -> DynFlags
-offsetDynFlags dflags =
-  dflags { hiDir = c hiDir
-         , objectDir  = c objectDir
-         , stubDir = c stubDir
-         , hieDir  = c hieDir
-         , dumpDir = c dumpDir  }
-
-  where
-    c f = augment_maybe (f dflags)
-
-    augment_maybe Nothing = Nothing
-    augment_maybe (Just f) = Just (augment f)
-    augment f | isRelative f, Just offset <- workingDirectory dflags = offset </> f
-              | otherwise = f
-
-
-createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> (HomeUnitGraph, UnitId)
-createUnitEnvFromFlags unitDflags =
-  let
-    newInternalUnitEnv dflags = mkHomeUnitEnv dflags emptyHomePackageTable Nothing
-    unitEnvList = NE.map (\dflags -> (homeUnitId_ dflags, newInternalUnitEnv dflags)) unitDflags
-    activeUnit = fst $ NE.head unitEnvList
-  in
-    (unitEnv_new (Map.fromList (NE.toList (unitEnvList))), activeUnit)
-
--- ---------------------------------------------------------------------------
--- Various banners and verbosity output.
-
-showBanner :: PostLoadMode -> DynFlags -> IO ()
-showBanner _postLoadMode dflags = do
-   let verb = verbosity dflags
-
-#if defined(HAVE_INTERNAL_INTERPRETER)
-   -- Show the GHCi banner
-   when (isInteractiveMode _postLoadMode && verb >= 1) $ putStrLn ghciWelcomeMsg
-#endif
-
-   -- Display details of the configuration in verbose mode
-   when (verb >= 2) $
-    do hPutStr stderr "Glasgow Haskell Compiler, Version "
-       hPutStr stderr cProjectVersion
-       hPutStr stderr ", stage "
-       hPutStr stderr cStage
-       hPutStr stderr " booted by GHC version "
-       hPutStrLn stderr cBooterVersion
-
--- We print out a Read-friendly string, but a prettier one than the
--- Show instance gives us
-showInfo :: DynFlags -> IO ()
-showInfo dflags = do
-        let sq x = " [" ++ x ++ "\n ]"
-        putStrLn $ sq $ intercalate "\n ," $ map show $ compilerInfo dflags
-
--- TODO use GHC.Utils.Error once that is disentangled from all the other GhcMonad stuff?
-showSupportedExtensions :: Maybe String -> IO ()
-showSupportedExtensions m_top_dir = do
-  res <- runExceptT $ do
-    top_dir <- lift (tryFindTopDir m_top_dir) >>= \case
-      Nothing -> throwE $ SettingsError_MissingData "Could not find the top directory, missing -B flag"
-      Just dir -> pure dir
-    initSettings top_dir
-  arch_os <- case res of
-    Right s -> pure $ platformArchOS $ sTargetPlatform s
-    Left (SettingsError_MissingData msg) -> do
-      hPutStrLn stderr $ "WARNING: " ++ show msg
-      hPutStrLn stderr $ "cannot know target platform so guessing target == host (native compiler)."
-      pure hostPlatformArchOS
-    Left (SettingsError_BadData msg) -> do
-      hPutStrLn stderr msg
-      exitWith $ ExitFailure 1
-  mapM_ putStrLn $ supportedLanguagesAndExtensions arch_os
-
-showVersion :: IO ()
-showVersion = putStrLn $ concat [ "Clash, version "
-                                , Data.Version.showVersion Paths_clash_ghc.version
-                                , " (using clash-lib, version: "
-                                , Data.Version.showVersion clashLibVersion
-                                , ")"
-                                ]
-
-showOptions :: Bool -> IORef ClashOpts -> IO ()
-showOptions isInteractive = putStr . unlines . availableOptions
-    where
-      availableOptions opts = concat [
-        flagsForCompletion isInteractive,
-        map ('-':) (getFlagNames mode_flags),
-        map ('-':) (getFlagNames (flagsClash opts))
-        ]
-      getFlagNames opts         = map flagName opts
-
-showGhcUsage :: DynFlags -> IO ()
-showGhcUsage = showUsage False
-
-showGhciUsage :: DynFlags -> IO ()
-showGhciUsage = showUsage True
-
-showUsage :: Bool -> DynFlags -> IO ()
-showUsage ghci dflags = do
-  let usage_path = if ghci then ghciUsagePath dflags
-                           else ghcUsagePath dflags
-  usage <- readFile usage_path
-  progName <- getProgName
-  dump progName usage
-  where
-    dump progName xs = case xs of
-      ""        -> return ()
-      '$':'$':s -> putStr progName >> dump progName s
-      c:s       -> putChar c >> dump progName s
-
-dumpFinalStats :: Logger -> IO ()
-dumpFinalStats logger = do
-  when (logHasDumpFlag logger Opt_D_faststring_stats) $ dumpFastStringStats logger
-
-  when (logHasDumpFlag logger Opt_D_dump_faststrings) $ do
-    fss <- getFastStringTable
-    let ppr_table         = fmap ppr_segment (fss `zip` [0..])
-        ppr_segment (s,n) = hang (text "Segment" <+> int n) 2 (vcat (fmap ppr_bucket (s `zip` [0..])))
-        ppr_bucket  (b,n) = hang (text "Bucket" <+> int n) 2 (vcat (fmap ftext b))
-    putDumpFileMaybe logger Opt_D_dump_faststrings "FastStrings" FormatText (vcat ppr_table)
-
-dumpFastStringStats :: Logger -> IO ()
-dumpFastStringStats logger = do
-  segments <- getFastStringTable
-  hasZ <- getFastStringZEncCounter
-  let buckets = concat segments
-      bucketsPerSegment = map length segments
-      entriesPerBucket = map length buckets
-      entries = sum entriesPerBucket
-      msg = text "FastString stats:" $$ nest 4 (vcat
-        [ text "segments:         " <+> int (length segments)
-        , text "buckets:          " <+> int (sum bucketsPerSegment)
-        , text "entries:          " <+> int entries
-        , text "largest segment:  " <+> int (maximum bucketsPerSegment)
-        , text "smallest segment: " <+> int (minimum bucketsPerSegment)
-        , text "longest bucket:   " <+> int (maximum entriesPerBucket)
-        , text "has z-encoding:   " <+> (hasZ `pcntOf` entries)
-        ])
-        -- we usually get more "has z-encoding" than "z-encoded", because
-        -- when we z-encode a string it might hash to the exact same string,
-        -- which is not counted as "z-encoded".  Only strings whose
-        -- Z-encoding is different from the original string are counted in
-        -- the "z-encoded" total.
-  putMsg logger msg
-  where
-   x `pcntOf` y = int ((x * 100) `quot` y) Outputable.<> char '%'
-
-showUnits, dumpUnits, dumpUnitsSimple :: HscEnv -> IO ()
-showUnits       hsc_env = putStrLn (showSDoc (hsc_dflags hsc_env) (pprUnits (hsc_units hsc_env)))
-dumpUnits       hsc_env = putMsg (hsc_logger hsc_env) (pprUnits (hsc_units hsc_env))
-dumpUnitsSimple hsc_env = putMsg (hsc_logger hsc_env) (pprUnitsSimple (hsc_units hsc_env))
-
--- -----------------------------------------------------------------------------
--- Frontend plugin support
-
-doFrontend :: ModuleName -> [(String, Maybe Phase)] -> Ghc ()
-doFrontend modname srcs = do
-    hsc_env <- getSession
-    (frontend_plugin, _pkgs, _deps) <- liftIO $ loadFrontendPlugin hsc_env modname -- TODO do these need to recorded?
-    frontend frontend_plugin
-      (reverse $ frontendPluginOpts (hsc_dflags hsc_env)) srcs
-
--- -----------------------------------------------------------------------------
--- ABI hash support
-
-{-
-        ghc --abi-hash Data.Foo System.Bar
-
-Generates a combined hash of the ABI for modules Data.Foo and
-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 ComponentId for a
-package.  The ComponentId must change when the visible ABI of
-the package changes, so during registration Cabal calls ghc --abi-hash
-to get a hash of the package's ABI.
--}
-
--- | Print ABI hash of input modules.
---
--- The resulting hash is the MD5 of the GHC version used (#5328,
--- see 'hiVersion') and of the existing ABI hash from each module (see
--- 'mi_mod_hash').
-abiHash :: [String] -- ^ List of module names
-        -> Ghc ()
-abiHash strs = do
-  hsc_env <- getSession
-  let dflags    = hsc_dflags hsc_env
-
-  liftIO $ do
-
-  let find_it str = do
-         let modname = mkModuleName str
-         r <- findImportedModule hsc_env modname NoPkgQual
-         case r of
-           Found _ m -> return m
-           _error    ->
-            let opts   = initIfaceMessageOpts dflags
-                err_txt = missingInterfaceErrorDiagnostic opts
-                        $ cannotFindModule hsc_env modname r
-            in throwGhcException . CmdLineError $ showSDoc dflags err_txt
-
-  mods <- mapM find_it strs
-
-  let get_iface modl = loadUserInterface NotBoot (text "abiHash") modl
-  ifaces <- initIfaceCheck (text "abiHash") hsc_env $ mapM get_iface mods
-
-  bh <- openBinMem (3*1024) -- just less than a block
-  put_ bh hiVersion
-    -- package hashes change when the compiler version changes (for now)
-    -- see #5328
-  mapM_ (put_ bh . mi_mod_hash . mi_final_exts) ifaces
-  f <- fingerprintBinMem bh
-
-  putStrLn (showPpr dflags f)
-
------------------------------------------------------------------------------
--- HDL Generation
-
-makeHDL'
-  :: forall backend
-   . Clash.Backend.Backend backend
-  => Proxy backend
-  -> Ghc ()
-  -> IORef ClashOpts
-  -> [(String,Maybe Phase)]
-  -> Ghc ()
-makeHDL' _     _           _ []   = throwGhcException (CmdLineError "No input files")
-makeHDL' proxy startAction r srcs = makeHDL proxy startAction r $ fmap fst srcs
-
-makeVHDL :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
-makeVHDL = makeHDL' (Proxy @VHDLState)
-
-makeVerilog :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
-makeVerilog = makeHDL' (Proxy @VerilogState)
-
-makeSystemVerilog :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
-makeSystemVerilog = makeHDL' (Proxy @SystemVerilogState)
-
--- -----------------------------------------------------------------------------
--- Util
-
-unknownFlagsErr :: [String] -> a
-unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs
-  where
-    oneError f =
-        "unrecognised flag: " ++ f ++ "\n" ++
-        (case flagSuggestions (nubSort allNonDeprecatedFlags) f of
-            [] -> ""
-            suggs -> "did you mean one of:\n" ++ unlines (map ("  " ++) suggs))
diff --git a/src-ghc/Clash/GHC/Evaluator/Primitive.hs b/src-ghc/Clash/GHC/Evaluator/Primitive.hs
--- a/src-ghc/Clash/GHC/Evaluator/Primitive.hs
+++ b/src-ghc/Clash/GHC/Evaluator/Primitive.hs
@@ -18,5890 +18,5956 @@
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
-module Clash.GHC.Evaluator.Primitive
-  ( ghcPrimStep
-  , ghcPrimUnwind
-  , isUndefinedPrimVal
-  , isUndefinedXPrimVal
-  ) where
-
-import           Control.DeepSeq            (force)
-import           Control.Exception          (ArithException(..), Exception, tryJust, evaluate)
-import           Control.Monad.State.Strict (State, MonadState)
-import qualified Control.Monad.State.Strict as State
-import           Control.Monad.Trans.Except (runExcept)
-import           Data.Binary.IEEE754        (doubleToWord, floatToWord, wordToDouble, wordToFloat)
-import           Data.Bits
-import qualified Data.ByteString.Internal as BS
-import           Data.Char           (chr,ord)
-import qualified Data.Either         as Either
-import           Data.Maybe (fromMaybe, mapMaybe)
-import qualified Data.List           as List
-import qualified Data.Primitive.ByteArray as BA
-import           Data.Proxy          (Proxy)
-import           Data.Reflection     (reifyNat)
-import           Data.Text           (Text)
-import qualified Data.Text           as Text
-import           Data.Text.Extra     (showt)
-import           GHC.Exts (IsList(..))
-import           GHC.Float
-import           GHC.Int
-import           GHC.Integer
-  (decodeDoubleInteger,encodeDoubleInteger,compareInteger,orInteger,andInteger,
-   xorInteger,complementInteger,absInteger,signumInteger)
-#if MIN_VERSION_base(4,16,0)
-import           GHC.Num.Integer (Integer (..), integerEncodeFloat#)
-#elif MIN_VERSION_base(4,15,0)
-import           GHC.Num.Integer
-  (Integer (..), integerEncodeFloat#, integerToFloat#, integerToDouble#)
-#else
-import           GHC.Integer.GMP.Internals
-  (Integer (..), BigNat (..))
-#endif
-#if MIN_VERSION_base(4,15,0)
-import           GHC.Num.Natural     (naturalSubUnsafe)
-#endif
-import           GHC.Natural
-import           GHC.ForeignPtr
-import           GHC.Prim
-import           GHC.Real            (Ratio (..))
-import           GHC.TypeLits        (KnownNat)
-import           GHC.Types           (IO (..))
-import           GHC.Word
-import           System.IO.Unsafe    (unsafeDupablePerformIO)
-#if MIN_VERSION_ghc(9,4,0)
-import           Data.Bifunctor      (first)
-import qualified Data.Text.Array     as Text
-import qualified Data.Text.Internal  as Text
-#endif
-
-#if MIN_VERSION_ghc(9,0,0)
-import           GHC.Types.Basic     (Boxity (..))
-import           GHC.Types.Name      (getSrcSpan, nameOccName, occNameString)
-import           GHC.Builtin.Names   (trueDataConKey, falseDataConKey)
-import qualified GHC.Core.TyCon      as TyCon
-import           GHC.Builtin.Types   (tupleTyCon)
-#else
-import           BasicTypes          (Boxity (..))
-import           Name                (getSrcSpan, nameOccName, occNameString)
-import           PrelNames           (trueDataConKey, falseDataConKey)
-import qualified TyCon
-import           TysWiredIn          (tupleTyCon)
-#endif
-
-import           Clash.Class.BitPack (pack,unpack)
-import           Clash.Core.DataCon  (DataCon (..))
-import           Clash.Core.Evaluator.Types
-import           Clash.Core.HasType  (piResultTys, applyTypeToArgs)
-import           Clash.Core.Literal  (Literal (..))
-import           Clash.Core.Name
-  (Name (..), NameSort (..), mkUnsafeSystemName)
-import           Clash.Core.Pretty   (showPpr)
-import           Clash.Core.Term
-  (IsMultiPrim (..), Pat (..), PrimInfo (..), Term (..), WorkInfo (..), mkApps,
-   PrimUnfolding(..), collectArgs)
-import           Clash.Core.Type
-  (Type (..), ConstTy (..), LitTy (..), TypeView (..), mkFunTy, mkTyConApp,
-   splitFunForallTy, tyView)
-import           Clash.Core.TyCon
-  (TyConMap, TyConName, tyConDataCons)
-import           Clash.Core.TysPrim
-import           Clash.Core.Util
-  (mkRTree,mkVec,tyNatSize,dataConInstArgTys,primCo, mkSelectorCase,undefinedPrims,
-   undefinedXPrims)
-import           Clash.Core.Var      (mkLocalId, mkTyVar)
-import qualified Clash.Data.UniqMap as UniqMap
-import           Clash.Debug
-import           Clash.GHC.GHC2Core  (modNameM)
-import           Clash.Unique        (fromGhcUnique)
-import           Clash.Util
-  (MonadUnique (..), clogBase, flogBase, curLoc)
-import           Clash.Util.Supply   (Supply,freshId)
-import           Clash.Normalize.PrimitiveReductions
-  (typeNatMul, typeNatSub, typeNatAdd, vecLastPrim, vecInitPrim, vecHeadPrim,
-   vecTailPrim, mkVecCons, mkVecNil)
-
-import qualified Clash.Normalize.Primitives as NP
-import Clash.Promoted.Nat.Unsafe (unsafeSNat)
-import qualified Clash.Sized.Internal.BitVector as BitVector
-import qualified Clash.Sized.Internal.Signed    as Signed
-import qualified Clash.Sized.Internal.Unsigned  as Unsigned
-import Clash.Sized.Internal.BitVector(BitVector(..), Bit(..))
-import Clash.Sized.Internal.Signed   (Signed   (..))
-import Clash.Sized.Internal.Unsigned (Unsigned (..))
-import Clash.XException (isX)
-
-import {-# SOURCE #-} Clash.GHC.Evaluator
-
-isUndefinedPrimVal :: Value -> Bool
-isUndefinedPrimVal (PrimVal (PrimInfo{primName}) _ _) =
-  primName `elem` undefinedPrims
-isUndefinedPrimVal _ = False
-
-isUndefinedXPrimVal :: Value -> Bool
-isUndefinedXPrimVal (PrimVal (PrimInfo{primName}) _ _) =
-  primName `elem` undefinedXPrims
-isUndefinedXPrimVal _ = False
-
--- | Evaluation of primitive operations.
-ghcPrimUnwind :: PrimUnwind
-ghcPrimUnwind tcm p tys vs v [] m
-  | primName p `elem` [ "Clash.Sized.Internal.Index.fromInteger#"
-                       , "GHC.CString.unpackCString#"
-                       , Text.pack (show 'NP.removedArg)
-                       , "GHC.Prim.MutableByteArray#"
-                       , Text.pack (show 'NP.undefined)
-                       , Text.pack (show 'NP.undefinedX)
-                       ]
-              -- The above primitives are actually values, and not operations.
-  = ghcUnwind (PrimVal p tys (vs ++ [v])) m tcm
-  | primName p == "Clash.Sized.Internal.BitVector.fromInteger#"
-  = case (vs,v) of
-    ([naturalLiteral -> Just n,mask], integerLiteral -> Just i) ->
-      ghcUnwind (PrimVal p tys [Lit (NaturalLiteral n), mask, Lit (IntegerLiteral (wrapUnsigned n i))]) m tcm
-    _ -> error ($(curLoc) ++ "Internal error"  ++ show (vs,v))
-  | primName p == "Clash.Sized.Internal.BitVector.fromInteger##"
-  = case (vs,v) of
-    ([mask], integerLiteral -> Just i) ->
-      ghcUnwind (PrimVal p tys [mask, Lit (IntegerLiteral (wrapUnsigned 1 i))]) m tcm
-    _ -> error ($(curLoc) ++ "Internal error"  ++ show (vs,v))
-  | primName p == "Clash.Sized.Internal.Signed.fromInteger#"
-  = case (vs,v) of
-    ([naturalLiteral -> Just n],integerLiteral -> Just i) ->
-      ghcUnwind (PrimVal p tys [Lit (NaturalLiteral n), Lit (IntegerLiteral (wrapSigned n i))]) m tcm
-    _ -> error ($(curLoc) ++ "Internal error"  ++ show (vs,v))
-  | primName p == "Clash.Sized.Internal.Unsigned.fromInteger#"
-  = case (vs,v) of
-    ([naturalLiteral -> Just n],integerLiteral -> Just i) ->
-      ghcUnwind (PrimVal p tys [Lit (NaturalLiteral n), Lit (IntegerLiteral (wrapUnsigned n i))]) m tcm
-    _ -> error ($(curLoc) ++ "Internal error"  ++ show (vs,v))
-  | isUndefinedPrimVal v
-  = let tyArgs = map Right tys
-        tmArgs = map (Left . valToTerm) (vs ++ [v])
-    in  Just $ flip setTerm m $ TyApp (Prim NP.undefined) $
-          applyTypeToArgs (Prim p) tcm (primType p) (tyArgs ++ tmArgs)
-  | isUndefinedXPrimVal v
-  = let tyArgs = map Right tys
-        tmArgs = map (Left . valToTerm) (vs ++ [v])
-    in  Just $ flip setTerm m $ TyApp (Prim NP.undefinedX) $
-          applyTypeToArgs (Prim p) tcm (primType p) (tyArgs ++ tmArgs)
-  | otherwise
-  = ghcPrimStep tcm (forcePrims m) p tys (vs ++ [v]) m
-
-ghcPrimUnwind tcm p tys vs v [e] m0
-  -- Note [Lazy primitives]
-  -- ~~~~~~~~~~~~~~~~~~~~~~
-  --
-  -- Primitives are usually considered undefined when one of their arguments is
-  -- (unless they're unused). _Some_ primitives can still yield a result even
-  -- though one of their arguments is undefined. It turns out that all primitives
-  -- exhibiting this property happen to be "lazy" in their last argument. Thus,
-  -- all the cases can be covered by a match on [e] and their names:
-  | primName p `elem` [ "Clash.Sized.Vector.lazyV"
-                       , "Clash.Sized.Vector.replicate"
-                       , "Clash.Sized.Vector.replace_int"
-                       , "GHC.Classes.&&"
-                       , "GHC.Classes.||"
-                       , showt 'BitVector.xToBV
-                       , "Clash.Sized.Vector.imap_go"
-                       ]
-  = if isUndefinedPrimVal v then
-      let tyArgs = map Right tys
-          tmArgs = map (Left . valToTerm) (vs ++ [v]) ++ [Left e]
-      in  Just $ flip setTerm m0 $ TyApp (Prim NP.undefined) $
-            applyTypeToArgs (Prim p) tcm (primType p) (tyArgs ++ tmArgs)
-    else
-      let (m1,i) = newLetBinding tcm m0 e
-      in  ghcPrimStep tcm (forcePrims m0) p tys (vs ++ [v,Suspend (Var i)]) m1
-
-ghcPrimUnwind tcm p tys vs (collectValueTicks -> (v, ts)) (e:es) m
-  | isUndefinedPrimVal v
-  = let tyArgs = map Right tys
-        tmArgs = map (Left . valToTerm) (vs ++ [v]) ++ map Left (e:es)
-    in  Just $ flip setTerm m $ TyApp (Prim NP.undefined) $
-          applyTypeToArgs (Prim p) tcm (primType p) (tyArgs ++ tmArgs)
-  | otherwise
-  = Just . setTerm e $ stackPush (PrimApply p tys (vs ++ [foldr TickValue v ts]) es) m
-
-newtype PrimEvalMonad a = PEM (State Supply a)
-  deriving (Functor, Applicative, Monad, MonadState Supply)
-
-instance MonadUnique PrimEvalMonad where
-  getUniqueM = PEM $ State.state (\s -> case freshId s of (!i,!s') -> (i,s'))
-
-runPEM :: PrimEvalMonad a -> Supply -> (a, Supply)
-runPEM (PEM m) = State.runState m
-
-ghcPrimStep :: PrimStep
-ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
------------------
--- GHC.Prim.Char#
------------------
-  "GHC.Prim.gtChar#" | Just (i,j) <- charLiterals args
-    -> reduce (boolToIntLiteral (i > j))
-  "GHC.Prim.geChar#" | Just (i,j) <- charLiterals args
-    -> reduce (boolToIntLiteral (i >= j))
-  "GHC.Prim.eqChar#" | Just (i,j) <- charLiterals args
-    -> reduce (boolToIntLiteral (i == j))
-  "GHC.Prim.neChar#" | Just (i,j) <- charLiterals args
-    -> reduce (boolToIntLiteral (i /= j))
-  "GHC.Prim.ltChar#" | Just (i,j) <- charLiterals args
-    -> reduce (boolToIntLiteral (i < j))
-  "GHC.Prim.leChar#" | Just (i,j) <- charLiterals args
-    -> reduce (boolToIntLiteral (i <= j))
-  "GHC.Prim.ord#" | [i] <- charLiterals' args
-    -> reduce (integerToIntLiteral (toInteger $ ord i))
-
-----------------
--- GHC.Prim.Int#
-----------------
-  "GHC.Prim.+#" | Just (i,j) <- intLiterals args
-    -> reduce (integerToIntLiteral (i+j))
-  "GHC.Prim.-#" | Just (i,j) <- intLiterals args
-    -> reduce (integerToIntLiteral (i-j))
-  "GHC.Prim.*#" | Just (i,j) <- intLiterals args
-    -> reduce (integerToIntLiteral (i*j))
-
-  "GHC.Prim.mulIntMayOflo#" | Just (i,j) <- intLiterals  args
-    -> let !(I# a)  = fromInteger i
-           !(I# b)  = fromInteger j
-           c :: Int#
-           c = mulIntMayOflo# a b
-       in  reduce (integerToIntLiteral (toInteger $ I# c))
-
-  "GHC.Prim.quotInt#" | Just (i,j) <- intLiterals args
-    -> reduce $ catchDivByZero (integerToIntLiteral (i `quot` j))
-  "GHC.Prim.remInt#" | Just (i,j) <- intLiterals args
-    -> reduce $ catchDivByZero (integerToIntLiteral (i `rem` j))
-  "GHC.Prim.quotRemInt#" | Just (i,j) <- intLiterals args
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           (q,r)   = quotRem i j
-           ret     = mkApps (Data tupDc) (map Right tyArgs ++
-                    [Left $ catchDivByZero (integerToIntLiteral q)
-                    ,Left $ catchDivByZero (integerToIntLiteral r)])
-       in  reduce ret
-
-  "GHC.Prim.andI#" | Just (i,j) <- intLiterals args
-    -> reduce (integerToIntLiteral (i .&. j))
-  "GHC.Prim.orI#" | Just (i,j) <- intLiterals args
-    -> reduce (integerToIntLiteral (i .|. j))
-  "GHC.Prim.xorI#" | Just (i,j) <- intLiterals args
-    -> reduce (integerToIntLiteral (i `xor` j))
-  "GHC.Prim.notI#" | [i] <- intLiterals' args
-    -> reduce (integerToIntLiteral (complement i))
-
-  "GHC.Prim.negateInt#"
-    | [Lit (IntLiteral i)] <- args
-    -> reduce (integerToIntLiteral (negate i))
-
-  "GHC.Prim.addIntC#" | Just (i,j) <- intLiterals args
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           !(I# a)  = fromInteger i
-           !(I# b)  = fromInteger j
-           !(# d, c #) = addIntC# a b
-       in  reduce $
-           mkApps (Data tupDc) (map Right tyArgs ++
-                   [ Left (Literal . IntLiteral . toInteger $ I# d)
-                   , Left (Literal . IntLiteral . toInteger $ I# c)])
-  "GHC.Prim.subIntC#" | Just (i,j) <- intLiterals args
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           !(I# a)  = fromInteger i
-           !(I# b)  = fromInteger j
-           !(# d, c #) = subIntC# a b
-       in  reduce $
-           mkApps (Data tupDc) (map Right tyArgs ++
-                   [ Left (Literal . IntLiteral . toInteger $ I# d)
-                   , Left (Literal . IntLiteral . toInteger $ I# c)])
-
-  "GHC.Prim.>#" | Just (i,j) <- intLiterals args
-    -> reduce (boolToIntLiteral (i > j))
-  "GHC.Prim.>=#" | Just (i,j) <- intLiterals args
-    -> reduce (boolToIntLiteral (i >= j))
-  "GHC.Prim.==#" | Just (i,j) <- intLiterals args
-    -> reduce (boolToIntLiteral (i == j))
-  "GHC.Prim./=#" | Just (i,j) <- intLiterals args
-    -> reduce (boolToIntLiteral (i /= j))
-  "GHC.Prim.<#" | Just (i,j) <- intLiterals args
-    -> reduce (boolToIntLiteral (i < j))
-  "GHC.Prim.<=#" | Just (i,j) <- intLiterals args
-    -> reduce (boolToIntLiteral (i <= j))
-
-  "GHC.Prim.chr#" | [i] <- intLiterals' args
-    -> reduce (charToCharLiteral (chr $ fromInteger i))
-
-  "GHC.Prim.int2Word#"
-    | [Lit (IntLiteral i)] <- args
-    -> reduce . Literal . WordLiteral . toInteger $ (fromInteger :: Integer -> Word) i -- for overflow behavior
-
-  "GHC.Prim.int2Float#"
-    | [Lit (IntLiteral i)] <- args
-    -> reduce . Literal . FloatLiteral  . floatToWord $ fromInteger i
-  "GHC.Prim.int2Double#"
-    | [Lit (IntLiteral i)] <- args
-    -> reduce . Literal . DoubleLiteral . doubleToWord $ fromInteger i
-
-  "GHC.Prim.word2Float#"
-    | [Lit (WordLiteral i)] <- args
-    -> reduce . Literal . FloatLiteral  . floatToWord $ fromInteger i
-  "GHC.Prim.word2Double#"
-    | [Lit (WordLiteral i)] <- args
-    -> reduce . Literal . DoubleLiteral . doubleToWord $ fromInteger i
-
-  "GHC.Prim.uncheckedIShiftL#"
-    | [ Lit (IntLiteral i)
-      , Lit (IntLiteral s)
-      ] <- args
-    -> reduce (integerToIntLiteral (i `shiftL` fromInteger s))
-  "GHC.Prim.uncheckedIShiftRA#"
-    | [ Lit (IntLiteral i)
-      , Lit (IntLiteral s)
-      ] <- args
-    -> reduce (integerToIntLiteral (i `shiftR` fromInteger s))
-  "GHC.Prim.uncheckedIShiftRL#" | Just (i,j) <- intLiterals args
-    -> let !(I# a)  = fromInteger i
-           !(I# b)  = fromInteger j
-           c :: Int#
-           c = uncheckedIShiftRL# a b
-       in  reduce (integerToIntLiteral (toInteger $ I# c))
-
------------------
--- GHC.Prim.Word#
------------------
-  "GHC.Prim.plusWord#" | Just (i,j) <- wordLiterals args
-    -> reduce (integerToWordLiteral (i+j))
-
-  "GHC.Prim.subWordC#" | Just (i,j) <- wordLiterals args
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           !(W# a)  = fromInteger i
-           !(W# b)  = fromInteger j
-           !(# d, c #) = subWordC# a b
-       in  reduce $
-           mkApps (Data tupDc) (map Right tyArgs ++
-                   [ Left (Literal . WordLiteral . toInteger $ W# d)
-                   , Left (Literal . IntLiteral . toInteger $ I# c)])
-
-  "GHC.Prim.plusWord2#" | Just (i,j) <- wordLiterals args
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           !(W# a)  = fromInteger i
-           !(W# b)  = fromInteger j
-           !(# h', l #) = plusWord2# a b
-       in  reduce $
-           mkApps (Data tupDc) (map Right tyArgs ++
-                   [ Left (Literal . WordLiteral . toInteger $ W# h')
-                   , Left (Literal . WordLiteral . toInteger $ W# l)])
-
-  "GHC.Prim.minusWord#" | Just (i,j) <- wordLiterals args
-    -> reduce (integerToWordLiteral (i-j))
-  "GHC.Prim.timesWord#" | Just (i,j) <- wordLiterals args
-    -> reduce (integerToWordLiteral (i*j))
-
-  "GHC.Prim.timesWord2#" | Just (i,j) <- wordLiterals args
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           !(W# a)  = fromInteger i
-           !(W# b)  = fromInteger j
-           !(# h', l #) = timesWord2# a b
-       in  reduce $
-           mkApps (Data tupDc) (map Right tyArgs ++
-                   [ Left (Literal . WordLiteral . toInteger $ W# h')
-                   , Left (Literal . WordLiteral . toInteger $ W# l)])
-
-  "GHC.Prim.quotWord#" | Just (i,j) <- wordLiterals args
-    -> reduce $ catchDivByZero (integerToWordLiteral (i `quot` j))
-  "GHC.Prim.remWord#" | Just (i,j) <- wordLiterals args
-    -> reduce $ catchDivByZero (integerToWordLiteral (i `rem` j))
-  "GHC.Prim.quotRemWord#" | Just (i,j) <- wordLiterals args
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           (q,r)   = quotRem i j
-           ret     = mkApps (Data tupDc) (map Right tyArgs ++
-                    [Left $ catchDivByZero (integerToWordLiteral q)
-                    ,Left $ catchDivByZero (integerToWordLiteral r)])
-       in  reduce ret
-  "GHC.Prim.quotRemWord2#" | [i,j,k'] <- wordLiterals' args
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           !(W# a)  = fromInteger i
-           !(W# b)  = fromInteger j
-           !(W# c)  = fromInteger k'
-           !(# x, y #) = quotRemWord2# a b c
-       in  reduce $
-           mkApps (Data tupDc) (map Right tyArgs ++
-                   [ Left $ catchDivByZero (Literal . WordLiteral . toInteger $ W# x)
-                   , Left $ catchDivByZero (Literal . WordLiteral . toInteger $ W# y)])
-
-  "GHC.Prim.and#" | Just (i,j) <- wordLiterals args
-    -> reduce (integerToWordLiteral (i .&. j))
-  "GHC.Prim.or#" | Just (i,j) <- wordLiterals args
-    -> reduce (integerToWordLiteral (i .|. j))
-  "GHC.Prim.xor#" | Just (i,j) <- wordLiterals args
-    -> reduce (integerToWordLiteral (i `xor` j))
-  "GHC.Prim.not#" | [i] <- wordLiterals' args
-    -> reduce (integerToWordLiteral (complement i))
-
-  "GHC.Prim.uncheckedShiftL#"
-    | [ Lit (WordLiteral w)
-      , Lit (IntLiteral  i)
-      ] <- args
-    -> reduce (Literal (WordLiteral (w `shiftL` fromInteger i)))
-  "GHC.Prim.uncheckedShiftRL#"
-    | [ Lit (WordLiteral w)
-      , Lit (IntLiteral  i)
-      ] <- args
-    -> reduce (Literal (WordLiteral (w `shiftR` fromInteger i)))
-
-  "GHC.Prim.word2Int#"
-    | [Lit (WordLiteral i)] <- args
-    -> reduce . Literal . IntLiteral . toInteger $ (fromInteger :: Integer -> Int) i -- for overflow behavior
-
-  "GHC.Prim.gtWord#" | Just (i,j) <- wordLiterals args
-    -> reduce (boolToIntLiteral (i > j))
-  "GHC.Prim.geWord#" | Just (i,j) <- wordLiterals args
-    -> reduce (boolToIntLiteral (i >= j))
-  "GHC.Prim.eqWord#" | Just (i,j) <- wordLiterals args
-    -> reduce (boolToIntLiteral (i == j))
-  "GHC.Prim.neWord#" | Just (i,j) <- wordLiterals args
-    -> reduce (boolToIntLiteral (i /= j))
-  "GHC.Prim.ltWord#" | Just (i,j) <- wordLiterals args
-    -> reduce (boolToIntLiteral (i < j))
-  "GHC.Prim.leWord#" | Just (i,j) <- wordLiterals args
-    -> reduce (boolToIntLiteral (i <= j))
-
-  "GHC.Prim.popCnt8#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . popCount . (fromInteger :: Integer -> Word8) $ i
-  "GHC.Prim.popCnt16#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . popCount . (fromInteger :: Integer -> Word16) $ i
-  "GHC.Prim.popCnt32#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . popCount . (fromInteger :: Integer -> Word32) $ i
-  "GHC.Prim.popCnt64#" | [i] <- word64Literals' args
-    -> reduce . integerToWordLiteral . toInteger . popCount . (fromInteger :: Integer -> Word64) $ i
-  "GHC.Prim.popCnt#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . popCount . (fromInteger :: Integer -> Word) $ i
-
-  "GHC.Prim.clz8#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . countLeadingZeros . (fromInteger :: Integer -> Word8) $ i
-  "GHC.Prim.clz16#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . countLeadingZeros . (fromInteger :: Integer -> Word16) $ i
-  "GHC.Prim.clz32#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . countLeadingZeros . (fromInteger :: Integer -> Word32) $ i
-  "GHC.Prim.clz64#" | [i] <- word64Literals' args
-    -> reduce . integerToWordLiteral . toInteger . countLeadingZeros . (fromInteger :: Integer -> Word64) $ i
-  "GHC.Prim.clz#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . countLeadingZeros . (fromInteger :: Integer -> Word) $ i
-
-  "GHC.Prim.ctz8#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . countTrailingZeros . (fromInteger :: Integer -> Word) $ i .&. (bit 8 - 1)
-  "GHC.Prim.ctz16#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . countTrailingZeros . (fromInteger :: Integer -> Word) $ i .&. (bit 16 - 1)
-  "GHC.Prim.ctz32#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . countTrailingZeros . (fromInteger :: Integer -> Word) $ i .&. (bit 32 - 1)
-  "GHC.Prim.ctz64#" | [i] <- word64Literals' args
-    -> reduce . integerToWordLiteral . toInteger . countTrailingZeros . (fromInteger :: Integer -> Word64) $ i .&. (bit 64 - 1)
-  "GHC.Prim.ctz#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . countTrailingZeros . (fromInteger :: Integer -> Word) $ i
-
-  "GHC.Prim.byteSwap16#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . byteSwap16 . (fromInteger :: Integer -> Word16) $ i
-  "GHC.Prim.byteSwap32#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . byteSwap32 . (fromInteger :: Integer -> Word32) $ i
-  "GHC.Prim.byteSwap64#" | [i] <- word64Literals' args
-    -> reduce . integerToWordLiteral . toInteger . byteSwap64 . (fromInteger :: Integer -> Word64) $ i
-  "GHC.Prim.byteSwap#" | [i] <- wordLiterals' args -- assume 64bits
-    -> reduce . integerToWordLiteral . toInteger . byteSwap64 . (fromInteger :: Integer -> Word64) $ i
-
-#if MIN_VERSION_base(4,14,0)
-  "GHC.Prim.bitReverse#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . bitReverse64 . fromInteger $ i -- assume 64bits
-  "GHC.Prim.bitReverse8#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . bitReverse8 . fromInteger $ i
-  "GHC.Prim.bitReverse16#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . bitReverse16 . fromInteger $ i
-  "GHC.Prim.bitReverse32#" | [i] <- wordLiterals' args
-    -> reduce . integerToWordLiteral . toInteger . bitReverse32 . fromInteger $ i
-  "GHC.Prim.bitReverse64#" | [i] <- word64Literals' args
-    -> reduce . integerToWordLiteral . toInteger . bitReverse64 . fromInteger $ i
-#endif
-------------
--- Narrowing
-------------
-  "GHC.Prim.narrow8Int#" | [i] <- intLiterals' args
-    -> let !(I# a)  = fromInteger i
-           b = narrow8Int# a
-       in  reduce . Literal . IntLiteral . toInteger $ I# b
-  "GHC.Prim.narrow16Int#" | [i] <- intLiterals' args
-    -> let !(I# a)  = fromInteger i
-           b = narrow16Int# a
-       in  reduce . Literal . IntLiteral . toInteger $ I# b
-  "GHC.Prim.narrow32Int#" | [i] <- intLiterals' args
-    -> let !(I# a)  = fromInteger i
-           b = narrow32Int# a
-       in  reduce . Literal . IntLiteral . toInteger $ I# b
-  "GHC.Prim.narrow8Word#" | [i] <- wordLiterals' args
-    -> let !(W# a)  = fromInteger i
-           b = narrow8Word# a
-       in  reduce . Literal . WordLiteral . toInteger $ W# b
-  "GHC.Prim.narrow16Word#" | [i] <- wordLiterals' args
-    -> let !(W# a)  = fromInteger i
-           b = narrow16Word# a
-       in  reduce . Literal . WordLiteral . toInteger $ W# b
-  "GHC.Prim.narrow32Word#" | [i] <- wordLiterals' args
-    -> let !(W# a)  = fromInteger i
-           b = narrow32Word# a
-       in  reduce . Literal . WordLiteral . toInteger $ W# b
-
-#if MIN_VERSION_base(4,16,0)
---------
--- Int8#
---------
-  "GHC.Prim.intToInt8#" | [i] <- intLiterals' args
-    -> let !(I# a)  = fromInteger i
-           b = narrow8Int# a
-       in  reduce . Literal . Int8Literal . toInteger $ I# b
-  "GHC.Prim.int8ToInt#" | [i] <- int8Literals' args
-    -> reduce . Literal $ IntLiteral i
-  "GHC.Prim.negateInt8" | [i] <- int8Literals' args
-    -> let !(I8# a) = fromInteger i
-        in reduce (Literal (Int8Literal (toInteger (I8# (negateInt8# a)))))
-  "GHC.Prim.plusInt8#" | Just r <- liftI8 plusInt8# args
-    -> reduce r
-  "GHC.Prim.subInt8#" | Just r <- liftI8 subInt8# args
-    -> reduce r
-  "GHC.Prim.timesInt8#" | Just r <- liftI8 timesInt8# args
-    -> reduce r
-  "GHC.Prim.quotInt8#" | Just r <- liftI8 quotInt8# args
-    -> reduce r
-  "GHC.Prim.remInt8#" | Just r <- liftI8 remInt8# args
-    -> reduce r
-  "GHC.Prim.quotRemInt8#"
-    | [i, j] <- int8Literals' args
-    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
-    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
-    , [tupDc] <- tyConDataCons tupTc
-    -> let !(I8# a)    = fromInteger i
-           !(I8# b)    = fromInteger j
-           !(# q, r #) = quotRemInt8# a b
-        in reduce $
-           mkApps (Data tupDc) (map Right tyArgs ++
-                  [ Left (Literal (Int8Literal (toInteger (I8# q))))
-                  , Left (Literal (Int8Literal (toInteger (I8# r))))])
-  "GHC.Prim.uncheckedShiftLInt8#" | Just r <- liftI8I uncheckedShiftLInt8# args
-    -> reduce r
-  "GHC.Prim.uncheckedShiftRAInt8#" | Just r <- liftI8I uncheckedShiftRAInt8# args
-    -> reduce r
-  "GHC.Prim.uncheckedShiftRLInt8#" | Just r <- liftI8I uncheckedShiftRLInt8# args
-    -> reduce r
-  "GHC.Prim.int8ToWord8#" | [i] <- int8Literals' args
-    -> let !(I8# a) = fromInteger i
-        in reduce (Literal (Word8Literal (toInteger (W8# (int8ToWord8# a)))))
-  "GHC.Prim.eqInt8#" | Just r <- liftI8RI eqInt8# args
-    -> reduce r
-  "GHC.Prim.geInt8#" | Just r <- liftI8RI geInt8# args
-    -> reduce r
-  "GHC.Prim.gtInt8#" | Just r <- liftI8RI gtInt8# args
-    -> reduce r
-  "GHC.Prim.leInt8#" | Just r <- liftI8RI leInt8# args
-    -> reduce r
-  "GHC.Prim.ltInt8#" | Just r <- liftI8RI ltInt8# args
-    -> reduce r
-  "GHC.Prim.neInt8#" | Just r <- liftI8RI neInt8# args
-    -> reduce r
-
----------
--- Int16#
----------
-  "GHC.Prim.intToInt16#" | [i] <- intLiterals' args
-    -> let !(I# a)  = fromInteger i
-           b = narrow16Int# a
-       in  reduce . Literal . Int16Literal . toInteger $ I# b
-  "GHC.Prim.int16ToInt#" | [i] <- int16Literals' args
-    -> reduce . Literal $ IntLiteral i
-  "GHC.Prim.negateInt16" | [i] <- int16Literals' args
-    -> let !(I16# a) = fromInteger i
-        in reduce (Literal (Int16Literal (toInteger (I16# (negateInt16# a)))))
-  "GHC.Prim.plusInt16#" | Just r <- liftI16 plusInt16# args
-    -> reduce r
-  "GHC.Prim.subInt16#" | Just r <- liftI16 subInt16# args
-    -> reduce r
-  "GHC.Prim.timesInt16#" | Just r <- liftI16 timesInt16# args
-    -> reduce r
-  "GHC.Prim.quotInt16#" | Just r <- liftI16 quotInt16# args
-    -> reduce r
-  "GHC.Prim.remInt16#" | Just r <- liftI16 remInt16# args
-    -> reduce r
-  "GHC.Prim.quotRemInt16#"
-    | [i, j] <- int16Literals' args
-    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
-    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
-    , [tupDc] <- tyConDataCons tupTc
-    -> let !(I16# a)   = fromInteger i
-           !(I16# b)   = fromInteger j
-           !(# q, r #) = quotRemInt16# a b
-        in reduce $
-           mkApps (Data tupDc) (map Right tyArgs ++
-                  [ Left (Literal (Int16Literal (toInteger (I16# q))))
-                  , Left (Literal (Int16Literal (toInteger (I16# r))))])
-  "GHC.Prim.uncheckedShiftLInt16#" | Just r <- liftI16I uncheckedShiftLInt16# args
-    -> reduce r
-  "GHC.Prim.uncheckedShiftRAInt16#" | Just r <- liftI16I uncheckedShiftRAInt16# args
-    -> reduce r
-  "GHC.Prim.uncheckedShiftRLInt16#" | Just r <- liftI16I uncheckedShiftRLInt16# args
-    -> reduce r
-  "GHC.Prim.int16ToWord16#" | [i] <- int16Literals' args
-    -> let !(I16# a) = fromInteger i
-        in reduce (Literal (Word16Literal (toInteger (W16# (int16ToWord16# a)))))
-  "GHC.Prim.eqInt16#" | Just r <- liftI16RI eqInt16# args
-    -> reduce r
-  "GHC.Prim.geInt16#" | Just r <- liftI16RI geInt16# args
-    -> reduce r
-  "GHC.Prim.gtInt16#" | Just r <- liftI16RI gtInt16# args
-    -> reduce r
-  "GHC.Prim.leInt16#" | Just r <- liftI16RI leInt16# args
-    -> reduce r
-  "GHC.Prim.ltInt16#" | Just r <- liftI16RI ltInt16# args
-    -> reduce r
-  "GHC.Prim.neInt16#" | Just r <- liftI16RI neInt16# args
-    -> reduce r
-
----------
--- Int32#
----------
-  "GHC.Prim.intToInt32#" | [i] <- intLiterals' args
-    -> let !(I# a)  = fromInteger i
-           b = narrow32Int# a
-       in  reduce . Literal . Int32Literal . toInteger $ I# b
-  "GHC.Prim.int32ToInt#" | [i] <- int32Literals' args
-    -> reduce . Literal $ IntLiteral i
-  "GHC.Prim.negateInt32" | [i] <- int32Literals' args
-    -> let !(I32# a) = fromInteger i
-        in reduce (Literal (Int32Literal (toInteger (I32# (negateInt32# a)))))
-  "GHC.Prim.plusInt32#" | Just r <- liftI32 plusInt32# args
-    -> reduce r
-  "GHC.Prim.subInt32#" | Just r <- liftI32 subInt32# args
-    -> reduce r
-  "GHC.Prim.timesInt32#" | Just r <- liftI32 timesInt32# args
-    -> reduce r
-  "GHC.Prim.quotInt32#" | Just r <- liftI32 quotInt32# args
-    -> reduce r
-  "GHC.Prim.remInt32#" | Just r <- liftI32 remInt32# args
-    -> reduce r
-  "GHC.Prim.quotRemInt32#"
-    | [i, j] <- int32Literals' args
-    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
-    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
-    , [tupDc] <- tyConDataCons tupTc
-    -> let !(I32# a)   = fromInteger i
-           !(I32# b)   = fromInteger j
-           !(# q, r #) = quotRemInt32# a b
-        in reduce $
-           mkApps (Data tupDc) (map Right tyArgs ++
-                  [ Left (Literal (Int32Literal (toInteger (I32# q))))
-                  , Left (Literal (Int32Literal (toInteger (I32# r))))])
-  "GHC.Prim.uncheckedShiftLInt32#" | Just r <- liftI32I uncheckedShiftLInt32# args
-    -> reduce r
-  "GHC.Prim.uncheckedShiftRAInt32#" | Just r <- liftI32I uncheckedShiftRAInt32# args
-    -> reduce r
-  "GHC.Prim.uncheckedShiftRLInt32#" | Just r <- liftI32I uncheckedShiftRLInt32# args
-    -> reduce r
-  "GHC.Prim.int32ToWord32#" | [i] <- int32Literals' args
-    -> let !(I32# a) = fromInteger i
-        in reduce (Literal (Word32Literal (toInteger (W32# (int32ToWord32# a)))))
-  "GHC.Prim.eqInt32#" | Just r <- liftI32RI eqInt32# args
-    -> reduce r
-  "GHC.Prim.geInt32#" | Just r <- liftI32RI geInt32# args
-    -> reduce r
-  "GHC.Prim.gtInt32#" | Just r <- liftI32RI gtInt32# args
-    -> reduce r
-  "GHC.Prim.leInt32#" | Just r <- liftI32RI leInt32# args
-    -> reduce r
-  "GHC.Prim.ltInt32#" | Just r <- liftI32RI ltInt32# args
-    -> reduce r
-  "GHC.Prim.neInt32#" | Just r <- liftI32RI neInt32# args
-    -> reduce r
-
----------
--- Int64#
----------
-#if MIN_VERSION_base(4,17,0)
-  "GHC.Prim.intToInt64#" | [i] <- intLiterals' args
-    -> reduce (Literal (Int64Literal i))
-  "GHC.Prim.int64ToInt#" | [i] <- int64Literals' args
-    -> reduce . Literal $ IntLiteral i
-  "GHC.Prim.negateInt64" | [i] <- int64Literals' args
-    -> let !(I64# a) = fromInteger i
-        in reduce (Literal (Int64Literal (toInteger (I64# (negateInt64# a)))))
-  "GHC.Prim.plusInt64#" | Just r <- liftI64 plusInt64# args
-    -> reduce r
-  "GHC.Prim.subInt64#" | Just r <- liftI64 subInt64# args
-    -> reduce r
-  "GHC.Prim.timesInt64#" | Just r <- liftI64 timesInt64# args
-    -> reduce r
-  "GHC.Prim.quotInt64#" | Just r <- liftI64 quotInt64# args
-    -> reduce r
-  "GHC.Prim.remInt64#" | Just r <- liftI64 remInt64# args
-    -> reduce r
-  "GHC.Prim.uncheckedIShiftL64#" | Just r <- liftI64I uncheckedIShiftL64# args
-    -> reduce r
-  "GHC.Prim.uncheckedIShiftRA64#" | Just r <- liftI64I uncheckedIShiftRA64# args
-    -> reduce r
-  "GHC.Prim.uncheckedIShiftRL64#" | Just r <- liftI64I uncheckedIShiftRL64# args
-    -> reduce r
-  "GHC.Prim.int64ToWord64#" | [i] <- int64Literals' args
-    -> let !(I64# a) = fromInteger i
-        in reduce (Literal (Word64Literal (toInteger (W64# (int64ToWord64# a)))))
-  "GHC.Prim.eqInt64#" | Just r <- liftI64RI eqInt64# args
-    -> reduce r
-  "GHC.Prim.geInt64#" | Just r <- liftI64RI geInt64# args
-    -> reduce r
-  "GHC.Prim.gtInt64#" | Just r <- liftI64RI gtInt64# args
-    -> reduce r
-  "GHC.Prim.leInt64#" | Just r <- liftI64RI leInt64# args
-    -> reduce r
-  "GHC.Prim.ltInt64#" | Just r <- liftI64RI ltInt64# args
-    -> reduce r
-  "GHC.Prim.neInt64#" | Just r <- liftI64RI neInt64# args
-    -> reduce r
-#endif
-
----------
--- Word8#
----------
-  "GHC.Prim.wordToWord8#" | [i] <- wordLiterals' args
-    -> let !(W# a)  = fromInteger i
-           b = narrow8Word# a
-       in  reduce . Literal . Word8Literal . toInteger $ W# b
-  "GHC.Prim.word8ToWord#" | [i] <- word8Literals' args
-    -> reduce . Literal $ WordLiteral i
-  "GHC.Prim.plusWord8#" | Just r <- liftW8 plusWord8# args
-    -> reduce r
-  "GHC.Prim.subWord8#" | Just r <- liftW8 subWord8# args
-    -> reduce r
-  "GHC.Prim.timesWord8#" | Just r <- liftW8 timesWord8# args
-    -> reduce r
-  "GHC.Prim.quotWord8#" | Just r <- liftW8 quotWord8# args
-    -> reduce r
-  "GHC.Prim.remWord8#" | Just r <- liftW8 remWord8# args
-    -> reduce r
-  "GHC.Prim.quotRemWord8#"
-    | [i, j] <- word8Literals' args
-    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
-    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
-    , [tupDc] <- tyConDataCons tupTc
-    -> let !(W8# a)    = fromInteger i
-           !(W8# b)    = fromInteger j
-           !(# q, r #) = quotRemWord8# a b
-        in reduce $
-           mkApps (Data tupDc) (map Right tyArgs ++
-                  [ Left (Literal (Word8Literal (toInteger (W8# q))))
-                  , Left (Literal (Word8Literal (toInteger (W8# r))))])
-  "GHC.Prim.andWord8#" | Just r <- liftW8 andWord8# args
-    -> reduce r
-  "GHC.Prim.orWord8#" | Just r <- liftW8 orWord8# args
-    -> reduce r
-  "GHC.Prim.xorWord8#" | Just r <- liftW8 xorWord8# args
-    -> reduce r
-  "GHC.Prim.notWord8#" | [i] <- word8Literals' args
-    -> let !(W8# a) = fromInteger i
-        in reduce (Literal (Word8Literal (toInteger (W8# (notWord8# a)))))
-  "GHC.Prim.uncheckedShiftLWord8#" | Just r <- liftW8I uncheckedShiftLWord8# args
-    -> reduce r
-  "GHC.Prim.uncheckedShiftRLWord8#" | Just r <- liftW8I uncheckedShiftRLWord8# args
-    -> reduce r
-  "GHC.Prim.word8ToInt8#" | [i] <- word8Literals' args
-    -> let !(W8# a) = fromInteger i
-        in reduce (Literal (Int8Literal (toInteger (I8# (word8ToInt8# a)))))
-  "GHC.Prim.eqWord8#" | Just r <- liftW8RI eqWord8# args
-    -> reduce r
-  "GHC.Prim.geWord8#" | Just r <- liftW8RI geWord8# args
-    -> reduce r
-  "GHC.Prim.gtWord8#" | Just r <- liftW8RI gtWord8# args
-    -> reduce r
-  "GHC.Prim.leWord8#" | Just r <- liftW8RI leWord8# args
-    -> reduce r
-  "GHC.Prim.ltWord8#" | Just r <- liftW8RI ltWord8# args
-    -> reduce r
-  "GHC.Prim.neWord8#" | Just r <- liftW8RI neWord8# args
-    -> reduce r
-
-----------
--- Word16#
-----------
-  "GHC.Prim.wordToWord16#" | [i] <- wordLiterals' args
-    -> let !(W# a)  = fromInteger i
-           b = narrow16Word# a
-       in  reduce . Literal . Word16Literal . toInteger $ W# b
-  "GHC.Prim.word16ToWord#" | [i] <- word16Literals' args
-    -> reduce . Literal $ WordLiteral i
-  "GHC.Prim.plusWord16#" | Just r <- liftW16 plusWord16# args
-    -> reduce r
-  "GHC.Prim.subWord16#" | Just r <- liftW16 subWord16# args
-    -> reduce r
-  "GHC.Prim.timesWord16#" | Just r <- liftW16 timesWord16# args
-    -> reduce r
-  "GHC.Prim.quotWord16#" | Just r <- liftW16 quotWord16# args
-    -> reduce r
-  "GHC.Prim.remWord16#" | Just r <- liftW16 remWord16# args
-    -> reduce r
-  "GHC.Prim.quotRemWord16#"
-    | [i, j] <- word16Literals' args
-    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
-    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
-    , [tupDc] <- tyConDataCons tupTc
-    -> let !(W16# a)    = fromInteger i
-           !(W16# b)    = fromInteger j
-           !(# q, r #) = quotRemWord16# a b
-        in reduce $
-           mkApps (Data tupDc) (map Right tyArgs ++
-                  [ Left (Literal (Word16Literal (toInteger (W16# q))))
-                  , Left (Literal (Word16Literal (toInteger (W16# r))))])
-  "GHC.Prim.andWord16#" | Just r <- liftW16 andWord16# args
-    -> reduce r
-  "GHC.Prim.orWord16#" | Just r <- liftW16 orWord16# args
-    -> reduce r
-  "GHC.Prim.xorWord16#" | Just r <- liftW16 xorWord16# args
-    -> reduce r
-  "GHC.Prim.notWord16#" | [i] <- word16Literals' args
-    -> let !(W16# a) = fromInteger i
-        in reduce (Literal (Word16Literal (toInteger (W16# (notWord16# a)))))
-  "GHC.Prim.uncheckedShiftLWord16#" | Just r <- liftW16I uncheckedShiftLWord16# args
-    -> reduce r
-  "GHC.Prim.uncheckedShiftRLWord16#" | Just r <- liftW16I uncheckedShiftRLWord16# args
-    -> reduce r
-  "GHC.Prim.word16ToInt16#" | [i] <- word16Literals' args
-    -> let !(W16# a) = fromInteger i
-        in reduce (Literal (Int16Literal (toInteger (I16# (word16ToInt16# a)))))
-  "GHC.Prim.eqWord16#" | Just r <- liftW16RI eqWord16# args
-    -> reduce r
-  "GHC.Prim.geWord16#" | Just r <- liftW16RI geWord16# args
-    -> reduce r
-  "GHC.Prim.gtWord16#" | Just r <- liftW16RI gtWord16# args
-    -> reduce r
-  "GHC.Prim.leWord16#" | Just r <- liftW16RI leWord16# args
-    -> reduce r
-  "GHC.Prim.ltWord16#" | Just r <- liftW16RI ltWord16# args
-    -> reduce r
-  "GHC.Prim.neWord16#" | Just r <- liftW16RI neWord16# args
-    -> reduce r
-
-----------
--- Word32#
-----------
-  "GHC.Prim.wordToWord32#" | [i] <- wordLiterals' args
-    -> let !(W# a)  = fromInteger i
-           b = narrow32Word# a
-       in  reduce . Literal . Word32Literal . toInteger $ W# b
-  "GHC.Prim.word32ToWord#" | [i] <- word32Literals' args
-    -> reduce . Literal $ WordLiteral i
-  "GHC.Prim.plusWord32#" | Just r <- liftW32 plusWord32# args
-    -> reduce r
-  "GHC.Prim.subWord32#" | Just r <- liftW32 subWord32# args
-    -> reduce r
-  "GHC.Prim.timesWord32#" | Just r <- liftW32 timesWord32# args
-    -> reduce r
-  "GHC.Prim.quotWord32#" | Just r <- liftW32 quotWord32# args
-    -> reduce r
-  "GHC.Prim.remWord32#" | Just r <- liftW32 remWord32# args
-    -> reduce r
-  "GHC.Prim.quotRemWord32#"
-    | [i, j] <- word32Literals' args
-    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
-    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
-    , [tupDc] <- tyConDataCons tupTc
-    -> let !(W32# a)    = fromInteger i
-           !(W32# b)    = fromInteger j
-           !(# q, r #) = quotRemWord32# a b
-        in reduce $
-           mkApps (Data tupDc) (map Right tyArgs ++
-                  [ Left (Literal (Word32Literal (toInteger (W32# q))))
-                  , Left (Literal (Word32Literal (toInteger (W32# r))))])
-  "GHC.Prim.andWord32#" | Just r <- liftW32 andWord32# args
-    -> reduce r
-  "GHC.Prim.orWord32#" | Just r <- liftW32 orWord32# args
-    -> reduce r
-  "GHC.Prim.xorWord32#" | Just r <- liftW32 xorWord32# args
-    -> reduce r
-  "GHC.Prim.notWord32#" | [i] <- word32Literals' args
-    -> let !(W32# a) = fromInteger i
-        in reduce (Literal (Word32Literal (toInteger (W32# (notWord32# a)))))
-  "GHC.Prim.uncheckedShiftLWord32#" | Just r <- liftW32I uncheckedShiftLWord32# args
-    -> reduce r
-  "GHC.Prim.uncheckedShiftRLWord32#" | Just r <- liftW32I uncheckedShiftRLWord32# args
-    -> reduce r
-  "GHC.Prim.word32ToInt32#" | [i] <- word32Literals' args
-    -> let !(W32# a) = fromInteger i
-        in reduce (Literal (Int32Literal (toInteger (I32# (word32ToInt32# a)))))
-  "GHC.Prim.eqWord32#" | Just r <- liftW32RI eqWord32# args
-    -> reduce r
-  "GHC.Prim.geWord32#" | Just r <- liftW32RI geWord32# args
-    -> reduce r
-  "GHC.Prim.gtWord32#" | Just r <- liftW32RI gtWord32# args
-    -> reduce r
-  "GHC.Prim.leWord32#" | Just r <- liftW32RI leWord32# args
-    -> reduce r
-  "GHC.Prim.ltWord32#" | Just r <- liftW32RI ltWord32# args
-    -> reduce r
-  "GHC.Prim.neWord32#" | Just r <- liftW32RI neWord32# args
-    -> reduce r
-
-#if MIN_VERSION_base(4,17,0)
-----------
--- Word64#
-----------
-  "GHC.Prim.wordToWord64#" | [i] <- wordLiterals' args
-    -> reduce (Literal (Word64Literal i))
-  "GHC.Prim.word64ToWord#" | [i] <- word64Literals' args
-    -> reduce . Literal $ WordLiteral i
-  "GHC.Prim.plusWord64#" | Just r <- liftW64 plusWord64# args
-    -> reduce r
-  "GHC.Prim.subWord64#" | Just r <- liftW64 subWord64# args
-    -> reduce r
-  "GHC.Prim.timesWord64#" | Just r <- liftW64 timesWord64# args
-    -> reduce r
-  "GHC.Prim.quotWord64#" | Just r <- liftW64 quotWord64# args
-    -> reduce r
-  "GHC.Prim.remWord64#" | Just r <- liftW64 remWord64# args
-    -> reduce r
-  "GHC.Prim.and64#" | Just r <- liftW64 and64# args
-    -> reduce r
-  "GHC.Prim.or64#" | Just r <- liftW64 or64# args
-    -> reduce r
-  "GHC.Prim.xor64#" | Just r <- liftW64 xor64# args
-    -> reduce r
-  "GHC.Prim.not64#" | [i] <- word64Literals' args
-    -> let !(W64# a) = fromInteger i
-        in reduce (Literal (Word64Literal (toInteger (W64# (not64# a)))))
-  "GHC.Prim.uncheckedShiftL64#" | Just r <- liftW64I uncheckedShiftL64# args
-    -> reduce r
-  "GHC.Prim.uncheckedShiftRL64#" | Just r <- liftW64I uncheckedShiftRL64# args
-    -> reduce r
-  "GHC.Prim.word64ToInt64#" | [i] <- word64Literals' args
-    -> let !(W64# a) = fromInteger i
-        in reduce (Literal (Int64Literal (toInteger (I64# (word64ToInt64# a)))))
-  "GHC.Prim.eqWord64#" | Just r <- liftW64RI eqWord64# args
-    -> reduce r
-  "GHC.Prim.geWord64#" | Just r <- liftW64RI geWord64# args
-    -> reduce r
-  "GHC.Prim.gtWord64#" | Just r <- liftW64RI gtWord64# args
-    -> reduce r
-  "GHC.Prim.leWord64#" | Just r <- liftW64RI leWord64# args
-    -> reduce r
-  "GHC.Prim.ltWord64#" | Just r <- liftW64RI ltWord64# args
-    -> reduce r
-  "GHC.Prim.neWord64#" | Just r <- liftW64RI neWord64# args
-    -> reduce r
-#endif
-#endif
-
-----------
--- Double#
-----------
-  "GHC.Prim.>##"  | Just r <- liftDDI (>##)  args
-    -> reduce r
-  "GHC.Prim.>=##" | Just r <- liftDDI (>=##) args
-    -> reduce r
-  "GHC.Prim.==##" | Just r <- liftDDI (==##) args
-    -> reduce r
-  "GHC.Prim./=##" | Just r <- liftDDI (/=##) args
-    -> reduce r
-  "GHC.Prim.<##"  | Just r <- liftDDI (<##)  args
-    -> reduce r
-  "GHC.Prim.<=##" | Just r <- liftDDI (<=##) args
-    -> reduce r
-  "GHC.Prim.+##"  | Just r <- liftDDD (+##)  args
-    -> reduce r
-  "GHC.Prim.-##"  | Just r <- liftDDD (-##)  args
-    -> reduce r
-  "GHC.Prim.*##"  | Just r <- liftDDD (*##)  args
-    -> reduce r
-  "GHC.Prim./##"  | Just r <- liftDDD (/##)  args
-    -> reduce r
-
-  "GHC.Prim.negateDouble#" | Just r <- liftDD negateDouble# args
-    -> reduce r
-  "GHC.Prim.fabsDouble#" | Just r <- liftDD fabsDouble# args
-    -> reduce r
-
-  "GHC.Prim.double2Int#" | [i] <- doubleLiterals' args
-    -> let !(D# a) = wordToDouble i
-           r = double2Int# a
-       in  reduce . Literal . IntLiteral . toInteger $ I# r
-  "GHC.Prim.double2Float#"
-    | [Lit (DoubleLiteral d)] <- args
-    -> let !(D# a) = wordToDouble d
-           r = double2Float# a
-       in reduce . Literal . FloatLiteral . floatToWord $ F# r
-
-  "GHC.Prim.expDouble#" | Just r <- liftDD expDouble# args
-    -> reduce r
-  "GHC.Prim.logDouble#" | Just r <- liftDD logDouble# args
-    -> reduce r
-  "GHC.Prim.sqrtDouble#" | Just r <- liftDD sqrtDouble# args
-    -> reduce r
-  "GHC.Prim.sinDouble#" | Just r <- liftDD sinDouble# args
-    -> reduce r
-  "GHC.Prim.cosDouble#" | Just r <- liftDD cosDouble# args
-    -> reduce r
-  "GHC.Prim.tanDouble#" | Just r <- liftDD tanDouble# args
-    -> reduce r
-  "GHC.Prim.asinDouble#" | Just r <- liftDD asinDouble# args
-    -> reduce r
-  "GHC.Prim.acosDouble#" | Just r <- liftDD acosDouble# args
-    -> reduce r
-  "GHC.Prim.atanDouble#" | Just r <- liftDD atanDouble# args
-    -> reduce r
-  "GHC.Prim.sinhDouble#" | Just r <- liftDD sinhDouble# args
-    -> reduce r
-  "GHC.Prim.coshDouble#" | Just r <- liftDD coshDouble# args
-    -> reduce r
-  "GHC.Prim.tanhDouble#" | Just r <- liftDD tanhDouble# args
-    -> reduce r
-
-#if MIN_VERSION_ghc(8,7,0)
-  "GHC.Prim.asinhDouble#"  | Just r <- liftDD asinhDouble# args
-    -> reduce r
-  "GHC.Prim.acoshDouble#"  | Just r <- liftDD acoshDouble# args
-    -> reduce r
-  "GHC.Prim.atanhDouble#"  | Just r <- liftDD atanhDouble# args
-    -> reduce r
-#endif
-
-  "GHC.Prim.**##" | Just r <- liftDDD (**##) args
-    -> reduce r
--- decodeDouble_2Int# :: Double# -> (#Int#, Word#, Word#, Int##)
-  "GHC.Prim.decodeDouble_2Int#" | [i] <- doubleLiterals' args
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           !(D# a) = wordToDouble i
-           !(# p, q, r, s #) = decodeDouble_2Int# a
-       in reduce $
-          mkApps (Data tupDc) (map Right tyArgs ++
-                   [ Left (Literal . IntLiteral  . toInteger $ I# p)
-                   , Left (Literal . WordLiteral . toInteger $ W# q)
-                   , Left (Literal . WordLiteral . toInteger $ W# r)
-                   , Left (Literal . IntLiteral  . toInteger $ I# s)])
--- decodeDouble_Int64# :: Double# -> (# Int64#, Int# #)
-  "GHC.Prim.decodeDouble_Int64#" | [i] <- doubleLiterals' args
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           !(D# a) = wordToDouble i
-           !(# p, q #) = decodeDouble_Int64# a
-       in reduce $
-          mkApps (Data tupDc) (map Right tyArgs ++
-#if MIN_VERSION_ghc_prim(0,9,0)
-                   [ Left (Literal . Int64Literal  . toInteger $ I64# p)
-#else
-                   [ Left (Literal . IntLiteral  . toInteger $ I64# p)
-#endif
-                   , Left (Literal . IntLiteral  . toInteger $ I# q)])
-
---------
--- Float
---------
-  "GHC.Prim.gtFloat#"  | Just r <- liftFFI gtFloat# args
-    -> reduce r
-  "GHC.Prim.geFloat#"  | Just r <- liftFFI geFloat# args
-    -> reduce r
-  "GHC.Prim.eqFloat#"  | Just r <- liftFFI eqFloat# args
-    -> reduce r
-  "GHC.Prim.neFloat#"  | Just r <- liftFFI neFloat# args
-    -> reduce r
-  "GHC.Prim.ltFloat#"  | Just r <- liftFFI ltFloat# args
-    -> reduce r
-  "GHC.Prim.leFloat#"  | Just r <- liftFFI leFloat# args
-    -> reduce r
-
-  "GHC.Prim.plusFloat#"  | Just r <- liftFFF plusFloat# args
-    -> reduce r
-  "GHC.Prim.minusFloat#"  | Just r <- liftFFF minusFloat# args
-    -> reduce r
-  "GHC.Prim.timesFloat#"  | Just r <- liftFFF timesFloat# args
-    -> reduce r
-  "GHC.Prim.divideFloat#"  | Just r <- liftFFF divideFloat# args
-    -> reduce r
-
-  "GHC.Prim.negateFloat#"  | Just r <- liftFF negateFloat# args
-    -> reduce r
-  "GHC.Prim.fabsFloat#"  | Just r <- liftFF fabsFloat# args
-    -> reduce r
-
-  "GHC.Prim.float2Int#" | [i] <- floatLiterals' args
-    -> let !(F# a) = wordToFloat i
-           r = float2Int# a
-       in  reduce . Literal . IntLiteral . toInteger $ I# r
-
-  "GHC.Prim.expFloat#"  | Just r <- liftFF expFloat# args
-    -> reduce r
-  "GHC.Prim.logFloat#"  | Just r <- liftFF logFloat# args
-    -> reduce r
-  "GHC.Prim.sqrtFloat#"  | Just r <- liftFF sqrtFloat# args
-    -> reduce r
-  "GHC.Prim.sinFloat#"  | Just r <- liftFF sinFloat# args
-    -> reduce r
-  "GHC.Prim.cosFloat#"  | Just r <- liftFF cosFloat# args
-    -> reduce r
-  "GHC.Prim.tanFloat#"  | Just r <- liftFF tanFloat# args
-    -> reduce r
-  "GHC.Prim.asinFloat#"  | Just r <- liftFF asinFloat# args
-    -> reduce r
-  "GHC.Prim.acosFloat#"  | Just r <- liftFF acosFloat# args
-    -> reduce r
-  "GHC.Prim.atanFloat#"  | Just r <- liftFF atanFloat# args
-    -> reduce r
-  "GHC.Prim.sinhFloat#"  | Just r <- liftFF sinhFloat# args
-    -> reduce r
-  "GHC.Prim.coshFloat#"  | Just r <- liftFF coshFloat# args
-    -> reduce r
-  "GHC.Prim.tanhFloat#"  | Just r <- liftFF tanhFloat# args
-    -> reduce r
-  "GHC.Prim.powerFloat#"  | Just r <- liftFFF powerFloat# args
-    -> reduce r
-
-  -- GHC.Float.asinh  -- XXX: Very fragile
-  --  $w$casinh is the Double specialisation of asinh
-  --  $w$casinh1 is the Float specialisation of asinh
-  "GHC.Float.$w$casinh" | Just r <- liftDD go args
-    -> reduce r
-    where go f = case asinh (D# f) of
-                   D# f' -> f'
-  "GHC.Float.$w$casinh1" | Just r <- liftFF go args
-    -> reduce r
-    where go f = case asinh (F# f) of
-                   F# f' -> f'
-
-#if MIN_VERSION_ghc(8,7,0)
-  "GHC.Prim.asinhFloat#"  | Just r <- liftFF asinhFloat# args
-    -> reduce r
-  "GHC.Prim.acoshFloat#"  | Just r <- liftFF acoshFloat# args
-    -> reduce r
-  "GHC.Prim.atanhFloat#"  | Just r <- liftFF atanhFloat# args
-    -> reduce r
-#endif
-
-  "GHC.Prim.float2Double#" | [i] <- floatLiterals' args
-    -> let !(F# a) = wordToFloat i
-           r = float2Double# a
-       in  reduce . Literal . DoubleLiteral . doubleToWord $ D# r
-
-
-  "GHC.Prim.newByteArray#"
-    | [iV,PrimVal rwTy _ _] <- args
-    , [i] <- intLiterals' [iV]
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           p = primCount mach
-           lit = Literal (ByteArrayLiteral (fromList (List.genericReplicate i 0)))
-           mbaTy = mkFunTy intPrimTy (last tyArgs)
-           newE = mkApps (Data tupDc) (map Right tyArgs ++
-                    [Left (Prim rwTy)
-                    ,Left (mkApps (Prim (PrimInfo "GHC.Prim.MutableByteArray#" mbaTy WorkNever SingleResult NoUnfolding))
-                                  [Left (Literal . IntLiteral $ toInteger p)])
-                    ])
-       in Just . setTerm newE $ primInsert p lit mach
-
-  "GHC.Prim.setByteArray#"
-    | [PrimVal _mbaTy _ [baV]
-      ,offV,lenV,cV
-      ,PrimVal rwTy _ _
-      ] <- args
-    , [ba,off,len,c] <- intLiterals' [baV,offV,lenV,cV]
-    -> let Just (Literal (ByteArrayLiteral ba1)) =
-              primLookup (fromInteger ba) mach
-           !(I# off') = fromInteger off
-           !(I# len') = fromInteger len
-           !(I# c')   = fromInteger c
-           ba2 = unsafeDupablePerformIO $ do
-                  BA.MutableByteArray mba <- BA.unsafeThawByteArray ba1
-                  svoid (setByteArray# mba off' len' c')
-                  BA.unsafeFreezeByteArray (BA.MutableByteArray mba)
-           ba3 = Literal (ByteArrayLiteral ba2)
-       in Just . setTerm (Prim rwTy) $ primUpdate (fromInteger ba) ba3 mach
-
-  "GHC.Prim.writeWordArray#"
-    | [PrimVal _mbaTy _  [baV]
-      ,iV,wV
-      ,PrimVal rwTy _ _
-      ] <- args
-    , [ba,i] <- intLiterals' [baV,iV]
-    , [w] <- wordLiterals' [wV]
-    -> let Just (Literal (ByteArrayLiteral ba1)) =
-              primLookup (fromInteger ba) mach
-           !(I# i') = fromInteger i
-           !(W# w') = fromIntegral w
-           ba2 = unsafeDupablePerformIO $ do
-                  BA.MutableByteArray mba <- BA.unsafeThawByteArray ba1
-                  svoid (writeWordArray# mba i' w')
-                  BA.unsafeFreezeByteArray (BA.MutableByteArray mba)
-           ba3 = Literal (ByteArrayLiteral ba2)
-       in Just . setTerm (Prim rwTy) $ primUpdate (fromInteger ba) ba3 mach
-
-  "GHC.Prim.unsafeFreezeByteArray#"
-    | [PrimVal _mbaTy _ [baV]
-      ,PrimVal rwTy _ _
-      ] <- args
-    , [ba] <-  intLiterals' [baV]
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           Just ba' = primLookup (fromInteger ba) mach
-       in  reduce $ mkApps (Data tupDc) (map Right tyArgs ++
-                      [Left (Prim rwTy)
-                      ,Left ba'])
-
-  "GHC.Prim.sizeofByteArray#"
-    | [Lit (ByteArrayLiteral ba)] <- args
-    -> reduce (Literal (IntLiteral (toInteger (BA.sizeofByteArray ba))))
-
-  "GHC.Prim.indexWordArray#"
-    | [Lit (ByteArrayLiteral (BA.ByteArray ba)),iV] <- args
-    , [i] <- intLiterals' [iV]
-    -> let !(I# i') = fromInteger i
-           !w       = indexWordArray# ba i'
-       in  reduce (Literal (WordLiteral (toInteger (W# w))))
-
-  "GHC.Prim.getSizeofMutBigNat#"
-    | [PrimVal _mbaTy _ [baV]
-      ,PrimVal rwTy _ _
-      ] <- args
-    , [ba] <- intLiterals' [baV]
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           Just (Literal (ByteArrayLiteral ba')) = primLookup (fromInteger ba) mach
-           lit = Literal (IntLiteral (toInteger (BA.sizeofByteArray ba')))
-       in  reduce $ mkApps (Data tupDc) (map Right tyArgs ++
-                      [Left (Prim rwTy)
-                      ,Left lit])
-
-  "GHC.Prim.resizeMutableByteArray#"
-    | [PrimVal mbaTy _ [baV]
-      ,iV
-      ,PrimVal rwTy _ _
-      ] <- args
-    , [ba,i] <- intLiterals' [baV,iV]
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           p = primCount mach
-           Just (Literal (ByteArrayLiteral ba1))
-            = primLookup (fromInteger ba) mach
-           !(I# i') = fromInteger i
-           ba2 = unsafeDupablePerformIO $ do
-                   BA.MutableByteArray mba <- BA.unsafeThawByteArray ba1
-                   mba' <- IO (\s -> case resizeMutableByteArray# mba i' s of
-                                 (# s', mba' #) -> (# s', BA.MutableByteArray mba' #))
-                   BA.unsafeFreezeByteArray mba'
-           ba3 = Literal (ByteArrayLiteral ba2)
-           newE = mkApps (Data tupDc) (map Right tyArgs ++
-                    [Left (Prim rwTy)
-                    ,Left (mkApps (Prim mbaTy)
-                                  [Left (Literal . IntLiteral $ toInteger p)])
-                    ])
-       in Just . setTerm newE $ primInsert p ba3 mach
-
-  "GHC.Prim.shrinkMutableByteArray#"
-    | [PrimVal _mbaTy _ [baV]
-      ,lenV
-      ,PrimVal rwTy _ _
-      ] <- args
-    , [ba,len] <- intLiterals' [baV,lenV]
-    -> let Just (Literal (ByteArrayLiteral ba1)) =
-              primLookup (fromInteger ba) mach
-           !(I# len') = fromInteger len
-           ba2 = unsafeDupablePerformIO $ do
-                  BA.MutableByteArray mba <- BA.unsafeThawByteArray ba1
-                  svoid (shrinkMutableByteArray# mba len')
-                  BA.unsafeFreezeByteArray (BA.MutableByteArray mba)
-           ba3 = Literal (ByteArrayLiteral ba2)
-       in Just . setTerm (Prim rwTy) $ primUpdate (fromInteger ba) ba3 mach
-
-  "GHC.Prim.copyByteArray#"
-    | [Lit (ByteArrayLiteral (BA.ByteArray src_ba))
-      ,src_offV
-      ,PrimVal _mbaTy _ [dst_mbaV]
-      ,dst_offV, nV
-      ,PrimVal rwTy _ _
-      ] <- args
-    , [src_off,dst_mba,dst_off,n] <- intLiterals' [src_offV,dst_mbaV,dst_offV,nV]
-    -> let Just (Literal (ByteArrayLiteral dst_ba)) =
-              primLookup (fromInteger dst_mba) mach
-           !(I# src_off') = fromInteger src_off
-           !(I# dst_off') = fromInteger dst_off
-           !(I# n')       = fromInteger n
-           ba2 = unsafeDupablePerformIO $ do
-                  BA.MutableByteArray dst_mba1 <- BA.unsafeThawByteArray dst_ba
-                  svoid (copyByteArray# src_ba src_off' dst_mba1 dst_off' n')
-                  BA.unsafeFreezeByteArray (BA.MutableByteArray dst_mba1)
-           ba3 = Literal (ByteArrayLiteral ba2)
-       in Just . setTerm (Prim rwTy) $ primUpdate (fromInteger dst_mba) ba3 mach
-
-  "GHC.Prim.readWordArray#"
-    | [PrimVal _mbaTy _  [baV]
-      ,offV
-      ,PrimVal rwTy _ _
-      ] <- args
-    , [ba,off] <- intLiterals' [baV,offV]
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           Just (Literal (ByteArrayLiteral ba1)) =
-              primLookup (fromInteger ba) mach
-           !(I# off') = fromInteger off
-           w = unsafeDupablePerformIO $ do
-                  BA.MutableByteArray mba <- BA.unsafeThawByteArray ba1
-                  IO (\s -> case readWordArray# mba off' s of
-                        (# s', w' #) -> (# s',  W# w' #))
-           newE = mkApps (Data tupDc) (map Right tyArgs ++
-                    [Left (Prim rwTy)
-                    ,Left (Literal (WordLiteral (toInteger w)))
-                    ])
-       in reduce newE
-
-  "GHC.Prim.copyAddrToByteArray#"
-    | [ Lit (StringLiteral addr)
-      , PrimVal _mbaTy _ [dst_mbaV]
-      , offV, lenV
-      , PrimVal rwTy _ _
-      ] <- args
-    , [off,len,dst_mba] <- intLiterals' [offV, lenV, dst_mbaV]
-    -> let Just (Literal (ByteArrayLiteral dst_ba)) =
-              primLookup (fromInteger dst_mba) mach
-           !(I# off') = fromInteger off
-           !(I# len') = fromInteger len
-           !(BS.PS (ForeignPtr addr' _) _ _) = BS.packChars addr
-           ba2 = unsafeDupablePerformIO $ do
-                    BA.MutableByteArray dst_mba1 <- BA.unsafeThawByteArray dst_ba
-                    svoid (copyAddrToByteArray# addr' dst_mba1 off' len')
-                    BA.unsafeFreezeByteArray (BA.MutableByteArray dst_mba1)
-           ba3 = Literal (ByteArrayLiteral ba2)
-        in Just . setTerm (Prim rwTy) $ primUpdate (fromInteger dst_mba) ba3 mach
-
--- decodeFloat_Int# :: Float# -> (#Int#, Int##)
-  "GHC.Prim.decodeFloat_Int#" | [i] <- floatLiterals' args
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           !(F# a) = wordToFloat i
-           !(# p, q #) = decodeFloat_Int# a
-       in reduce $
-          mkApps (Data tupDc) (map Right tyArgs ++
-                   [ Left (Literal . IntLiteral  . toInteger $ I# p)
-                   , Left (Literal . IntLiteral  . toInteger $ I# q)])
-
-  "GHC.Prim.tagToEnum#"
-    | [ConstTy (TyCon tcN)] <- tys
-    , [Lit (IntLiteral i)]  <- args
-    -> let dc = do { tc <- UniqMap.lookup tcN tcm
-                   ; let dcs = tyConDataCons tc
-                   ; List.find ((== (i+1)) . toInteger . dcTag) dcs
-                   }
-       in (\e -> setTerm (Data e) mach) <$> dc
-
-  "GHC.Prim.dataToTag#"
-    | [DC dc _] <- args
-    -> reduce (Literal (IntLiteral (toInteger (dcTag dc - 1))))
-
-  "GHC.Prim.dataToTagSmall#"
-    | [DC dc _] <- args
-    -> reduce (Literal (IntLiteral (toInteger (dcTag dc - 1))))
-
-  "GHC.Prim.dataToTagLarge#"
-    | [DC dc _] <- args
-    -> reduce (Literal (IntLiteral (toInteger (dcTag dc - 1))))
-
-  "GHC.Classes.eqInt" | Just (i,j) <- intCLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i == j))
-
-  "GHC.Classes.neInt" | Just (i,j) <- intCLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i /= j))
-
-  "GHC.Classes.leInt" | Just (i,j) <- intCLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i <= j))
-
-  "GHC.Classes.ltInt" | Just (i,j) <- intCLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i < j))
-
-  "GHC.Classes.geInt" | Just (i,j) <- intCLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i >= j))
-
-  "GHC.Classes.gtInt" | Just (i,j) <- intCLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i > j))
-
-  "GHC.Classes.&&"
-    | [ lArg , rArg ] <- args
-    , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
-    -- evaluation of the arguments is deferred until the evaluation of the ghcPrimUnwindWith
-    -- to make `&&` lazy in both arguments
-    , mach1@Machine{mStack=[],mTerm=lArgWHNF} <- whnf eval tcm True (setTerm (valToTerm lArg) $ stackClear mach)
-    , mach2@Machine{mStack=[],mTerm=rArgWHNF} <- whnf eval tcm True (setTerm (valToTerm rArg) $ stackClear mach1)
-    -> case [ lArgWHNF, rArgWHNF ] of
-         [ Data lCon, Data rCon ] ->
-           Just $ mach2
-             { mStack = mStack mach
-             , mTerm = boolToBoolLiteral tcm ty (isTrueDC lCon && isTrueDC rCon)
-             }
-
-         [ Data lCon, _ ]
-           | isTrueDC lCon -> reduce rArgWHNF
-           | otherwise     -> reduce (boolToBoolLiteral tcm ty False)
-
-         [ _, Data rCon ]
-           | isTrueDC rCon -> reduce lArgWHNF
-           | otherwise     -> reduce (boolToBoolLiteral tcm ty False)
-
-         _ -> Nothing
-
-  "GHC.Classes.||"
-    | [ lArg , rArg ] <- args
-    , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
-    -- evaluation of the arguments is deferred until the evaluation of the ghcPrimUnwindWith
-    -- to make `||` lazy in both arguments
-    , mach1@Machine{mStack=[],mTerm=lArgWHNF} <- whnf eval tcm True (setTerm (valToTerm lArg) $ stackClear mach)
-    , mach2@Machine{mStack=[],mTerm=rArgWHNF} <- whnf eval tcm True (setTerm (valToTerm rArg) $ stackClear mach1)
-    -> case [ lArgWHNF, rArgWHNF ] of
-         [ Data lCon, Data rCon ] ->
-           Just $ mach2
-             { mStack = mStack mach
-             , mTerm = boolToBoolLiteral tcm ty (isTrueDC lCon || isTrueDC rCon)
-             }
-
-         [ Data lCon, _ ]
-           | isFalseDC lCon -> reduce rArgWHNF
-           | otherwise      -> reduce (boolToBoolLiteral tcm ty True)
-
-         [ _, Data rCon ]
-           | isFalseDC rCon -> reduce lArgWHNF
-           | otherwise      -> reduce (boolToBoolLiteral tcm ty True)
-
-         _ -> Nothing
-
-  "GHC.Classes.divInt#" | Just (i,j) <- intLiterals args
-    -> reduce (integerToIntLiteral (i `div` j))
-
-  -- modInt# :: Int# -> Int# -> Int#
-  "GHC.Classes.modInt#"
-    | [dividend, divisor] <- intLiterals' args
-    ->
-      if divisor == 0 then
-        let iTy = snd (splitFunForallTy ty) in
-        reduce (TyApp (Prim NP.undefined) iTy)
-      else
-        reduce (Literal (IntLiteral (dividend `mod` divisor)))
-
-  "GHC.Classes.not"
-    | [DC bCon _] <- args
-    -> reduce (boolToBoolLiteral tcm ty (nameOcc (dcName bCon) == "GHC.Types.False"))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerLogBase#"
-    | Just (a,b) <- integerLiterals args
-    , Just c <- flogBase a b
-    -> (reduce . Literal . WordLiteral . toInteger) c
-
-  "GHC.Internal.Float.integerToFloat#"
-    | [v] <- args
-    , Just i <- integerLiteral v
-    -> reduce . Literal . FloatLiteral . floatToWord $ F# (integerToFloat# i)
-
-  "GHC.Internal.Float.integerToDouble#"
-    | [v] <- args
-    , Just i <- integerLiteral v
-    -> reduce . Literal . DoubleLiteral . doubleToWord $ D# (integerToDouble# i)
-
-  "GHC.Num.Integer.integerToFloat#"
-    | [v] <- args
-    , Just i <- integerLiteral v
-    -> reduce . Literal . FloatLiteral . floatToWord $ F# (integerToFloat# i)
-
-  "GHC.Num.Integer.integerToDouble#"
-    | [v] <- args
-    , Just i <- integerLiteral v
-    -> reduce . Literal . DoubleLiteral . doubleToWord $ D# (integerToDouble# i)
-
-  "GHC.Float.integerToFloat#"
-    | [v] <- args
-    , Just i <- integerLiteral v
-    -> reduce . Literal . FloatLiteral . floatToWord $ F# (integerToFloat# i)
-
-  "GHC.Float.integerToDouble#"
-    | [v] <- args
-    , Just i <- integerLiteral v
-    -> reduce . Literal . DoubleLiteral . doubleToWord $ D# (integerToDouble# i)
-
-  "GHC.Num.Natural.naturalLogBase#"
-    | Just (a,b) <- naturalLiterals args
-    , Just c <- flogBase a b
-    -> (reduce . Literal . WordLiteral . toInteger) c
-#else
-  "GHC.Integer.Logarithms.integerLogBase#"
-    | Just (a,b) <- integerLiterals args
-    , Just c <- flogBase a b
-    -> (reduce . Literal . IntLiteral . toInteger) c
-#endif
-
-#if !MIN_VERSION_base(4,15,0)
-  "GHC.Integer.Type.smallInteger"
-    | [Lit (IntLiteral i)] <- args
-    -> reduce (Literal (IntegerLiteral i))
-#endif
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerToInt#"
-#else
-  "GHC.Integer.Type.integerToInt"
-#endif
-    | [i] <- integerLiterals' args
-    -> reduce (integerToIntLiteral i)
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerDecodeDouble#" -- :: Double# -> (#Integer, Int##)
-#else
-  "GHC.Integer.Type.decodeDoubleInteger" -- :: Double# -> (#Integer, Int##)
-#endif
-    | [Lit (DoubleLiteral i)] <- args
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           !(D# a)  = wordToDouble i
-           !(# b, c #) = decodeDoubleInteger a
-    in reduce $
-       mkApps (Data tupDc) (map Right tyArgs ++
-                [ Left (integerToIntegerLiteral b)
-                , Left (integerToIntLiteral . toInteger $ I# c)])
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerEncodeDouble#" -- :: Integer -> Int# -> Double
-#else
-  "GHC.Integer.Type.encodeDoubleInteger" -- :: Integer -> Int# -> Double
-#endif
-    | [iV, Lit (IntLiteral j)] <- args
-    , [i] <- integerLiterals' [iV]
-    -> let !(I# k') = fromInteger j
-           r = encodeDoubleInteger i k'
-    in  reduce . Literal . DoubleLiteral . doubleToWord $ D# r
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerEncodeFloat#"
-    | [iV, Lit (IntLiteral j)] <- args
-    , [i] <- integerLiterals' [iV]
-    -> let !(I# k') = fromInteger j
-           r = integerEncodeFloat# i k'
-        in reduce . Literal . FloatLiteral . floatToWord $ F# r
-#endif
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerQuotRem#" -- :: Integer -> Integer -> (#Integer, Integer#)
-#else
-  "GHC.Integer.Type.quotRemInteger" -- :: Integer -> Integer -> (#Integer, Integer#)
-#endif
-    | [i, j] <- integerLiterals' args
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           (q,r) = quotRem i j
-    in reduce $
-         mkApps (Data tupDc) (map Right tyArgs ++
-                [ Left $ catchDivByZero (integerToIntegerLiteral q)
-                , Left $ catchDivByZero (integerToIntegerLiteral r)])
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerAdd"
-#else
-  "GHC.Integer.Type.plusInteger"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (integerToIntegerLiteral (i+j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerSub"
-#else
-  "GHC.Integer.Type.minusInteger"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (integerToIntegerLiteral (i-j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerMul"
-#else
-  "GHC.Integer.Type.timesInteger"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (integerToIntegerLiteral (i*j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerNegate"
-#else
-  "GHC.Integer.Type.negateInteger"
-#endif
-    | [i] <- integerLiterals' args
-    -> reduce (integerToIntegerLiteral (negate i))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerDiv"
-#else
-  "GHC.Integer.Type.divInteger"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce $ catchDivByZero (integerToIntegerLiteral (i `div` j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerMod"
-#else
-  "GHC.Integer.Type.modInteger"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce $ catchDivByZero (integerToIntegerLiteral (i `mod` j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerQuot"
-#else
-  "GHC.Integer.Type.quotInteger"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce $ catchDivByZero (integerToIntegerLiteral (i `quot` j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerRem"
-#else
-  "GHC.Integer.Type.remInteger"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce $ catchDivByZero (integerToIntegerLiteral (i `rem` j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerDivMod#"
-#else
-  "GHC.Integer.Type.divModInteger"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> let (_,tyView -> TyConApp ubTupTcNm [liftedKi,_,intTy,_]) = splitFunForallTy ty
-           (Just ubTupTc) = UniqMap.lookup ubTupTcNm tcm
-           [ubTupDc] = tyConDataCons ubTupTc
-           (d,m) = divMod i j
-       in  reduce $
-           mkApps (Data ubTupDc) [ Right liftedKi, Right liftedKi
-                                 , Right intTy,    Right intTy
-                                 , Left $ catchDivByZero (Literal (IntegerLiteral d))
-                                 , Left $ catchDivByZero (Literal (IntegerLiteral m))
-                                 ]
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerGt"
-#else
-  "GHC.Integer.Type.gtInteger"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i > j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerGe"
-#else
-  "GHC.Integer.Type.geInteger"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i >= j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerEq"
-#else
-  "GHC.Integer.Type.eqInteger"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i == j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerNe"
-#else
-  "GHC.Integer.Type.neqInteger"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i /= j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerLt"
-#else
-  "GHC.Integer.Type.ltInteger"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i < j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerLe"
-#else
-  "GHC.Integer.Type.leInteger"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i <= j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerGt#"
-#else
-  "GHC.Integer.Type.gtInteger#"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (boolToIntLiteral (i > j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerGe#"
-#else
-  "GHC.Integer.Type.geInteger#"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (boolToIntLiteral (i >= j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerEq#"
-#else
-  "GHC.Integer.Type.eqInteger#"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (boolToIntLiteral (i == j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerNe#"
-#else
-  "GHC.Integer.Type.neqInteger#"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (boolToIntLiteral (i /= j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerLt#"
-#else
-  "GHC.Integer.Type.ltInteger#"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (boolToIntLiteral (i < j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerLe#"
-#else
-  "GHC.Integer.Type.leInteger#"
-#endif
-    | Just (i,j) <- integerLiterals args
-    -> reduce (boolToIntLiteral (i <= j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerCompare"
-#else
-  "GHC.Integer.Type.compareInteger" -- :: Integer -> Integer -> Ordering
-#endif
-    | [i, j] <- integerLiterals' args
-    -> let -- Get the required result type (viewed as an applied type constructor name)
-           (_,tyView -> TyConApp tupTcNm []) = splitFunForallTy ty
-           -- Find the type constructor from the name
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           -- Get the data constructors of that type
-           -- The type is 'Ordering', so they are: 'LT', 'EQ', 'GT'
-           [ltDc, eqDc, gtDc] = tyConDataCons tupTc
-           -- Do the actual compile-time evaluation
-           ordVal = compareInteger i j
-        in reduce $ case ordVal of
-            LT -> Data ltDc
-            EQ -> Data eqDc
-            GT -> Data gtDc
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerShiftR#"
-    | [iV, Lit (WordLiteral j)] <- args
-#else
-  "GHC.Integer.Type.shiftRInteger"
-    | [iV, Lit (IntLiteral j)] <- args
-#endif
-    , [i] <- integerLiterals' [iV]
-    -> reduce (integerToIntegerLiteral (i `shiftR` fromInteger j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerShiftL#"
-    | [iV, Lit (WordLiteral j)] <- args
-#else
-  "GHC.Integer.Type.shiftLInteger"
-    | [iV, Lit (IntLiteral j)] <- args
-#endif
-    , [i] <- integerLiterals' [iV]
-    -> reduce (integerToIntegerLiteral (i `shiftL` fromInteger j))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerFromWord#"
-#else
-  "GHC.Integer.Type.wordToInteger"
-#endif
-    | [Lit (WordLiteral w)] <- args
-    -> reduce (Literal (IntegerLiteral w))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerToWord#"
-#else
-  "GHC.Integer.Type.integerToWord"
-#endif
-    | [i] <- integerLiterals' args
-    -> reduce (integerToWordLiteral i)
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerTestBit#" -- :: Integer -> Int# -> Int#
-    | [Lit (IntegerLiteral i), Lit (WordLiteral j)] <- args
-    -> reduce (boolToIntLiteral (testBit i (fromInteger j)))
-#else
-  "GHC.Integer.Type.testBitInteger" -- :: Integer -> Int# -> Bool
-    | [Lit (IntegerLiteral i), Lit (IntLiteral j)] <- args
-    -> reduce (boolToBoolLiteral tcm ty (testBit i (fromInteger j)))
-#endif
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Natural.NS"
-    | [Lit (WordLiteral w)] <- args
-    -> reduce (Literal (NaturalLiteral w))
-  "GHC.Num.Natural.NB"
-    | [Lit (ByteArrayLiteral (BA.ByteArray ba))] <- args
-    -> reduce (Literal (NaturalLiteral (IP ba)))
-    | [Lit l] <- args
-    -> error ("NB: " <> show l)
-  "GHC.Num.Integer.IS"
-    | [Lit (IntLiteral i)] <- args
-    -> reduce (Literal (IntegerLiteral i))
-  "GHC.Num.Integer.IP"
-    | [Lit (ByteArrayLiteral (BA.ByteArray ba))] <- args
-    -> reduce (Literal (IntegerLiteral (IP ba)))
-    | [Lit l] <- args
-    -> error ("IP: " <> show l)
-  "GHC.Num.Integer.IN"
-    | [Lit (ByteArrayLiteral (BA.ByteArray ba))] <- args
-    -> reduce (Literal (IntegerLiteral (IN ba)))
-    | [Lit l] <- args
-    -> error ("IN: " <> show l)
-#else
-  "GHC.Natural.NatS#"
-    | [Lit (WordLiteral w)] <- args
-    -> reduce (Literal (NaturalLiteral w))
-#endif
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerFromNatural"
-#else
-  "GHC.Natural.naturalToInteger"
-#endif
-    | [i] <- naturalLiterals' args
-    -> reduce (Literal (IntegerLiteral (toInteger i)))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerToNatural"
-#else
-  "GHC.Natural.naturalFromInteger"
-#endif
-    | [i] <- integerLiterals' args
-    ->
-     let nTy = snd (splitFunForallTy ty) in
-     reduce (checkNaturalRange1 nTy i id)
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerToNaturalClamp"
-    | [i] <- integerLiterals' args
-    -> if i < 0 then
-         reduce (naturalToNaturalLiteral 0)
-       else
-         reduce (naturalToNaturalLiteral (fromInteger i))
-
-  "GHC.Num.Integer.integerToNaturalThrow"
-    | [i] <- integerLiterals' args
-    -> let nTy = snd (splitFunForallTy ty) in
-       reduce (checkNaturalRange1 nTy i id)
-#endif
-
-  "GHC.Num.Integer.integerToInt64#"
-    | [i] <- integerLiterals' args
-    -> reduce (integerToInt64Literal i)
-
-  "GHC.Num.Integer.integerToWord64#"
-    | [i] <- integerLiterals' args
-    -> reduce (integerToWord64Literal i)
-
-#if MIN_VERSION_base(4,17,0)
-  "GHC.Num.Integer.integerFromWord64#"
-    | [w] <- word64Literals' args
-    -> reduce (Literal (IntegerLiteral w))
-#endif
-
-#if !MIN_VERSION_base(4,15,0)
-  -- GHC.shiftLNatural --- XXX: Fragile worker of GHC.shiflLNatural
-  "GHC.Natural.$wshiftLNatural"
-    | [nV,iV] <- args
-    , [n] <- naturalLiterals' [nV]
-    , [i] <- fromInteger <$> intLiterals' [iV]
-    ->
-     let nTy = snd (splitFunForallTy ty) in
-     reduce (checkNaturalRange1 nTy n ((flip shiftL) i))
-#endif
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Natural.naturalAdd"
-#else
-  "GHC.Natural.plusNatural"
-#endif
-    | Just (i,j) <- naturalLiterals args
-    ->
-     let nTy = snd (splitFunForallTy ty) in
-     reduce (checkNaturalRange2 nTy i j (+))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Natural.naturalMul"
-#else
-  "GHC.Natural.timesNatural"
-#endif
-    | Just (i,j) <- naturalLiterals args
-    ->
-     let nTy = snd (splitFunForallTy ty) in
-     reduce (checkNaturalRange2 nTy i j (*))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Natural.naturalSubUnsafe"
-    | Just (i,j) <- naturalLiterals args
-    ->
-     let nTy = snd (splitFunForallTy ty) in
-     reduce (checkNaturalRange nTy [i, j] (\[i', j'] ->
-      naturalToNaturalLiteral (naturalSubUnsafe i' j')))
-
-  "GHC.Num.Natural.naturalSubThrow"
-    | Just (i,j) <- naturalLiterals args
-    ->
-     let nTy = snd (splitFunForallTy ty) in
-     reduce (checkNaturalRange nTy [i, j] (\[i', j'] ->
-                case minusNaturalMaybe i' j' of
-                  Nothing -> checkNaturalRange1 nTy (-1) id
-                  Just n -> naturalToNaturalLiteral n))
-#else
-  "GHC.Natural.minusNatural"
-    | Just (i,j) <- naturalLiterals args
-    ->
-     let nTy = snd (splitFunForallTy ty) in
-     reduce (checkNaturalRange nTy [i, j] (\[i', j'] ->
-                case minusNaturalMaybe i' j' of
-                  Nothing -> checkNaturalRange1 nTy (-1) id
-                  Just n -> naturalToNaturalLiteral n))
-#endif
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Natural.naturalFromWord#"
-#else
-  "GHC.Natural.wordToNatural#"
-#endif
-    | [Lit (WordLiteral w)] <- args
-    ->
-     let nTy = snd (splitFunForallTy ty) in
-     reduce (checkNaturalRange1 nTy w id)
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Natural.naturalToWord#"
-    | [i] <- naturalLiterals' args
-    -> reduce (integerToWordLiteral i)
-
-  "GHC.Num.Natural.naturalQuot"
-    | Just (i,j) <- naturalLiterals args
-    ->
-     let nTy = snd (splitFunForallTy ty) in
-     reduce (checkNaturalRange2 nTy i j quot)
-
-  "GHC.Num.Natural.naturalRem"
-    | Just (i,j) <- naturalLiterals args
-    ->
-     let nTy = snd (splitFunForallTy ty) in
-     reduce (checkNaturalRange2 nTy i j rem)
-#endif
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Natural.naturalQuotRem#" -- :: Natural -> Natural -> (#Natural, Natural#)
-    | [i, j] <- naturalLiterals' args
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           (q,r) = quotRem (fromInteger i) (fromInteger j)
-    in reduce $
-         mkApps (Data tupDc) (map Right tyArgs ++
-                [ Left $ catchDivByZero (naturalToNaturalLiteral q)
-                , Left $ catchDivByZero (naturalToNaturalLiteral r)])
-#endif
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Natural.naturalGcd"
-#else
-  "GHC.Natural.gcdNatural"
-#endif
-    | Just (i,j) <- naturalLiterals args
-    ->
-     let nTy = snd (splitFunForallTy ty) in
-     reduce (checkNaturalRange2 nTy i j gcd)
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Natural.naturalLcm"
-    | Just (i,j) <- naturalLiterals args
-    ->
-     let nTy = snd (splitFunForallTy ty) in
-     reduce (checkNaturalRange2 nTy i j lcm)
-#endif
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Natural.naturalGt#"
-    | Just (i,j) <- naturalLiterals args
-    -> reduce (boolToIntLiteral (i > j))
-
-  "GHC.Num.Natural.naturalGe#"
-    | Just (i,j) <- naturalLiterals args
-    -> reduce (boolToIntLiteral (i >= j))
-
-  "GHC.Num.Natural.naturalEq#"
-    | Just (i,j) <- naturalLiterals args
-    -> reduce (boolToIntLiteral (i == j))
-
-  "GHC.Num.Natural.naturalNe#"
-    | Just (i,j) <- naturalLiterals args
-    -> reduce (boolToIntLiteral (i /= j))
-
-  "GHC.Num.Natural.naturalLt#"
-    | Just (i,j) <- naturalLiterals args
-    -> reduce (boolToIntLiteral (i < j))
-
-  "GHC.Num.Natural.naturalLe#"
-    | Just (i,j) <- naturalLiterals args
-    -> reduce (boolToIntLiteral (i <= j))
-
-  "GHC.Num.Natural.naturalShiftL#"
-    | [iV, Lit (WordLiteral j)] <- args
-    , [i] <- naturalLiterals' [iV]
-    -> reduce (naturalToNaturalLiteral (fromInteger (i `shiftL` fromInteger j)))
-
-  "GHC.Num.Natural.naturalShiftR#"
-    | [iV, Lit (WordLiteral j)] <- args
-    , [i] <- naturalLiterals' [iV]
-    -> reduce (naturalToNaturalLiteral (fromInteger (i `shiftR` fromInteger j)))
-
-  "GHC.Num.Natural.naturalCompare"
-    | [i, j] <- naturalLiterals' args
-    -> let -- Get the required result type (viewed as an applied type constructor name)
-           (_,tyView -> TyConApp tupTcNm []) = splitFunForallTy ty
-           -- Find the type constructor from the name
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           -- Get the data constructors of that type
-           -- The type is 'Ordering', so they are: 'LT', 'EQ', 'GT'
-           [ltDc, eqDc, gtDc] = tyConDataCons tupTc
-           -- Do the actual compile-time evaluation
-           ordVal = compareInteger i j
-        in reduce $ case ordVal of
-            LT -> Data ltDc
-            EQ -> Data eqDc
-            GT -> Data gtDc
-
-  "GHC.Num.Natural.naturalSignum"
-    | [i] <- naturalLiterals' args
-    -> reduce (Literal (NaturalLiteral (signum i)))
-
-  "GHC.Num.Natural.$wnaturalSignum"
-    | [i] <- naturalLiterals' args
-    -> reduce (Literal (WordLiteral (signum i)))
-#endif
-
-  -- GHC.Real.^  -- XXX: Very fragile
-  --   ^_f, $wf, $wf1 are specialisations of the internal function f in the implementation of (^) in GHC.Real
-  "GHC.Real.^_f"  -- :: Integer -> Integer -> Integer
-    | [i,j] <- integerLiterals' args
-    -> reduce (integerToIntegerLiteral $ i ^ j)
-  "GHC.Real.$wf"  -- :: Integer -> Int# -> Integer
-    | [iV, Lit (IntLiteral j)] <- args
-    , [i] <- integerLiterals' [iV]
-    -> reduce (integerToIntegerLiteral $ i ^ j)
-  "GHC.Real.$wf1" -- :: Int# -> Int# -> Int#
-    | [Lit (IntLiteral i), Lit (IntLiteral j)] <- args
-    -> reduce (integerToIntLiteral $ i ^ j)
-
-  -- Type level ^    -- XXX: Very fragile
-  -- These is are specialized versions of ^_f, named by some combination of ghc and singletons.
-  "Data.Singletons.TypeLits.Internal.$fSingI->^@#@$_f" -- ghc-8.6.5, singletons-2.5.1
-    | [i,j] <- naturalLiterals' args
-    -> reduce (Literal (NaturalLiteral (i ^ j)))
-  "Data.Singletons.TypeLits.Internal.%^_f"             -- ghc-8.8.1, singletons-2.6
-    | [i,j] <- naturalLiterals' args
-    -> reduce (Literal (NaturalLiteral (i ^ j)))
-
-  "GHC.TypeLits.natVal"
-    | [Lit (NaturalLiteral n), _] <- args
-    -> reduce (integerToIntegerLiteral n)
-
-  "GHC.TypeNats.natVal"
-    | [Lit (NaturalLiteral n), _] <- args
-    -> reduce (Literal (NaturalLiteral n))
-
-  "GHC.TypeNats.someNatVal"
-    | [Lit (NaturalLiteral n)] <- args
-    -> let resTy = getResultTy tcm ty tys
-        in reduce (mkSomeNat tcm n resTy)
-
-  "GHC.Internal.TypeNats.natVal"
-    | [Lit (NaturalLiteral n), _] <- args
-    -> reduce (Literal (NaturalLiteral n))
-
-  "GHC.Internal.TypeNats.someNatVal"
-    | [Lit (NaturalLiteral n)] <- args
-    -> let resTy = getResultTy tcm ty tys
-        in reduce (mkSomeNat tcm n resTy)
-
-  "GHC.Types.I#"
-    | isSubj
-    , [Lit (IntLiteral i)] <- args
-    ->  let (_,tyView -> TyConApp intTcNm []) = splitFunForallTy ty
-            (Just intTc) = UniqMap.lookup intTcNm tcm
-            [intDc] = tyConDataCons intTc
-        in  reduce (mkApps (Data intDc) [Left (Literal (IntLiteral i))])
-
-  "GHC.Int.I8#"
-    | isSubj
-#if MIN_VERSION_base(4,16,0)
-    , [Lit (Int8Literal i)] <- args
-#else
-    , [Lit (IntLiteral i)] <- args
-#endif
-    ->  let (_,tyView -> TyConApp intTcNm []) = splitFunForallTy ty
-            (Just intTc) = UniqMap.lookup intTcNm tcm
-            [intDc] = tyConDataCons intTc
-#if MIN_VERSION_base(4,16,0)
-        in  reduce (mkApps (Data intDc) [Left (Literal (Int8Literal i))])
-#else
-        in  reduce (mkApps (Data intDc) [Left (Literal (IntLiteral i))])
-#endif
-  "GHC.Int.I16#"
-    | isSubj
-#if MIN_VERSION_base(4,16,0)
-    , [Lit (Int16Literal i)] <- args
-#else
-    , [Lit (IntLiteral i)] <- args
-#endif
-    ->  let (_,tyView -> TyConApp intTcNm []) = splitFunForallTy ty
-            (Just intTc) = UniqMap.lookup intTcNm tcm
-            [intDc] = tyConDataCons intTc
-#if MIN_VERSION_base(4,16,0)
-        in  reduce (mkApps (Data intDc) [Left (Literal (Int16Literal i))])
-#else
-        in  reduce (mkApps (Data intDc) [Left (Literal (IntLiteral i))])
-#endif
-  "GHC.Int.I32#"
-    | isSubj
-#if MIN_VERSION_base(4,16,0)
-    , [Lit (Int32Literal i)] <- args
-#else
-    , [Lit (IntLiteral i)] <- args
-#endif
-    ->  let (_,tyView -> TyConApp intTcNm []) = splitFunForallTy ty
-            (Just intTc) = UniqMap.lookup intTcNm tcm
-            [intDc] = tyConDataCons intTc
-#if MIN_VERSION_base(4,16,0)
-        in  reduce (mkApps (Data intDc) [Left (Literal (Int32Literal i))])
-#else
-        in  reduce (mkApps (Data intDc) [Left (Literal (IntLiteral i))])
-#endif
-  "GHC.Int.I64#"
-    | isSubj
-#if MIN_VERSION_base(4,16,0)
-    , [Lit (Int64Literal i)] <- args
-#else
-    , [Lit (IntLiteral i)] <- args
-#endif
-    ->  let (_,tyView -> TyConApp intTcNm []) = splitFunForallTy ty
-            (Just intTc) = UniqMap.lookup intTcNm tcm
-            [intDc] = tyConDataCons intTc
-#if MIN_VERSION_base(4,16,0)
-        in  reduce (mkApps (Data intDc) [Left (Literal (Int64Literal i))])
-#else
-        in  reduce (mkApps (Data intDc) [Left (Literal (IntLiteral i))])
-#endif
-
-  "GHC.Word.W8#"
-    | isSubj
-#if MIN_VERSION_base(4,16,0)
-    , [Lit (Word8Literal c)] <- args
-#else
-    , [Lit (WordLiteral c)] <- args
-#endif
-    ->  let (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
-            (Just wordTc) = UniqMap.lookup wordTcNm tcm
-            [wordDc] = tyConDataCons wordTc
-#if MIN_VERSION_base(4,16,0)
-        in  reduce (mkApps (Data wordDc) [Left (Literal (Word8Literal c))])
-#else
-        in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral c))])
-#endif
-  "GHC.Word.W16#"
-    | isSubj
-#if MIN_VERSION_base(4,16,0)
-    , [Lit (Word16Literal c)] <- args
-#else
-    , [Lit (WordLiteral c)] <- args
-#endif
-    ->  let (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
-            (Just wordTc) = UniqMap.lookup wordTcNm tcm
-            [wordDc] = tyConDataCons wordTc
-#if MIN_VERSION_base(4,16,0)
-        in  reduce (mkApps (Data wordDc) [Left (Literal (Word16Literal c))])
-#else
-        in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral c))])
-#endif
-  "GHC.Word.W32#"
-    | isSubj
-#if MIN_VERSION_base(4,16,0)
-    , [Lit (Word32Literal c)] <- args
-#else
-    , [Lit (WordLiteral c)] <- args
-#endif
-    ->  let (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
-            (Just wordTc) = UniqMap.lookup wordTcNm tcm
-            [wordDc] = tyConDataCons wordTc
-#if MIN_VERSION_base(4,16,0)
-        in  reduce (mkApps (Data wordDc) [Left (Literal (Word32Literal c))])
-#else
-        in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral c))])
-#endif
-  "GHC.Word.W64#"
-    | isSubj
-#if MIN_VERSION_base(4,16,0)
-    , [Lit (Word64Literal c)] <- args
-#else
-    , [Lit (WordLiteral c)] <- args
-#endif
-    ->  let (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
-            (Just wordTc) = UniqMap.lookup wordTcNm tcm
-            [wordDc] = tyConDataCons wordTc
-#if MIN_VERSION_base(4,16,0)
-        in  reduce (mkApps (Data wordDc) [Left (Literal (Word64Literal c))])
-#else
-        in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral c))])
-#endif
-
-  "GHC.Types.W#"
-    | isSubj
-    , [Lit (WordLiteral i)] <- args
-    ->  let (_,tyView -> TyConApp intTcNm []) = splitFunForallTy ty
-            (Just intTc) = UniqMap.lookup intTcNm tcm
-            [intDc] = tyConDataCons intTc
-        in  reduce (mkApps (Data intDc) [Left (Literal (WordLiteral i))])
-
-  "GHC.Float.$w$sfromRat''" -- XXX: Very fragile
-    | [Lit (IntLiteral _minEx)
-      ,Lit (IntLiteral matDigs)
-      ,nV
-      ,dV] <- args
-    , [n,d] <- integerLiterals' [nV,dV]
-    -> case fromInteger matDigs of
-          matDigs'
-            | matDigs' == floatDigits (undefined :: Float)
-            -> reduce (Literal (FloatLiteral (floatToWord (fromRational (n :% d)))))
-            | matDigs' == floatDigits (undefined :: Double)
-            -> reduce (Literal (DoubleLiteral (doubleToWord (fromRational (n :% d)))))
-          _ -> error $ $(curLoc) ++ "GHC.Float.$w$sfromRat'': Not a Float or Double"
-
-  "GHC.Float.$w$sfromRat''1" -- XXX: Very fragile
-    | [Lit (IntLiteral _minEx)
-      ,Lit (IntLiteral matDigs)
-      ,nV
-      ,dV] <- args
-    , [n,d] <- integerLiterals' [nV,dV]
-    -> case fromInteger matDigs of
-          matDigs'
-            | matDigs' == floatDigits (undefined :: Float)
-            -> reduce (Literal (FloatLiteral (floatToWord (fromRational (n :% d)))))
-            | matDigs' == floatDigits (undefined :: Double)
-            -> reduce (Literal (DoubleLiteral (doubleToWord (fromRational (n :% d)))))
-          _ -> error $ $(curLoc) ++ "GHC.Float.$w$sfromRat'': Not a Float or Double"
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerSignum#"
-#else
-  "GHC.Integer.Type.$wsignumInteger" -- XXX: Not super-fragile, but still..
-#endif
-    | [i] <- integerLiterals' args
-    -> reduce (Literal (IntLiteral (signum i)))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerSignum"
-#else
-  "GHC.Integer.Type.signumInteger"
-#endif
-    | [i] <- integerLiterals' args
-    -> reduce (Literal (IntegerLiteral (signumInteger i)))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.$wintegerSignum"
-    | [i] <- integerLiterals' args
-    -> reduce (Literal (IntLiteral (signum i)))
-#endif
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerAbs"
-#else
-  "GHC.Integer.Type.absInteger"
-#endif
-    | [i] <- integerLiterals' args
-    -> reduce (Literal (IntegerLiteral (absInteger i)))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerBit#"
-    | [i] <- wordLiterals' args
-#else
-  "GHC.Integer.Type.bitInteger"
-    | [i] <- intLiterals' args
-#endif
-    -> reduce (Literal (IntegerLiteral (bit (fromInteger i))))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerComplement"
-#else
-  "GHC.Integer.Type.complementInteger"
-#endif
-    | [i] <- integerLiterals' args
-    -> reduce (Literal (IntegerLiteral (complementInteger i)))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerOr"
-#else
-  "GHC.Integer.Type.orInteger"
-#endif
-    | [i, j] <- integerLiterals' args
-    -> reduce (Literal (IntegerLiteral (orInteger i j)))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerXor"
-#else
-  "GHC.Integer.Type.xorInteger"
-#endif
-    | [i, j] <- integerLiterals' args
-    -> reduce (Literal (IntegerLiteral (xorInteger i j)))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerAnd"
-#else
-  "GHC.Integer.Type.andInteger"
-#endif
-    | [i, j] <- integerLiterals' args
-    -> reduce (Literal (IntegerLiteral (andInteger i j)))
-
-#if MIN_VERSION_base(4,15,0)
-  "GHC.Num.Integer.integerToDouble#"
-#else
-  "GHC.Integer.Type.doubleFromInteger"
-#endif
-    | [i] <- integerLiterals' args
-    -> reduce (Literal (DoubleLiteral (doubleToWord (fromInteger i))))
-
-#if MIN_VERSION_base(4,17,0)
-  "GHC.Num.Integer.$wintegerFromInt64#"
-    | [i] <- int64Literals' args
-    -> reduce . Literal $ IntLiteral i
-#endif
-
-  "GHC.Base.eqString"
-    | [PrimVal _ _ [Lit (StringLiteral s1)]
-      ,PrimVal _ _ [Lit (StringLiteral s2)]
-      ] <- args
-    -> reduce (boolToBoolLiteral tcm ty (s1 == s2))
-    | otherwise -> error (show args)
-
-  "GHC.Base.quotInt"
-    | [ DC intDc [Left (Literal (IntLiteral i))]
-      , DC _     [Left (Literal (IntLiteral j))]
-      ] <- args
-    -> reduce (App (Data intDc) (Literal (IntLiteral (i `quot` j))))
-
-  "GHC.Base.remInt"
-    | [ DC intDc [Left (Literal (IntLiteral i))]
-      , DC _     [Left (Literal (IntLiteral j))]
-      ] <- args
-    -> reduce (App (Data intDc) (Literal (IntLiteral (i `rem` j))))
-
-  "GHC.Base.divInt"
-    | [ DC intDc [Left (Literal (IntLiteral i))]
-      , DC _     [Left (Literal (IntLiteral j))]
-      ] <- args
-    -> reduce (App (Data intDc) (Literal (IntLiteral (i `div` j))))
-
-
-  "GHC.Base.modInt"
-    | [ DC intDc [Left (Literal (IntLiteral i))]
-      , DC _     [Left (Literal (IntLiteral j))]
-      ] <- args
-    -> reduce (App (Data intDc) (Literal (IntLiteral (i `mod` j))))
-
-  "Clash.Class.BitPack.Internal.packDouble#" -- :: Double -> BitVector 64
-    | [DC _ [Left arg]] <- args
-    , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
-    , mach2@Machine{mStack=[],mTerm=Literal (DoubleLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
-    -> let resTyInfo = extractTySizeInfo tcm ty tys
-        in Just $ mach2
-             { mStack = mStack mach
-             , mTerm = mkBitVectorLit' resTyInfo 0 (toInteger $ (pack :: Word64 -> BitVector 64) i)
-             }
-
-  "Clash.Class.BitPack.Internal.packFloat#" -- :: Float -> BitVector 32
-    | [DC _ [Left arg]] <- args
-    , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
-    , mach2@Machine{mStack=[],mTerm=Literal (FloatLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
-    -> let resTyInfo = extractTySizeInfo tcm ty tys
-        in Just $ mach2
-             { mStack = mStack mach
-             , mTerm = mkBitVectorLit' resTyInfo 0 (toInteger $ (pack :: Word32 -> BitVector 32) i)
-             }
-
-  "Clash.Class.BitPack.Internal.unpackFloat#"
-    | [i] <- bitVectorLiterals' args
-    -> let resTy = getResultTy tcm ty tys
-           val = unpack (toBV i :: BitVector 32)
-        in reduce (mkFloatCLit tcm val resTy)
-
-  "Clash.Class.BitPack.Internal.unpackDouble#"
-    | [i] <- bitVectorLiterals' args
-    -> let resTy = getResultTy tcm ty tys
-           val = unpack (toBV i :: BitVector 64)
-        in reduce (mkDoubleCLit tcm val resTy)
-
-  "Clash.Sized.Internal.BitVector.xToBV"
-    | isSubj
-    , Just (nTy, kn) <- extractKnownNat tcm tys
-    -- The second argument to `xToBV` is always going to be suspended.
-    -- See Note [Lazy primitives]
-    , [ _, (Suspend arg) ] <- args
-    , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
-    , mach1@Machine{mStack=[],mTerm=argWHNF} <-
-        whnf eval tcm True (setTerm arg (stackClear mach))
-    , let undefBitVector =
-            Just $ mach1
-                 { mStack = mStack mach
-                 , mTerm  = mkBitVectorLit ty nTy kn (bit (fromInteger kn)-1) 0
-                 }
-    -> case isX argWHNF of
-         Left _ -> undefBitVector
-         _ -> case collectArgs argWHNF of
-           (Prim p,_) | primName p `elem` undefinedXPrims -> undefBitVector
-           _ -> Just $ mach1
-                     { mStack = mStack mach
-                     , mTerm  = argWHNF
-                     }
-
-  -- expIndex#
-  --   :: KnownNat m
-  --   => Index m
-  --   -> SNat n
-  --   -> Index (n^m)
-  "Clash.Class.Exp.expIndex#"
-    | [b] <- indexLiterals' args
-    , [(_mTy, km), (_, e)] <- extractKnownNats tcm tys
-    -> reduce (mkIndexLit ty (LitTy (NumTy (km^e))) (km^e) (b^e))
-
-  -- expSigned#
-  --   :: KnownNat m
-  --   => Signed m
-  --   -> SNat n
-  --   -> Signed (n*m)
-  "Clash.Class.Exp.expSigned#"
-    | [b] <- signedLiterals' args
-    , [(_mTy, km), (_, e)] <- extractKnownNats tcm tys
-    -> reduce (mkSignedLit ty (LitTy (NumTy (km*e))) (km*e) (b^e))
-
-  -- expUnsigned#
-  --   :: KnownNat m
-  --   => Unsigned m
-  --   -> SNat n
-  --   -> Unsigned m
-  "Clash.Class.Exp.expUnsigned#"
-    | [b] <- unsignedLiterals' args
-    , [(_mTy, km), (_, e)] <- extractKnownNats tcm tys
-    -> reduce (mkUnsignedLit ty (LitTy (NumTy (km*e))) (km*e) (b^e))
-
-  "Clash.Promoted.Nat.powSNat"
-    | [Right a, Right b] <- map (runExcept . tyNatSize tcm) tys
-    -> let c = case a of
-                 2 -> 1 `shiftL` (fromInteger b)
-                 _ -> a ^ b
-           (_,tyView -> TyConApp snatTcNm _) = splitFunForallTy ty
-           (Just snatTc) = UniqMap.lookup snatTcNm tcm
-           [snatDc] = tyConDataCons snatTc
-       in  reduce $
-           mkApps (Data snatDc) [ Right (LitTy (NumTy c))
-                                , Left (Literal (NaturalLiteral c))]
-
-  "Clash.Promoted.Nat.flogBaseSNat"
-    | [Right a, Right b] <- map (runExcept . tyNatSize tcm) tys
-    , Just c <- flogBase a b
-    , let c' = toInteger c
-    -> let (_,tyView -> TyConApp snatTcNm _) = splitFunForallTy ty
-           (Just snatTc) = UniqMap.lookup snatTcNm tcm
-           [snatDc] = tyConDataCons snatTc
-       in  reduce $
-           mkApps (Data snatDc) [ Right (LitTy (NumTy c'))
-                                , Left (Literal (NaturalLiteral c'))]
-
-  "Clash.Promoted.Nat.clogBaseSNat"
-    | [Right a, Right b] <- map (runExcept . tyNatSize tcm) tys
-    , Just c <- clogBase a b
-    , let c' = toInteger c
-    -> let (_,tyView -> TyConApp snatTcNm _) = splitFunForallTy ty
-           (Just snatTc) = UniqMap.lookup snatTcNm tcm
-           [snatDc] = tyConDataCons snatTc
-       in  reduce $
-           mkApps (Data snatDc) [ Right (LitTy (NumTy c'))
-                                , Left (Literal (NaturalLiteral c'))]
-    | otherwise
-    -> error ("clogBaseSNat: args = " <> show args <> ", tys = " <> show tys)
-
-  "Clash.Promoted.Nat.logBaseSNat"
-    | [Right a, Right b] <- map (runExcept . tyNatSize tcm) tys
-    , Just c <- flogBase a b
-    , let c' = toInteger c
-    -> let (_,tyView -> TyConApp snatTcNm _) = splitFunForallTy ty
-           (Just snatTc) = UniqMap.lookup snatTcNm tcm
-           [snatDc] = tyConDataCons snatTc
-       in  reduce $
-           mkApps (Data snatDc) [ Right (LitTy (NumTy c'))
-                                , Left (Literal (NaturalLiteral c'))]
-
-------------
--- BitVector
-------------
--- Constructor
-  "Clash.Sized.Internal.BitVector.BV"
-    | [Right _] <- map (runExcept . tyNatSize tcm) tys
-    , Just (m,i) <- integerLiterals args
-    -> let resTyInfo = extractTySizeInfo tcm ty tys
-       in  reduce (mkBitVectorLit' resTyInfo m i)
-
-  "Clash.Sized.Internal.BitVector.Bit"
-    | Just (m,i) <- integerLiterals args
-    -> reduce (mkBitLit ty m i)
-
--- Initialisation
-  "Clash.Sized.Internal.BitVector.size#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    -> let (_,tyView -> TyConApp intTcNm _) = splitFunForallTy ty
-           (Just intTc) = UniqMap.lookup intTcNm tcm
-           [intCon] = tyConDataCons intTc
-       in  reduce (mkApps (Data intCon) [Left (Literal (IntLiteral kn))])
-  "Clash.Sized.Internal.BitVector.maxIndex#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    -> let (_,tyView -> TyConApp intTcNm _) = splitFunForallTy ty
-           (Just intTc) = UniqMap.lookup intTcNm tcm
-           [intCon] = tyConDataCons intTc
-       in  reduce (mkApps (Data intCon) [Left (Literal (IntLiteral (kn-1)))])
-
--- Construction
-  "Clash.Sized.Internal.BitVector.high"
-    -> reduce (mkBitLit ty 0 1)
-  "Clash.Sized.Internal.BitVector.low"
-    -> reduce (mkBitLit ty 0 0)
-
-  "Clash.Sized.Internal.BitVector.undefined#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    -> let resTyInfo = extractTySizeInfo tcm ty tys
-           mask = bit (fromInteger kn) - 1
-       in reduce (mkBitVectorLit' resTyInfo mask 0)
-
--- Eq
-  "Clash.Sized.Internal.BitVector.eq##" | [(0,i),(0,j)] <- bitLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i == j))
-  "Clash.Sized.Internal.BitVector.neq##" | [(0,i),(0,j)] <- bitLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i /= j))
-
--- Ord
-  "Clash.Sized.Internal.BitVector.lt##" | [(0,i),(0,j)] <- bitLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i <  j))
-  "Clash.Sized.Internal.BitVector.ge##" | [(0,i),(0,j)] <- bitLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i >= j))
-  "Clash.Sized.Internal.BitVector.gt##" | [(0,i),(0,j)] <- bitLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i >  j))
-  "Clash.Sized.Internal.BitVector.le##" | [(0,i),(0,j)] <- bitLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i <= j))
-
--- Enum
-  "Clash.Sized.Internal.BitVector.toEnum##"
-    | [i] <- intCLiterals' args
-    -> let Bit msk val = BitVector.toEnum## (fromInteger i)
-       in reduce (mkBitLit ty (toInteger msk) (toInteger val))
-
--- Bits
-  "Clash.Sized.Internal.BitVector.and##"
-    | [i,j] <- bitLiterals args
-    -> let Bit msk val = BitVector.and## (toBit i) (toBit j)
-       in reduce (mkBitLit ty (toInteger msk) (toInteger val))
-  "Clash.Sized.Internal.BitVector.or##"
-    | [i,j] <- bitLiterals args
-    -> let Bit msk val = BitVector.or## (toBit i) (toBit j)
-       in reduce (mkBitLit ty (toInteger msk) (toInteger val))
-  "Clash.Sized.Internal.BitVector.xor##"
-    | [i,j] <- bitLiterals args
-    -> let Bit msk val = BitVector.xor## (toBit i) (toBit j)
-       in reduce (mkBitLit ty (toInteger msk) (toInteger val))
-
-  "Clash.Sized.Internal.BitVector.complement##"
-    | [i] <- bitLiterals args
-    -> let Bit msk val = BitVector.complement## (toBit i)
-       in reduce (mkBitLit ty (toInteger msk) (toInteger val))
-
--- Pack
-  "Clash.Sized.Internal.BitVector.pack#"
-    | [(msk,i)] <- bitLiterals args
-    -> let resTyInfo = extractTySizeInfo tcm ty tys
-       in  reduce (mkBitVectorLit' resTyInfo msk i)
-
-  "Clash.Sized.Internal.BitVector.unpack#"
-    | [(msk,i)] <- bitVectorLiterals' args
-    -> reduce (mkBitLit ty msk i)
-
--- Concatenation
-  "Clash.Sized.Internal.BitVector.++#" -- :: KnownNat m => BitVector n -> BitVector m -> BitVector (n + m)
-    | Just (_,m) <- extractKnownNat tcm tys
-    , [(mski,i),(mskj,j)] <- bitVectorLiterals' args
-    -> let val = i `shiftL` fromInteger m .|. j
-           msk = mski `shiftL` fromInteger m .|. mskj
-           resTyInfo = extractTySizeInfo tcm ty tys
-       in reduce (mkBitVectorLit' resTyInfo msk val)
-
--- Reduction
-  "Clash.Sized.Internal.BitVector.reduceAnd#" -- :: KnownNat n => BitVector n -> Bit
-    | [i] <- bitVectorLiterals' args
-    , Just (_, kn) <- extractKnownNat tcm tys
-    -> let resTy = getResultTy tcm ty tys
-           val = reifyNat kn (op (toBV i))
-       in reduce (mkBitLit resTy 0 val)
-    where
-      op :: KnownNat n => BitVector n -> Proxy n -> Integer
-      op u _ = toInteger (BitVector.reduceAnd# u)
-  "Clash.Sized.Internal.BitVector.reduceOr#" -- :: KnownNat n => BitVector n -> Bit
-    | [i] <- bitVectorLiterals' args
-    , Just (_, kn) <- extractKnownNat tcm tys
-    -> let resTy = getResultTy tcm ty tys
-           val = reifyNat kn (op (toBV i))
-       in reduce (mkBitLit resTy 0 val)
-    where
-      op :: KnownNat n => BitVector n -> Proxy n -> Integer
-      op u _ = toInteger (BitVector.reduceOr# u)
-  "Clash.Sized.Internal.BitVector.reduceXor#" -- :: KnownNat n => BitVector n -> Bit
-    | [i] <- bitVectorLiterals' args
-    , Just (_, kn) <- extractKnownNat tcm tys
-    -> let resTy = getResultTy tcm ty tys
-           val = reifyNat kn (op (toBV i))
-       in reduce (mkBitLit resTy 0 val)
-    where
-      op :: KnownNat n => BitVector n -> Proxy n -> Integer
-      op u _ = toInteger (BitVector.reduceXor# u)
-
-
--- Indexing
-  "Clash.Sized.Internal.BitVector.index#" -- :: KnownNat n => BitVector n -> Int -> Bit
-    | Just (_,kn,i,j) <- bitVectorLitIntLit tcm tys args
-      -> let resTy = getResultTy tcm ty tys
-             (msk,val) = reifyNat kn (op (toBV i) (fromInteger j))
-         in reduce (mkBitLit resTy msk val)
-      where
-        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
-        op u i _ = (toInteger m, toInteger v)
-          where Bit m v = (BitVector.index# u i)
-  "Clash.Sized.Internal.BitVector.replaceBit#" -- :: :: KnownNat n => BitVector n -> Int -> Bit -> BitVector n
-    | Just (_, n) <- extractKnownNat tcm tys
-    , [ _
-      , PrimVal bvP _ [_, Lit (NaturalLiteral mskBv), Lit (IntegerLiteral bv)]
-      , valArgs -> Just [Literal (IntLiteral i)]
-      , PrimVal bP _ [Lit (WordLiteral mskB), Lit (IntegerLiteral b)]
-      ] <- args
-    , primName bvP == "Clash.Sized.Internal.BitVector.fromInteger#"
-    , primName bP  == "Clash.Sized.Internal.BitVector.fromInteger##"
-      -> let resTyInfo = extractTySizeInfo tcm ty tys
-             (mskVal,val) = reifyNat n (op (BV (fromInteger mskBv) (fromInteger bv))
-                                           (fromInteger i)
-                                           (Bit (fromInteger mskB) (fromInteger b)))
-      in reduce (mkBitVectorLit' resTyInfo mskVal val)
-      where
-        op :: KnownNat n => BitVector n -> Int -> Bit -> Proxy n -> (Integer,Integer)
-        -- op bv i b _ = (BitVector.unsafeMask res, BitVector.unsafeToInteger res)
-        op bv i b _ = splitBV (BitVector.replaceBit# bv i b)
-  "Clash.Sized.Internal.BitVector.setSlice#"
-  -- :: SNat (m+1+i) -> BitVector (m + 1 + i) -> SNat m -> SNat n -> BitVector (m + 1 - n) -> BitVector (m + 1 + i)
-    | mTy : iTy : nTy : _ <- tys
-    , Right m <- runExcept (tyNatSize tcm mTy)
-    , Right iN <- runExcept (tyNatSize tcm iTy)
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    , [i,j] <- bitVectorLiterals' args
-    -> let BV msk val = BitVector.setSlice# (unsafeSNat (m+1+iN)) (toBV i) (unsafeSNat m) (unsafeSNat n) (toBV j)
-           resTyInfo = extractTySizeInfo tcm ty tys
-       in  reduce (mkBitVectorLit' resTyInfo (toInteger msk) (toInteger val))
-  "Clash.Sized.Internal.BitVector.slice#"
-  -- :: BitVector (m + 1 + i) -> SNat m -> SNat n -> BitVector (m + 1 - n)
-    | mTy : _ : nTy : _ <- tys
-    , Right m <- runExcept (tyNatSize tcm mTy)
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    , [i] <- bitVectorLiterals' args
-    -> let BV msk val = BitVector.slice# (toBV i) (unsafeSNat m) (unsafeSNat n)
-           resTyInfo = extractTySizeInfo tcm ty tys
-       in  reduce (mkBitVectorLit' resTyInfo (toInteger msk) (toInteger val))
-  "Clash.Sized.Internal.BitVector.split#" -- :: forall n m. KnownNat n => BitVector (m + n) -> (BitVector m, BitVector n)
-    | nTy : mTy : _ <- tys
-    , Right n <-  runExcept (tyNatSize tcm nTy)
-    , Right m <-  runExcept (tyNatSize tcm mTy)
-    , [(mski,i)] <- bitVectorLiterals' args
-    -> let ty' = piResultTys tcm ty tys
-           (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty'
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           bvTy : _ = tyArgs
-           valM = i `shiftR` fromInteger n
-           mskM = mski `shiftR` fromInteger n
-           valN = i .&. mask
-           mskN = mski .&. mask
-           mask = bit (fromInteger n) - 1
-    in reduce $
-       mkApps (Data tupDc) (map Right tyArgs ++
-                [ Left (mkBitVectorLit bvTy mTy m mskM valM)
-                , Left (mkBitVectorLit bvTy nTy n mskN valN)])
-
-  "Clash.Sized.Internal.BitVector.msb#" -- :: forall n. KnownNat n => BitVector n -> Bit
-    | [i] <- bitVectorLiterals' args
-    , Just (_, kn) <- extractKnownNat tcm tys
-    -> let resTy = getResultTy tcm ty tys
-           (msk,val) = reifyNat kn (op (toBV i))
-       in reduce (mkBitLit resTy (toInteger msk) (toInteger val))
-    where
-      op :: KnownNat n => BitVector n -> Proxy n -> (Word,Word)
-      op u _ = (unsafeMask# res, BitVector.unsafeToInteger# res)
-        where
-          res = BitVector.msb# u
-  "Clash.Sized.Internal.BitVector.lsb#" -- :: BitVector n -> Bit
-    | [i] <- bitVectorLiterals' args
-    -> let resTy = getResultTy tcm ty tys
-           Bit msk val = BitVector.lsb# (toBV i)
-    in reduce (mkBitLit resTy (toInteger msk) (toInteger val))
-
-
--- Eq
-  -- eq#, neq# :: KnownNat n => BitVector n -> BitVector n -> Bool
-  "Clash.Sized.Internal.BitVector.eq#"
-    | nTy : _ <- tys
-    , Right 0 <- runExcept (tyNatSize tcm nTy)
-    -> reduce (boolToBoolLiteral tcm ty True)
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftBitVector2Bool BitVector.eq# ty tcm args)
-    -> reduce val
-
-  "Clash.Sized.Internal.BitVector.neq#"
-    | nTy : _ <- tys
-    , Right 0 <- runExcept (tyNatSize tcm nTy)
-    -> reduce (boolToBoolLiteral tcm ty False)
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftBitVector2Bool BitVector.neq# ty tcm args)
-    -> reduce val
-
--- Ord
-  -- lt#,ge#,gt#,le# :: KnownNat n => BitVector n -> BitVector n -> Bool
-  "Clash.Sized.Internal.BitVector.lt#"
-    | nTy : _ <- tys
-    , Right 0 <- runExcept (tyNatSize tcm nTy)
-    -> reduce (boolToBoolLiteral tcm ty False)
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftBitVector2Bool BitVector.lt# ty tcm args)
-    -> reduce val
-  "Clash.Sized.Internal.BitVector.ge#"
-    | nTy : _ <- tys
-    , Right 0 <- runExcept (tyNatSize tcm nTy)
-    -> reduce (boolToBoolLiteral tcm ty True)
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftBitVector2Bool BitVector.ge# ty tcm args)
-    -> reduce val
-  "Clash.Sized.Internal.BitVector.gt#"
-    | nTy : _ <- tys
-    , Right 0 <- runExcept (tyNatSize tcm nTy)
-    -> reduce (boolToBoolLiteral tcm ty False)
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftBitVector2Bool BitVector.gt# ty tcm args)
-    -> reduce val
-  "Clash.Sized.Internal.BitVector.le#"
-    | nTy : _ <- tys
-    , Right 0 <- runExcept (tyNatSize tcm nTy)
-    -> reduce (boolToBoolLiteral tcm ty True)
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftBitVector2Bool BitVector.le# ty tcm args)
-    -> reduce val
-
--- Enum
-
-  "Clash.Sized.Internal.BitVector.toEnum#"
-    | let resTyInfo@(_,_,kn) = extractTySizeInfo tcm ty tys
-    , Just val <- reifyNat kn (liftInteger2BitVector (BitVector.toEnum# . fromInteger) resTyInfo args)
-    -> reduce val
-
-  "Clash.Sized.Internal.BitVector.fromEnum#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , let resTy = getResultTy tcm ty tys
-    , Just val <- reifyNat kn (liftBitVector2CInt tcm resTy (toInteger . BitVector.fromEnum#) args)
-    -> reduce val
-
--- Bounded
-  "Clash.Sized.Internal.BitVector.minBound#"
-    | Just (nTy,len) <- extractKnownNat tcm tys
-    -> reduce (mkBitVectorLit ty nTy len 0 0)
-  "Clash.Sized.Internal.BitVector.maxBound#"
-    | Just (litTy,mb) <- extractKnownNat tcm tys
-    -> let maxB = (2 ^ mb) - 1
-       in  reduce (mkBitVectorLit ty litTy mb 0 maxB)
-
--- Num
-  "Clash.Sized.Internal.BitVector.+#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftBitVector2 (BitVector.+#) ty tcm tys args)
-    -> reduce val
-  "Clash.Sized.Internal.BitVector.-#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftBitVector2 (BitVector.-#) ty tcm tys args)
-    -> reduce val
-  "Clash.Sized.Internal.BitVector.*#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftBitVector2 (BitVector.*#) ty tcm tys args)
-    -> reduce val
-  "Clash.Sized.Internal.BitVector.negate#"
-    | Just (nTy, kn) <- extractKnownNat tcm tys
-    , [i] <- bitVectorLiterals' args
-    -> let (msk,val) = reifyNat kn (op (toBV i))
-    in reduce (mkBitVectorLit ty nTy kn msk val)
-    where
-      op :: KnownNat n => BitVector n -> Proxy n -> (Integer,Integer)
-      op u _ = splitBV (BitVector.negate# u)
-
--- ExtendingNum
-  "Clash.Sized.Internal.BitVector.plus#" -- :: (KnownNat n, KnownNat m) => BitVector m -> BitVector n -> BitVector (Max m n + 1)
-    | [(0,i),(0,j)] <- bitVectorLiterals' args
-    -> let ty' = piResultTys tcm ty tys
-           (_,resTy) = splitFunForallTy ty'
-           (TyConApp _ [resSizeTy]) = tyView resTy
-           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
-       in  reduce (mkBitVectorLit resTy resSizeTy resSizeInt 0 (i+j))
-
-  "Clash.Sized.Internal.BitVector.minus#"
-    | [(0,i),(0,j)] <- bitVectorLiterals' args
-    -> let ty' = piResultTys tcm ty tys
-           (_,resTy) = splitFunForallTy ty'
-           (TyConApp _ [resSizeTy]) = tyView resTy
-           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
-           val = reifyNat resSizeInt (runSizedF (BitVector.-#) i j)
-      in  reduce (mkBitVectorLit resTy resSizeTy resSizeInt 0 val)
-
-  "Clash.Sized.Internal.BitVector.times#"
-    | [(0,i),(0,j)] <- bitVectorLiterals' args
-    -> let ty' = piResultTys tcm ty tys
-           (_,resTy) = splitFunForallTy ty'
-           (TyConApp _ [resSizeTy]) = tyView resTy
-           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
-       in  reduce (mkBitVectorLit resTy resSizeTy resSizeInt 0 (i*j))
-
--- Integral
-  "Clash.Sized.Internal.BitVector.quot#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftBitVector2 (BitVector.quot#) ty tcm tys args)
-    -> reduce $ catchDivByZero val
-  "Clash.Sized.Internal.BitVector.rem#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftBitVector2 (BitVector.rem#) ty tcm tys args)
-    -> reduce $ catchDivByZero val
-  "Clash.Sized.Internal.BitVector.toInteger#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , [i] <- bitVectorLiterals' args
-    -> let val = reifyNat kn (op (toBV i))
-    in reduce (integerToIntegerLiteral val)
-    where
-      op :: KnownNat n => BitVector n -> Proxy n -> Integer
-      op u _ = BitVector.toInteger# u
-
--- Bits
-  "Clash.Sized.Internal.BitVector.and#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftBitVector2 (BitVector.and#) ty tcm tys args)
-    -> reduce val
-  "Clash.Sized.Internal.BitVector.or#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftBitVector2 (BitVector.or#) ty tcm tys args)
-    -> reduce val
-  "Clash.Sized.Internal.BitVector.xor#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftBitVector2 (BitVector.xor#) ty tcm tys args)
-    -> reduce val
-
-  "Clash.Sized.Internal.BitVector.complement#"
-    | [i] <- bitVectorLiterals' args
-    , Just (nTy, kn) <- extractKnownNat tcm tys
-    -> let (msk,val) = reifyNat kn (op (toBV i))
-    in reduce (mkBitVectorLit ty nTy kn msk val)
-    where
-      op :: KnownNat n => BitVector n -> Proxy n -> (Integer,Integer)
-      op u _ = splitBV $ BitVector.complement# u
-
-  "Clash.Sized.Internal.BitVector.shiftL#"
-    | Just (nTy,kn,i,j) <- bitVectorLitIntLit tcm tys args
-      -> let (msk,val) = reifyNat kn (op (toBV i) (fromInteger j))
-      in reduce (mkBitVectorLit ty nTy kn msk val)
-      where
-        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
-        op u i _ = splitBV (BitVector.shiftL# u i)
-  "Clash.Sized.Internal.BitVector.shiftR#"
-    | Just (nTy,kn,i,j) <- bitVectorLitIntLit tcm tys args
-      -> let (msk,val) = reifyNat kn (op (toBV i) (fromInteger j))
-      in reduce (mkBitVectorLit ty nTy kn msk val)
-      where
-        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
-        op u i _ = splitBV (BitVector.shiftR# u i)
-  "Clash.Sized.Internal.BitVector.rotateL#"
-    | Just (nTy,kn,i,j) <- bitVectorLitIntLit tcm tys args
-      -> let (msk,val) = reifyNat kn (op (toBV i) (fromInteger j))
-      in reduce (mkBitVectorLit ty nTy kn msk val)
-      where
-        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
-        op u i _ = splitBV (BitVector.rotateL# u i)
-  "Clash.Sized.Internal.BitVector.rotateR#"
-    | Just (nTy,kn,i,j) <- bitVectorLitIntLit tcm tys args
-      -> let (msk,val) = reifyNat kn (op (toBV i) (fromInteger j))
-      in reduce (mkBitVectorLit ty nTy kn msk val)
-      where
-        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
-        op u i _ = splitBV (BitVector.rotateR# u i)
-
--- truncateB
-  "Clash.Sized.Internal.BitVector.truncateB#" -- forall a b . KnownNat a => BitVector (a + b) -> BitVector a
-    | aTy  : _ <- tys
-    , Right ka <- runExcept (tyNatSize tcm aTy)
-    , [(mski,i)] <- bitVectorLiterals' args
-    -> let bitsKeep = (bit (fromInteger ka)) - 1
-           val = i .&. bitsKeep
-           msk = mski .&. bitsKeep
-    in reduce (mkBitVectorLit ty aTy ka msk val)
-
---------
--- Index
---------
--- BitPack
-  "Clash.Sized.Internal.Index.pack#"
-    | nTy : _ <- tys
-    , Right _ <- runExcept (tyNatSize tcm nTy)
-    , [i] <- indexLiterals' args
-    -> let resTyInfo = extractTySizeInfo tcm ty tys
-       in  reduce (mkBitVectorLit' resTyInfo 0 i)
-  "Clash.Sized.Internal.Index.unpack#"
-    | Just (nTy,kn) <- extractKnownNat tcm tys
-    , [(0,i)] <- bitVectorLiterals' args
-    -> reduce (mkIndexLit ty nTy kn i)
-
--- Eq
-  "Clash.Sized.Internal.Index.eq#" | Just (i,j) <- indexLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i == j))
-  "Clash.Sized.Internal.Index.neq#" | Just (i,j) <- indexLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i /= j))
-
--- Ord
-  "Clash.Sized.Internal.Index.lt#"
-    | Just (i,j) <- indexLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i < j))
-  "Clash.Sized.Internal.Index.ge#"
-    | Just (i,j) <- indexLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i >= j))
-  "Clash.Sized.Internal.Index.gt#"
-    | Just (i,j) <- indexLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i > j))
-  "Clash.Sized.Internal.Index.le#"
-    | Just (i,j) <- indexLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i <= j))
-
--- Enum
-  "Clash.Sized.Internal.Index.toEnum#"
-    | [i] <- intCLiterals' args
-    , Just (nTy, mb) <- extractKnownNat tcm tys
-    -> reduce (mkIndexLit ty nTy mb i)
-
-  "Clash.Sized.Internal.Index.fromEnum#"
-    | [i] <- indexLiterals' args
-    -> let resTy = getResultTy tcm ty tys
-        in reduce (mkIntCLit tcm i resTy)
-
--- Bounded
-  "Clash.Sized.Internal.Index.maxBound#"
-    | Just (nTy,mb) <- extractKnownNat tcm tys
-    -> reduce (mkIndexLit ty nTy mb (mb - 1))
-
--- Num
-  "Clash.Sized.Internal.Index.+#"
-    | Just (nTy,kn) <- extractKnownNat tcm tys
-    , [i,j] <- indexLiterals' args
-    -> reduce (mkIndexLit ty nTy kn (i + j))
-  "Clash.Sized.Internal.Index.-#"
-    | Just (nTy,kn) <- extractKnownNat tcm tys
-    , [i,j] <- indexLiterals' args
-    -> reduce (mkIndexLit ty nTy kn (i - j))
-  "Clash.Sized.Internal.Index.*#"
-    | Just (nTy,kn) <- extractKnownNat tcm tys
-    , [i,j] <- indexLiterals' args
-    -> reduce (mkIndexLit ty nTy kn (i * j))
-
--- ExtendingNum
-  "Clash.Sized.Internal.Index.plus#"
-    | mTy : nTy : _ <- tys
-    , Right _ <- runExcept (tyNatSize tcm mTy)
-    , Right _ <- runExcept (tyNatSize tcm nTy)
-    , Just (i,j) <- indexLiterals args
-    -> let resTyInfo = extractTySizeInfo tcm ty tys
-       in  reduce (mkIndexLit' resTyInfo (i + j))
-  "Clash.Sized.Internal.Index.minus#"
-    | mTy : nTy : _ <- tys
-    , Right _ <- runExcept (tyNatSize tcm mTy)
-    , Right _ <- runExcept (tyNatSize tcm nTy)
-    , Just (i,j) <- indexLiterals args
-    -> let resTyInfo = extractTySizeInfo tcm ty tys
-       in  reduce (mkIndexLit' resTyInfo (i - j))
-  "Clash.Sized.Internal.Index.times#"
-    | mTy : nTy : _ <- tys
-    , Right _ <- runExcept (tyNatSize tcm mTy)
-    , Right _ <- runExcept (tyNatSize tcm nTy)
-    , Just (i,j) <- indexLiterals args
-    -> let resTyInfo = extractTySizeInfo tcm ty tys
-       in  reduce (mkIndexLit' resTyInfo (i * j))
-
--- Integral
-  "Clash.Sized.Internal.Index.quot#"
-    | Just (nTy,kn) <- extractKnownNat tcm tys
-    , Just (i,j) <- indexLiterals args
-    -> reduce $ catchDivByZero (mkIndexLit ty nTy kn (i `quot` j))
-  "Clash.Sized.Internal.Index.rem#"
-    | Just (nTy,kn) <- extractKnownNat tcm tys
-    , Just (i,j) <- indexLiterals args
-    -> reduce $ catchDivByZero (mkIndexLit ty nTy kn (i `rem` j))
-  "Clash.Sized.Internal.Index.toInteger#"
-    | [PrimVal p _ [_, Lit (IntegerLiteral i)]] <- args
-    , primName p == "Clash.Sized.Internal.Index.fromInteger#"
-    -> reduce (integerToIntegerLiteral i)
-
--- Resize
-  "Clash.Sized.Internal.Index.resize#"
-    | Just (mTy,m) <- extractKnownNat tcm tys
-    , [i] <- indexLiterals' args
-    -> reduce (mkIndexLit ty mTy m i)
-
----------
--- Signed
----------
-  "Clash.Sized.Internal.Signed.size#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    -> let (_,tyView -> TyConApp intTcNm _) = splitFunForallTy ty
-           (Just intTc) = UniqMap.lookup intTcNm tcm
-           [intCon] = tyConDataCons intTc
-       in  reduce (mkApps (Data intCon) [Left (Literal (IntLiteral kn))])
-
--- BitPack
-  "Clash.Sized.Internal.Signed.pack#"
-    | Just (nTy, kn) <- extractKnownNat tcm tys
-    , [i] <- signedLiterals' args
-    -> let val = reifyNat kn (op (fromInteger i))
-       in reduce (mkBitVectorLit ty nTy kn 0 val)
-    where
-        op :: KnownNat n => Signed n -> Proxy n -> Integer
-        op s _ = toInteger (Signed.pack# s)
-  "Clash.Sized.Internal.Signed.unpack#"
-    | Just (nTy, kn) <- extractKnownNat tcm tys
-    , [(0,i)] <- bitVectorLiterals' args
-    -> let val = reifyNat kn (op (fromInteger i))
-       in reduce (mkSignedLit ty nTy kn val)
-    where
-        op :: KnownNat n => BitVector n -> Proxy n -> Integer
-        op s _ = toInteger (Signed.unpack# s)
-
--- Eq
-  "Clash.Sized.Internal.Signed.eq#" | Just (i,j) <- signedLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i == j))
-  "Clash.Sized.Internal.Signed.neq#" | Just (i,j) <- signedLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i /= j))
-
--- Ord
-  "Clash.Sized.Internal.Signed.lt#" | Just (i,j) <- signedLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i <  j))
-  "Clash.Sized.Internal.Signed.ge#" | Just (i,j) <- signedLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i >= j))
-  "Clash.Sized.Internal.Signed.gt#" | Just (i,j) <- signedLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i >  j))
-  "Clash.Sized.Internal.Signed.le#" | Just (i,j) <- signedLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i <= j))
-
--- Enum
-  "Clash.Sized.Internal.Signed.toEnum#"
-    | [i] <- intCLiterals' args
-    , Just (litTy, mb) <- extractKnownNat tcm tys
-    -> reduce (mkSignedLit ty litTy mb i)
-
-  "Clash.Sized.Internal.Signed.fromEnum#"
-    | [i] <- signedLiterals' args
-    -> let resTy = getResultTy tcm ty tys
-        in reduce (mkIntCLit tcm i resTy)
-
--- Bounded
-  "Clash.Sized.Internal.Signed.minBound#"
-    | Just (litTy,mb) <- extractKnownNat tcm tys
-    -> let minB = negate (2 ^ (mb - 1))
-       in  reduce (mkSignedLit ty litTy mb minB)
-  "Clash.Sized.Internal.Signed.maxBound#"
-    | Just (litTy,mb) <- extractKnownNat tcm tys
-    -> let maxB = (2 ^ (mb - 1)) - 1
-       in reduce (mkSignedLit ty litTy mb maxB)
-
--- Num
-  "Clash.Sized.Internal.Signed.+#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftSigned2 (Signed.+#) ty tcm tys args)
-    -> reduce (val)
-  "Clash.Sized.Internal.Signed.-#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftSigned2 (Signed.-#) ty tcm tys args)
-    -> reduce (val)
-  "Clash.Sized.Internal.Signed.*#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftSigned2 (Signed.*#) ty tcm tys args)
-    -> reduce (val)
-  "Clash.Sized.Internal.Signed.negate#"
-    | Just (nTy, kn) <- extractKnownNat tcm tys
-    , [i] <- signedLiterals' args
-    -> let val = reifyNat kn (op (fromInteger i))
-    in reduce (mkSignedLit ty nTy kn val)
-    where
-      op :: KnownNat n => Signed n -> Proxy n -> Integer
-      op s _ = toInteger (Signed.negate# s)
-  "Clash.Sized.Internal.Signed.abs#"
-    | Just (nTy, kn) <- extractKnownNat tcm tys
-    , [i] <- signedLiterals' args
-    -> let val = reifyNat kn (op (fromInteger i))
-    in reduce (mkSignedLit ty nTy kn val)
-    where
-      op :: KnownNat n => Signed n -> Proxy n -> Integer
-      op s _ = toInteger (Signed.abs# s)
-
--- ExtendingNum
-  "Clash.Sized.Internal.Signed.plus#"
-    | Just (i,j) <- signedLiterals args
-    -> let ty' = piResultTys tcm ty tys
-           (_,resTy) = splitFunForallTy ty'
-           (TyConApp _ [resSizeTy]) = tyView resTy
-           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
-       in  reduce (mkSignedLit resTy resSizeTy resSizeInt (i+j))
-
-  "Clash.Sized.Internal.Signed.minus#"
-    | Just (i,j) <- signedLiterals args
-    -> let ty' = piResultTys tcm ty tys
-           (_,resTy) = splitFunForallTy ty'
-           (TyConApp _ [resSizeTy]) = tyView resTy
-           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
-       in  reduce (mkSignedLit resTy resSizeTy resSizeInt (i-j))
-
-  "Clash.Sized.Internal.Signed.times#"
-    | Just (i,j) <- signedLiterals args
-    -> let ty' = piResultTys tcm ty tys
-           (_,resTy) = splitFunForallTy ty'
-           (TyConApp _ [resSizeTy]) = tyView resTy
-           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
-       in  reduce (mkSignedLit resTy resSizeTy resSizeInt (i*j))
-
--- Integral
-  "Clash.Sized.Internal.Signed.quot#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftSigned2 (Signed.quot#) ty tcm tys args)
-    -> reduce $ catchDivByZero val
-  "Clash.Sized.Internal.Signed.rem#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftSigned2 (Signed.rem#) ty tcm tys args)
-    -> reduce $ catchDivByZero val
-  "Clash.Sized.Internal.Signed.div#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftSigned2 (Signed.div#) ty tcm tys args)
-    -> reduce $ catchDivByZero val
-  "Clash.Sized.Internal.Signed.mod#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftSigned2 (Signed.mod#) ty tcm tys args)
-    -> reduce $ catchDivByZero val
-  "Clash.Sized.Internal.Signed.toInteger#"
-    | [PrimVal p _ [_, Lit (IntegerLiteral i)]] <- args
-    , primName p == "Clash.Sized.Internal.Signed.fromInteger#"
-    -> reduce (integerToIntegerLiteral i)
-
--- Bits
-  "Clash.Sized.Internal.Signed.and#"
-    | [i,j] <- signedLiterals' args
-    , Just (nTy, kn) <- extractKnownNat tcm tys
-    -> reduce (mkSignedLit ty nTy kn (i .&. j))
-  "Clash.Sized.Internal.Signed.or#"
-    | [i,j] <- signedLiterals' args
-    , Just (nTy, kn) <- extractKnownNat tcm tys
-    -> reduce (mkSignedLit ty nTy kn (i .|. j))
-  "Clash.Sized.Internal.Signed.xor#"
-    | [i,j] <- signedLiterals' args
-    , Just (nTy, kn) <- extractKnownNat tcm tys
-    -> reduce (mkSignedLit ty nTy kn (i `xor` j))
-
-  "Clash.Sized.Internal.Signed.complement#"
-    | [i] <- signedLiterals' args
-    , Just (nTy, kn) <- extractKnownNat tcm tys
-    -> let val = reifyNat kn (op (fromInteger i))
-    in reduce (mkSignedLit ty nTy kn val)
-    where
-      op :: KnownNat n => Signed n -> Proxy n -> Integer
-      op u _ = toInteger (Signed.complement# u)
-
-  "Clash.Sized.Internal.Signed.shiftL#"
-    | Just (nTy,kn,i,j) <- signedLitIntLit tcm tys args
-      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
-      in reduce (mkSignedLit ty nTy kn val)
-      where
-        op :: KnownNat n => Signed n -> Int -> Proxy n -> Integer
-        op u i _ = toInteger (Signed.shiftL# u i)
-  "Clash.Sized.Internal.Signed.shiftR#"
-    | Just (nTy,kn,i,j) <- signedLitIntLit tcm tys args
-      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
-      in reduce (mkSignedLit ty nTy kn val)
-      where
-        op :: KnownNat n => Signed n -> Int -> Proxy n -> Integer
-        op u i _ = toInteger (Signed.shiftR# u i)
-  "Clash.Sized.Internal.Signed.rotateL#"
-    | Just (nTy,kn,i,j) <- signedLitIntLit tcm tys args
-      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
-      in reduce (mkSignedLit ty nTy kn val)
-      where
-        op :: KnownNat n => Signed n -> Int -> Proxy n -> Integer
-        op u i _ = toInteger (Signed.rotateL# u i)
-  "Clash.Sized.Internal.Signed.rotateR#"
-    | Just (nTy,kn,i,j) <- signedLitIntLit tcm tys args
-      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
-      in reduce (mkSignedLit ty nTy kn val)
-      where
-        op :: KnownNat n => Signed n -> Int -> Proxy n -> Integer
-        op u i _ = toInteger (Signed.rotateR# u i)
-
--- Resize
-  "Clash.Sized.Internal.Signed.resize#" -- forall m n. (KnownNat n, KnownNat m) => Signed n -> Signed m
-    | mTy : nTy : _ <- tys
-    , Right mInt <- runExcept (tyNatSize tcm mTy)
-    , Right nInt <- runExcept (tyNatSize tcm nTy)
-    , [i] <- signedLiterals' args
-    -> let val | nInt <= mInt = extended
-               | otherwise    = truncated
-           extended  = i
-           mask      = 1 `shiftL` fromInteger (mInt - 1)
-           i'        = i `mod` mask
-           truncated = if testBit i (fromInteger nInt - 1)
-                          then (i' - mask)
-                          else i'
-       in reduce (mkSignedLit ty mTy mInt val)
-  "Clash.Sized.Internal.Signed.truncateB#" -- KnownNat m => Signed (m + n) -> Signed m
-    | Just (mTy, km) <- extractKnownNat tcm tys
-    , [i] <- signedLiterals' args
-    -> let bitsKeep = (bit (fromInteger km)) - 1
-           val = i .&. bitsKeep
-    in reduce (mkSignedLit ty mTy km val)
-
--- SaturatingNum
--- No need to manually evaluate Clash.Sized.Internal.Signed.minBoundSym#
--- It is just implemented in terms of other primitives.
-
-
------------
--- Unsigned
------------
-  "Clash.Sized.Internal.Unsigned.size#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    -> let (_,ty') = splitFunForallTy ty
-           (TyConApp intTcNm _) = tyView ty'
-           (Just intTc) = UniqMap.lookup intTcNm tcm
-           [intCon] = tyConDataCons intTc
-       in  reduce (mkApps (Data intCon) [Left (Literal (IntLiteral kn))])
-
--- BitPack
-  "Clash.Sized.Internal.Unsigned.pack#"
-    | Just (nTy, kn) <- extractKnownNat tcm tys
-    , [i] <- unsignedLiterals' args
-    -> reduce (mkBitVectorLit ty nTy kn 0 i)
-  "Clash.Sized.Internal.Unsigned.unpack#"
-    | Just (nTy, kn) <- extractKnownNat tcm tys
-    , [i] <- bitVectorLiterals' args
-    -> let val = reifyNat kn (op (toBV i))
-    in reduce (mkUnsignedLit ty nTy kn val)
-    where
-      op :: KnownNat n => BitVector n -> Proxy n -> Integer
-      op u _ = toInteger (Unsigned.unpack# u)
-
--- Eq
-  "Clash.Sized.Internal.Unsigned.eq#" | Just (i,j) <- unsignedLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i == j))
-  "Clash.Sized.Internal.Unsigned.neq#" | Just (i,j) <- unsignedLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i /= j))
-
--- Ord
-  "Clash.Sized.Internal.Unsigned.lt#" | Just (i,j) <- unsignedLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i <  j))
-  "Clash.Sized.Internal.Unsigned.ge#" | Just (i,j) <- unsignedLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i >= j))
-  "Clash.Sized.Internal.Unsigned.gt#" | Just (i,j) <- unsignedLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i >  j))
-  "Clash.Sized.Internal.Unsigned.le#" | Just (i,j) <- unsignedLiterals args
-    -> reduce (boolToBoolLiteral tcm ty (i <= j))
-
--- Enum
-  "Clash.Sized.Internal.Unsigned.toEnum#"
-    | [i] <- intCLiterals' args
-    , Just (litTy, mb) <- extractKnownNat tcm tys
-    -> reduce (mkUnsignedLit ty litTy mb i)
-
-  "Clash.Sized.Internal.Unsigned.fromEnum#"
-    | [i] <- unsignedLiterals' args
-    -> let resTy = getResultTy tcm ty tys
-        in reduce (mkIntCLit tcm i resTy)
-
--- Bounded
-  "Clash.Sized.Internal.Unsigned.minBound#"
-    | Just (nTy,len) <- extractKnownNat tcm tys
-    -> reduce (mkUnsignedLit ty nTy len 0)
-  "Clash.Sized.Internal.Unsigned.maxBound#"
-    | Just (litTy,mb) <- extractKnownNat tcm tys
-    -> let maxB = (2 ^ mb) - 1
-       in  reduce (mkUnsignedLit ty litTy mb maxB)
-
--- Num
-  "Clash.Sized.Internal.Unsigned.+#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftUnsigned2 (Unsigned.+#) ty tcm tys args)
-    -> reduce val
-  "Clash.Sized.Internal.Unsigned.-#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftUnsigned2 (Unsigned.-#) ty tcm tys args)
-    -> reduce val
-  "Clash.Sized.Internal.Unsigned.*#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftUnsigned2 (Unsigned.*#) ty tcm tys args)
-    -> reduce val
-  "Clash.Sized.Internal.Unsigned.negate#"
-    | Just (nTy, kn) <- extractKnownNat tcm tys
-    , [i] <- unsignedLiterals' args
-    -> let val = reifyNat kn (op (fromInteger i))
-    in reduce (mkUnsignedLit ty nTy kn val)
-    where
-      op :: KnownNat n => Unsigned n -> Proxy n -> Integer
-      op u _ = toInteger (Unsigned.negate# u)
-
--- ExtendingNum
-  "Clash.Sized.Internal.Unsigned.plus#" -- :: Unsigned m -> Unsigned n -> Unsigned (Max m n + 1)
-    | Just (i,j) <- unsignedLiterals args
-    -> let ty' = piResultTys tcm ty tys
-           (_,resTy) = splitFunForallTy ty'
-           (TyConApp _ [resSizeTy]) = tyView resTy
-           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
-       in  reduce (mkUnsignedLit resTy resSizeTy resSizeInt (i+j))
-
-  "Clash.Sized.Internal.Unsigned.minus#"
-    | [i,j] <- unsignedLiterals' args
-    -> let ty' = piResultTys tcm ty tys
-           (_,resTy) = splitFunForallTy ty'
-           (TyConApp _ [resSizeTy]) = tyView resTy
-           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
-           val = reifyNat resSizeInt (runSizedF (Unsigned.-#) i j)
-      in   reduce (mkUnsignedLit resTy resSizeTy resSizeInt val)
-
-  "Clash.Sized.Internal.Unsigned.times#"
-    | Just (i,j) <- unsignedLiterals args
-    -> let ty' = piResultTys tcm ty tys
-           (_,resTy) = splitFunForallTy ty'
-           (TyConApp _ [resSizeTy]) = tyView resTy
-           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
-       in  reduce (mkUnsignedLit resTy resSizeTy resSizeInt (i*j))
-
--- Integral
-  "Clash.Sized.Internal.Unsigned.quot#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftUnsigned2 (Unsigned.quot#) ty tcm tys args)
-    -> reduce $ catchDivByZero val
-  "Clash.Sized.Internal.Unsigned.rem#"
-    | Just (_, kn) <- extractKnownNat tcm tys
-    , Just val <- reifyNat kn (liftUnsigned2 (Unsigned.rem#) ty tcm tys args)
-    -> reduce $ catchDivByZero val
-  "Clash.Sized.Internal.Unsigned.toInteger#"
-    | [PrimVal p _ [_, Lit (IntegerLiteral i)]] <- args
-    , primName p == "Clash.Sized.Internal.Unsigned.fromInteger#"
-    -> reduce (integerToIntegerLiteral i)
-
--- Bits
-  "Clash.Sized.Internal.Unsigned.and#"
-    | Just (i,j) <- unsignedLiterals args
-    , Just (nTy, kn) <- extractKnownNat tcm tys
-    -> reduce (mkUnsignedLit ty nTy kn (i .&. j))
-  "Clash.Sized.Internal.Unsigned.or#"
-    | Just (i,j) <- unsignedLiterals args
-    , Just (nTy, kn) <- extractKnownNat tcm tys
-    -> reduce (mkUnsignedLit ty nTy kn (i .|. j))
-  "Clash.Sized.Internal.Unsigned.xor#"
-    | Just (i,j) <- unsignedLiterals args
-    , Just (nTy, kn) <- extractKnownNat tcm tys
-    -> reduce (mkUnsignedLit ty nTy kn (i `xor` j))
-
-  "Clash.Sized.Internal.Unsigned.complement#"
-    | [i] <- unsignedLiterals' args
-    , Just (nTy, kn) <- extractKnownNat tcm tys
-    -> let val = reifyNat kn (op (fromInteger i))
-    in reduce (mkUnsignedLit ty nTy kn val)
-    where
-      op :: KnownNat n => Unsigned n -> Proxy n -> Integer
-      op u _ = toInteger (Unsigned.complement# u)
-
-  "Clash.Sized.Internal.Unsigned.shiftL#" -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
-    | Just (nTy,kn,i,j) <- unsignedLitIntLit tcm tys args
-      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
-      in reduce (mkUnsignedLit ty nTy kn val)
-      where
-        op :: KnownNat n => Unsigned n -> Int -> Proxy n -> Integer
-        op u i _ = toInteger (Unsigned.shiftL# u i)
-  "Clash.Sized.Internal.Unsigned.shiftR#" -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
-    | Just (nTy,kn,i,j) <- unsignedLitIntLit tcm tys args
-      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
-      in reduce (mkUnsignedLit ty nTy kn val)
-      where
-        op :: KnownNat n => Unsigned n -> Int -> Proxy n -> Integer
-        op u i _ = toInteger (Unsigned.shiftR# u i)
-  "Clash.Sized.Internal.Unsigned.rotateL#" -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
-    | Just (nTy,kn,i,j) <- unsignedLitIntLit tcm tys args
-      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
-      in reduce (mkUnsignedLit ty nTy kn val)
-      where
-        op :: KnownNat n => Unsigned n -> Int -> Proxy n -> Integer
-        op u i _ = toInteger (Unsigned.rotateL# u i)
-  "Clash.Sized.Internal.Unsigned.rotateR#" -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
-    | Just (nTy,kn,i,j) <- unsignedLitIntLit tcm tys args
-      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
-      in reduce (mkUnsignedLit ty nTy kn val)
-      where
-        op :: KnownNat n => Unsigned n -> Int -> Proxy n -> Integer
-        op u i _ = toInteger (Unsigned.rotateR# u i)
-
--- Resize
-  "Clash.Sized.Internal.Unsigned.resize#" -- forall n m . KnownNat m => Unsigned n -> Unsigned m
-    | _ : mTy : _ <- tys
-    , Right km <- runExcept (tyNatSize tcm mTy)
-    , [i] <- unsignedLiterals' args
-    -> let bitsKeep = (bit (fromInteger km)) - 1
-           val = i .&. bitsKeep
-    in reduce (mkUnsignedLit ty mTy km val)
-
--- Conversions
-  "Clash.Sized.Internal.Unsigned.unsignedToWord"
-    | isSubj
-    , [a] <- unsignedLiterals' args
-    -> let b = Unsigned.unsignedToWord (U (fromInteger a))
-           (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
-           (Just wordTc) = UniqMap.lookup wordTcNm tcm
-           [wordDc] = tyConDataCons wordTc
-       in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral (toInteger b)))])
-
-  "Clash.Sized.Internal.Unsigned.unsigned8toWord8"
-    | isSubj
-    , [a] <- unsignedLiterals' args
-    -> let b = Unsigned.unsigned8toWord8 (U (fromInteger a))
-           (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
-           (Just wordTc) = UniqMap.lookup wordTcNm tcm
-           [wordDc] = tyConDataCons wordTc
-       in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral (toInteger b)))])
-
-  "Clash.Sized.Internal.Unsigned.unsigned16toWord16"
-    | isSubj
-    , [a] <- unsignedLiterals' args
-    -> let b = Unsigned.unsigned16toWord16 (U (fromInteger a))
-           (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
-           (Just wordTc) = UniqMap.lookup wordTcNm tcm
-           [wordDc] = tyConDataCons wordTc
-       in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral (toInteger b)))])
-
-  "Clash.Sized.Internal.Unsigned.unsigned32toWord32"
-    | isSubj
-    , [a] <- unsignedLiterals' args
-    -> let b = Unsigned.unsigned32toWord32 (U (fromInteger a))
-           (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
-           (Just wordTc) = UniqMap.lookup wordTcNm tcm
-           [wordDc] = tyConDataCons wordTc
-       in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral (toInteger b)))])
-
-  "Clash.Annotations.BitRepresentation.Deriving.dontApplyInHDL"
-    | isSubj
-    , f : a : _ <- args
-    -> reduceWHNF (mkApps (valToTerm f) [Left (valToTerm a)])
-
---------
--- RTree
---------
-  "Clash.Sized.RTree.textract"
-    | isSubj
-    , [DC _ tArgs] <- args
-    -> reduceWHNF (Either.lefts tArgs !! 1)
-
-  "Clash.Sized.RTree.tsplit"
-    | isSubj
-    , dTy : aTy : _ <- tys
-    , [DC _ tArgs] <- args
-    , (tyArgs,tyView -> TyConApp tupTcNm _) <- splitFunForallTy ty
-    , TyConApp treeTcNm _ <- tyView (Either.rights tyArgs !! 0)
-    -> let (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc]      = tyConDataCons tupTc
-       in  reduce $
-           mkApps (Data tupDc)
-                  [Right (mkTyConApp treeTcNm [dTy,aTy])
-                  ,Right (mkTyConApp treeTcNm [dTy,aTy])
-                  ,Left (Either.lefts tArgs !! 1)
-                  ,Left (Either.lefts tArgs !! 2)
-                  ]
-
-  "Clash.Sized.RTree.tdfold"
-    | isSubj
-    , pTy : kTy : aTy : _ <- tys
-    , _ : p : f : g : ts : _ <- args
-    , DC _ tArgs <- ts
-    , Right k' <- runExcept (tyNatSize tcm kTy)
-    -> case k' of
-         0 -> reduceWHNF (mkApps (valToTerm f) [Left (Either.lefts tArgs !! 1)])
-         _ -> let k'ty = LitTy (NumTy (k'-1))
-                  (tyArgs,_)  = splitFunForallTy ty
-                  (tyArgs',_) = splitFunForallTy (Either.rights tyArgs !! 3)
-                  TyConApp snatTcNm _ = tyView (Either.rights tyArgs' !! 0)
-                  Just snatTc = UniqMap.lookup snatTcNm tcm
-                  [snatDc]    = tyConDataCons snatTc
-              in  reduceWHNF $
-                  mkApps (valToTerm g)
-                         [Right k'ty
-                         ,Left (mkApps (Data snatDc)
-                                       [Right k'ty
-                                       ,Left (Literal (NaturalLiteral (k'-1)))])
-                         ,Left (mkApps (Prim pInfo)
-                                       [Right pTy
-                                       ,Right k'ty
-                                       ,Right aTy
-                                       ,Left (Literal (NaturalLiteral (k'-1)))
-                                       ,Left (valToTerm p)
-                                       ,Left (valToTerm f)
-                                       ,Left (valToTerm g)
-                                       ,Left (Either.lefts tArgs !! 1)
-                                       ])
-                         ,Left (mkApps (Prim pInfo)
-                                       [Right pTy
-                                       ,Right k'ty
-                                       ,Right aTy
-                                       ,Left (Literal (NaturalLiteral (k'-1)))
-                                       ,Left (valToTerm p)
-                                       ,Left (valToTerm f)
-                                       ,Left (valToTerm g)
-                                       ,Left (Either.lefts tArgs !! 2)
-                                       ])
-                         ]
-
-  "Clash.Sized.RTree.treplicate"
-    | isSubj
-    , let ty' = piResultTys tcm ty tys
-    , (_,tyView -> TyConApp treeTcNm [lenTy,argTy]) <- splitFunForallTy ty'
-    , Right len <- runExcept (tyNatSize tcm lenTy)
-    -> let (Just treeTc) = UniqMap.lookup treeTcNm tcm
-           [lrCon,brCon] = tyConDataCons treeTc
-       in  reduce (mkRTree lrCon brCon argTy len (replicate (2^len) (valToTerm (last args))))
-
----------
--- Vector
----------
-  "Clash.Sized.Vector.length" -- :: KnownNat n => Vec n a -> Int
-    | isSubj
-    , [nTy, _] <- tys
-    , Right n <-runExcept (tyNatSize tcm nTy)
-    -> let (_, tyView -> TyConApp intTcNm _) = splitFunForallTy ty
-           (Just intTc) = UniqMap.lookup intTcNm tcm
-           [intCon] = tyConDataCons intTc
-       in  reduce (mkApps (Data intCon) [Left (Literal (IntLiteral (toInteger n)))])
-
-  "Clash.Sized.Vector.maxIndex"
-    | isSubj
-    , [nTy, _] <- tys
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> let (_, tyView -> TyConApp intTcNm _) = splitFunForallTy ty
-           (Just intTc) = UniqMap.lookup intTcNm tcm
-           [intCon] = tyConDataCons intTc
-       in  reduce (mkApps (Data intCon) [Left (Literal (IntLiteral (toInteger (n - 1))))])
-
--- Indexing
-  "Clash.Sized.Vector.index_int" -- :: KnownNat n => Vec n a -> Int
-    | nTy : aTy : _  <- tys
-    , _ : xs : i : _ <- args
-    , DC intDc [Left (Literal (IntLiteral i'))] <- i
-    -> if i' < 0
-          then Nothing
-          else case xs of
-                 DC _ vArgs  -> case runExcept (tyNatSize tcm nTy) of
-                    Right 0  -> Nothing
-                    Right n' ->
-                      if i' == 0
-                         then reduceWHNF (Either.lefts vArgs !! 1)
-                         else reduceWHNF $
-                              mkApps (Prim pInfo)
-                                     [Right (LitTy (NumTy (n'-1)))
-                                     ,Right aTy
-                                     ,Left (Literal (NaturalLiteral (n'-1)))
-                                     ,Left (Either.lefts vArgs !! 2)
-                                     ,Left (mkApps (Data intDc)
-                                                   [Left (Literal (IntLiteral (i'-1)))])
-                                     ]
-                    _ -> Nothing
-                 _ -> Nothing
-  "Clash.Sized.Vector.head" -- :: Vec (n+1) a -> a
-    | isSubj
-    , [DC _ vArgs] <- args
-    -> reduceWHNF (Either.lefts vArgs !! 1)
-  "Clash.Sized.Vector.last" -- :: Vec (n+1) a -> a
-    | isSubj
-    , [DC _ vArgs] <- args
-    , (Right _ : Right aTy : Right nTy : _) <- vArgs
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> if n == 0
-          then reduceWHNF (Either.lefts vArgs !! 1)
-          else reduceWHNF
-                (mkApps (Prim pInfo)
-                                     [Right (LitTy (NumTy (n-1)))
-                                     ,Right aTy
-                                     ,Left (Either.lefts vArgs !! 2)
-                                     ])
--- - Sub-vectors
-  "Clash.Sized.Vector.tail" -- :: Vec (n+1) a -> Vec n a
-    | isSubj
-    , [DC _ vArgs] <- args
-    -> reduceWHNF (Either.lefts vArgs !! 2)
-  "Clash.Sized.Vector.init" -- :: Vec (n+1) a -> Vec n a
-    | isSubj
-    , [DC consCon vArgs] <- args
-    , (Right _ : Right aTy : Right nTy : _) <- vArgs
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> if n == 0
-          then reduceWHNF (Either.lefts vArgs !! 2)
-          else reduce $
-               mkVecCons consCon aTy n
-                  (Either.lefts vArgs !! 1)
-                  (mkApps (Prim pInfo)
-                                       [Right (LitTy (NumTy (n-1)))
-                                       ,Right aTy
-                                       ,Left (Either.lefts vArgs !! 2)])
-  "Clash.Sized.Vector.select" -- :: (CmpNat (i+s) (s*n) ~ GT) => SNat f -> SNat s -> SNat n -> Vec (f + i) a -> Vec n a
-    | isSubj
-    , iTy : sTy : nTy : fTy : aTy : _ <- tys
-    , eq : f : s : n : xs : _ <- args
-    , Right n' <- runExcept (tyNatSize tcm nTy)
-    , Right f' <- runExcept (tyNatSize tcm fTy)
-    , Right i' <- runExcept (tyNatSize tcm iTy)
-    , Right s' <- runExcept (tyNatSize tcm sTy)
-    , DC _ vArgs <- xs
-    -> case n' of
-         0 -> reduce (mkVecNil nilCon aTy)
-         _ -> case f' of
-          0 -> let splitAtCall =
-                    mkApps (splitAtPrim snatTcNm vecTcNm)
-                           [Right sTy
-                           ,Right (LitTy (NumTy (i'-s')))
-                           ,Right aTy
-                           ,Left (valToTerm s)
-                           ,Left (valToTerm xs)
-                           ]
-                   fVecTy = mkTyConApp vecTcNm [sTy,aTy]
-                   iVecTy = mkTyConApp vecTcNm [LitTy (NumTy (i'-s')),aTy]
-                   -- Guaranteed no capture, so okay to use unsafe name generation
-                   fNm    = mkUnsafeSystemName "fxs" 0
-                   iNm    = mkUnsafeSystemName "ixs" 1
-                   fId    = mkLocalId fVecTy fNm
-                   iId    = mkLocalId iVecTy iNm
-                   tupPat = DataPat tupDc [] [fId,iId]
-                   iAlt   = (tupPat, (Var iId))
-               in  reduce $
-                   mkVecCons consCon aTy n' (Either.lefts vArgs !! 1) $
-                   mkApps (Prim pInfo)
-                          [Right (LitTy (NumTy (i'-s')))
-                          ,Right sTy
-                          ,Right (LitTy (NumTy (n'-1)))
-                          ,Right (LitTy (NumTy 0))
-                          ,Right aTy
-                          ,Left (valToTerm eq)
-                          ,Left (Literal (NaturalLiteral 0))
-                          ,Left (valToTerm s)
-                          ,Left (Literal (NaturalLiteral (n'-1)))
-                          ,Left (Case splitAtCall iVecTy [iAlt])
-                          ]
-          _ -> let splitAtCall =
-                    mkApps (splitAtPrim snatTcNm vecTcNm)
-                           [Right fTy
-                           ,Right iTy
-                           ,Right aTy
-                           ,Left (valToTerm f)
-                           ,Left (valToTerm xs)
-                           ]
-                   fVecTy = mkTyConApp vecTcNm [fTy,aTy]
-                   iVecTy = mkTyConApp vecTcNm [iTy,aTy]
-                   -- Guaranteed no capture, so okay to use unsafe name generation
-                   fNm    = mkUnsafeSystemName "fxs" 0
-                   iNm    = mkUnsafeSystemName "ixs" 1
-                   fId    = mkLocalId fVecTy fNm
-                   iId    = mkLocalId iVecTy iNm
-                   tupPat = DataPat tupDc [] [fId,iId]
-                   iAlt   = (tupPat, (Var iId))
-               in  reduceWHNF $
-                   mkApps (Prim pInfo)
-                     [Right iTy
-                     ,Right sTy
-                     ,Right nTy
-                     ,Right (LitTy (NumTy 0))
-                     ,Right aTy
-                     ,Left (valToTerm eq)
-                     ,Left (Literal (NaturalLiteral 0))
-                     ,Left (valToTerm s)
-                     ,Left (valToTerm n)
-                     ,Left (Case splitAtCall iVecTy [iAlt])
-                     ]
-    where
-      (tyArgs,tyView -> TyConApp vecTcNm _) = splitFunForallTy ty
-      Just vecTc          = UniqMap.lookup vecTcNm tcm
-      [nilCon,consCon]    = tyConDataCons vecTc
-      TyConApp snatTcNm _ = tyView (Either.rights tyArgs !! 1)
-      tupTcNm            = ghcTyconToTyConName (tupleTyCon Boxed 2)
-      (Just tupTc)       = UniqMap.lookup tupTcNm tcm
-      [tupDc]            = tyConDataCons tupTc
--- - Splitting
-  "Clash.Sized.Vector.splitAt" -- :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a)
-    | isSubj
-    , (DC snatDc (Right mTy:_)):_ <- args
-    , Right m <- runExcept (tyNatSize tcm mTy)
-    -> let _:nTy:aTy:_ = tys
-           -- Get the tuple data-constructor
-           ty1 = piResultTys tcm ty tys
-           (_,tyView -> TyConApp tupTcNm tyArgs@(tyArg:_)) = splitFunForallTy ty1
-           (Just tupTc)       = UniqMap.lookup tupTcNm tcm
-           [tupDc]            = tyConDataCons tupTc
-           -- Get the vector data-constructors
-           TyConApp vecTcNm _ = tyView tyArg
-           Just vecTc         = UniqMap.lookup vecTcNm tcm
-           [nilCon,consCon]   = tyConDataCons vecTc
-           -- Recursive call to @splitAt@
-           splitAtRec v =
-            mkApps (Prim pInfo)
-                   [Right (LitTy (NumTy (m-1)))
-                   ,Right nTy
-                   ,Right aTy
-                   ,Left (mkApps (Data snatDc)
-                                 [ Right (LitTy (NumTy (m-1)))
-                                 , Left  (Literal (NaturalLiteral (m-1)))])
-                   ,Left v
-                   ]
-           -- Projection either the first or second field of the recursive
-           -- call to @splitAt@
-           splitAtSelR v = Case (splitAtRec v)
-           m1VecTy = mkTyConApp vecTcNm [LitTy (NumTy (m-1)),aTy]
-           nVecTy  = mkTyConApp vecTcNm [nTy,aTy]
-           -- Guaranteed no capture, so okay to use unsafe name generation
-           lNm     = mkUnsafeSystemName "l" 0
-           rNm     = mkUnsafeSystemName "r" 1
-           lId     = mkLocalId m1VecTy lNm
-           rId     = mkLocalId nVecTy rNm
-           tupPat  = DataPat tupDc [] [lId,rId]
-           lAlt    = (tupPat, (Var lId))
-           rAlt    = (tupPat, (Var rId))
-
-       in case m of
-         -- (Nil,v)
-         0 -> reduce $
-              mkApps (Data tupDc) $ (map Right tyArgs) ++
-                [ Left (mkVecNil nilCon aTy)
-                , Left (valToTerm (last args))
-                ]
-         -- (x:xs) <- v
-         m' | DC _ vArgs <- last args
-            -- (x:fst (splitAt (m-1) xs),snd (splitAt (m-1) xs))
-            -> reduce $
-               mkApps (Data tupDc) $ (map Right tyArgs) ++
-                 [ Left (mkVecCons consCon aTy m' (Either.lefts vArgs !! 1)
-                           (splitAtSelR (Either.lefts vArgs !! 2) m1VecTy [lAlt]))
-                 , Left (splitAtSelR (Either.lefts vArgs !! 2) nVecTy [rAlt])
-                 ]
-         -- v doesn't reduce to a data-constructor
-         _  -> Nothing
-
-  "Clash.Sized.Vector.unconcat" -- :: KnownNat n => SNamt m -> Vec (n * m) a -> Vec n (Vec m a)
-    | isSubj
-    , kn : snat : v : _  <- args
-    , nTy : mTy : aTy :_ <- tys
-    , Lit (NaturalLiteral n) <- kn
-    -> let ( Either.rights -> argTys, tyView -> TyConApp vecTcNm _) =
-              splitFunForallTy ty
-           Just vecTc = UniqMap.lookup vecTcNm tcm
-           [nilCon,consCon]   = tyConDataCons vecTc
-           tupTcNm            = ghcTyconToTyConName (tupleTyCon Boxed 2)
-           (Just tupTc)       = UniqMap.lookup tupTcNm tcm
-           [tupDc]            = tyConDataCons tupTc
-           TyConApp snatTcNm _ = tyView (argTys !! 1)
-           n1mTy  = mkTyConApp typeNatMul
-                        [mkTyConApp typeNatSub [nTy,LitTy (NumTy 1)]
-                        ,mTy]
-           splitAtCall =
-            mkApps (splitAtPrim snatTcNm vecTcNm)
-                   [Right mTy
-                   ,Right n1mTy
-                   ,Right aTy
-                   ,Left (valToTerm snat)
-                   ,Left (valToTerm v)
-                   ]
-           mVecTy   = mkTyConApp vecTcNm [mTy,aTy]
-           n1mVecTy = mkTyConApp vecTcNm [n1mTy,aTy]
-           -- Guaranteed no capture, so okay to use unsafe name generation
-           asNm     = mkUnsafeSystemName "as" 0
-           bsNm     = mkUnsafeSystemName "bs" 1
-           asId     = mkLocalId mVecTy asNm
-           bsId     = mkLocalId n1mVecTy bsNm
-           tupPat   = DataPat tupDc [] [asId,bsId]
-           asAlt    = (tupPat, (Var asId))
-           bsAlt    = (tupPat, (Var bsId))
-
-       in  case n of
-         0 -> reduce (mkVecNil nilCon mVecTy)
-         _ -> reduce $
-              mkVecCons consCon mVecTy n
-                (Case splitAtCall mVecTy [asAlt])
-                (mkApps (Prim pInfo)
-                    [Right (LitTy (NumTy (n-1)))
-                    ,Right mTy
-                    ,Right aTy
-                    ,Left (Literal (NaturalLiteral (n-1)))
-                    ,Left (valToTerm snat)
-                    ,Left (Case splitAtCall n1mVecTy [bsAlt])])
--- Construction
--- - initialisation
-  "Clash.Sized.Vector.replicate" -- :: SNat n -> a -> Vec n a
-    | isSubj
-    , let ty' = piResultTys tcm ty tys
-    , let (_,resTy) = splitFunForallTy ty'
-    , (TyConApp vecTcNm [lenTy,argTy]) <- tyView resTy
-    , Right len <- runExcept (tyNatSize tcm lenTy)
-    -> let (Just vecTc) = UniqMap.lookup vecTcNm tcm
-           [nilCon,consCon] = tyConDataCons vecTc
-       in  reduce $
-           mkVec nilCon consCon argTy len
-                 (replicate (fromInteger len) (valToTerm (last args)))
--- - Concatenation
-  "Clash.Sized.Vector.++" -- :: Vec n a -> Vec m a -> Vec (n + m) a
-    | isSubj
-    , (DC dc vArgs):_ <- args
-    , Right nTy : Right aTy : _ <- vArgs
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> case n of
-         0  -> reduce (valToTerm (last args))
-         n' | (_ : _ : mTy : _) <- tys
-            , Right m <- runExcept (tyNatSize tcm mTy)
-            -> -- x : (xs ++ ys)
-               reduce $
-               mkVecCons dc aTy (n' + m) (Either.lefts vArgs !! 1)
-                 (mkApps (Prim pInfo)
-                                      [Right (LitTy (NumTy (n'-1)))
-                                      ,Right aTy
-                                      ,Right mTy
-                                      ,Left (Either.lefts vArgs !! 2)
-                                      ,Left (valToTerm (last args))
-                                      ])
-         _ -> Nothing
-  "Clash.Sized.Vector.concat" -- :: Vec n (Vec m a) -> Vec (n * m) a
-    | isSubj
-    , (nTy : mTy : aTy : _)  <- tys
-    , (xs : _)               <- args
-    , DC dc vArgs <- xs
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> case n of
-        0 -> reduce (mkVecNil dc aTy)
-        _ | _ : h' : t : _ <- Either.lefts  vArgs
-          , (_,tyView -> TyConApp vecTcNm _) <- splitFunForallTy ty
-          -> reduceWHNF $
-             mkApps (vecAppendPrim vecTcNm)
-                    [Right mTy
-                    ,Right aTy
-                    ,Right $ mkTyConApp typeNatMul
-                      [mkTyConApp typeNatSub [nTy,LitTy (NumTy 1)], mTy]
-                    ,Left h'
-                    ,Left $ mkApps (Prim pInfo)
-                      [ Right (LitTy (NumTy (n-1)))
-                      , Right mTy
-                      , Right aTy
-                      , Left t
-                      ]
-                    ]
-        _ -> Nothing
-
--- Modifying vectors
-  "Clash.Sized.Vector.replace_int" -- :: KnownNat n => Vec n a -> Int -> a -> Vec n a
-    | nTy : aTy : _  <- tys
-    , _ : xs : i : a : _ <- args
-    , DC intDc [Left (Literal (IntLiteral i'))] <- i
-    -> if i' < 0
-          then Nothing
-          else case xs of
-                 DC vecTcNm vArgs -> case runExcept (tyNatSize tcm nTy) of
-                    Right 0  -> Nothing
-                    Right n' ->
-                      if i' == 0
-                         then reduce (mkVecCons vecTcNm aTy n' (valToTerm a) (Either.lefts vArgs !! 2))
-                         else reduce $
-                              mkVecCons vecTcNm aTy n' (Either.lefts vArgs !! 1)
-                                (mkApps (Prim pInfo)
-                                        [Right (LitTy (NumTy (n'-1)))
-                                        ,Right aTy
-                                        ,Left (Literal (NaturalLiteral (n'-1)))
-                                        ,Left (Either.lefts vArgs !! 2)
-                                        ,Left (mkApps (Data intDc)
-                                                      [Left (Literal (IntLiteral (i'-1)))])
-                                        ,Left (valToTerm a)
-                                        ])
-                    _ -> Nothing
-                 _ -> Nothing
-
--- - specialized permutations
-  "Clash.Sized.Vector.reverse" -- :: Vec n a -> Vec n a
-    | isSubj
-    , nTy : aTy : _  <- tys
-    , [DC vecDc vArgs] <- args
-    -> case runExcept (tyNatSize tcm nTy) of
-         Right 0 -> reduce (mkVecNil vecDc aTy)
-         Right n
-           | (_,tyView -> TyConApp vecTcNm _) <- splitFunForallTy ty
-           , let (Just vecTc) = UniqMap.lookup vecTcNm tcm
-           , let [nilCon,consCon] = tyConDataCons vecTc
-           -> reduceWHNF $
-              mkApps (vecAppendPrim vecTcNm)
-                [Right (LitTy (NumTy (n-1)))
-                ,Right aTy
-                ,Right (LitTy (NumTy 1))
-                ,Left (mkApps (Prim pInfo)
-                              [Right (LitTy (NumTy (n-1)))
-                              ,Right aTy
-                              ,Left (Either.lefts vArgs !! 2)
-                              ])
-                ,Left (mkVec nilCon consCon aTy 1 [Either.lefts vArgs !! 1])
-                ]
-         _ -> Nothing
-  "Clash.Sized.Vector.transpose" -- :: KnownNat n => Vec m (Vec n a) -> Vec n (Vec m a)
-    | isSubj
-    , nTy : mTy : aTy : _ <- tys
-    , kn : xss : _ <- args
-    , (_,tyView -> TyConApp vecTcNm _) <- splitFunForallTy ty
-    , DC _ vArgs <- xss
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    , Right m <- runExcept (tyNatSize tcm mTy)
-    -> case m of
-      0 -> let (Just vecTc)     = UniqMap.lookup vecTcNm tcm
-               [nilCon,consCon] = tyConDataCons vecTc
-           in  reduce $
-               mkVec nilCon consCon (mkTyConApp vecTcNm [mTy,aTy]) n
-                (replicate (fromInteger n) (mkVec nilCon consCon aTy 0 []))
-      m' -> let (Just vecTc)     = UniqMap.lookup vecTcNm tcm
-                [_,consCon] = tyConDataCons vecTc
-                Just (consCoTy : _) = dataConInstArgTys consCon
-                                        [mTy,aTy,LitTy (NumTy (m'-1))]
-            in  reduceWHNF $
-                mkApps (vecZipWithPrim vecTcNm)
-                       [ Right aTy
-                       , Right (mkTyConApp vecTcNm [LitTy (NumTy (m'-1)),aTy])
-                       , Right (mkTyConApp vecTcNm [mTy,aTy])
-                       , Right nTy
-                       , Left  (mkApps (Data consCon)
-                                       [Right mTy
-                                       ,Right aTy
-                                       ,Right (LitTy (NumTy (m'-1)))
-                                       ,Left (primCo consCoTy)
-                                       ])
-                       , Left  (Either.lefts vArgs !! 1)
-                       , Left  (mkApps (Prim pInfo)
-                                       [ Right nTy
-                                       , Right (LitTy (NumTy (m'-1)))
-                                       , Right aTy
-                                       , Left  (valToTerm kn)
-                                       , Left  (Either.lefts vArgs !! 2)
-                                       ])
-                       ]
-
-  "Clash.Sized.Vector.rotateLeftS" -- :: KnownNat n => Vec n a -> SNat d -> Vec n a
-    | nTy : aTy : _ : _ <- tys
-    , kn : xs : d : _ <- args
-    , DC dc vArgs <- xs
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> case n of
-         0  -> reduce (mkVecNil dc aTy)
-         n' | DC snatDc [_,Left d'] <- d
-            , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
-            , mach2@Machine{mStack=[],mTerm=Literal (NaturalLiteral d2)} <- whnf eval tcm isSubj (setTerm d' $ stackClear mach)
-            -> case (d2 `mod` n) of
-                 0  -> reduce (valToTerm xs)
-                 d3 -> let (_,tyView -> TyConApp vecTcNm _) = splitFunForallTy ty
-                           (Just vecTc)     = UniqMap.lookup vecTcNm tcm
-                           [nilCon,consCon] = tyConDataCons vecTc
-                       in  reduceWHNF' mach2 $
-                           mkApps (Prim pInfo)
-                                  [Right nTy
-                                  ,Right aTy
-                                  ,Right (LitTy (NumTy (d3-1)))
-                                  ,Left (valToTerm kn)
-                                  ,Left (mkApps (vecAppendPrim vecTcNm)
-                                                [Right (LitTy (NumTy (n'-1)))
-                                                ,Right aTy
-                                                ,Right (LitTy (NumTy 1))
-                                                ,Left  (Either.lefts vArgs !! 2)
-                                                ,Left  (mkVec nilCon consCon aTy 1 [Either.lefts vArgs !! 1])])
-                                  ,Left (mkApps (Data snatDc)
-                                                [Right (LitTy (NumTy (d3-1)))
-                                                ,Left  (Literal (NaturalLiteral (d3-1)))])
-                                  ]
-         _  -> Nothing
-
-  "Clash.Sized.Vector.rotateRightS" -- :: KnownNat n => Vec n a -> SNat d -> Vec n a
-    | isSubj
-    , nTy : aTy : _ : _ <- tys
-    , kn : xs : d : _ <- args
-    , DC dc _ <- xs
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> case n of
-         0  -> reduce (mkVecNil dc aTy)
-         n' | DC snatDc [_,Left d'] <- d
-            , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
-            , mach2@Machine{mStack=[],mTerm=Literal (NaturalLiteral d2)} <- whnf eval tcm isSubj (setTerm d' $ stackClear mach)
-            -> case (d2 `mod` n) of
-                 0  -> reduce (valToTerm xs)
-                 d3 -> let (_,tyView -> TyConApp vecTcNm _) = splitFunForallTy ty
-                       in  reduceWHNF' mach2 $
-                           mkApps (Prim pInfo)
-                                  [Right nTy
-                                  ,Right aTy
-                                  ,Right (LitTy (NumTy (d3-1)))
-                                  ,Left (valToTerm kn)
-                                  ,Left (mkVecCons dc aTy n
-                                          (mkApps (vecLastPrim vecTcNm)
-                                                  [Right (LitTy (NumTy (n'-1)))
-                                                  ,Right aTy
-                                                  ,Left  (valToTerm xs)])
-                                          (mkApps (vecInitPrim vecTcNm)
-                                                  [Right (LitTy (NumTy (n'-1)))
-                                                  ,Right aTy
-                                                  ,Left (valToTerm xs)]))
-                                  ,Left (mkApps (Data snatDc)
-                                                [Right (LitTy (NumTy (d3-1)))
-                                                ,Left  (Literal (NaturalLiteral (d3-1)))])
-                                  ]
-         _  -> Nothing
--- Element-wise operations
--- - mapping
-  "Clash.Sized.Vector.map" -- :: (a -> b) -> Vec n a -> Vec n b
-    | isSubj
-    , DC dc vArgs <- args !! 1
-    , aTy : bTy : nTy : _ <- tys
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> case n of
-         0  -> reduce (mkVecNil dc bTy)
-         n' -> reduce $
-               mkVecCons dc bTy n'
-                 (mkApps (valToTerm (args !! 0)) [Left (Either.lefts vArgs !! 1)])
-                 (mkApps (Prim pInfo)
-                                      [Right aTy
-                                      ,Right bTy
-                                      ,Right (LitTy (NumTy (n' - 1)))
-                                      ,Left (valToTerm (args !! 0))
-                                      ,Left (Either.lefts vArgs !! 2)])
-  "Clash.Sized.Vector.imap" -- :: forall n a b . KnownNat n => (Index n -> a -> b) -> Vec n a -> Vec n b
-    | isSubj
-    , nTy : aTy : bTy : _ <- tys
-    , (tyArgs,tyView -> TyConApp vecTcNm _) <- splitFunForallTy ty
-    , let (tyArgs',_) = splitFunForallTy (Either.rights tyArgs !! 1)
-    , TyConApp indexTcNm _ <- tyView (Either.rights tyArgs' !! 0)
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    , let iLit = mkIndexLit (Either.rights tyArgs' !! 0) nTy n 0
-    -> reduceWHNF $
-       mkApps (Prim (PrimInfo "Clash.Sized.Vector.imap_go" (vecImapGoTy vecTcNm indexTcNm) WorkNever SingleResult NoUnfolding))
-              [Right nTy
-              ,Right nTy
-              ,Right aTy
-              ,Right bTy
-              ,Left (valToTerm (args !! 1))
-              ,Left (valToTerm (args !! 2))
-              ,Left iLit
-              ]
-
-  "Clash.Sized.Vector.imap_go"
-    | isSubj
-    , nTy : mTy : aTy : bTy : _ <- tys
-    , f : xs : (Suspend nArg) : _ <- args
-    , DC dc vArgs <- xs
-    , Right n' <- runExcept (tyNatSize tcm nTy)
-    , Right m <- runExcept (tyNatSize tcm mTy)
-    -> case m of
-         0  -> reduce (mkVecNil dc bTy)
-         m'
-          | eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
-          , mach1@Machine{mStack=[],mTerm=n} <-
-              whnf eval tcm True (setTerm nArg (stackClear mach))
-          ->  let (tyArgs,_) = splitFunForallTy ty
-                  TyConApp indexTcNm _ = tyView (Either.rights tyArgs !! 2)
-                  iLit = mkIndexLit (Either.rights tyArgs !! 2) nTy n' 1
-               in Just $ flip setTerm (mach1 {mStack = mStack mach}) $ mkVecCons dc bTy m'
-                 (mkApps (valToTerm f) [Left n,Left (Either.lefts vArgs !! 1)])
-                 (mkApps (Prim pInfo)
-                         [Right nTy
-                         ,Right (LitTy (NumTy (m'-1)))
-                         ,Right aTy
-                         ,Right bTy
-                         ,Left (valToTerm f)
-                         ,Left (Either.lefts vArgs !! 2)
-                         ,Left (mkApps (Prim (PrimInfo "Clash.Sized.Internal.Index.+#" (indexAddTy indexTcNm) WorkVariable SingleResult NoUnfolding))
-                                       [Right nTy
-                                       ,Left (Literal (NaturalLiteral n'))
-                                       ,Left n
-                                       ,Left iLit
-                                       ])
-                         ])
-          | otherwise
-          -> Nothing
-
-  -- :: forall n a. KnownNat n => (a -> a) -> a -> Vec n a
-  "Clash.Sized.Vector.iterateI"
-    | isSubj
-    , [nTy, aTy] <- tys
-    , [_n, f, a] <- args
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    ->
-      let
-        TyConApp vecTcNm _ = tyView (getResultTy tcm ty tys)
-        Just vecTc = UniqMap.lookup vecTcNm tcm
-        [nilCon, consCon] = tyConDataCons vecTc
-      in case n of
-         0 -> reduce (mkVecNil nilCon aTy)
-         _ -> reduce $
-          mkVecCons consCon aTy n
-            (valToTerm a)
-            (mkApps
-              (Prim pInfo)
-              [ Right (LitTy (NumTy (n - 1)))
-              , Right aTy
-              , Left (valToTerm (Lit (NaturalLiteral (n - 1))))
-              , Left (valToTerm f)
-              , Left (mkApps (valToTerm f) [Left (valToTerm a)])
-              ])
-
--- - Zipping
-  "Clash.Sized.Vector.zipWith" -- :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c
-    | isSubj
-    , aTy : bTy : cTy : nTy : _ <- tys
-    , f : xs : ys : _   <- args
-    , DC dc vArgs <- xs
-    , (_,tyView -> TyConApp vecTcNm _) <- splitFunForallTy ty
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> case n of
-         0  -> reduce (mkVecNil dc cTy)
-         n' -> reduce $ mkVecCons dc cTy n'
-                 (mkApps (valToTerm f)
-                            [Left (Either.lefts vArgs !! 1)
-                            ,Left (mkApps (vecHeadPrim vecTcNm)
-                                    [Right (LitTy (NumTy (n'-1)))
-                                    ,Right bTy
-                                    ,Left  (valToTerm ys)
-                                    ])
-                            ])
-                 (mkApps (Prim pInfo)
-                                      [Right aTy
-                                      ,Right bTy
-                                      ,Right cTy
-                                      ,Right (LitTy (NumTy (n' - 1)))
-                                      ,Left (valToTerm f)
-                                      ,Left (Either.lefts vArgs !! 2)
-                                      ,Left (mkApps (vecTailPrim vecTcNm)
-                                                    [Right (LitTy (NumTy (n'-1)))
-                                                    ,Right bTy
-                                                    ,Left (valToTerm ys)
-                                                    ])])
-
--- Folding
-  "Clash.Sized.Vector.foldr" -- :: (a -> b -> b) -> b -> Vec n a -> b
-    | isSubj
-    , aTy : bTy : nTy : _ <- tys
-    , f : z : xs : _ <- args
-    , DC _ vArgs <- xs
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> case n of
-         0 -> reduce (valToTerm z)
-         _ -> reduceWHNF $
-              mkApps (valToTerm f)
-                     [Left (Either.lefts vArgs !! 1)
-                     ,Left (mkApps (Prim pInfo)
-                                   [Right aTy
-                                   ,Right bTy
-                                   ,Right (LitTy (NumTy (n-1)))
-                                   ,Left  (valToTerm f)
-                                   ,Left  (valToTerm z)
-                                   ,Left  (Either.lefts vArgs !! 2)
-                                   ])
-                     ]
-  "Clash.Sized.Vector.fold" -- :: (a -> a -> a) -> Vec (n + 1) a -> a
-    | isSubj
-    , nTy : aTy :  _ <- tys
-    , f : vs : _ <- args
-    , DC _ vArgs <- vs
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> case n of
-         0 -> reduceWHNF (Either.lefts vArgs !! 1)
-         _ -> let (tyArgs,_)         = splitFunForallTy ty
-                  TyConApp vecTcNm _ = tyView (Either.rights tyArgs !! 1)
-                  tupTcNm      = ghcTyconToTyConName (tupleTyCon Boxed 2)
-                  (Just tupTc) = UniqMap.lookup tupTcNm tcm
-                  [tupDc]      = tyConDataCons tupTc
-                  n'     = n+1
-                  m      = n' `div` 2
-                  n1     = n' - m
-                  mTy    = LitTy (NumTy m)
-                  m'ty   = LitTy (NumTy (m-1))
-                  n1mTy  = LitTy (NumTy n1)
-                  n1m'ty = LitTy (NumTy (n1-1))
-                  splitAtCall =
-                   mkApps (Prim (PrimInfo "Clash.Sized.Vector.fold_split" (foldSplitAtTy vecTcNm) WorkNever SingleResult NoUnfolding))
-                          [Right mTy
-                          ,Right n1mTy
-                          ,Right aTy
-                          ,Left (Literal (NaturalLiteral m))
-                          ,Left (valToTerm vs)
-                          ]
-                  mVecTy   = mkTyConApp vecTcNm [mTy,aTy]
-                  n1mVecTy = mkTyConApp vecTcNm [n1mTy,aTy]
-                  -- Guaranteed no capture, so okay to use unsafe name generation
-                  asNm     = mkUnsafeSystemName "as" 0
-                  bsNm     = mkUnsafeSystemName "bs" 1
-                  asId     = mkLocalId mVecTy asNm
-                  bsId     = mkLocalId n1mVecTy bsNm
-                  tupPat   = DataPat tupDc [] [asId,bsId]
-                  asAlt    = (tupPat, (Var asId))
-                  bsAlt    = (tupPat, (Var bsId))
-              in  reduceWHNF $
-                  mkApps (valToTerm f)
-                         [Left (mkApps (Prim pInfo)
-                                       [Right m'ty
-                                       ,Right aTy
-                                       ,Left (valToTerm f)
-                                       ,Left (Case splitAtCall mVecTy [asAlt])
-                                       ])
-                         ,Left (mkApps (Prim pInfo)
-                                       [Right n1m'ty
-                                       ,Right aTy
-                                       ,Left  (valToTerm f)
-                                       ,Left  (Case splitAtCall n1mVecTy [bsAlt])
-                                       ])
-                         ]
-
-
-  "Clash.Sized.Vector.fold_split" -- :: Natural -> Vec (m + n) a -> (Vec m a, Vec n a)
-    | isSubj
-    , mTy : nTy : aTy : _ <- tys
-    , Right m <- runExcept (tyNatSize tcm mTy)
-    -> let -- Get the tuple data-constructor
-           ty1 = piResultTys tcm ty tys
-           (_,tyView -> TyConApp tupTcNm tyArgs@(tyArg:_)) = splitFunForallTy ty1
-           (Just tupTc)       = UniqMap.lookup tupTcNm tcm
-           [tupDc]            = tyConDataCons tupTc
-           -- Get the vector data-constructors
-           TyConApp vecTcNm _ = tyView tyArg
-           Just vecTc         = UniqMap.lookup vecTcNm tcm
-           [nilCon,consCon]   = tyConDataCons vecTc
-           -- Recursive call to @splitAt@
-           splitAtRec v =
-            mkApps (Prim pInfo)
-                   [Right (LitTy (NumTy (m-1)))
-                   ,Right nTy
-                   ,Right aTy
-                   ,Left (Literal (NaturalLiteral (m-1)))
-                   ,Left v
-                   ]
-           -- Projection either the first or second field of the recursive
-           -- call to @splitAt@
-           splitAtSelR v = Case (splitAtRec v)
-           m1VecTy = mkTyConApp vecTcNm [LitTy (NumTy (m-1)),aTy]
-           nVecTy  = mkTyConApp vecTcNm [nTy,aTy]
-           -- Guaranteed no capture, so okay to use unsafe name generation
-           lNm     = mkUnsafeSystemName "l" 0
-           rNm     = mkUnsafeSystemName "r" 1
-           lId     = mkLocalId m1VecTy lNm
-           rId     = mkLocalId nVecTy rNm
-           tupPat  = DataPat tupDc [] [lId,rId]
-           lAlt    = (tupPat, (Var lId))
-           rAlt    = (tupPat, (Var rId))
-       in case m of
-         -- (Nil,v)
-         0 -> reduce $
-              mkApps (Data tupDc) $ (map Right tyArgs) ++
-                [ Left (mkVecNil nilCon aTy)
-                , Left (valToTerm (last args))
-                ]
-         -- (x:xs) <- v
-         m' | DC _ vArgs <- last args
-            -- (x:fst (splitAt (m-1) xs),snd (splitAt (m-1) xs))
-            -> reduce $
-               mkApps (Data tupDc) $ (map Right tyArgs) ++
-                 [ Left (mkVecCons consCon aTy m' (Either.lefts vArgs !! 1)
-                           (splitAtSelR (Either.lefts vArgs !! 2) m1VecTy [lAlt]))
-                 , Left (splitAtSelR (Either.lefts vArgs !! 2) nVecTy [rAlt])
-                 ]
-         -- v doesn't reduce to a data-constructor
-         _  -> Nothing
--- - Specialised folds
-  "Clash.Sized.Vector.dfold"
-    | isSubj
-    , pTy : kTy : aTy : _ <- tys
-    , _ : p : f : z : xs : _ <- args
-    , DC _ vArgs <- xs
-    , Right k' <- runExcept (tyNatSize tcm kTy)
-    -> case k'  of
-         0 -> reduce (valToTerm z)
-         _ -> let (tyArgs,_)  = splitFunForallTy ty
-                  (tyArgs',_) = splitFunForallTy (Either.rights tyArgs !! 2)
-                  TyConApp snatTcNm _ = tyView (Either.rights tyArgs' !! 0)
-                  Just snatTc = UniqMap.lookup snatTcNm tcm
-                  [snatDc]    = tyConDataCons snatTc
-                  k'ty        = LitTy (NumTy (k'-1))
-              in  reduceWHNF $
-                  mkApps (valToTerm f)
-                         [Right k'ty
-                         ,Left (mkApps (Data snatDc)
-                                       [Right k'ty
-                                       ,Left (Literal (NaturalLiteral (k'-1)))])
-                         ,Left (Either.lefts vArgs !! 1)
-                         ,Left (mkApps (Prim pInfo)
-                                       [Right pTy
-                                       ,Right k'ty
-                                       ,Right aTy
-                                       ,Left (Literal (NaturalLiteral (k'-1)))
-                                       ,Left (valToTerm p)
-                                       ,Left (valToTerm f)
-                                       ,Left (valToTerm z)
-                                       ,Left (Either.lefts vArgs !! 2)
-                                       ])
-                         ]
-  "Clash.Sized.Vector.dtfold"
-    | isSubj
-    , pTy : kTy : aTy : _ <- tys
-    , _ : p : f : g : xs : _ <- args
-    , DC _ vArgs <- xs
-    , Right k' <- runExcept (tyNatSize tcm kTy)
-    -> case k' of
-         0 -> reduceWHNF (mkApps (valToTerm f) [Left (Either.lefts vArgs !! 1)])
-         _ -> let (tyArgs,_)  = splitFunForallTy ty
-                  TyConApp vecTcNm _ = tyView (Either.rights tyArgs !! 4)
-                  (tyArgs',_) = splitFunForallTy (Either.rights tyArgs !! 3)
-                  TyConApp snatTcNm _ = tyView (Either.rights tyArgs' !! 0)
-                  Just snatTc = UniqMap.lookup snatTcNm tcm
-                  [snatDc]    = tyConDataCons snatTc
-                  tupTcNm     = ghcTyconToTyConName (tupleTyCon Boxed 2)
-                  (Just tupTc) = UniqMap.lookup tupTcNm tcm
-                  [tupDc]     = tyConDataCons tupTc
-                  k'ty        = LitTy (NumTy (k'-1))
-                  k2ty        = LitTy (NumTy (2^(k'-1)))
-                  splitAtCall =
-                   mkApps (splitAtPrim snatTcNm vecTcNm)
-                          [Right k2ty
-                          ,Right k2ty
-                          ,Right aTy
-                          ,Left (mkApps (Data snatDc)
-                                        [Right k2ty
-                                        ,Left (Literal (NaturalLiteral (2^(k'-1))))])
-                          ,Left (valToTerm xs)
-                          ]
-                  xsSVecTy = mkTyConApp vecTcNm [k2ty,aTy]
-                  -- Guaranteed no capture, so okay to use unsafe name generation
-                  xsLNm    = mkUnsafeSystemName "xsL" 0
-                  xsRNm    = mkUnsafeSystemName "xsR" 1
-                  xsLId    = mkLocalId k2ty xsLNm
-                  xsRId    = mkLocalId k2ty xsRNm
-                  tupPat   = DataPat tupDc [] [xsLId,xsRId]
-                  asAlt    = (tupPat, (Var xsLId))
-                  bsAlt    = (tupPat, (Var xsRId))
-              in  reduceWHNF $
-                  mkApps (valToTerm g)
-                         [Right k'ty
-                         ,Left (mkApps (Data snatDc)
-                                       [Right k'ty
-                                       ,Left (Literal (NaturalLiteral (k'-1)))])
-                         ,Left (mkApps (Prim pInfo)
-                                       [Right pTy
-                                       ,Right k'ty
-                                       ,Right aTy
-                                       ,Left (Literal (NaturalLiteral (k'-1)))
-                                       ,Left (valToTerm p)
-                                       ,Left (valToTerm f)
-                                       ,Left (valToTerm g)
-                                       ,Left (Case splitAtCall xsSVecTy [asAlt])])
-                         ,Left (mkApps (Prim pInfo)
-                                       [Right pTy
-                                       ,Right k'ty
-                                       ,Right aTy
-                                       ,Left (Literal (NaturalLiteral (k'-1)))
-                                       ,Left (valToTerm p)
-                                       ,Left (valToTerm f)
-                                       ,Left (valToTerm g)
-                                       ,Left (Case splitAtCall xsSVecTy [bsAlt])])
-                         ]
--- Misc
-  "Clash.Sized.Vector.lazyV"
-    | isSubj
-    , nTy : aTy : _ <- tys
-    , _ : xs : _ <- args
-    , (_,tyView -> TyConApp vecTcNm _) <- splitFunForallTy ty
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> case n of
-         0  -> let (Just vecTc) = UniqMap.lookup vecTcNm tcm
-                   [nilCon,_]   = tyConDataCons vecTc
-               in  reduce (mkVecNil nilCon aTy)
-         n' -> let (Just vecTc) = UniqMap.lookup vecTcNm tcm
-                   [_,consCon]  = tyConDataCons vecTc
-               in  reduce $ mkVecCons consCon aTy n'
-                     (mkApps (vecHeadPrim vecTcNm)
-                             [ Right (LitTy (NumTy (n' - 1)))
-                             , Right aTy
-                             , Left  (valToTerm xs)
-                             ])
-                     (mkApps (Prim pInfo)
-                             [ Right (LitTy (NumTy (n' - 1)))
-                             , Right aTy
-                             , Left  (Literal (NaturalLiteral (n'-1)))
-                             , Left  (mkApps (vecTailPrim vecTcNm)
-                                             [ Right (LitTy (NumTy (n'-1)))
-                                             , Right aTy
-                                             , Left  (valToTerm xs)
-                                             ])
-                             ])
--- Traversable
-  "Clash.Sized.Vector.traverse#"
-    | isSubj
-    , aTy : fTy : bTy : nTy : _ <- tys
-    , apDict : f : xs : _ <- args
-    , DC dc vArgs <- xs
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> case n of
-         0 -> let (pureF,ids') = runPEM (mkSelectorCase $(curLoc) is0 tcm (valToTerm apDict) 1 1) ids
-              in  reduceWHNF' (mach { mSupply = ids' }) $
-                  mkApps pureF
-                         [Right (mkTyConApp (vecTcNm) [nTy,bTy])
-                         ,Left  (mkVecNil dc bTy)]
-         _ -> let ((fmapF,apF),ids') = flip runPEM ids $ do
-                    fDict  <- mkSelectorCase $(curLoc) is0 tcm (valToTerm apDict) 1 0
-                    fmapF' <- mkSelectorCase $(curLoc) is0 tcm fDict 1 0
-                    apF'   <- mkSelectorCase $(curLoc) is0 tcm (valToTerm apDict) 1 2
-                    return (fmapF',apF')
-                  n'ty = LitTy (NumTy (n-1))
-                  Just (consCoTy : _) = dataConInstArgTys dc [nTy,bTy,n'ty]
-              in  reduceWHNF' (mach { mSupply = ids' }) $
-                  mkApps apF
-                         [Right (mkTyConApp vecTcNm [n'ty,bTy])
-                         ,Right (mkTyConApp vecTcNm [nTy,bTy])
-                         ,Left (mkApps fmapF
-                                       [Right bTy
-                                       ,Right (mkFunTy (mkTyConApp vecTcNm [n'ty,bTy])
-                                                       (mkTyConApp vecTcNm [nTy,bTy]))
-                                       ,Left (mkApps (Data dc)
-                                                     [Right nTy
-                                                     ,Right bTy
-                                                     ,Right n'ty
-                                                     ,Left (primCo consCoTy)])
-                                       ,Left (mkApps (valToTerm f)
-                                                     [Left (Either.lefts vArgs !! 1)])
-                                       ])
-                         ,Left (mkApps (Prim pInfo)
-                                       [Right aTy
-                                       ,Right fTy
-                                       ,Right bTy
-                                       ,Right n'ty
-                                       ,Left (valToTerm apDict)
-                                       ,Left (valToTerm f)
-                                       ,Left (Either.lefts vArgs !! 2)
-                                       ])
-                         ]
-    where
-      (tyArgs,_)         = splitFunForallTy ty
-      TyConApp vecTcNm _ = tyView (Either.rights tyArgs !! 2)
-      (ids, is0) = (mSupply mach, mScopeNames mach)
-
--- BitPack
-  "Clash.Sized.Vector.concatBitVector#"
-    | isSubj
-    , nTy : mTy : _ <- tys
-    , _  : km  : v : _ <- args
-    , DC _ vArgs <- v
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> case n of
-         0  -> let resTyInfo = extractTySizeInfo tcm ty tys
-               in  reduce (mkBitVectorLit' resTyInfo 0 0)
-         n' | Right m <- runExcept (tyNatSize tcm mTy)
-            , (_,tyView -> TyConApp bvTcNm _) <- splitFunForallTy ty
-            -> reduceWHNF $
-               mkApps (bvAppendPrim bvTcNm)
-                 [ Right (mkTyConApp typeNatMul [LitTy (NumTy (n'-1)),mTy])
-                 , Right mTy
-                 , Left (Literal (NaturalLiteral ((n'-1)*m)))
-                 , Left (Either.lefts vArgs !! 1)
-                 , Left (mkApps (Prim pInfo)
-                                [ Right (LitTy (NumTy (n'-1)))
-                                , Right mTy
-                                , Left (Literal (NaturalLiteral (n'-1)))
-                                , Left (valToTerm km)
-                                , Left (Either.lefts vArgs !! 2)
-                                ])
-                 ]
-         _ -> Nothing
-  "Clash.Sized.Vector.unconcatBitVector#"
-    | isSubj
-    , nTy : mTy : _  <- tys
-    , _  : km  : bv : _ <- args
-    , (_,tyView -> TyConApp vecTcNm [_,bvMTy]) <- splitFunForallTy ty
-    , TyConApp bvTcNm _ <- tyView bvMTy
-    , Right n <- runExcept (tyNatSize tcm nTy)
-    -> case n of
-         0 ->
-          let (Just vecTc) = UniqMap.lookup vecTcNm tcm
-              [nilCon,_] = tyConDataCons vecTc
-          in  reduce (mkVecNil nilCon (mkTyConApp bvTcNm [mTy]))
-         n' | Right m <- runExcept (tyNatSize tcm mTy) ->
-          let Just vecTc  = UniqMap.lookup vecTcNm tcm
-              [_,consCon] = tyConDataCons vecTc
-              tupTcNm     = ghcTyconToTyConName (tupleTyCon Boxed 2)
-              Just tupTc  = UniqMap.lookup tupTcNm tcm
-              [tupDc]     = tyConDataCons tupTc
-              splitCall   =
-                mkApps (bvSplitPrim bvTcNm)
-                       [ Right (mkTyConApp typeNatMul [LitTy (NumTy (n'-1)),mTy])
-                       , Right mTy
-                       , Left (Literal (NaturalLiteral ((n'-1)*m)))
-                       , Left (valToTerm bv)
-                       ]
-              mBVTy       = mkTyConApp bvTcNm [mTy]
-              n1BVTy      = mkTyConApp bvTcNm
-                              [mkTyConApp typeNatMul
-                                [LitTy (NumTy (n'-1))
-                                ,mTy]]
-              -- Guaranteed no capture, so okay to use unsafe name generation
-              xNm         = mkUnsafeSystemName "x" 0
-              bvNm        = mkUnsafeSystemName "bv'" 1
-              xId         = mkLocalId mBVTy xNm
-              bvId        = mkLocalId n1BVTy bvNm
-              tupPat      = DataPat tupDc [] [xId,bvId]
-              xAlt        = (tupPat, (Var xId))
-              bvAlt       = (tupPat, (Var bvId))
-
-          in  reduce $ mkVecCons consCon (mkTyConApp bvTcNm [mTy]) n'
-                (Case splitCall mBVTy [xAlt])
-                (mkApps (Prim pInfo)
-                        [ Right (LitTy (NumTy (n'-1)))
-                        , Right mTy
-                        , Left (Literal (NaturalLiteral (n'-1)))
-                        , Left (valToTerm km)
-                        , Left (Case splitCall n1BVTy [bvAlt])
-                        ])
-         _ -> Nothing
-#if MIN_VERSION_ghc(9,4,0)
-  "Data.Text.Show.$wunpackCStringAscii#"
-    | [Lit (StringLiteral addr)] <- args
-    , Text.Text (Text.ByteArray ba) _off len <- Text.pack addr
-    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
-           (Just tupTc) = UniqMap.lookup tupTcNm tcm
-           [tupDc] = tyConDataCons tupTc
-           ret     = mkApps (Data tupDc) (map Right tyArgs ++
-                    [ Left (Literal (ByteArrayLiteral (BA.ByteArray ba)))
-                    , Left (Literal (IntLiteral 0))
-                    , Left (Literal (IntLiteral (toInteger len)))])
-        in reduce ret
-  "GHC.Magic.noinlineConstraint"
-    | [arg] <- args
-    -> reduce (valToTerm arg)
-  "GHC.TypeNats.withSomeSNat"
-    | Lit (NaturalLiteral n) : fun : _ <- args
-    , _ : funTy : _ <- Either.rights (fst (splitFunForallTy ty))
-    , (tyView -> TyConApp snatTcNm _) : _ <- Either.rights (fst (splitFunForallTy funTy))
-    , Just snatTc <- UniqMap.lookup snatTcNm tcm
-    , [snatDc] <- tyConDataCons snatTc
-    -> let nTy = LitTy (NumTy n)
-           snat = mkApps (Data snatDc) [Right nTy, Left (Literal (NaturalLiteral n))]
-           ret = mkApps (valToTerm fun) [Right nTy, Left snat]
-        in reduce ret
-  "GHC.Internal.TypeNats.withSomeSNat"
-    | Lit (NaturalLiteral n) : fun : _ <- args
-    , _ : funTy : _ <- Either.rights (fst (splitFunForallTy ty))
-    , (tyView -> TyConApp snatTcNm _) : _ <- Either.rights (fst (splitFunForallTy funTy))
-    , Just snatTc <- UniqMap.lookup snatTcNm tcm
-    , [snatDc] <- tyConDataCons snatTc
-    -> let nTy = LitTy (NumTy n)
-           snat = mkApps (Data snatDc) [Right nTy, Left (Literal (NaturalLiteral n))]
-           ret = mkApps (valToTerm fun) [Right nTy, Left snat]
-        in reduce ret
-  "GHC.Magic.nospec"
-    | [arg] <- args
-    -> reduce (valToTerm arg)
-  "GHC.Float.$wproperFractionDouble"
-    | _ : Lit (DoubleLiteral d) : _ <- args
-    , [sty@(tyView -> TyConApp signedTcNm [nTy@(LitTy (NumTy kn))])] <- tys
-    , nameOcc signedTcNm == showt ''Signed
-    , (_, tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
-    , Just tupTc <- UniqMap.lookup tupTcNm tcm
-    , [tupDc] <- tyConDataCons tupTc
-    -> let (sn, d1) = reifyNat kn (\p -> first toInteger (op p (wordToDouble d)))
-           ret = mkApps (Data tupDc) (map Right tyArgs ++
-                  [ Left (mkSignedLit sty nTy kn sn)
-                  , Left (mkDoubleCLit tcm (doubleToWord d1) (last tyArgs))
-                  ])
-        in reduce ret
-    where
-      op :: KnownNat n => Proxy n -> Double -> (Signed n, Double)
-      op _ = properFraction
-  "GHC.Internal.Float.$wproperFractionDouble"
-    | _ : Lit (DoubleLiteral d) : _ <- args
-    , [sty@(tyView -> TyConApp signedTcNm [nTy@(LitTy (NumTy kn))])] <- tys
-    , nameOcc signedTcNm == "Clash.Sized.Internal.Signed.Signed"
-    , (_, tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
-    , Just tupTc <- UniqMap.lookup tupTcNm tcm
-    , [tupDc] <- tyConDataCons tupTc
-    -> let (sn, d1) = reifyNat kn (\p -> first toInteger (op p (wordToDouble d)))
-           ret = mkApps (Data tupDc) (map Right tyArgs ++
-                  [ Left (mkSignedLit sty nTy kn sn)
-                  , Left (mkDoubleCLit tcm (doubleToWord d1) (last tyArgs))
-                  ])
-        in reduce ret
-    where
-      op :: KnownNat n => Proxy n -> Double -> (Signed n, Double)
-      op _ = properFraction
-#endif
-  _ -> Nothing
-  where
-    ty = primType pInfo
-
-    checkNaturalRange1 nTy i f =
-      checkNaturalRange nTy [i]
-        (\[i'] -> naturalToNaturalLiteral (f i'))
-
-    checkNaturalRange2 nTy i j f =
-      checkNaturalRange nTy [i, j]
-        (\[i', j'] -> naturalToNaturalLiteral (f i' j'))
-
-    -- Check given integer's range. If any of them are less than zero, give up
-    -- and return an undefined type.
-    checkNaturalRange
-      :: Type
-      -- Type of GHC.Natural.Natural ^
-      -> [Integer]
-      -> ([Natural] -> Term)
-      -> Term
-    checkNaturalRange nTy natsAsInts f =
-      if any (<0) natsAsInts then
-        TyApp (Prim NP.undefined) nTy
-      else
-        f (map fromInteger natsAsInts)
-
-    reduce :: Term -> Maybe Machine
-    reduce e = case isX e of
-      Left msg -> trace (unlines ["Warning: Not evaluating constant expression:", show (primName pInfo), "Because doing so generates an XException:", msg]) Nothing
-      Right e' -> Just (setTerm e' mach)
-
-    reduceWHNF e =
-      let eval = Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
-          mach1@Machine{mStack=[]} = whnf eval tcm isSubj (setTerm e $ stackClear mach)
-      in Just $ mach1 { mStack = mStack mach }
-
-    reduceWHNF' mach1 e =
-      let eval = Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
-          mach2@Machine{mStack=[]} = whnf eval tcm isSubj (setTerm e mach1)
-       in Just $ mach2 { mStack = mStack mach }
-
-    makeUndefinedIf :: Exception e => (e -> Bool) -> Term -> Term
-    makeUndefinedIf wantToHandle tm =
-      case unsafeDupablePerformIO $ tryJust selectException (evaluate $ force tm) of
-        Right b -> b
-        Left e -> trace (msg e) (TyApp (Prim NP.undefined) resTy)
-      where
-        resTy = getResultTy tcm ty tys
-        selectException e | wantToHandle e = Just e
-                          | otherwise = Nothing
-        msg e = unlines ["Warning: caught exception: \"" ++ show e ++ "\" while trying to evaluate: "
-                        , showPpr (mkApps (Prim pInfo) (map (Left . valToTerm) args))
-                        ]
-
-    catchDivByZero = makeUndefinedIf (==DivideByZero)
-
--- Helper functions for literals
-
-pairOf :: (Value -> Maybe a) -> [Value] -> Maybe (a, a)
-pairOf f [x, y] = (,) <$> f x <*> f y
-pairOf _ _ = Nothing
-
-listOf :: (Value -> Maybe a) -> [Value] -> [a]
-listOf = mapMaybe
-
-wrapUnsigned :: Integer -> Integer -> Integer
-wrapUnsigned n i = i `mod` sz
- where
-  sz = 1 `shiftL` fromInteger n
-
-wrapSigned :: Integer -> Integer -> Integer
-wrapSigned n i = if n == 0 then 0 else res
- where
-  mask = 1 `shiftL` fromInteger (n - 1)
-  res  = case divMod i mask of
-           (s,i1) | even s    -> i1
-                  | otherwise -> i1 - mask
-
-doubleLiterals' :: [Value] -> [Word64]
-doubleLiterals' = listOf doubleLiteral
-
-doubleLiteral :: Value -> Maybe Word64
-doubleLiteral v = case v of
-  Lit (DoubleLiteral i) -> Just i
-  _ -> Nothing
-
-floatLiterals' :: [Value] -> [Word32]
-floatLiterals' = listOf floatLiteral
-
-floatLiteral :: Value -> Maybe Word32
-floatLiteral v = case v of
-  Lit (FloatLiteral i) -> Just i
-  _ -> Nothing
-
-integerLiterals :: [Value] -> Maybe (Integer, Integer)
-integerLiterals = pairOf integerLiteral
-
-integerLiteral :: Value -> Maybe Integer
-integerLiteral v =
-  case v of
-    Lit (IntegerLiteral i) -> Just i
-    DC dc [Left (Literal (IntLiteral i))]
-      | dcTag dc == 1
-      -> Just i
-    DC dc [Left (Literal (ByteArrayLiteral (BA.ByteArray ba)))]
-      | dcTag dc == 2
-#if MIN_VERSION_base(4,15,0)
-      -> Just (IP ba)
-#else
-      -> Just (Jp# (BN# ba))
-#endif
-      | dcTag dc == 3
-#if MIN_VERSION_base(4,15,0)
-      -> Just (IN ba)
-#else
-      -> Just (Jn# (BN# ba))
-#endif
-    _ -> Nothing
-
-naturalLiterals :: [Value] -> Maybe (Integer, Integer)
-naturalLiterals = pairOf naturalLiteral
-
-naturalLiteral :: Value -> Maybe Integer
-naturalLiteral v =
-  case v of
-    Lit (NaturalLiteral i) -> Just i
-    DC dc [Left (Literal (WordLiteral i))]
-      | dcTag dc == 1
-      -> Just i
-    DC dc [Left (Literal (ByteArrayLiteral (BA.ByteArray ba)))]
-      | dcTag dc == 2
-#if MIN_VERSION_base(4,15,0)
-      -> Just (IP ba)
-#else
-      -> Just (Jp# (BN# ba))
-#endif
-    _ -> Nothing
-
-integerLiterals' :: [Value] -> [Integer]
-integerLiterals' = listOf integerLiteral
-
-naturalLiterals' :: [Value] -> [Integer]
-naturalLiterals' = listOf naturalLiteral
-
-intLiterals :: [Value] -> Maybe (Integer,Integer)
-intLiterals = pairOf intLiteral
-
-intLiterals' :: [Value] -> [Integer]
-intLiterals' = listOf intLiteral
-
-intCLiterals' :: [Value] -> [Integer]
-intCLiterals' = listOf intCLiteral
-
-intLiteral :: Value -> Maybe Integer
-intLiteral x = case x of
-  Lit (IntLiteral i) -> Just i
-  _ -> Nothing
-
-#if MIN_VERSION_base(4,16,0)
-int8Literals' :: [Value] -> [Integer]
-int8Literals' = listOf int8Literal
-
-int8Literal :: Value -> Maybe Integer
-int8Literal x = case x of
-  Lit (Int8Literal i) -> Just i
-  _ -> Nothing
-
-int16Literals' :: [Value] -> [Integer]
-int16Literals' = listOf int16Literal
-
-int16Literal :: Value -> Maybe Integer
-int16Literal x = case x of
-  Lit (Int16Literal i) -> Just i
-  _ -> Nothing
-
-int32Literals' :: [Value] -> [Integer]
-int32Literals' = listOf int32Literal
-
-int32Literal :: Value -> Maybe Integer
-int32Literal x = case x of
-  Lit (Int32Literal i) -> Just i
-  _ -> Nothing
-
-#if MIN_VERSION_base(4,17,0)
-int64Literals' :: [Value] -> [Integer]
-int64Literals' = listOf int64Literal
-
-int64Literal :: Value -> Maybe Integer
-int64Literal x = case x of
-  Lit (Int64Literal i) -> Just i
-  _ -> Nothing
-#endif
-#endif
-
-intCLiteral :: Value -> Maybe Integer
-intCLiteral v = case v of
-  (DC _ [Left (Literal (IntLiteral i))]) -> Just i
-  _ -> Nothing
-
-intCLiterals :: [Value] -> Maybe (Integer, Integer)
-intCLiterals = pairOf intCLiteral
-
-wordLiterals :: [Value] -> Maybe (Integer,Integer)
-wordLiterals = pairOf wordLiteral
-
-wordLiterals' :: [Value] -> [Integer]
-wordLiterals' = listOf wordLiteral
-
-wordLiteral :: Value -> Maybe Integer
-wordLiteral x = case x of
-  Lit (WordLiteral i) -> Just i
-  _ -> Nothing
-
-#if MIN_VERSION_base(4,16,0)
-word8Literals' :: [Value] -> [Integer]
-word8Literals' = listOf word8Literal
-
-word8Literal :: Value -> Maybe Integer
-word8Literal x = case x of
-  Lit (Word8Literal i) -> Just i
-  _ -> Nothing
-
-word16Literals' :: [Value] -> [Integer]
-word16Literals' = listOf word16Literal
-
-word16Literal :: Value -> Maybe Integer
-word16Literal x = case x of
-  Lit (Word16Literal i) -> Just i
-  _ -> Nothing
-
-word32Literals' :: [Value] -> [Integer]
-word32Literals' = listOf word32Literal
-
-word32Literal :: Value -> Maybe Integer
-word32Literal x = case x of
-  Lit (Word32Literal i) -> Just i
-  _ -> Nothing
-#endif
-
-word64Literals' :: [Value] -> [Integer]
-word64Literals' = listOf word64Literal
-
-#if MIN_VERSION_base(4,17,0)
-word64Literal :: Value -> Maybe Integer
-word64Literal x = case x of
-  Lit (Word64Literal i) -> Just i
-  _ -> Nothing
-#else
--- Prior to GHC 9.4 Word64# didn't exist, 64 bit primitives took Word# instead
-word64Literal :: Value -> Maybe Integer
-word64Literal= wordLiteral
-#endif
-
-charLiterals :: [Value] -> Maybe (Char,Char)
-charLiterals = pairOf charLiteral
-
-charLiterals' :: [Value] -> [Char]
-charLiterals' = listOf charLiteral
-
-charLiteral :: Value -> Maybe Char
-charLiteral x = case x of
-  Lit (CharLiteral c) -> Just c
-  _ -> Nothing
-
-sizedLiterals :: Text -> [Value] -> Maybe (Integer,Integer)
-sizedLiterals szCon = pairOf (sizedLiteral szCon)
-
-sizedLiterals' :: Text -> [Value] -> [Integer]
-sizedLiterals' szCon = listOf (sizedLiteral szCon)
-
-sizedLiteral :: Text -> Value -> Maybe Integer
-sizedLiteral szCon val = case val of
-  PrimVal p _ [_, Lit (IntegerLiteral i)]
-    | primName p == szCon -> Just i
-  _ -> Nothing
-
-bitLiterals
-  :: [Value]
-  -> [(Integer,Integer)]
-bitLiterals = map normalizeBit . mapMaybe go
- where
-  normalizeBit (msk,v) = (msk .&. 1, v .&. 1)
-  go val = case val of
-    PrimVal p _ [Lit (WordLiteral m), Lit (IntegerLiteral i)]
-      | primName p == "Clash.Sized.Internal.BitVector.fromInteger##"
-      -> Just (m,i)
-    _ -> Nothing
-
-indexLiterals, signedLiterals, unsignedLiterals
-  :: [Value] -> Maybe (Integer,Integer)
-indexLiterals     = sizedLiterals "Clash.Sized.Internal.Index.fromInteger#"
-signedLiterals    = sizedLiterals "Clash.Sized.Internal.Signed.fromInteger#"
-unsignedLiterals  = sizedLiterals "Clash.Sized.Internal.Unsigned.fromInteger#"
-
-indexLiterals', signedLiterals', unsignedLiterals'
-  :: [Value] -> [Integer]
-indexLiterals'     = sizedLiterals' "Clash.Sized.Internal.Index.fromInteger#"
-signedLiterals'    = sizedLiterals' "Clash.Sized.Internal.Signed.fromInteger#"
-unsignedLiterals'  = sizedLiterals' "Clash.Sized.Internal.Unsigned.fromInteger#"
-
-bitVectorLiterals'
-  :: [Value] -> [(Integer,Integer)]
-bitVectorLiterals' = listOf bitVectorLiteral
-
-bitVectorLiteral :: Value -> Maybe (Integer, Integer)
-bitVectorLiteral val = case val of
-  (PrimVal p _ [_, Lit (NaturalLiteral m), Lit (IntegerLiteral i)])
-    | primName p == "Clash.Sized.Internal.BitVector.fromInteger#" -> Just (m, i)
-  _ -> Nothing
-
-toBV :: (Integer,Integer) -> BitVector n
-toBV (mask,val) = BV (fromInteger mask) (fromInteger val)
-
-splitBV :: BitVector n -> (Integer,Integer)
-splitBV (BV msk val) = (toInteger msk, toInteger val)
-
-toBit :: (Integer,Integer) -> Bit
-toBit (mask,val) = Bit (fromInteger mask) (fromInteger val)
-
-valArgs
-  :: Value
-  -> Maybe [Term]
-valArgs v =
-  case v of
-    PrimVal _ _ vs -> Just (fmap valToTerm vs)
-    DC _ args -> Just (Either.lefts args)
-    _ -> Nothing
-
--- Tries to match literal arguments to a function like
---   (Unsigned.shiftL#  :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n)
-sizedLitIntLit
-  :: Text -> TyConMap -> [Type] -> [Value]
-  -> Maybe (Type,Integer,Integer,Integer)
-sizedLitIntLit szCon tcm tys args
-  | Just (nTy,kn) <- extractKnownNat tcm tys
-  , [_
-    ,PrimVal p _ [_,Lit (IntegerLiteral i)]
-    ,valArgs -> Just [Literal (IntLiteral j)]
-    ] <- args
-  , primName p == szCon
-  = Just (nTy,kn,i,j)
-  | otherwise
-  = Nothing
-
-signedLitIntLit, unsignedLitIntLit
-  :: TyConMap -> [Type] -> [Value]
-  -> Maybe (Type,Integer,Integer,Integer)
-signedLitIntLit    = sizedLitIntLit "Clash.Sized.Internal.Signed.fromInteger#"
-unsignedLitIntLit  = sizedLitIntLit "Clash.Sized.Internal.Unsigned.fromInteger#"
-
-bitVectorLitIntLit
-  :: TyConMap -> [Type] -> [Value]
-  -> Maybe (Type,Integer,(Integer,Integer),Integer)
-bitVectorLitIntLit tcm tys args
-  | Just (nTy,kn) <- extractKnownNat tcm tys
-  , [_
-    ,PrimVal p _ [_,Lit (NaturalLiteral m),Lit (IntegerLiteral i)]
-    ,valArgs -> Just [Literal (IntLiteral j)]
-    ] <- args
-  , primName p == "Clash.Sized.Internal.BitVector.fromInteger#"
-  = Just (nTy,kn,(m,i),j)
-  | otherwise
-  = Nothing
-
-mkIntCLit :: TyConMap -> Integer -> Type -> Term
-mkIntCLit tcm lit resTy =
-  App (Data intDc) (Literal (IntLiteral lit))
- where
-  (_, tyView -> TyConApp intTcNm []) = splitFunForallTy resTy
-  Just intTc = UniqMap.lookup intTcNm tcm
-  [intDc] = tyConDataCons intTc
-
-mkFloatCLit :: TyConMap -> Word32 -> Type -> Term
-mkFloatCLit tcm lit resTy =
-  App (Data floatDc) (Literal (FloatLiteral lit))
- where
-  (_, tyView -> TyConApp floatTcNm []) = splitFunForallTy resTy
-  (Just floatTc) = UniqMap.lookup floatTcNm tcm
-  [floatDc] = tyConDataCons floatTc
-
-mkDoubleCLit :: TyConMap -> Word64 -> Type -> Term
-mkDoubleCLit tcm lit resTy =
-  App (Data doubleDc) (Literal (DoubleLiteral lit))
- where
-  (_, tyView -> TyConApp doubleTcNm []) = splitFunForallTy resTy
-  (Just doubleTc) = UniqMap.lookup doubleTcNm tcm
-  [doubleDc] = tyConDataCons doubleTc
-
-mkSomeNat :: TyConMap -> Integer -> Type -> Term
-mkSomeNat tcm lit resTy =
-  mkApps (Data someNatDc)
-         [ Right (LitTy (NumTy lit))
-         , Left (Literal (NaturalLiteral lit))
-         , Left proxy
-         ]
- where
-  -- Get the SomeNat data constructor
-  TyConApp someNatTcNm [] = tyView resTy
-  (Just someNatTc) = UniqMap.lookup someNatTcNm tcm
-  [someNatDc] = tyConDataCons someNatTc
-
-  -- Get the Proxy data constructor
-  (_:_:Right (tyView -> TyConApp proxyTcNm [natTy,_]):_,_) =
-    splitFunForallTy (dcType someNatDc)
-  (Just proxyTc) = UniqMap.lookup proxyTcNm tcm
-  [proxyDc] = tyConDataCons proxyTc
-
-  -- Build the Proxy argument
-  proxy = mkApps (Data proxyDc)
-                 [ Right natTy
-                 , Right (LitTy (NumTy lit))
-                 ]
-
--- From an argument list to function of type
---   forall n. KnownNat n => ...
--- extract (nTy,nInt)
--- where nTy is the Type of n
--- and   nInt is its value as an Integer
-extractKnownNat :: TyConMap -> [Type] -> Maybe (Type, Integer)
-extractKnownNat tcm tys = case tys of
-  nTy : _ | Right nInt <- runExcept (tyNatSize tcm nTy)
-    -> Just (nTy, nInt)
-  _ -> Nothing
-
--- From an argument list to function of type
---   forall n m o .. . (KnownNat n, KnownNat m, KnownNat o, ..) => ...
--- extract [(nTy,nInt), (mTy,mInt), (oTy,oInt)]
--- where nTy is the Type of n
--- and   nInt is its value as an Integer
-extractKnownNats :: TyConMap -> [Type] -> [(Type, Integer)]
-extractKnownNats tcm =
-  mapMaybe (extractKnownNat tcm . pure)
-
--- Construct a constant term of a sized type
-mkSizedLit
-  :: (Type -> Term)
-  -- ^ Type constructor?
-  -> Type
-  -- ^ Result type
-  -> Type
-  -- ^ forall n.
-  -> Integer
-  -- ^ KnownNat n
-  -> Integer
-  -- ^ Value to construct
-  -> Term
-mkSizedLit conPrim ty nTy kn val =
-  mkApps
-    (conPrim sTy)
-    [ Right nTy
-    , Left (Literal (NaturalLiteral kn))
-    , Left (Literal (IntegerLiteral val)) ]
- where
-    (_,sTy) = splitFunForallTy ty
-
-mkBitLit
-  :: Type
-  -- ^ Result type
-  -> Integer
-  -- ^ Mask
-  -> Integer
-  -- ^ Value
-  -> Term
-mkBitLit ty msk val =
-  mkApps (bConPrim sTy) [ Left (Literal (WordLiteral (msk .&. 1)))
-                        , Left (Literal (IntegerLiteral (val .&. 1)))]
-  where
-    (_,sTy) = splitFunForallTy ty
-
-mkSignedLit, mkUnsignedLit
-  :: Type
-  -- Result type
-  -> Type
-  -- forall n.
-  -> Integer
-  -- KnownNat n
-  -> Integer
-  -- Value
-  -> Term
-mkSignedLit    = mkSizedLit signedConPrim
-mkUnsignedLit  = mkSizedLit unsignedConPrim
-
-mkBitVectorLit
-  :: Type
-  -- ^ Result type
-  -> Type
-  -- ^ forall n.
-  -> Integer
-  -- ^ KnownNat n
-  -> Integer
-  -- ^ mask
-  -> Integer
-  -- ^ Value to construct
-  -> Term
-mkBitVectorLit ty nTy kn mask val
-  = mkApps (bvConPrim sTy)
-           [Right nTy
-           ,Left (Literal (NaturalLiteral kn))
-           ,Left (Literal (NaturalLiteral mask))
-           ,Left (Literal (IntegerLiteral val))]
-  where
-    (_,sTy) = splitFunForallTy ty
-
-mkIndexLitE
-  :: Type
-  -- ^ Result type
-  -> Type
-  -- ^ forall n.
-  -> Integer
-  -- ^ KnownNat n
-  -> Integer
-  -- ^ Value to construct
-  -> Either Term Term
-  -- ^ Either undefined (if given value is out of bounds of given type) or term
-  -- representing literal
-mkIndexLitE rTy nTy kn val
-  | val >= 0
-  , val < kn
-  = Right (mkSizedLit indexConPrim rTy nTy kn val)
-  | otherwise
-  = Left (TyApp (Prim NP.undefined) (mkTyConApp indexTcNm [nTy]))
-  where
-    TyConApp indexTcNm _ = tyView (snd (splitFunForallTy rTy))
-
-mkIndexLit
-  :: Type
-  -- ^ Result type
-  -> Type
-  -- ^ forall n.
-  -> Integer
-  -- ^ KnownNat n
-  -> Integer
-  -- ^ Value to construct
-  -> Term
-mkIndexLit rTy nTy kn val =
-  either id id (mkIndexLitE rTy nTy kn val)
-
-mkBitVectorLit'
-  :: (Type, Type, Integer)
-  -- ^ (result type, forall n., KnownNat n)
-  -> Integer
-  -- ^ Mask
-  -> Integer
-  -- ^ Value
-  -> Term
-mkBitVectorLit' (ty,nTy,kn) = mkBitVectorLit ty nTy kn
-
-mkIndexLit'
-  :: (Type, Type, Integer)
-  -- ^ (result type, forall n., KnownNat n)
-  -> Integer
-  -- ^ value
-  -> Term
-mkIndexLit' (rTy,nTy,kn) = mkIndexLit rTy nTy kn
-
-boolToIntLiteral :: Bool -> Term
-boolToIntLiteral b = if b then Literal (IntLiteral 1) else Literal (IntLiteral 0)
-
-boolToBoolLiteral :: TyConMap -> Type -> Bool -> Term
-boolToBoolLiteral tcm ty b =
- let (_,tyView -> TyConApp boolTcNm []) = splitFunForallTy ty
-     (Just boolTc) = UniqMap.lookup boolTcNm tcm
-     [falseDc,trueDc] = tyConDataCons boolTc
-     retDc = if b then trueDc else falseDc
- in  Data retDc
-
-charToCharLiteral :: Char -> Term
-charToCharLiteral = Literal . CharLiteral
-
-integerToIntLiteral :: Integer -> Term
-integerToIntLiteral = Literal . IntLiteral . toInteger . (fromInteger :: Integer -> Int) -- for overflow behavior
-
-integerToWordLiteral :: Integer -> Term
-integerToWordLiteral = Literal . WordLiteral . toInteger . (fromInteger :: Integer -> Word) -- for overflow behavior
-
-integerToInt64Literal :: Integer -> Term
-integerToInt64Literal = Literal . Int64Literal . toInteger . (fromInteger :: Integer -> Int64) -- for overflow behavior
-
-integerToWord64Literal :: Integer -> Term
-integerToWord64Literal = Literal . Word64Literal . toInteger . (fromInteger :: Integer -> Word64) -- for overflow behavior
-
-integerToIntegerLiteral :: Integer -> Term
-integerToIntegerLiteral = Literal . IntegerLiteral
-
-naturalToNaturalLiteral :: Natural -> Term
-naturalToNaturalLiteral = Literal . NaturalLiteral . toInteger
-
-bConPrim :: Type -> Term
-bConPrim (tyView -> TyConApp bTcNm _)
-  = Prim (PrimInfo "Clash.Sized.Internal.BitVector.fromInteger##" funTy WorkNever SingleResult NoUnfolding)
-  where
-    funTy      = foldr1 mkFunTy [wordPrimTy,integerPrimTy,mkTyConApp bTcNm []]
-bConPrim _ = error $ $(curLoc) ++ "called with incorrect type"
-
-bvConPrim :: Type -> Term
-bvConPrim (tyView -> TyConApp bvTcNm _)
-  = Prim (PrimInfo "Clash.Sized.Internal.BitVector.fromInteger#" (ForAllTy nTV funTy) WorkNever SingleResult NoUnfolding)
-  where
-    funTy = foldr1 mkFunTy [naturalPrimTy,naturalPrimTy,integerPrimTy,mkTyConApp bvTcNm [nVar]]
-    nName = mkUnsafeSystemName "n" 0
-    nVar  = VarTy nTV
-    nTV   = mkTyVar typeNatKind nName
-bvConPrim _ = error $ $(curLoc) ++ "called with incorrect type"
-
-indexConPrim :: Type -> Term
-indexConPrim (tyView -> TyConApp indexTcNm _)
-  = Prim (PrimInfo "Clash.Sized.Internal.Index.fromInteger#" (ForAllTy nTV funTy) WorkNever SingleResult NoUnfolding)
-  where
-    funTy        = foldr1 mkFunTy [naturalPrimTy,integerPrimTy,mkTyConApp indexTcNm [nVar]]
-    nName      = mkUnsafeSystemName "n" 0
-    nVar       = VarTy nTV
-    nTV        = mkTyVar typeNatKind nName
-indexConPrim _ = error $ $(curLoc) ++ "called with incorrect type"
-
-signedConPrim :: Type -> Term
-signedConPrim (tyView -> TyConApp signedTcNm _)
-  = Prim (PrimInfo "Clash.Sized.Internal.Signed.fromInteger#" (ForAllTy nTV funTy) WorkNever SingleResult NoUnfolding)
-  where
-    funTy        = foldr1 mkFunTy [naturalPrimTy,integerPrimTy,mkTyConApp signedTcNm [nVar]]
-    nName      = mkUnsafeSystemName "n" 0
-    nVar       = VarTy nTV
-    nTV        = mkTyVar typeNatKind nName
-signedConPrim _ = error $ $(curLoc) ++ "called with incorrect type"
-
-unsignedConPrim :: Type -> Term
-unsignedConPrim (tyView -> TyConApp unsignedTcNm _)
-  = Prim (PrimInfo "Clash.Sized.Internal.Unsigned.fromInteger#" (ForAllTy nTV funTy) WorkNever SingleResult NoUnfolding)
-  where
-    funTy        = foldr1 mkFunTy [naturalPrimTy,integerPrimTy,mkTyConApp unsignedTcNm [nVar]]
-    nName        = mkUnsafeSystemName "n" 0
-    nVar         = VarTy nTV
-    nTV          = mkTyVar typeNatKind nName
-unsignedConPrim _ = error $ $(curLoc) ++ "called with incorrect type"
-
-
--- |  Lift a binary function over 'Unsigned' values to be used as literal Evaluator
---
---
-liftUnsigned2 :: KnownNat n
-              => (Unsigned n -> Unsigned n -> Unsigned n)
-              -> Type
-              -> TyConMap
-              -> [Type]
-              -> [Value]
-              -> (Proxy n -> Maybe Term)
-liftUnsigned2 = liftSized2 unsignedLiterals' mkUnsignedLit
-
-liftSigned2 :: KnownNat n
-              => (Signed n -> Signed n -> Signed n)
-              -> Type
-              -> TyConMap
-              -> [Type]
-              -> [Value]
-              -> (Proxy n -> Maybe Term)
-liftSigned2 = liftSized2 signedLiterals' mkSignedLit
-
-liftBitVector2 :: KnownNat n
-              => (BitVector n -> BitVector n -> BitVector n)
-              -> Type
-              -> TyConMap
-              -> [Type]
-              -> [Value]
-              -> (Proxy n -> Maybe Term)
-liftBitVector2  f ty tcm tys args _p
-  | Just (nTy, kn) <- extractKnownNat tcm tys
-  , [i,j] <- bitVectorLiterals' args
-  = let BV mask val = f (toBV i) (toBV j)
-    in Just $ mkBitVectorLit ty nTy kn (toInteger mask) (toInteger val)
-  | otherwise = Nothing
-
-liftBitVector2Bool :: KnownNat n
-              => (BitVector n -> BitVector n -> Bool)
-              -> Type
-              -> TyConMap
-              -> [Value]
-              -> (Proxy n -> Maybe Term)
-liftBitVector2Bool  f ty tcm args _p
-  | [i,j] <- bitVectorLiterals' args
-  = let val = f (toBV i) (toBV j)
-    in Just $ boolToBoolLiteral tcm ty val
-  | otherwise = Nothing
-
-liftInteger2BitVector
-  :: KnownNat n
-  => (Integer -> BitVector n)
-  -> (Type, Type, Integer)
-  -> [Value]
-  -> (Proxy n -> Maybe Term)
-liftInteger2BitVector f resTyInfo args _p
-  | [i] <- intCLiterals' args
-  = let BV msk val = f i
-     in Just (mkBitVectorLit' resTyInfo (toInteger msk) (toInteger val))
-
-  | otherwise
-  = Nothing
-
-liftBitVector2CInt
-  :: KnownNat n
-  => TyConMap
-  -> Type
-  -> (BitVector n -> Integer)
-  -> [Value]
-  -> (Proxy n -> Maybe Term)
-liftBitVector2CInt tcm resTy f args _p
-  | [i] <- bitVectorLiterals' args
-  = let val = f (toBV i)
-     in Just $ mkIntCLit tcm val resTy
-  | otherwise
-  = Nothing
-
-liftSized2 :: (KnownNat n, Integral (sized n))
-           => ([Value] -> [Integer])
-              -- ^ literal argument extraction function
-           -> (Type -> Type -> Integer -> Integer -> Term)
-              -- ^ literal contruction function
-           -> (sized n -> sized n -> sized n)
-           -> Type
-           -> TyConMap
-           -> [Type]
-           -> [Value]
-           -> (Proxy n -> Maybe Term)
-liftSized2 extractLitArgs mkLit f ty tcm tys args p
-  | Just (nTy, kn) <- extractKnownNat tcm tys
-  , [i,j] <- extractLitArgs args
-  = let val = runSizedF f i j p
-    in Just $ mkLit ty nTy kn val
-  | otherwise = Nothing
-
--- | Helper to run a function over sized types on integers
---
--- This only works on function of type (sized n -> sized n -> sized n)
--- The resulting function must be executed with reifyNat
-runSizedF
-  :: (KnownNat n, Integral (sized n))
-  => (sized n -> sized n -> sized n)
-  -- ^ function to run
-  -> Integer
-  -- ^ first  argument
-  -> Integer
-  -- ^ second argument
-  -> (Proxy n -> Integer)
-runSizedF f i j _ = toInteger $ f (fromInteger i) (fromInteger j)
-
-extractTySizeInfo :: TyConMap -> Type -> [Type] -> (Type, Type, Integer)
-extractTySizeInfo tcm ty tys = (resTy,resSizeTy,resSize)
-  where
-    ty' = piResultTys tcm ty tys
-    (_,resTy) = splitFunForallTy ty'
-    TyConApp _ [resSizeTy] = tyView resTy
-    Right resSize = runExcept (tyNatSize tcm resSizeTy)
-
-getResultTy
-  :: TyConMap
-  -> Type
-  -> [Type]
-  -> Type
-getResultTy tcm ty tys = resTy
- where
-  ty' = piResultTys tcm ty tys
-  (_,resTy) = splitFunForallTy ty'
-
-liftDDI :: (Double# -> Double# -> Int#) -> [Value] -> Maybe Term
-liftDDI f args = case doubleLiterals' args of
-  [i,j] -> Just $ runDDI f i j
-  _     -> Nothing
-liftDDD :: (Double# -> Double# -> Double#) -> [Value] -> Maybe Term
-liftDDD f args = case doubleLiterals' args of
-  [i,j] -> Just $ runDDD f i j
-  _     -> Nothing
-liftDD  :: (Double# -> Double#) -> [Value] -> Maybe Term
-liftDD  f args = case doubleLiterals' args of
-  [i]   -> Just $ runDD f i
-  _     -> Nothing
-runDDI :: (Double# -> Double# -> Int#) -> Word64 -> Word64 -> Term
-runDDI f i j
-  = let !(D# a) = wordToDouble i
-        !(D# b) = wordToDouble j
-        r = f a b
-    in  Literal . IntLiteral . toInteger $ I# r
-runDDD :: (Double# -> Double# -> Double#) -> Word64 -> Word64 -> Term
-runDDD f i j
-  = let !(D# a) = wordToDouble i
-        !(D# b) = wordToDouble j
-        r = f a b
-    in  Literal . DoubleLiteral . doubleToWord $ D# r
-runDD :: (Double# -> Double#) -> Word64 -> Term
-runDD f i
-  = let !(D# a) = wordToDouble i
-        r = f a
-    in  Literal . DoubleLiteral . doubleToWord $ D# r
-
-liftFFI :: (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
-liftFFI f args = case floatLiterals' args of
-  [i,j] -> Just $ runFFI f i j
-  _     -> Nothing
-liftFFF :: (Float# -> Float# -> Float#) -> [Value] -> Maybe Term
-liftFFF f args = case floatLiterals' args of
-  [i,j] -> Just $ runFFF f i j
-  _     -> Nothing
-liftFF  :: (Float# -> Float#) -> [Value] -> Maybe Term
-liftFF  f args = case floatLiterals' args of
-  [i]   -> Just $ runFF f i
-  _     -> Nothing
-runFFI :: (Float# -> Float# -> Int#) -> Word32 -> Word32 -> Term
-runFFI f i j
-  = let !(F# a) = wordToFloat i
-        !(F# b) = wordToFloat j
-        r = f a b
-    in  Literal . IntLiteral . toInteger $ I# r
-runFFF :: (Float# -> Float# -> Float#) -> Word32 -> Word32 -> Term
-runFFF f i j
-  = let !(F# a) = wordToFloat i
-        !(F# b) = wordToFloat j
-        r = f a b
-    in  Literal . FloatLiteral . floatToWord $ F# r
-runFF :: (Float# -> Float#) -> Word32 -> Term
-runFF f i
-  = let !(F# a) = wordToFloat i
-        r = f a
-    in  Literal . FloatLiteral . floatToWord $ F# r
-
-#if MIN_VERSION_base(4,16,0)
-liftI8 :: (Int8# -> Int8# -> Int8#) -> [Value] -> Maybe Term
-liftI8 f args = case int8Literals' args of
-  [i,j] ->
-    let !(I8# a) = fromInteger i
-        !(I8# b) = fromInteger j
-     in Just (Literal (Int8Literal (toInteger (I8# (f a b)))))
-  _ -> Nothing
-
-liftI8I :: (Int8# -> Int# -> Int8#) -> [Value] -> Maybe Term
-liftI8I f args = case args of
-  [Lit (Int8Literal i),Lit (IntLiteral j)] ->
-    let !(I8# a) = fromInteger i
-        !(I# b) = fromInteger j
-     in Just (Literal (Int8Literal (toInteger (I8# (f a b)))))
-  _ -> Nothing
-
-liftI8RI :: (Int8# -> Int8# -> Int#) -> [Value] -> Maybe Term
-liftI8RI f args = case int8Literals' args of
-  [i,j] ->
-    let !(I8# a) = fromInteger i
-        !(I8# b) = fromInteger j
-     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
-  _ -> Nothing
-
-liftI16 :: (Int16# -> Int16# -> Int16#) -> [Value] -> Maybe Term
-liftI16 f args = case int16Literals' args of
-  [i,j] ->
-    let !(I16# a) = fromInteger i
-        !(I16# b) = fromInteger j
-     in Just (Literal (Int16Literal (toInteger (I16# (f a b)))))
-  _ -> Nothing
-
-liftI16I :: (Int16# -> Int# -> Int16#) -> [Value] -> Maybe Term
-liftI16I f args = case args of
-  [Lit (Int16Literal i),Lit (IntLiteral j)] ->
-    let !(I16# a) = fromInteger i
-        !(I# b) = fromInteger j
-     in Just (Literal (Int16Literal (toInteger (I16# (f a b)))))
-  _ -> Nothing
-
-liftI16RI :: (Int16# -> Int16# -> Int#) -> [Value] -> Maybe Term
-liftI16RI f args = case int16Literals' args of
-  [i,j] ->
-    let !(I16# a) = fromInteger i
-        !(I16# b) = fromInteger j
-     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
-  _ -> Nothing
-
-liftI32 :: (Int32# -> Int32# -> Int32#) -> [Value] -> Maybe Term
-liftI32 f args = case int32Literals' args of
-  [i,j] ->
-    let !(I32# a) = fromInteger i
-        !(I32# b) = fromInteger j
-     in Just (Literal (Int32Literal (toInteger (I32# (f a b)))))
-  _ -> Nothing
-
-liftI32I :: (Int32# -> Int# -> Int32#) -> [Value] -> Maybe Term
-liftI32I f args = case args of
-  [Lit (Int32Literal i),Lit (IntLiteral j)] ->
-    let !(I32# a) = fromInteger i
-        !(I# b) = fromInteger j
-     in Just (Literal (Int32Literal (toInteger (I32# (f a b)))))
-  _ -> Nothing
-
-liftI32RI :: (Int32# -> Int32# -> Int#) -> [Value] -> Maybe Term
-liftI32RI f args = case int32Literals' args of
-  [i,j] ->
-    let !(I32# a) = fromInteger i
-        !(I32# b) = fromInteger j
-     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
-  _ -> Nothing
-
-#if MIN_VERSION_base(4,17,0)
-liftI64 :: (Int64# -> Int64# -> Int64#) -> [Value] -> Maybe Term
-liftI64 f args = case int64Literals' args of
-  [i,j] ->
-    let !(I64# a) = fromInteger i
-        !(I64# b) = fromInteger j
-     in Just (Literal (Int64Literal (toInteger (I64# (f a b)))))
-  _ -> Nothing
-
-liftI64I :: (Int64# -> Int# -> Int64#) -> [Value] -> Maybe Term
-liftI64I f args = case args of
-  [Lit (Int64Literal i),Lit (IntLiteral j)] ->
-    let !(I64# a) = fromInteger i
-        !(I# b) = fromInteger j
-     in Just (Literal (Int64Literal (toInteger (I64# (f a b)))))
-  _ -> Nothing
-
-liftI64RI :: (Int64# -> Int64# -> Int#) -> [Value] -> Maybe Term
-liftI64RI f args = case int64Literals' args of
-  [i,j] ->
-    let !(I64# a) = fromInteger i
-        !(I64# b) = fromInteger j
-     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
-  _ -> Nothing
-#endif
-
-liftW8 :: (Word8# -> Word8# -> Word8#) -> [Value] -> Maybe Term
-liftW8 f args = case word8Literals' args of
-  [i,j] ->
-    let !(W8# a) = fromInteger i
-        !(W8# b) = fromInteger j
-     in Just (Literal (Word8Literal (toInteger (W8# (f a b)))))
-  _ -> Nothing
-
-liftW8I :: (Word8# -> Int# -> Word8#) -> [Value] -> Maybe Term
-liftW8I f args = case args of
-  [Lit (Word8Literal i),Lit (IntLiteral j)] ->
-    let !(W8# a) = fromInteger i
-        !(I# b) = fromInteger j
-     in Just (Literal (Word8Literal (toInteger (W8# (f a b)))))
-  _ -> Nothing
-
-liftW8RI :: (Word8# -> Word8# -> Int#) -> [Value] -> Maybe Term
-liftW8RI f args = case word8Literals' args of
-  [i,j] ->
-    let !(W8# a) = fromInteger i
-        !(W8# b) = fromInteger j
-     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
-  _ -> Nothing
-
-liftW16 :: (Word16# -> Word16# -> Word16#) -> [Value] -> Maybe Term
-liftW16 f args = case word16Literals' args of
-  [i,j] -> let !(W16# a) = fromInteger i
-               !(W16# b) = fromInteger j
-            in Just (Literal (Word16Literal (toInteger (W16# (f a b)))))
-  _ -> Nothing
-
-liftW16I :: (Word16# -> Int# -> Word16#) -> [Value] -> Maybe Term
-liftW16I f args = case args of
-  [Lit (Word16Literal i),Lit (IntLiteral j)] ->
-    let !(W16# a) = fromInteger i
-        !(I# b) = fromInteger j
-     in Just (Literal (Word16Literal (toInteger (W16# (f a b)))))
-  _ -> Nothing
-
-liftW16RI :: (Word16# -> Word16# -> Int#) -> [Value] -> Maybe Term
-liftW16RI f args = case word16Literals' args of
-  [i,j] ->
-    let !(W16# a) = fromInteger i
-        !(W16# b) = fromInteger j
-     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
-  _ -> Nothing
-
-liftW32 :: (Word32# -> Word32# -> Word32#) -> [Value] -> Maybe Term
-liftW32 f args = case word32Literals' args of
-  [i,j] -> let !(W32# a) = fromInteger i
-               !(W32# b) = fromInteger j
-            in Just (Literal (Word32Literal (toInteger (W32# (f a b)))))
-  _ -> Nothing
-
-liftW32I :: (Word32# -> Int# -> Word32#) -> [Value] -> Maybe Term
-liftW32I f args = case args of
-  [Lit (Word32Literal i),Lit (IntLiteral j)] ->
-    let !(W32# a) = fromInteger i
-        !(I# b) = fromInteger j
-     in Just (Literal (Word32Literal (toInteger (W32# (f a b)))))
-  _ -> Nothing
-
-liftW32RI :: (Word32# -> Word32# -> Int#) -> [Value] -> Maybe Term
-liftW32RI f args = case word32Literals' args of
-  [i,j] ->
-    let !(W32# a) = fromInteger i
-        !(W32# b) = fromInteger j
-     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
-  _ -> Nothing
-
-#if MIN_VERSION_base(4,17,0)
-liftW64 :: (Word64# -> Word64# -> Word64#) -> [Value] -> Maybe Term
-liftW64 f args = case word64Literals' args of
-  [i,j] -> let !(W64# a) = fromInteger i
-               !(W64# b) = fromInteger j
-            in Just (Literal (Word64Literal (toInteger (W64# (f a b)))))
-  _ -> Nothing
-
-liftW64I :: (Word64# -> Int# -> Word64#) -> [Value] -> Maybe Term
-liftW64I f args = case args of
-  [Lit (Word64Literal i),Lit (IntLiteral j)] ->
-    let !(W64# a) = fromInteger i
-        !(I# b) = fromInteger j
-     in Just (Literal (Word64Literal (toInteger (W64# (f a b)))))
-  _ -> Nothing
-
-liftW64RI :: (Word64# -> Word64# -> Int#) -> [Value] -> Maybe Term
-liftW64RI f args = case word64Literals' args of
-  [i,j] ->
-    let !(W64# a) = fromInteger i
-        !(W64# b) = fromInteger j
-     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
-  _ -> Nothing
-#endif
-#endif
-
-splitAtPrim
-  :: TyConName
-  -- ^ SNat TyCon name
-  -> TyConName
-  -- ^ Vec TyCon name
-  -> Term
-splitAtPrim snatTcNm vecTcNm =
-  Prim (PrimInfo "Clash.Sized.Vector.splitAt" (splitAtTy snatTcNm vecTcNm) WorkNever SingleResult NoUnfolding)
-
-splitAtTy
-  :: TyConName
-  -- ^ SNat TyCon name
-  -> TyConName
-  -- ^ Vec TyCon name
-  -> Type
-splitAtTy snatNm vecNm =
-  ForAllTy mTV (
-  ForAllTy nTV (
-  ForAllTy aTV (
-  mkFunTy
-    (mkTyConApp snatNm [VarTy mTV])
-    (mkFunTy
-      (mkTyConApp vecNm
-                  [mkTyConApp typeNatAdd
-                    [VarTy mTV
-                    ,VarTy nTV]
-                  ,VarTy aTV])
-      (mkTyConApp tupNm
-                  [mkTyConApp vecNm
-                              [VarTy mTV
-                              ,VarTy aTV]
-                  ,mkTyConApp vecNm
-                              [VarTy nTV
-                              ,VarTy aTV]])))))
-  where
-    mTV   = mkTyVar typeNatKind (mkUnsafeSystemName "m" 0)
-    nTV   = mkTyVar typeNatKind (mkUnsafeSystemName "n" 1)
-    aTV   = mkTyVar liftedTypeKind (mkUnsafeSystemName "a" 2)
-    tupNm = ghcTyconToTyConName (tupleTyCon Boxed 2)
-
-foldSplitAtTy
-  :: TyConName
-  -- ^ Vec TyCon name
-  -> Type
-foldSplitAtTy vecNm =
-  ForAllTy mTV (
-  ForAllTy nTV (
-  ForAllTy aTV (
-  mkFunTy
-    naturalPrimTy
-    (mkFunTy
-      (mkTyConApp vecNm
-                  [mkTyConApp typeNatAdd
-                    [VarTy mTV
-                    ,VarTy nTV]
-                  ,VarTy aTV])
-      (mkTyConApp tupNm
-                  [mkTyConApp vecNm
-                              [VarTy mTV
-                              ,VarTy aTV]
-                  ,mkTyConApp vecNm
-                              [VarTy nTV
-                              ,VarTy aTV]])))))
-  where
-    mTV   = mkTyVar typeNatKind (mkUnsafeSystemName "m" 0)
-    nTV   = mkTyVar typeNatKind (mkUnsafeSystemName "n" 1)
-    aTV   = mkTyVar liftedTypeKind (mkUnsafeSystemName "a" 2)
-    tupNm = ghcTyconToTyConName (tupleTyCon Boxed 2)
-
-vecAppendPrim
-  :: TyConName
-  -- ^ Vec TyCon name
-  -> Term
-vecAppendPrim vecNm =
-  Prim (PrimInfo "Clash.Sized.Vector.++" (vecAppendTy vecNm) WorkNever SingleResult NoUnfolding)
-
-vecAppendTy
-  :: TyConName
-  -- ^ Vec TyCon name
-  -> Type
-vecAppendTy vecNm =
-    ForAllTy nTV (
-    ForAllTy aTV (
-    ForAllTy mTV (
-    mkFunTy
-      (mkTyConApp vecNm [VarTy nTV
-                        ,VarTy aTV
-                        ])
-      (mkFunTy
-         (mkTyConApp vecNm [VarTy mTV
-                           ,VarTy aTV
-                           ])
-         (mkTyConApp vecNm [mkTyConApp typeNatAdd
-                              [VarTy nTV
-                              ,VarTy mTV]
-                           ,VarTy aTV
-                           ])))))
-  where
-    nTV = mkTyVar typeNatKind (mkUnsafeSystemName "n" 0)
-    aTV = mkTyVar liftedTypeKind (mkUnsafeSystemName "a" 1)
-    mTV = mkTyVar typeNatKind (mkUnsafeSystemName "m" 2)
-
-vecZipWithPrim
-  :: TyConName
-  -- ^ Vec TyCon name
-  -> Term
-vecZipWithPrim vecNm =
-  Prim (PrimInfo "Clash.Sized.Vector.zipWith" (vecZipWithTy vecNm) WorkNever SingleResult NoUnfolding)
-
-vecZipWithTy
-  :: TyConName
-  -- ^ Vec TyCon name
-  -> Type
-vecZipWithTy vecNm =
-  ForAllTy aTV (
-  ForAllTy bTV (
-  ForAllTy cTV (
-  ForAllTy nTV (
-  mkFunTy
-    (mkFunTy aTy (mkFunTy bTy cTy))
-    (mkFunTy
-      (mkTyConApp vecNm [nTy,aTy])
-      (mkFunTy
-        (mkTyConApp vecNm [nTy,bTy])
-        (mkTyConApp vecNm [nTy,cTy])))))))
-  where
-    aTV = mkTyVar liftedTypeKind (mkUnsafeSystemName "a" 0)
-    bTV = mkTyVar liftedTypeKind (mkUnsafeSystemName "b" 1)
-    cTV = mkTyVar liftedTypeKind (mkUnsafeSystemName "c" 2)
-    nTV = mkTyVar typeNatKind (mkUnsafeSystemName "n" 3)
-    aTy = VarTy aTV
-    bTy = VarTy bTV
-    cTy = VarTy cTV
-    nTy = VarTy nTV
-
-vecImapGoTy
-  :: TyConName
-  -- ^ Vec TyCon name
-  -> TyConName
-  -- ^ Index TyCon name
-  -> Type
-vecImapGoTy vecTcNm indexTcNm =
-  ForAllTy nTV (
-  ForAllTy mTV (
-  ForAllTy aTV (
-  ForAllTy bTV (
-  mkFunTy fTy
-       (mkFunTy vecATy (mkFunTy indexTy vecBTy))))))
-  where
-    nTV = mkTyVar typeNatKind (mkUnsafeSystemName "n" 0)
-    mTV = mkTyVar typeNatKind (mkUnsafeSystemName "m" 1)
-    aTV = mkTyVar liftedTypeKind (mkUnsafeSystemName "a" 2)
-    bTV = mkTyVar liftedTypeKind (mkUnsafeSystemName "b" 3)
-    indexTy = mkTyConApp indexTcNm [nTy]
-    nTy = VarTy nTV
-    mTy = VarTy mTV
-    fTy = mkFunTy indexTy (mkFunTy aTy bTy)
-    aTy = VarTy aTV
-    bTy = VarTy bTV
-    vecATy = mkTyConApp vecTcNm [mTy,aTy]
-    vecBTy = mkTyConApp vecTcNm [mTy,bTy]
-
-indexAddTy
-  :: TyConName
-  -- ^ Index TyCon name
-  -> Type
-indexAddTy indexTcNm =
-  ForAllTy nTV (
-  mkFunTy naturalPrimTy (mkFunTy indexTy (mkFunTy indexTy indexTy)))
-  where
-    nTV     = mkTyVar typeNatKind (mkUnsafeSystemName "n" 0)
-    indexTy = mkTyConApp indexTcNm [VarTy nTV]
-
-bvAppendPrim
-  :: TyConName
-  -- ^ BitVector TyCon Name
-  -> Term
-bvAppendPrim bvTcNm =
-  Prim (PrimInfo "Clash.Sized.Internal.BitVector.++#" (bvAppendTy bvTcNm) WorkNever SingleResult NoUnfolding)
-
-bvAppendTy
-  :: TyConName
-  -- ^ BitVector TyCon Name
-  -> Type
-bvAppendTy bvNm =
-  ForAllTy mTV (
-  ForAllTy nTV (
-  mkFunTy naturalPrimTy (mkFunTy
-    (mkTyConApp bvNm [VarTy nTV])
-    (mkFunTy
-      (mkTyConApp bvNm [VarTy mTV])
-      (mkTyConApp bvNm [mkTyConApp typeNatAdd
-                          [VarTy nTV
-                          ,VarTy mTV]])))))
-  where
-    mTV = mkTyVar typeNatKind (mkUnsafeSystemName "m" 0)
-    nTV = mkTyVar typeNatKind (mkUnsafeSystemName "n" 1)
-
-bvSplitPrim
-  :: TyConName
-  -- ^ BitVector TyCon Name
-  -> Term
-bvSplitPrim bvTcNm =
-  Prim (PrimInfo "Clash.Sized.Internal.BitVector.split#" (bvSplitTy bvTcNm) WorkNever SingleResult NoUnfolding)
+#include "MachDeps.h"
+
+module Clash.GHC.Evaluator.Primitive
+  ( ghcPrimStep
+  , ghcPrimUnwind
+  , isUndefinedPrimVal
+  , isUndefinedXPrimVal
+  ) where
+
+import           Control.DeepSeq            (force)
+import           Control.Exception          (ArithException(..), Exception, tryJust, evaluate)
+import           Control.Monad.State.Strict (State, MonadState)
+import qualified Control.Monad.State.Strict as State
+import           Control.Monad.Trans.Except (runExcept)
+import           Data.Binary.IEEE754        (doubleToWord, floatToWord, wordToDouble, wordToFloat)
+import           Data.Bits
+import qualified Data.ByteString.Internal as BS
+import           Data.Char           (chr,ord)
+import qualified Data.Either         as Either
+import           Data.Maybe (fromMaybe, mapMaybe)
+import qualified Data.List           as List
+import qualified Data.Primitive.ByteArray as BA
+import           Data.Proxy          (Proxy)
+import           Data.Reflection     (reifyNat)
+import           Data.Text           (Text)
+import qualified Data.Text           as Text
+import           Data.Text.Extra     (showt)
+import           GHC.Exts (IsList(..))
+import           GHC.Float
+import           GHC.Int
+import           GHC.Integer
+  (decodeDoubleInteger,encodeDoubleInteger,compareInteger,orInteger,andInteger,
+   xorInteger,complementInteger,absInteger,signumInteger)
+#if MIN_VERSION_base(4,16,0)
+import           GHC.Num.Integer (Integer (..), integerEncodeFloat#)
+#elif MIN_VERSION_base(4,15,0)
+import           GHC.Num.Integer
+  (Integer (..), integerEncodeFloat#, integerToFloat#, integerToDouble#)
+#else
+import           GHC.Integer.GMP.Internals
+  (Integer (..), BigNat (..))
+#endif
+#if MIN_VERSION_base(4,15,0)
+import           GHC.Num.Natural     (naturalSubUnsafe)
+#endif
+import           GHC.Natural
+import           GHC.ForeignPtr
+import           GHC.Prim
+import           GHC.Real            (Ratio (..))
+import           GHC.TypeLits        (KnownNat)
+import           GHC.Types           (IO (..))
+import           GHC.Word
+import           System.IO.Unsafe    (unsafeDupablePerformIO)
+#if MIN_VERSION_ghc(9,4,0)
+import           Data.Bifunctor      (first)
+import qualified Data.Text.Array     as Text
+import qualified Data.Text.Internal  as Text
+#endif
+
+#if MIN_VERSION_ghc(9,0,0)
+import           GHC.Types.Basic     (Boxity (..))
+import           GHC.Types.Name      (getSrcSpan, nameOccName, occNameString)
+import           GHC.Builtin.Names   (trueDataConKey, falseDataConKey)
+import qualified GHC.Core.TyCon      as TyCon
+import           GHC.Builtin.Types   (tupleTyCon)
+#else
+import           BasicTypes          (Boxity (..))
+import           Name                (getSrcSpan, nameOccName, occNameString)
+import           PrelNames           (trueDataConKey, falseDataConKey)
+import qualified TyCon
+import           TysWiredIn          (tupleTyCon)
+#endif
+
+import           Clash.Class.BitPack (pack,unpack)
+import           Clash.Core.DataCon  (DataCon (..))
+import           Clash.Core.Evaluator.Types
+import           Clash.Core.HasType  (piResultTys, applyTypeToArgs)
+import           Clash.Core.Literal  (Literal (..))
+import           Clash.Core.Name
+  (Name (..), NameSort (..), mkUnsafeSystemName)
+import           Clash.Core.Pretty   (showPpr)
+import           Clash.Core.Term
+  (IsMultiPrim (..), Pat (..), PrimInfo (..), Term (..), WorkInfo (..), mkApps,
+   PrimUnfolding(..), collectArgs)
+import           Clash.Core.Type
+  (Type (..), ConstTy (..), LitTy (..), TypeView (..), mkFunTy, mkTyConApp,
+   splitFunForallTy, tyView)
+import           Clash.Core.TyCon
+  (TyConMap, TyConName, tyConDataCons)
+import           Clash.Core.TysPrim
+import           Clash.Core.Util
+  (mkRTree,mkVec,tyNatSize,dataConInstArgTys,primCo, mkSelectorCase,undefinedPrims,
+   undefinedXPrims)
+import           Clash.Core.Var      (mkLocalId, mkTyVar)
+import qualified Clash.Data.UniqMap as UniqMap
+import           Clash.Debug
+import           Clash.GHC.GHC2Core  (modNameM)
+import           Clash.Unique        (fromGhcUnique)
+import           Clash.Util
+  (MonadUnique (..), clogBase, flogBase, curLoc, namePat)
+import           Clash.Util.Supply   (Supply,freshId)
+import           Clash.Normalize.PrimitiveReductions
+  (typeNatMul, typeNatSub, typeNatAdd, vecLastPrim, vecInitPrim, vecHeadPrim,
+   vecTailPrim, mkVecCons, mkVecNil)
+
+import qualified Clash.Normalize.Primitives as NP
+import Clash.Promoted.Nat.Unsafe (unsafeSNat)
+import qualified Clash.Sized.Internal.BitVector as BitVector
+import qualified Clash.Sized.Internal.Signed    as Signed
+import qualified Clash.Sized.Internal.Unsigned  as Unsigned
+import Clash.Sized.Internal.BitVector(BitVector(..), Bit(..))
+import Clash.Sized.Internal.Signed   (Signed   (..))
+import Clash.Sized.Internal.Unsigned (Unsigned (..))
+import Clash.XException (isX)
+
+import {-# SOURCE #-} Clash.GHC.Evaluator
+
+import qualified Clash.Annotations.BitRepresentation.Deriving
+import qualified Clash.Class.BitPack.Internal
+import qualified Clash.Class.Exp
+import qualified Clash.Promoted.Nat
+import qualified Clash.Sized.Internal.BitVector
+import qualified Clash.Sized.Internal.Index
+import qualified Clash.Sized.Internal.Signed
+import qualified Clash.Sized.Internal.Unsigned
+import qualified Clash.Sized.RTree
+import qualified Clash.Sized.Vector
+import qualified GHC.Base
+import qualified GHC.Classes
+import qualified GHC.CString
+import qualified GHC.TypeLits
+import qualified GHC.TypeNats
+import qualified GHC.Types
+
+#if MIN_VERSION_base(4,15,0)
+import qualified GHC.Num
+import qualified GHC.Num.Integer
+#endif
+
+#if MIN_VERSION_ghc_prim(0,12,0)
+import qualified GHC.PrimopWrappers
+#endif
+
+#if !MIN_VERSION_base(4,15,0)
+import qualified GHC.Integer.Logarithms
+#endif
+
+isUndefinedPrimVal :: Value -> Bool
+isUndefinedPrimVal (PrimVal (PrimInfo{primName}) _ _) =
+  primName `elem` undefinedPrims
+isUndefinedPrimVal _ = False
+
+isUndefinedXPrimVal :: Value -> Bool
+isUndefinedXPrimVal (PrimVal (PrimInfo{primName}) _ _) =
+  primName `elem` undefinedXPrims
+isUndefinedXPrimVal _ = False
+
+-- | Evaluation of primitive operations.
+ghcPrimUnwind :: PrimUnwind
+ghcPrimUnwind tcm p tys vs v [] m
+  | primName p `elem` [ showt 'Clash.Sized.Internal.Index.fromInteger#
+                       , showt 'GHC.CString.unpackCString#
+                       , showt 'NP.removedArg
+                       , showt ''MutableByteArray#
+                       , showt 'NP.undefined
+                       , showt 'NP.undefinedX
+                       ]
+              -- The above primitives are actually values, and not operations.
+  = ghcUnwind (PrimVal p tys (vs ++ [v])) m tcm
+  | primName p == showt 'Clash.Sized.Internal.BitVector.fromInteger#
+  = case (vs,v) of
+    ([naturalLiteral -> Just n,mask], integerLiteral -> Just i) ->
+      ghcUnwind (PrimVal p tys [Lit (NaturalLiteral n), mask, Lit (IntegerLiteral (wrapUnsigned n i))]) m tcm
+    _ -> error ($(curLoc) ++ "Internal error"  ++ show (vs,v))
+  | primName p == showt 'Clash.Sized.Internal.BitVector.fromInteger##
+  = case (vs,v) of
+    ([mask], integerLiteral -> Just i) ->
+      ghcUnwind (PrimVal p tys [mask, Lit (IntegerLiteral (wrapUnsigned 1 i))]) m tcm
+    _ -> error ($(curLoc) ++ "Internal error"  ++ show (vs,v))
+  | primName p == showt 'Clash.Sized.Internal.Signed.fromInteger#
+  = case (vs,v) of
+    ([naturalLiteral -> Just n],integerLiteral -> Just i) ->
+      ghcUnwind (PrimVal p tys [Lit (NaturalLiteral n), Lit (IntegerLiteral (wrapSigned n i))]) m tcm
+    _ -> error ($(curLoc) ++ "Internal error"  ++ show (vs,v))
+  | primName p == showt 'Clash.Sized.Internal.Unsigned.fromInteger#
+  = case (vs,v) of
+    ([naturalLiteral -> Just n],integerLiteral -> Just i) ->
+      ghcUnwind (PrimVal p tys [Lit (NaturalLiteral n), Lit (IntegerLiteral (wrapUnsigned n i))]) m tcm
+    _ -> error ($(curLoc) ++ "Internal error"  ++ show (vs,v))
+  | isUndefinedPrimVal v
+  = let tyArgs = map Right tys
+        tmArgs = map (Left . valToTerm) (vs ++ [v])
+    in  Just $ flip setTerm m $ TyApp (Prim NP.undefined) $
+          applyTypeToArgs (Prim p) tcm (primType p) (tyArgs ++ tmArgs)
+  | isUndefinedXPrimVal v
+  = let tyArgs = map Right tys
+        tmArgs = map (Left . valToTerm) (vs ++ [v])
+    in  Just $ flip setTerm m $ TyApp (Prim NP.undefinedX) $
+          applyTypeToArgs (Prim p) tcm (primType p) (tyArgs ++ tmArgs)
+  | otherwise
+  = ghcPrimStep tcm (forcePrims m) p tys (vs ++ [v]) m
+
+ghcPrimUnwind tcm p tys vs v [e] m0
+  -- Note [Lazy primitives]
+  -- ~~~~~~~~~~~~~~~~~~~~~~
+  --
+  -- Primitives are usually considered undefined when one of their arguments is
+  -- (unless they're unused). _Some_ primitives can still yield a result even
+  -- though one of their arguments is undefined. It turns out that all primitives
+  -- exhibiting this property happen to be "lazy" in their last argument. Thus,
+  -- all the cases can be covered by a match on [e] and their names:
+  | primName p `elem` [  showt 'Clash.Sized.Vector.lazyV
+                       , showt 'Clash.Sized.Vector.replicate
+                       , "Clash.Sized.Vector.replace_int"
+                       , showt '(GHC.Classes.&&)
+                       , showt '(GHC.Classes.||)
+                       , showt 'BitVector.xToBV
+                       , "Clash.Sized.Vector.imap_go"
+                       ]
+  = if isUndefinedPrimVal v then
+      let tyArgs = map Right tys
+          tmArgs = map (Left . valToTerm) (vs ++ [v]) ++ [Left e]
+      in  Just $ flip setTerm m0 $ TyApp (Prim NP.undefined) $
+            applyTypeToArgs (Prim p) tcm (primType p) (tyArgs ++ tmArgs)
+    else
+      let (m1,i) = newLetBinding tcm m0 e
+      in  ghcPrimStep tcm (forcePrims m0) p tys (vs ++ [v,Suspend (Var i)]) m1
+
+ghcPrimUnwind tcm p tys vs (collectValueTicks -> (v, ts)) (e:es) m
+  | isUndefinedPrimVal v
+  = let tyArgs = map Right tys
+        tmArgs = map (Left . valToTerm) (vs ++ [v]) ++ map Left (e:es)
+    in  Just $ flip setTerm m $ TyApp (Prim NP.undefined) $
+          applyTypeToArgs (Prim p) tcm (primType p) (tyArgs ++ tmArgs)
+  | otherwise
+  = Just . setTerm e $ stackPush (PrimApply p tys (vs ++ [foldr TickValue v ts]) es) m
+
+newtype PrimEvalMonad a = PEM (State Supply a)
+  deriving (Functor, Applicative, Monad, MonadState Supply)
+
+instance MonadUnique PrimEvalMonad where
+  getUniqueM = PEM $ State.state (\s -> case freshId s of (!i,!s') -> (i,s'))
+
+runPEM :: PrimEvalMonad a -> Supply -> (a, Supply)
+runPEM (PEM m) = State.runState m
+
+ghcPrimStep :: PrimStep
+ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
+-----------------
+-- GHC.Prim.Char#
+-----------------
+  $(namePat 'GHC.Prim.gtChar#) | Just (i,j) <- charLiterals args
+    -> reduce (boolToIntLiteral (i > j))
+  $(namePat 'GHC.Prim.geChar#) | Just (i,j) <- charLiterals args
+    -> reduce (boolToIntLiteral (i >= j))
+  $(namePat 'GHC.Prim.eqChar#) | Just (i,j) <- charLiterals args
+    -> reduce (boolToIntLiteral (i == j))
+  $(namePat 'GHC.Prim.neChar#) | Just (i,j) <- charLiterals args
+    -> reduce (boolToIntLiteral (i /= j))
+  $(namePat 'GHC.Prim.ltChar#) | Just (i,j) <- charLiterals args
+    -> reduce (boolToIntLiteral (i < j))
+  $(namePat 'GHC.Prim.leChar#) | Just (i,j) <- charLiterals args
+    -> reduce (boolToIntLiteral (i <= j))
+  $(namePat 'GHC.Prim.ord#) | [i] <- charLiterals' args
+    -> reduce (integerToIntLiteral (toInteger $ ord i))
+
+----------------
+-- GHC.Prim.Int#
+----------------
+  $(namePat '(GHC.Prim.+#)) | Just (i,j) <- intLiterals args
+    -> reduce (integerToIntLiteral (i+j))
+  $(namePat '(GHC.Prim.-#)) | Just (i,j) <- intLiterals args
+    -> reduce (integerToIntLiteral (i-j))
+  $(namePat '(GHC.Prim.*#)) | Just (i,j) <- intLiterals args
+    -> reduce (integerToIntLiteral (i*j))
+
+  $(namePat 'GHC.Prim.mulIntMayOflo#) | Just (i,j) <- intLiterals  args
+    -> let !(I# a)  = fromInteger i
+           !(I# b)  = fromInteger j
+           c :: Int#
+           c = mulIntMayOflo# a b
+       in  reduce (integerToIntLiteral (toInteger $ I# c))
+
+  $(namePat 'GHC.Prim.quotInt#) | Just (i,j) <- intLiterals args
+    -> reduce $ catchDivByZero (integerToIntLiteral (i `quot` j))
+  $(namePat 'GHC.Prim.remInt#) | Just (i,j) <- intLiterals args
+    -> reduce $ catchDivByZero (integerToIntLiteral (i `rem` j))
+  $(namePat 'GHC.Prim.quotRemInt#) | Just (i,j) <- intLiterals args
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           (q,r)   = quotRem i j
+           ret     = mkApps (Data tupDc) (map Right tyArgs ++
+                    [Left $ catchDivByZero (integerToIntLiteral q)
+                    ,Left $ catchDivByZero (integerToIntLiteral r)])
+       in  reduce ret
+
+  $(namePat 'GHC.Prim.andI#) | Just (i,j) <- intLiterals args
+    -> reduce (integerToIntLiteral (i .&. j))
+  $(namePat 'GHC.Prim.orI#) | Just (i,j) <- intLiterals args
+    -> reduce (integerToIntLiteral (i .|. j))
+  $(namePat 'GHC.Prim.xorI#) | Just (i,j) <- intLiterals args
+    -> reduce (integerToIntLiteral (i `xor` j))
+  $(namePat 'GHC.Prim.notI#) | [i] <- intLiterals' args
+    -> reduce (integerToIntLiteral (complement i))
+
+  $(namePat 'GHC.Prim.negateInt#)
+    | [Lit (IntLiteral i)] <- args
+    -> reduce (integerToIntLiteral (negate i))
+
+  $(namePat 'GHC.Prim.addIntC#) | Just (i,j) <- intLiterals args
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           !(I# a)  = fromInteger i
+           !(I# b)  = fromInteger j
+           !(# d, c #) = addIntC# a b
+       in  reduce $
+           mkApps (Data tupDc) (map Right tyArgs ++
+                   [ Left (Literal . IntLiteral . toInteger $ I# d)
+                   , Left (Literal . IntLiteral . toInteger $ I# c)])
+  $(namePat 'GHC.Prim.subIntC#) | Just (i,j) <- intLiterals args
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           !(I# a)  = fromInteger i
+           !(I# b)  = fromInteger j
+           !(# d, c #) = subIntC# a b
+       in  reduce $
+           mkApps (Data tupDc) (map Right tyArgs ++
+                   [ Left (Literal . IntLiteral . toInteger $ I# d)
+                   , Left (Literal . IntLiteral . toInteger $ I# c)])
+
+  $(namePat '(GHC.Prim.>#)) | Just (i,j) <- intLiterals args
+    -> reduce (boolToIntLiteral (i > j))
+  $(namePat '(GHC.Prim.>=#)) | Just (i,j) <- intLiterals args
+    -> reduce (boolToIntLiteral (i >= j))
+  $(namePat '(GHC.Prim.==#)) | Just (i,j) <- intLiterals args
+    -> reduce (boolToIntLiteral (i == j))
+  $(namePat '(GHC.Prim./=#)) | Just (i,j) <- intLiterals args
+    -> reduce (boolToIntLiteral (i /= j))
+  $(namePat '(GHC.Prim.<#))| Just (i,j) <- intLiterals args
+    -> reduce (boolToIntLiteral (i < j))
+  $(namePat '(GHC.Prim.<=#)) | Just (i,j) <- intLiterals args
+    -> reduce (boolToIntLiteral (i <= j))
+
+  $(namePat 'GHC.Prim.chr#) | [i] <- intLiterals' args
+    -> reduce (charToCharLiteral (chr $ fromInteger i))
+
+  $(namePat 'GHC.Prim.int2Word#)
+    | [Lit (IntLiteral i)] <- args
+    -> reduce . Literal . WordLiteral . toInteger $ (fromInteger :: Integer -> Word) i -- for overflow behavior
+
+  $(namePat 'GHC.Prim.int2Float#)
+    | [Lit (IntLiteral i)] <- args
+    -> reduce . Literal . FloatLiteral  . floatToWord $ fromInteger i
+  $(namePat 'GHC.Prim.int2Double#)
+    | [Lit (IntLiteral i)] <- args
+    -> reduce . Literal . DoubleLiteral . doubleToWord $ fromInteger i
+
+  $(namePat 'GHC.Prim.word2Float#)
+    | [Lit (WordLiteral i)] <- args
+    -> reduce . Literal . FloatLiteral  . floatToWord $ fromInteger i
+  $(namePat 'GHC.Prim.word2Double#)
+    | [Lit (WordLiteral i)] <- args
+    -> reduce . Literal . DoubleLiteral . doubleToWord $ fromInteger i
+
+  $(namePat 'GHC.Prim.uncheckedIShiftL#)
+    | [ Lit (IntLiteral i)
+      , Lit (IntLiteral s)
+      ] <- args
+    -> reduce (integerToIntLiteral (i `shiftL` fromInteger s))
+  $(namePat 'GHC.Prim.uncheckedIShiftRA#)
+    | [ Lit (IntLiteral i)
+      , Lit (IntLiteral s)
+      ] <- args
+    -> reduce (integerToIntLiteral (i `shiftR` fromInteger s))
+  $(namePat 'GHC.Prim.uncheckedIShiftRL#) | Just (i,j) <- intLiterals args
+    -> let !(I# a)  = fromInteger i
+           !(I# b)  = fromInteger j
+           c :: Int#
+           c = uncheckedIShiftRL# a b
+       in  reduce (integerToIntLiteral (toInteger $ I# c))
+
+-----------------
+-- GHC.Prim.Word#
+-----------------
+  $(namePat 'GHC.Prim.plusWord#) | Just (i,j) <- wordLiterals args
+    -> reduce (integerToWordLiteral (i+j))
+
+  $(namePat 'GHC.Prim.subWordC#) | Just (i,j) <- wordLiterals args
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           !(W# a)  = fromInteger i
+           !(W# b)  = fromInteger j
+           !(# d, c #) = subWordC# a b
+       in  reduce $
+           mkApps (Data tupDc) (map Right tyArgs ++
+                   [ Left (Literal . WordLiteral . toInteger $ W# d)
+                   , Left (Literal . IntLiteral . toInteger $ I# c)])
+
+  $(namePat 'GHC.Prim.plusWord2#) | Just (i,j) <- wordLiterals args
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           !(W# a)  = fromInteger i
+           !(W# b)  = fromInteger j
+           !(# h', l #) = plusWord2# a b
+       in  reduce $
+           mkApps (Data tupDc) (map Right tyArgs ++
+                   [ Left (Literal . WordLiteral . toInteger $ W# h')
+                   , Left (Literal . WordLiteral . toInteger $ W# l)])
+
+  $(namePat 'GHC.Prim.minusWord#) | Just (i,j) <- wordLiterals args
+    -> reduce (integerToWordLiteral (i-j))
+  $(namePat 'GHC.Prim.timesWord#) | Just (i,j) <- wordLiterals args
+    -> reduce (integerToWordLiteral (i*j))
+
+  $(namePat 'GHC.Prim.timesWord2#) | Just (i,j) <- wordLiterals args
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           !(W# a)  = fromInteger i
+           !(W# b)  = fromInteger j
+           !(# h', l #) = timesWord2# a b
+       in  reduce $
+           mkApps (Data tupDc) (map Right tyArgs ++
+                   [ Left (Literal . WordLiteral . toInteger $ W# h')
+                   , Left (Literal . WordLiteral . toInteger $ W# l)])
+
+  $(namePat 'GHC.Prim.quotWord#) | Just (i,j) <- wordLiterals args
+    -> reduce $ catchDivByZero (integerToWordLiteral (i `quot` j))
+  $(namePat 'GHC.Prim.remWord#) | Just (i,j) <- wordLiterals args
+    -> reduce $ catchDivByZero (integerToWordLiteral (i `rem` j))
+  $(namePat 'GHC.Prim.quotRemWord#) | Just (i,j) <- wordLiterals args
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           (q,r)   = quotRem i j
+           ret     = mkApps (Data tupDc) (map Right tyArgs ++
+                    [Left $ catchDivByZero (integerToWordLiteral q)
+                    ,Left $ catchDivByZero (integerToWordLiteral r)])
+       in  reduce ret
+  $(namePat 'GHC.Prim.quotRemWord2#) | [i,j,k'] <- wordLiterals' args
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           !(W# a)  = fromInteger i
+           !(W# b)  = fromInteger j
+           !(W# c)  = fromInteger k'
+           !(# x, y #) = quotRemWord2# a b c
+       in  reduce $
+           mkApps (Data tupDc) (map Right tyArgs ++
+                   [ Left $ catchDivByZero (Literal . WordLiteral . toInteger $ W# x)
+                   , Left $ catchDivByZero (Literal . WordLiteral . toInteger $ W# y)])
+
+  $(namePat 'GHC.Prim.and#) | Just (i,j) <- wordLiterals args
+    -> reduce (integerToWordLiteral (i .&. j))
+  $(namePat 'GHC.Prim.or#) | Just (i,j) <- wordLiterals args
+    -> reduce (integerToWordLiteral (i .|. j))
+  $(namePat 'GHC.Prim.xor#) | Just (i,j) <- wordLiterals args
+    -> reduce (integerToWordLiteral (i `xor` j))
+  $(namePat 'GHC.Prim.not#) | [i] <- wordLiterals' args
+    -> reduce (integerToWordLiteral (complement i))
+
+  $(namePat 'GHC.Prim.uncheckedShiftL#)
+    | [ Lit (WordLiteral w)
+      , Lit (IntLiteral  i)
+      ] <- args
+    -> reduce (Literal (WordLiteral (w `shiftL` fromInteger i)))
+  $(namePat 'GHC.Prim.uncheckedShiftRL#)
+    | [ Lit (WordLiteral w)
+      , Lit (IntLiteral  i)
+      ] <- args
+    -> reduce (Literal (WordLiteral (w `shiftR` fromInteger i)))
+
+  $(namePat 'GHC.Prim.word2Int#)
+    | [Lit (WordLiteral i)] <- args
+    -> reduce . Literal . IntLiteral . toInteger $ (fromInteger :: Integer -> Int) i -- for overflow behavior
+
+  $(namePat 'GHC.Prim.gtWord#) | Just (i,j) <- wordLiterals args
+    -> reduce (boolToIntLiteral (i > j))
+  $(namePat 'GHC.Prim.geWord#) | Just (i,j) <- wordLiterals args
+    -> reduce (boolToIntLiteral (i >= j))
+  $(namePat 'GHC.Prim.eqWord#) | Just (i,j) <- wordLiterals args
+    -> reduce (boolToIntLiteral (i == j))
+  $(namePat 'GHC.Prim.neWord#) | Just (i,j) <- wordLiterals args
+    -> reduce (boolToIntLiteral (i /= j))
+  $(namePat 'GHC.Prim.ltWord#) | Just (i,j) <- wordLiterals args
+    -> reduce (boolToIntLiteral (i < j))
+  $(namePat 'GHC.Prim.leWord#) | Just (i,j) <- wordLiterals args
+    -> reduce (boolToIntLiteral (i <= j))
+
+  $(namePat 'GHC.Prim.popCnt8#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . popCount . (fromInteger :: Integer -> Word8) $ i
+  $(namePat 'GHC.Prim.popCnt16#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . popCount . (fromInteger :: Integer -> Word16) $ i
+  $(namePat 'GHC.Prim.popCnt32#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . popCount . (fromInteger :: Integer -> Word32) $ i
+  $(namePat 'GHC.Prim.popCnt64#) | [i] <- word64Literals' args
+    -> reduce . integerToWordLiteral . toInteger . popCount . (fromInteger :: Integer -> Word64) $ i
+  $(namePat 'GHC.Prim.popCnt#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . popCount . (fromInteger :: Integer -> Word) $ i
+
+  $(namePat 'GHC.Prim.clz8#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . countLeadingZeros . (fromInteger :: Integer -> Word8) $ i
+  $(namePat 'GHC.Prim.clz16#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . countLeadingZeros . (fromInteger :: Integer -> Word16) $ i
+  $(namePat 'GHC.Prim.clz32#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . countLeadingZeros . (fromInteger :: Integer -> Word32) $ i
+  $(namePat 'GHC.Prim.clz64#) | [i] <- word64Literals' args
+    -> reduce . integerToWordLiteral . toInteger . countLeadingZeros . (fromInteger :: Integer -> Word64) $ i
+  $(namePat 'GHC.Prim.clz#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . countLeadingZeros . (fromInteger :: Integer -> Word) $ i
+
+  $(namePat 'GHC.Prim.ctz8#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . countTrailingZeros . (fromInteger :: Integer -> Word) $ i .&. (bit 8 - 1)
+  $(namePat 'GHC.Prim.ctz16#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . countTrailingZeros . (fromInteger :: Integer -> Word) $ i .&. (bit 16 - 1)
+  $(namePat 'GHC.Prim.ctz32#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . countTrailingZeros . (fromInteger :: Integer -> Word) $ i .&. (bit 32 - 1)
+  $(namePat 'GHC.Prim.ctz64#) | [i] <- word64Literals' args
+    -> reduce . integerToWordLiteral . toInteger . countTrailingZeros . (fromInteger :: Integer -> Word64) $ i .&. (bit 64 - 1)
+  $(namePat 'GHC.Prim.ctz#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . countTrailingZeros . (fromInteger :: Integer -> Word) $ i
+
+  $(namePat 'GHC.Prim.byteSwap16#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . byteSwap16 . (fromInteger :: Integer -> Word16) $ i
+  $(namePat 'GHC.Prim.byteSwap32#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . byteSwap32 . (fromInteger :: Integer -> Word32) $ i
+  $(namePat 'GHC.Prim.byteSwap64#) | [i] <- word64Literals' args
+    -> reduce . integerToWordLiteral . toInteger . byteSwap64 . (fromInteger :: Integer -> Word64) $ i
+  $(namePat 'GHC.Prim.byteSwap#) | [i] <- wordLiterals' args -- assume 64bits
+    -> reduce . integerToWordLiteral . toInteger . byteSwap64 . (fromInteger :: Integer -> Word64) $ i
+
+#if MIN_VERSION_base(4,14,0)
+  $(namePat 'GHC.Prim.bitReverse#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . bitReverse64 . fromInteger $ i -- assume 64bits
+  $(namePat 'GHC.Prim.bitReverse8#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . bitReverse8 . fromInteger $ i
+  $(namePat 'GHC.Prim.bitReverse16#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . bitReverse16 . fromInteger $ i
+  $(namePat 'GHC.Prim.bitReverse32#) | [i] <- wordLiterals' args
+    -> reduce . integerToWordLiteral . toInteger . bitReverse32 . fromInteger $ i
+  $(namePat 'GHC.Prim.bitReverse64#) | [i] <- word64Literals' args
+    -> reduce . integerToWordLiteral . toInteger . bitReverse64 . fromInteger $ i
+#endif
+------------
+-- Narrowing
+------------
+  $(namePat 'GHC.Prim.narrow8Int#) | [i] <- intLiterals' args
+    -> let !(I# a)  = fromInteger i
+           b = narrow8Int# a
+       in  reduce . Literal . IntLiteral . toInteger $ I# b
+  $(namePat 'GHC.Prim.narrow16Int#) | [i] <- intLiterals' args
+    -> let !(I# a)  = fromInteger i
+           b = narrow16Int# a
+       in  reduce . Literal . IntLiteral . toInteger $ I# b
+  $(namePat 'GHC.Prim.narrow32Int#) | [i] <- intLiterals' args
+    -> let !(I# a)  = fromInteger i
+           b = narrow32Int# a
+       in  reduce . Literal . IntLiteral . toInteger $ I# b
+  $(namePat 'GHC.Prim.narrow8Word#) | [i] <- wordLiterals' args
+    -> let !(W# a)  = fromInteger i
+           b = narrow8Word# a
+       in  reduce . Literal . WordLiteral . toInteger $ W# b
+  $(namePat 'GHC.Prim.narrow16Word#) | [i] <- wordLiterals' args
+    -> let !(W# a)  = fromInteger i
+           b = narrow16Word# a
+       in  reduce . Literal . WordLiteral . toInteger $ W# b
+  $(namePat 'GHC.Prim.narrow32Word#) | [i] <- wordLiterals' args
+    -> let !(W# a)  = fromInteger i
+           b = narrow32Word# a
+       in  reduce . Literal . WordLiteral . toInteger $ W# b
+
+#if MIN_VERSION_base(4,16,0)
+--------
+-- Int8#
+--------
+  $(namePat 'GHC.Prim.intToInt8#) | [i] <- intLiterals' args
+    -> let !(I# a)  = fromInteger i
+           b = narrow8Int# a
+       in  reduce . Literal . Int8Literal . toInteger $ I# b
+  $(namePat 'GHC.Prim.int8ToInt#) | [i] <- int8Literals' args
+    -> reduce . Literal $ IntLiteral i
+  -- XXX: Primitive does not exist?
+  "GHC.Prim.negateInt8" | [i] <- int8Literals' args
+    -> let !(I8# a) = fromInteger i
+        in reduce (Literal (Int8Literal (toInteger (I8# (negateInt8# a)))))
+  $(namePat 'GHC.Prim.plusInt8#) | Just r <- liftI8 plusInt8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.subInt8#) | Just r <- liftI8 subInt8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.timesInt8#) | Just r <- liftI8 timesInt8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.quotInt8#) | Just r <- liftI8 quotInt8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.remInt8#) | Just r <- liftI8 remInt8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.quotRemInt8#)
+    | [i, j] <- int8Literals' args
+    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
+    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
+    , [tupDc] <- tyConDataCons tupTc
+    -> let !(I8# a)    = fromInteger i
+           !(I8# b)    = fromInteger j
+           !(# q, r #) = quotRemInt8# a b
+        in reduce $
+           mkApps (Data tupDc) (map Right tyArgs ++
+                  [ Left (Literal (Int8Literal (toInteger (I8# q))))
+                  , Left (Literal (Int8Literal (toInteger (I8# r))))])
+  $(namePat 'GHC.Prim.uncheckedShiftLInt8#) | Just r <- liftI8I uncheckedShiftLInt8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.uncheckedShiftRAInt8#) | Just r <- liftI8I uncheckedShiftRAInt8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.uncheckedShiftRLInt8#) | Just r <- liftI8I uncheckedShiftRLInt8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.int8ToWord8#) | [i] <- int8Literals' args
+    -> let !(I8# a) = fromInteger i
+        in reduce (Literal (Word8Literal (toInteger (W8# (int8ToWord8# a)))))
+  $(namePat 'GHC.Prim.eqInt8#) | Just r <- liftI8RI eqInt8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.geInt8#) | Just r <- liftI8RI geInt8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.gtInt8#) | Just r <- liftI8RI gtInt8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.leInt8#) | Just r <- liftI8RI leInt8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.ltInt8#) | Just r <- liftI8RI ltInt8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.neInt8#) | Just r <- liftI8RI neInt8# args
+    -> reduce r
+
+---------
+-- Int16#
+---------
+  $(namePat 'GHC.Prim.intToInt16#) | [i] <- intLiterals' args
+    -> let !(I# a)  = fromInteger i
+           b = narrow16Int# a
+       in  reduce . Literal . Int16Literal . toInteger $ I# b
+  $(namePat 'GHC.Prim.int16ToInt#) | [i] <- int16Literals' args
+    -> reduce . Literal $ IntLiteral i
+  -- XXX: Primitive does not exist?
+  "GHC.Prim.negateInt16" | [i] <- int16Literals' args
+    -> let !(I16# a) = fromInteger i
+        in reduce (Literal (Int16Literal (toInteger (I16# (negateInt16# a)))))
+  $(namePat 'GHC.Prim.plusInt16#) | Just r <- liftI16 plusInt16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.subInt16#) | Just r <- liftI16 subInt16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.timesInt16#) | Just r <- liftI16 timesInt16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.quotInt16#) | Just r <- liftI16 quotInt16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.remInt16#) | Just r <- liftI16 remInt16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.quotRemInt16#)
+    | [i, j] <- int16Literals' args
+    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
+    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
+    , [tupDc] <- tyConDataCons tupTc
+    -> let !(I16# a)   = fromInteger i
+           !(I16# b)   = fromInteger j
+           !(# q, r #) = quotRemInt16# a b
+        in reduce $
+           mkApps (Data tupDc) (map Right tyArgs ++
+                  [ Left (Literal (Int16Literal (toInteger (I16# q))))
+                  , Left (Literal (Int16Literal (toInteger (I16# r))))])
+  $(namePat 'GHC.Prim.uncheckedShiftLInt16#) | Just r <- liftI16I uncheckedShiftLInt16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.uncheckedShiftRAInt16#) | Just r <- liftI16I uncheckedShiftRAInt16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.uncheckedShiftRLInt16#) | Just r <- liftI16I uncheckedShiftRLInt16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.int16ToWord16#) | [i] <- int16Literals' args
+    -> let !(I16# a) = fromInteger i
+        in reduce (Literal (Word16Literal (toInteger (W16# (int16ToWord16# a)))))
+  $(namePat 'GHC.Prim.eqInt16#) | Just r <- liftI16RI eqInt16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.geInt16#) | Just r <- liftI16RI geInt16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.gtInt16#) | Just r <- liftI16RI gtInt16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.leInt16#) | Just r <- liftI16RI leInt16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.ltInt16#) | Just r <- liftI16RI ltInt16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.neInt16#) | Just r <- liftI16RI neInt16# args
+    -> reduce r
+
+---------
+-- Int32#
+---------
+  $(namePat 'GHC.Prim.intToInt32#) | [i] <- intLiterals' args
+    -> let !(I# a)  = fromInteger i
+           b = narrow32Int# a
+       in  reduce . Literal . Int32Literal . toInteger $ I# b
+  $(namePat 'GHC.Prim.int32ToInt#) | [i] <- int32Literals' args
+    -> reduce . Literal $ IntLiteral i
+  -- XXX: Primitive does not exist?
+  "GHC.Prim.negateInt32" | [i] <- int32Literals' args
+    -> let !(I32# a) = fromInteger i
+        in reduce (Literal (Int32Literal (toInteger (I32# (negateInt32# a)))))
+  $(namePat 'GHC.Prim.plusInt32#) | Just r <- liftI32 plusInt32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.subInt32#) | Just r <- liftI32 subInt32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.timesInt32#) | Just r <- liftI32 timesInt32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.quotInt32#) | Just r <- liftI32 quotInt32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.remInt32#) | Just r <- liftI32 remInt32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.quotRemInt32#)
+    | [i, j] <- int32Literals' args
+    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
+    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
+    , [tupDc] <- tyConDataCons tupTc
+    -> let !(I32# a)   = fromInteger i
+           !(I32# b)   = fromInteger j
+           !(# q, r #) = quotRemInt32# a b
+        in reduce $
+           mkApps (Data tupDc) (map Right tyArgs ++
+                  [ Left (Literal (Int32Literal (toInteger (I32# q))))
+                  , Left (Literal (Int32Literal (toInteger (I32# r))))])
+  $(namePat 'GHC.Prim.uncheckedShiftLInt32#) | Just r <- liftI32I uncheckedShiftLInt32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.uncheckedShiftRAInt32#) | Just r <- liftI32I uncheckedShiftRAInt32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.uncheckedShiftRLInt32#) | Just r <- liftI32I uncheckedShiftRLInt32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.int32ToWord32#) | [i] <- int32Literals' args
+    -> let !(I32# a) = fromInteger i
+        in reduce (Literal (Word32Literal (toInteger (W32# (int32ToWord32# a)))))
+  $(namePat 'GHC.Prim.eqInt32#) | Just r <- liftI32RI eqInt32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.geInt32#) | Just r <- liftI32RI geInt32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.gtInt32#) | Just r <- liftI32RI gtInt32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.leInt32#) | Just r <- liftI32RI leInt32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.ltInt32#) | Just r <- liftI32RI ltInt32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.neInt32#) | Just r <- liftI32RI neInt32# args
+    -> reduce r
+
+---------
+-- Int64#
+---------
+#if MIN_VERSION_base(4,17,0)
+  $(namePat 'GHC.Prim.intToInt64#) | [i] <- intLiterals' args
+    -> reduce (Literal (Int64Literal i))
+  $(namePat 'GHC.Prim.int64ToInt#) | [i] <- int64Literals' args
+    -> reduce . Literal $ IntLiteral i
+  -- XXX: Primitive does not exist?
+  "GHC.Prim.negateInt64" | [i] <- int64Literals' args
+    -> let !(I64# a) = fromInteger i
+        in reduce (Literal (Int64Literal (toInteger (I64# (negateInt64# a)))))
+  $(namePat 'GHC.Prim.plusInt64#) | Just r <- liftI64 plusInt64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.subInt64#) | Just r <- liftI64 subInt64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.timesInt64#) | Just r <- liftI64 timesInt64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.quotInt64#) | Just r <- liftI64 quotInt64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.remInt64#) | Just r <- liftI64 remInt64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.uncheckedIShiftL64#) | Just r <- liftI64I uncheckedIShiftL64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.uncheckedIShiftRA64#) | Just r <- liftI64I uncheckedIShiftRA64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.uncheckedIShiftRL64#) | Just r <- liftI64I uncheckedIShiftRL64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.int64ToWord64#) | [i] <- int64Literals' args
+    -> let !(I64# a) = fromInteger i
+        in reduce (Literal (Word64Literal (toInteger (W64# (int64ToWord64# a)))))
+  $(namePat 'GHC.Prim.eqInt64#) | Just r <- liftI64RI eqInt64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.geInt64#) | Just r <- liftI64RI geInt64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.gtInt64#) | Just r <- liftI64RI gtInt64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.leInt64#) | Just r <- liftI64RI leInt64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.ltInt64#) | Just r <- liftI64RI ltInt64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.neInt64#) | Just r <- liftI64RI neInt64# args
+    -> reduce r
+#endif
+
+---------
+-- Word8#
+---------
+  $(namePat 'GHC.Prim.wordToWord8#) | [i] <- wordLiterals' args
+    -> let !(W# a)  = fromInteger i
+           b = narrow8Word# a
+       in  reduce . Literal . Word8Literal . toInteger $ W# b
+  $(namePat 'GHC.Prim.word8ToWord#) | [i] <- word8Literals' args
+    -> reduce . Literal $ WordLiteral i
+  $(namePat 'GHC.Prim.plusWord8#) | Just r <- liftW8 plusWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.subWord8#) | Just r <- liftW8 subWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.timesWord8#) | Just r <- liftW8 timesWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.quotWord8#) | Just r <- liftW8 quotWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.remWord8#) | Just r <- liftW8 remWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.quotRemWord8#)
+    | [i, j] <- word8Literals' args
+    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
+    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
+    , [tupDc] <- tyConDataCons tupTc
+    -> let !(W8# a)    = fromInteger i
+           !(W8# b)    = fromInteger j
+           !(# q, r #) = quotRemWord8# a b
+        in reduce $
+           mkApps (Data tupDc) (map Right tyArgs ++
+                  [ Left (Literal (Word8Literal (toInteger (W8# q))))
+                  , Left (Literal (Word8Literal (toInteger (W8# r))))])
+  $(namePat 'GHC.Prim.andWord8#) | Just r <- liftW8 andWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.orWord8#) | Just r <- liftW8 orWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.xorWord8#) | Just r <- liftW8 xorWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.notWord8#) | [i] <- word8Literals' args
+    -> let !(W8# a) = fromInteger i
+        in reduce (Literal (Word8Literal (toInteger (W8# (notWord8# a)))))
+  $(namePat 'GHC.Prim.uncheckedShiftLWord8#) | Just r <- liftW8I uncheckedShiftLWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.uncheckedShiftRLWord8#) | Just r <- liftW8I uncheckedShiftRLWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.word8ToInt8#) | [i] <- word8Literals' args
+    -> let !(W8# a) = fromInteger i
+        in reduce (Literal (Int8Literal (toInteger (I8# (word8ToInt8# a)))))
+  $(namePat 'GHC.Prim.eqWord8#) | Just r <- liftW8RI eqWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.geWord8#) | Just r <- liftW8RI geWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.gtWord8#) | Just r <- liftW8RI gtWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.leWord8#) | Just r <- liftW8RI leWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.ltWord8#) | Just r <- liftW8RI ltWord8# args
+    -> reduce r
+  $(namePat 'GHC.Prim.neWord8#) | Just r <- liftW8RI neWord8# args
+    -> reduce r
+
+----------
+-- Word16#
+----------
+  $(namePat 'GHC.Prim.wordToWord16#) | [i] <- wordLiterals' args
+    -> let !(W# a)  = fromInteger i
+           b = narrow16Word# a
+       in  reduce . Literal . Word16Literal . toInteger $ W# b
+  $(namePat 'GHC.Prim.word16ToWord#) | [i] <- word16Literals' args
+    -> reduce . Literal $ WordLiteral i
+  $(namePat 'GHC.Prim.plusWord16#) | Just r <- liftW16 plusWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.subWord16#) | Just r <- liftW16 subWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.timesWord16#) | Just r <- liftW16 timesWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.quotWord16#) | Just r <- liftW16 quotWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.remWord16#) | Just r <- liftW16 remWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.quotRemWord16#)
+    | [i, j] <- word16Literals' args
+    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
+    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
+    , [tupDc] <- tyConDataCons tupTc
+    -> let !(W16# a)    = fromInteger i
+           !(W16# b)    = fromInteger j
+           !(# q, r #) = quotRemWord16# a b
+        in reduce $
+           mkApps (Data tupDc) (map Right tyArgs ++
+                  [ Left (Literal (Word16Literal (toInteger (W16# q))))
+                  , Left (Literal (Word16Literal (toInteger (W16# r))))])
+  $(namePat 'GHC.Prim.andWord16#) | Just r <- liftW16 andWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.orWord16#) | Just r <- liftW16 orWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.xorWord16#) | Just r <- liftW16 xorWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.notWord16#) | [i] <- word16Literals' args
+    -> let !(W16# a) = fromInteger i
+        in reduce (Literal (Word16Literal (toInteger (W16# (notWord16# a)))))
+  $(namePat 'GHC.Prim.uncheckedShiftLWord16#) | Just r <- liftW16I uncheckedShiftLWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.uncheckedShiftRLWord16#) | Just r <- liftW16I uncheckedShiftRLWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.word16ToInt16#) | [i] <- word16Literals' args
+    -> let !(W16# a) = fromInteger i
+        in reduce (Literal (Int16Literal (toInteger (I16# (word16ToInt16# a)))))
+  $(namePat 'GHC.Prim.eqWord16#) | Just r <- liftW16RI eqWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.geWord16#) | Just r <- liftW16RI geWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.gtWord16#) | Just r <- liftW16RI gtWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.leWord16#) | Just r <- liftW16RI leWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.ltWord16#) | Just r <- liftW16RI ltWord16# args
+    -> reduce r
+  $(namePat 'GHC.Prim.neWord16#) | Just r <- liftW16RI neWord16# args
+    -> reduce r
+
+----------
+-- Word32#
+----------
+  $(namePat 'GHC.Prim.wordToWord32#) | [i] <- wordLiterals' args
+    -> let !(W# a)  = fromInteger i
+           b = narrow32Word# a
+       in  reduce . Literal . Word32Literal . toInteger $ W# b
+  $(namePat 'GHC.Prim.word32ToWord#) | [i] <- word32Literals' args
+    -> reduce . Literal $ WordLiteral i
+  $(namePat 'GHC.Prim.plusWord32#) | Just r <- liftW32 plusWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.subWord32#) | Just r <- liftW32 subWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.timesWord32#) | Just r <- liftW32 timesWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.quotWord32#) | Just r <- liftW32 quotWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.remWord32#) | Just r <- liftW32 remWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.quotRemWord32#)
+    | [i, j] <- word32Literals' args
+    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
+    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
+    , [tupDc] <- tyConDataCons tupTc
+    -> let !(W32# a)    = fromInteger i
+           !(W32# b)    = fromInteger j
+           !(# q, r #) = quotRemWord32# a b
+        in reduce $
+           mkApps (Data tupDc) (map Right tyArgs ++
+                  [ Left (Literal (Word32Literal (toInteger (W32# q))))
+                  , Left (Literal (Word32Literal (toInteger (W32# r))))])
+  $(namePat 'GHC.Prim.andWord32#) | Just r <- liftW32 andWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.orWord32#) | Just r <- liftW32 orWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.xorWord32#) | Just r <- liftW32 xorWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.notWord32#) | [i] <- word32Literals' args
+    -> let !(W32# a) = fromInteger i
+        in reduce (Literal (Word32Literal (toInteger (W32# (notWord32# a)))))
+  $(namePat 'GHC.Prim.uncheckedShiftLWord32#) | Just r <- liftW32I uncheckedShiftLWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.uncheckedShiftRLWord32#) | Just r <- liftW32I uncheckedShiftRLWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.word32ToInt32#) | [i] <- word32Literals' args
+    -> let !(W32# a) = fromInteger i
+        in reduce (Literal (Int32Literal (toInteger (I32# (word32ToInt32# a)))))
+  $(namePat 'GHC.Prim.eqWord32#) | Just r <- liftW32RI eqWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.geWord32#) | Just r <- liftW32RI geWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.gtWord32#) | Just r <- liftW32RI gtWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.leWord32#) | Just r <- liftW32RI leWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.ltWord32#) | Just r <- liftW32RI ltWord32# args
+    -> reduce r
+  $(namePat 'GHC.Prim.neWord32#) | Just r <- liftW32RI neWord32# args
+    -> reduce r
+
+#if MIN_VERSION_base(4,17,0)
+----------
+-- Word64#
+----------
+  $(namePat 'GHC.Prim.wordToWord64#) | [i] <- wordLiterals' args
+    -> reduce (Literal (Word64Literal i))
+  $(namePat 'GHC.Prim.word64ToWord#) | [i] <- word64Literals' args
+    -> reduce . Literal $ WordLiteral i
+  $(namePat 'GHC.Prim.plusWord64#) | Just r <- liftW64 plusWord64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.subWord64#) | Just r <- liftW64 subWord64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.timesWord64#) | Just r <- liftW64 timesWord64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.quotWord64#) | Just r <- liftW64 quotWord64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.remWord64#) | Just r <- liftW64 remWord64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.and64#) | Just r <- liftW64 and64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.or64#) | Just r <- liftW64 or64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.xor64#) | Just r <- liftW64 xor64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.not64#) | [i] <- word64Literals' args
+    -> let !(W64# a) = fromInteger i
+        in reduce (Literal (Word64Literal (toInteger (W64# (not64# a)))))
+  $(namePat 'GHC.Prim.uncheckedShiftL64#) | Just r <- liftW64I uncheckedShiftL64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.uncheckedShiftRL64#) | Just r <- liftW64I uncheckedShiftRL64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.word64ToInt64#) | [i] <- word64Literals' args
+    -> let !(W64# a) = fromInteger i
+        in reduce (Literal (Int64Literal (toInteger (I64# (word64ToInt64# a)))))
+  $(namePat 'GHC.Prim.eqWord64#) | Just r <- liftW64RI eqWord64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.geWord64#) | Just r <- liftW64RI geWord64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.gtWord64#) | Just r <- liftW64RI gtWord64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.leWord64#) | Just r <- liftW64RI leWord64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.ltWord64#) | Just r <- liftW64RI ltWord64# args
+    -> reduce r
+  $(namePat 'GHC.Prim.neWord64#) | Just r <- liftW64RI neWord64# args
+    -> reduce r
+#endif
+#endif
+
+----------
+-- Double#
+----------
+  $(namePat '(GHC.Prim.>##))  | Just r <- liftDDI (>##)  args
+    -> reduce r
+  $(namePat '(GHC.Prim.>=##)) | Just r <- liftDDI (>=##) args
+    -> reduce r
+  $(namePat '(GHC.Prim.==##)) | Just r <- liftDDI (==##) args
+    -> reduce r
+  $(namePat '(GHC.Prim./=##)) | Just r <- liftDDI (/=##) args
+    -> reduce r
+  $(namePat '(GHC.Prim.<##))  | Just r <- liftDDI (<##)  args
+    -> reduce r
+  $(namePat '(GHC.Prim.<=##)) | Just r <- liftDDI (<=##) args
+    -> reduce r
+  $(namePat '(GHC.Prim.+##))  | Just r <- liftDDD (+##)  args
+    -> reduce r
+  $(namePat '(GHC.Prim.-##))  | Just r <- liftDDD (-##)  args
+    -> reduce r
+  $(namePat '(GHC.Prim.*##))  | Just r <- liftDDD (*##)  args
+    -> reduce r
+  $(namePat '(GHC.Prim./##))  | Just r <- liftDDD (/##)  args
+    -> reduce r
+
+  $(namePat 'GHC.Prim.negateDouble#) | Just r <- liftDD negateDouble# args
+    -> reduce r
+  $(namePat 'GHC.Prim.fabsDouble#) | Just r <- liftDD fabsDouble# args
+    -> reduce r
+
+  $(namePat 'GHC.Prim.double2Int#) | [i] <- doubleLiterals' args
+    -> let !(D# a) = wordToDouble i
+           r = double2Int# a
+       in  reduce . Literal . IntLiteral . toInteger $ I# r
+  $(namePat 'GHC.Prim.double2Float#)
+    | [Lit (DoubleLiteral d)] <- args
+    -> let !(D# a) = wordToDouble d
+           r = double2Float# a
+       in reduce . Literal . FloatLiteral . floatToWord $ F# r
+
+  $(namePat 'GHC.Prim.expDouble#) | Just r <- liftDD expDouble# args
+    -> reduce r
+  $(namePat 'GHC.Prim.logDouble#) | Just r <- liftDD logDouble# args
+    -> reduce r
+  $(namePat 'GHC.Prim.sqrtDouble#) | Just r <- liftDD sqrtDouble# args
+    -> reduce r
+  $(namePat 'GHC.Prim.sinDouble#) | Just r <- liftDD sinDouble# args
+    -> reduce r
+  $(namePat 'GHC.Prim.cosDouble#) | Just r <- liftDD cosDouble# args
+    -> reduce r
+  $(namePat 'GHC.Prim.tanDouble#) | Just r <- liftDD tanDouble# args
+    -> reduce r
+  $(namePat 'GHC.Prim.asinDouble#) | Just r <- liftDD asinDouble# args
+    -> reduce r
+  $(namePat 'GHC.Prim.acosDouble#) | Just r <- liftDD acosDouble# args
+    -> reduce r
+  $(namePat 'GHC.Prim.atanDouble#) | Just r <- liftDD atanDouble# args
+    -> reduce r
+  $(namePat 'GHC.Prim.sinhDouble#) | Just r <- liftDD sinhDouble# args
+    -> reduce r
+  $(namePat 'GHC.Prim.coshDouble#) | Just r <- liftDD coshDouble# args
+    -> reduce r
+  $(namePat 'GHC.Prim.tanhDouble#) | Just r <- liftDD tanhDouble# args
+    -> reduce r
+
+#if MIN_VERSION_ghc(8,7,0)
+  $(namePat 'GHC.Prim.asinhDouble#)  | Just r <- liftDD asinhDouble# args
+    -> reduce r
+  $(namePat 'GHC.Prim.acoshDouble#)  | Just r <- liftDD acoshDouble# args
+    -> reduce r
+  $(namePat 'GHC.Prim.atanhDouble#)  | Just r <- liftDD atanhDouble# args
+    -> reduce r
+#endif
+
+  $(namePat '(GHC.Prim.**##)) | Just r <- liftDDD (**##) args
+    -> reduce r
+-- decodeDouble_2Int# :: Double# -> (#Int#, Word#, Word#, Int##)
+  $(namePat 'GHC.Prim.decodeDouble_2Int#) | [i] <- doubleLiterals' args
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           !(D# a) = wordToDouble i
+           !(# p, q, r, s #) = decodeDouble_2Int# a
+       in reduce $
+          mkApps (Data tupDc) (map Right tyArgs ++
+                   [ Left (Literal . IntLiteral  . toInteger $ I# p)
+                   , Left (Literal . WordLiteral . toInteger $ W# q)
+                   , Left (Literal . WordLiteral . toInteger $ W# r)
+                   , Left (Literal . IntLiteral  . toInteger $ I# s)])
+-- decodeDouble_Int64# :: Double# -> (# Int64#, Int# #)
+  $(namePat 'GHC.Prim.decodeDouble_Int64#) | [i] <- doubleLiterals' args
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           !(D# a) = wordToDouble i
+           !(# p, q #) = decodeDouble_Int64# a
+       in reduce $
+          mkApps (Data tupDc) (map Right tyArgs ++
+#if MIN_VERSION_ghc_prim(0,9,0)
+                   [ Left (Literal . Int64Literal  . toInteger $ I64# p)
+#else
+                   [ Left (Literal . IntLiteral  . toInteger $ I64# p)
+#endif
+                   , Left (Literal . IntLiteral  . toInteger $ I# q)])
+
+--------
+-- Float
+--------
+  $(namePat 'GHC.Prim.gtFloat#)  | Just r <- liftFFI gtFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.geFloat#)  | Just r <- liftFFI geFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.eqFloat#)  | Just r <- liftFFI eqFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.neFloat#)  | Just r <- liftFFI neFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.ltFloat#)  | Just r <- liftFFI ltFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.leFloat#)  | Just r <- liftFFI leFloat# args
+    -> reduce r
+
+  $(namePat 'GHC.Prim.plusFloat#)  | Just r <- liftFFF plusFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.minusFloat#)  | Just r <- liftFFF minusFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.timesFloat#)  | Just r <- liftFFF timesFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.divideFloat#)  | Just r <- liftFFF divideFloat# args
+    -> reduce r
+
+  $(namePat 'GHC.Prim.negateFloat#)  | Just r <- liftFF negateFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.fabsFloat#)  | Just r <- liftFF fabsFloat# args
+    -> reduce r
+
+  $(namePat 'GHC.Prim.float2Int#) | [i] <- floatLiterals' args
+    -> let !(F# a) = wordToFloat i
+           r = float2Int# a
+       in  reduce . Literal . IntLiteral . toInteger $ I# r
+
+  $(namePat 'GHC.Prim.expFloat#)  | Just r <- liftFF expFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.logFloat#)  | Just r <- liftFF logFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.sqrtFloat#)  | Just r <- liftFF sqrtFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.sinFloat#)  | Just r <- liftFF sinFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.cosFloat#)  | Just r <- liftFF cosFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.tanFloat#)  | Just r <- liftFF tanFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.asinFloat#)  | Just r <- liftFF asinFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.acosFloat#)  | Just r <- liftFF acosFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.atanFloat#)  | Just r <- liftFF atanFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.sinhFloat#)  | Just r <- liftFF sinhFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.coshFloat#)  | Just r <- liftFF coshFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.tanhFloat#)  | Just r <- liftFF tanhFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.powerFloat#)  | Just r <- liftFFF powerFloat# args
+    -> reduce r
+
+  -- GHC.Float.asinh  -- XXX: Very fragile
+  --  $w$casinh is the Double specialisation of asinh
+  --  $w$casinh1 is the Float specialisation of asinh
+  "GHC.Float.$w$casinh" | Just r <- liftDD go args
+    -> reduce r
+    where go f = case asinh (D# f) of
+                   D# f' -> f'
+  "GHC.Float.$w$casinh1" | Just r <- liftFF go args
+    -> reduce r
+    where go f = case asinh (F# f) of
+                   F# f' -> f'
+
+#if MIN_VERSION_ghc(8,7,0)
+  $(namePat 'GHC.Prim.asinhFloat#)  | Just r <- liftFF asinhFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.acoshFloat#)  | Just r <- liftFF acoshFloat# args
+    -> reduce r
+  $(namePat 'GHC.Prim.atanhFloat#)  | Just r <- liftFF atanhFloat# args
+    -> reduce r
+#endif
+
+  $(namePat 'GHC.Prim.float2Double#) | [i] <- floatLiterals' args
+    -> let !(F# a) = wordToFloat i
+           r = float2Double# a
+       in  reduce . Literal . DoubleLiteral . doubleToWord $ D# r
+
+
+  $(namePat 'GHC.Prim.newByteArray#)
+    | [iV,PrimVal rwTy _ _] <- args
+    , [i] <- intLiterals' [iV]
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           p = primCount mach
+           lit = Literal (ByteArrayLiteral (fromList (List.genericReplicate i 0)))
+           mbaTy = mkFunTy intPrimTy (last tyArgs)
+           newE = mkApps (Data tupDc) (map Right tyArgs ++
+                    [Left (Prim rwTy)
+                    ,Left (mkApps (Prim (PrimInfo (showt ''MutableByteArray#) mbaTy WorkNever SingleResult NoUnfolding))
+                                  [Left (Literal . IntLiteral $ toInteger p)])
+                    ])
+       in Just . setTerm newE $ primInsert p lit mach
+
+  $(namePat 'GHC.Prim.setByteArray#)
+    | [PrimVal _mbaTy _ [baV]
+      ,offV,lenV,cV
+      ,PrimVal rwTy _ _
+      ] <- args
+    , [ba,off,len,c] <- intLiterals' [baV,offV,lenV,cV]
+    -> let Just (Literal (ByteArrayLiteral ba1)) =
+              primLookup (fromInteger ba) mach
+           !(I# off') = fromInteger off
+           !(I# len') = fromInteger len
+           !(I# c')   = fromInteger c
+           ba2 = unsafeDupablePerformIO $ do
+                  BA.MutableByteArray mba <- BA.unsafeThawByteArray ba1
+                  svoid (setByteArray# mba off' len' c')
+                  BA.unsafeFreezeByteArray (BA.MutableByteArray mba)
+           ba3 = Literal (ByteArrayLiteral ba2)
+       in Just . setTerm (Prim rwTy) $ primUpdate (fromInteger ba) ba3 mach
+
+  $(namePat 'GHC.Prim.writeWordArray#)
+    | [PrimVal _mbaTy _  [baV]
+      ,iV,wV
+      ,PrimVal rwTy _ _
+      ] <- args
+    , [ba,i] <- intLiterals' [baV,iV]
+    , [w] <- wordLiterals' [wV]
+    -> let Just (Literal (ByteArrayLiteral ba1)) =
+              primLookup (fromInteger ba) mach
+           !(I# i') = fromInteger i
+           !(W# w') = fromIntegral w
+           ba2 = unsafeDupablePerformIO $ do
+                  BA.MutableByteArray mba <- BA.unsafeThawByteArray ba1
+                  svoid (writeWordArray# mba i' w')
+                  BA.unsafeFreezeByteArray (BA.MutableByteArray mba)
+           ba3 = Literal (ByteArrayLiteral ba2)
+       in Just . setTerm (Prim rwTy) $ primUpdate (fromInteger ba) ba3 mach
+
+  $(namePat 'GHC.Prim.unsafeFreezeByteArray#)
+    | [PrimVal _mbaTy _ [baV]
+      ,PrimVal rwTy _ _
+      ] <- args
+    , [ba] <-  intLiterals' [baV]
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           Just ba' = primLookup (fromInteger ba) mach
+       in  reduce $ mkApps (Data tupDc) (map Right tyArgs ++
+                      [Left (Prim rwTy)
+                      ,Left ba'])
+
+  $(namePat 'GHC.Prim.sizeofByteArray#)
+    | [Lit (ByteArrayLiteral ba)] <- args
+    -> reduce (Literal (IntLiteral (toInteger (BA.sizeofByteArray ba))))
+
+  $(namePat 'GHC.Prim.indexWordArray#)
+    | [Lit (ByteArrayLiteral (BA.ByteArray ba)),iV] <- args
+    , [i] <- intLiterals' [iV]
+    -> let !(I# i') = fromInteger i
+           !w       = indexWordArray# ba i'
+       in  reduce (Literal (WordLiteral (toInteger (W# w))))
+
+  -- XXX: Primitive does not exist?
+  "GHC.Prim.getSizeofMutBigNat#"
+    | [PrimVal _mbaTy _ [baV]
+      ,PrimVal rwTy _ _
+      ] <- args
+    , [ba] <- intLiterals' [baV]
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           Just (Literal (ByteArrayLiteral ba')) = primLookup (fromInteger ba) mach
+           lit = Literal (IntLiteral (toInteger (BA.sizeofByteArray ba')))
+       in  reduce $ mkApps (Data tupDc) (map Right tyArgs ++
+                      [Left (Prim rwTy)
+                      ,Left lit])
+
+  $(namePat 'GHC.Prim.resizeMutableByteArray#)
+    | [PrimVal mbaTy _ [baV]
+      ,iV
+      ,PrimVal rwTy _ _
+      ] <- args
+    , [ba,i] <- intLiterals' [baV,iV]
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           p = primCount mach
+           Just (Literal (ByteArrayLiteral ba1))
+            = primLookup (fromInteger ba) mach
+           !(I# i') = fromInteger i
+           ba2 = unsafeDupablePerformIO $ do
+                   BA.MutableByteArray mba <- BA.unsafeThawByteArray ba1
+                   mba' <- IO (\s -> case resizeMutableByteArray# mba i' s of
+                                 (# s', mba' #) -> (# s', BA.MutableByteArray mba' #))
+                   BA.unsafeFreezeByteArray mba'
+           ba3 = Literal (ByteArrayLiteral ba2)
+           newE = mkApps (Data tupDc) (map Right tyArgs ++
+                    [Left (Prim rwTy)
+                    ,Left (mkApps (Prim mbaTy)
+                                  [Left (Literal . IntLiteral $ toInteger p)])
+                    ])
+       in Just . setTerm newE $ primInsert p ba3 mach
+
+  $(namePat 'GHC.Prim.shrinkMutableByteArray#)
+    | [PrimVal _mbaTy _ [baV]
+      ,lenV
+      ,PrimVal rwTy _ _
+      ] <- args
+    , [ba,len] <- intLiterals' [baV,lenV]
+    -> let Just (Literal (ByteArrayLiteral ba1)) =
+              primLookup (fromInteger ba) mach
+           !(I# len') = fromInteger len
+           ba2 = unsafeDupablePerformIO $ do
+                  BA.MutableByteArray mba <- BA.unsafeThawByteArray ba1
+                  svoid (shrinkMutableByteArray# mba len')
+                  BA.unsafeFreezeByteArray (BA.MutableByteArray mba)
+           ba3 = Literal (ByteArrayLiteral ba2)
+       in Just . setTerm (Prim rwTy) $ primUpdate (fromInteger ba) ba3 mach
+
+  $(namePat 'GHC.Prim.copyByteArray#)
+    | [Lit (ByteArrayLiteral (BA.ByteArray src_ba))
+      ,src_offV
+      ,PrimVal _mbaTy _ [dst_mbaV]
+      ,dst_offV, nV
+      ,PrimVal rwTy _ _
+      ] <- args
+    , [src_off,dst_mba,dst_off,n] <- intLiterals' [src_offV,dst_mbaV,dst_offV,nV]
+    -> let Just (Literal (ByteArrayLiteral dst_ba)) =
+              primLookup (fromInteger dst_mba) mach
+           !(I# src_off') = fromInteger src_off
+           !(I# dst_off') = fromInteger dst_off
+           !(I# n')       = fromInteger n
+           ba2 = unsafeDupablePerformIO $ do
+                  BA.MutableByteArray dst_mba1 <- BA.unsafeThawByteArray dst_ba
+                  svoid (copyByteArray# src_ba src_off' dst_mba1 dst_off' n')
+                  BA.unsafeFreezeByteArray (BA.MutableByteArray dst_mba1)
+           ba3 = Literal (ByteArrayLiteral ba2)
+       in Just . setTerm (Prim rwTy) $ primUpdate (fromInteger dst_mba) ba3 mach
+
+  $(namePat 'GHC.Prim.readWordArray#)
+    | [PrimVal _mbaTy _  [baV]
+      ,offV
+      ,PrimVal rwTy _ _
+      ] <- args
+    , [ba,off] <- intLiterals' [baV,offV]
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           Just (Literal (ByteArrayLiteral ba1)) =
+              primLookup (fromInteger ba) mach
+           !(I# off') = fromInteger off
+           w = unsafeDupablePerformIO $ do
+                  BA.MutableByteArray mba <- BA.unsafeThawByteArray ba1
+                  IO (\s -> case readWordArray# mba off' s of
+                        (# s', w' #) -> (# s',  W# w' #))
+           newE = mkApps (Data tupDc) (map Right tyArgs ++
+                    [Left (Prim rwTy)
+                    ,Left (Literal (WordLiteral (toInteger w)))
+                    ])
+       in reduce newE
+
+  $(namePat 'GHC.Prim.copyAddrToByteArray#)
+    | [ Lit (StringLiteral addr)
+      , PrimVal _mbaTy _ [dst_mbaV]
+      , offV, lenV
+      , PrimVal rwTy _ _
+      ] <- args
+    , [off,len,dst_mba] <- intLiterals' [offV, lenV, dst_mbaV]
+    -> let Just (Literal (ByteArrayLiteral dst_ba)) =
+              primLookup (fromInteger dst_mba) mach
+           !(I# off') = fromInteger off
+           !(I# len') = fromInteger len
+           !(BS.PS (ForeignPtr addr' _) _ _) = BS.packChars addr
+           ba2 = unsafeDupablePerformIO $ do
+                    BA.MutableByteArray dst_mba1 <- BA.unsafeThawByteArray dst_ba
+                    svoid (copyAddrToByteArray# addr' dst_mba1 off' len')
+                    BA.unsafeFreezeByteArray (BA.MutableByteArray dst_mba1)
+           ba3 = Literal (ByteArrayLiteral ba2)
+        in Just . setTerm (Prim rwTy) $ primUpdate (fromInteger dst_mba) ba3 mach
+
+-- decodeFloat_Int# :: Float# -> (#Int#, Int##)
+  $(namePat 'GHC.Prim.decodeFloat_Int#) | [i] <- floatLiterals' args
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           !(F# a) = wordToFloat i
+           !(# p, q #) = decodeFloat_Int# a
+       in reduce $
+          mkApps (Data tupDc) (map Right tyArgs ++
+                   [ Left (Literal . IntLiteral  . toInteger $ I# p)
+                   , Left (Literal . IntLiteral  . toInteger $ I# q)])
+
+  $(namePat 'GHC.Prim.tagToEnum#)
+    | [ConstTy (TyCon tcN)] <- tys
+    , [Lit (IntLiteral i)]  <- args
+    -> let dc = do { tc <- UniqMap.lookup tcN tcm
+                   ; let dcs = tyConDataCons tc
+                   ; List.find ((== (i+1)) . toInteger . dcTag) dcs
+                   }
+       in (\e -> setTerm (Data e) mach) <$> dc
+
+#if MIN_VERSION_ghc_prim(0,12,0)
+  $(namePat 'GHC.PrimopWrappers.dataToTagSmall#)
+    | [DC dc _] <- args
+    -> reduce (Literal (IntLiteral (toInteger (dcTag dc - 1))))
+
+  $(namePat 'GHC.PrimopWrappers.dataToTagLarge#)
+    | [DC dc _] <- args
+    -> reduce (Literal (IntLiteral (toInteger (dcTag dc - 1))))
+#endif
+#if MIN_VERSION_ghc(9,10,0)
+  $(namePat 'GHC.Prim.dataToTagSmall#)
+    | [DC dc _] <- args
+    -> reduce (Literal (IntLiteral (toInteger (dcTag dc - 1))))
+  $(namePat 'GHC.Prim.dataToTagLarge#)
+    | [DC dc _] <- args
+    -> reduce (Literal (IntLiteral (toInteger (dcTag dc - 1))))
+  $(namePat 'GHC.Base.dataToTag#)
+    | [DC dc _] <- args
+    -> reduce (Literal (IntLiteral (toInteger (dcTag dc - 1))))
+#else
+  $(namePat 'GHC.Prim.dataToTag#)
+    | [DC dc _] <- args
+    -> reduce (Literal (IntLiteral (toInteger (dcTag dc - 1))))
+#endif
+
+  $(namePat 'GHC.Classes.eqInt) | Just (i,j) <- intCLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i == j))
+
+  $(namePat 'GHC.Classes.neInt) | Just (i,j) <- intCLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i /= j))
+
+  $(namePat 'GHC.Classes.leInt) | Just (i,j) <- intCLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i <= j))
+
+  $(namePat 'GHC.Classes.ltInt) | Just (i,j) <- intCLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i < j))
+
+  $(namePat 'GHC.Classes.geInt) | Just (i,j) <- intCLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i >= j))
+
+  $(namePat 'GHC.Classes.gtInt) | Just (i,j) <- intCLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i > j))
+
+  $(namePat '(GHC.Classes.&&))
+    | [ lArg , rArg ] <- args
+    , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
+    -- evaluation of the arguments is deferred until the evaluation of the ghcPrimUnwindWith
+    -- to make `&&` lazy in both arguments
+    , mach1@Machine{mStack=[],mTerm=lArgWHNF} <- whnf eval tcm True (setTerm (valToTerm lArg) $ stackClear mach)
+    , mach2@Machine{mStack=[],mTerm=rArgWHNF} <- whnf eval tcm True (setTerm (valToTerm rArg) $ stackClear mach1)
+    -> case [ lArgWHNF, rArgWHNF ] of
+         [ Data lCon, Data rCon ] ->
+           Just $ mach2
+             { mStack = mStack mach
+             , mTerm = boolToBoolLiteral tcm ty (isTrueDC lCon && isTrueDC rCon)
+             }
+
+         [ Data lCon, _ ]
+           | isTrueDC lCon -> reduce rArgWHNF
+           | otherwise     -> reduce (boolToBoolLiteral tcm ty False)
+
+         [ _, Data rCon ]
+           | isTrueDC rCon -> reduce lArgWHNF
+           | otherwise     -> reduce (boolToBoolLiteral tcm ty False)
+
+         _ -> Nothing
+
+  $(namePat '(GHC.Classes.||))
+    | [ lArg , rArg ] <- args
+    , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
+    -- evaluation of the arguments is deferred until the evaluation of the ghcPrimUnwindWith
+    -- to make `||` lazy in both arguments
+    , mach1@Machine{mStack=[],mTerm=lArgWHNF} <- whnf eval tcm True (setTerm (valToTerm lArg) $ stackClear mach)
+    , mach2@Machine{mStack=[],mTerm=rArgWHNF} <- whnf eval tcm True (setTerm (valToTerm rArg) $ stackClear mach1)
+    -> case [ lArgWHNF, rArgWHNF ] of
+         [ Data lCon, Data rCon ] ->
+           Just $ mach2
+             { mStack = mStack mach
+             , mTerm = boolToBoolLiteral tcm ty (isTrueDC lCon || isTrueDC rCon)
+             }
+
+         [ Data lCon, _ ]
+           | isFalseDC lCon -> reduce rArgWHNF
+           | otherwise      -> reduce (boolToBoolLiteral tcm ty True)
+
+         [ _, Data rCon ]
+           | isFalseDC rCon -> reduce lArgWHNF
+           | otherwise      -> reduce (boolToBoolLiteral tcm ty True)
+
+         _ -> Nothing
+
+  $(namePat 'GHC.Classes.divInt#) | Just (i,j) <- intLiterals args
+    -> reduce (integerToIntLiteral (i `div` j))
+
+  -- modInt# :: Int# -> Int# -> Int#
+  $(namePat 'GHC.Classes.modInt#)
+    | [dividend, divisor] <- intLiterals' args
+    ->
+      if divisor == 0 then
+        let iTy = snd (splitFunForallTy ty) in
+        reduce (TyApp (Prim NP.undefined) iTy)
+      else
+        reduce (Literal (IntLiteral (dividend `mod` divisor)))
+
+  $(namePat 'GHC.Classes.not)
+    | [DC bCon _] <- args
+    -> reduce (boolToBoolLiteral tcm ty (nameOcc (dcName bCon) == showt 'False))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerLogBase#)
+    | Just (a,b) <- integerLiterals args
+    , Just c <- flogBase a b
+    -> (reduce . Literal . WordLiteral . toInteger) c
+
+#if MIN_VERSION_base(4,16,0)
+  $(namePat 'GHC.Float.integerToFloat#)
+#else
+  $(namePat 'GHC.Num.integerToFloat#)
+#endif
+    | [v] <- args
+    , Just i <- integerLiteral v
+    -> reduce . Literal . FloatLiteral . floatToWord $ F# (integerToFloat# i)
+
+#if MIN_VERSION_base(4,16,0)
+  $(namePat 'GHC.Float.integerToDouble#)
+#else
+  $(namePat 'GHC.Num.integerToDouble#)
+#endif
+    | [v] <- args
+    , Just i <- integerLiteral v
+    -> reduce . Literal . DoubleLiteral . doubleToWord $ D# (integerToDouble# i)
+
+  $(namePat 'GHC.Num.naturalLogBase#)
+    | Just (a,b) <- naturalLiterals args
+    , Just c <- flogBase a b
+    -> (reduce . Literal . WordLiteral . toInteger) c
+#else
+  $(namePat 'GHC.Integer.Logarithms.integerLogBase#)
+    | Just (a,b) <- integerLiterals args
+    , Just c <- flogBase a b
+    -> (reduce . Literal . IntLiteral . toInteger) c
+#endif
+
+#if !MIN_VERSION_base(4,15,0)
+  "GHC.Integer.Type.smallInteger"
+    | [Lit (IntLiteral i)] <- args
+    -> reduce (Literal (IntegerLiteral i))
+#endif
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerToInt#)
+#else
+  "GHC.Integer.Type.integerToInt"
+#endif
+    | [i] <- integerLiterals' args
+    -> reduce (integerToIntLiteral i)
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerDecodeDouble#) -- :: Double# -> (#Integer, Int##)
+#else
+  "GHC.Integer.Type.decodeDoubleInteger" -- :: Double# -> (#Integer, Int##)
+#endif
+    | [Lit (DoubleLiteral i)] <- args
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           !(D# a)  = wordToDouble i
+           !(# b, c #) = decodeDoubleInteger a
+    in reduce $
+       mkApps (Data tupDc) (map Right tyArgs ++
+                [ Left (integerToIntegerLiteral b)
+                , Left (integerToIntLiteral . toInteger $ I# c)])
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerEncodeDouble#) -- :: Integer -> Int# -> Double
+#else
+  "GHC.Integer.Type.encodeDoubleInteger" -- :: Integer -> Int# -> Double
+#endif
+    | [iV, Lit (IntLiteral j)] <- args
+    , [i] <- integerLiterals' [iV]
+    -> let !(I# k') = fromInteger j
+           r = encodeDoubleInteger i k'
+    in  reduce . Literal . DoubleLiteral . doubleToWord $ D# r
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerEncodeFloat#)
+    | [iV, Lit (IntLiteral j)] <- args
+    , [i] <- integerLiterals' [iV]
+    -> let !(I# k') = fromInteger j
+           r = integerEncodeFloat# i k'
+        in reduce . Literal . FloatLiteral . floatToWord $ F# r
+#endif
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerQuotRem#) -- :: Integer -> Integer -> (#Integer, Integer#)
+#else
+  "GHC.Integer.Type.quotRemInteger" -- :: Integer -> Integer -> (#Integer, Integer#)
+#endif
+    | [i, j] <- integerLiterals' args
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           (q,r) = quotRem i j
+    in reduce $
+         mkApps (Data tupDc) (map Right tyArgs ++
+                [ Left $ catchDivByZero (integerToIntegerLiteral q)
+                , Left $ catchDivByZero (integerToIntegerLiteral r)])
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerAdd)
+#else
+  "GHC.Integer.Type.plusInteger"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (integerToIntegerLiteral (i+j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerSub)
+#else
+  "GHC.Integer.Type.minusInteger"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (integerToIntegerLiteral (i-j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerMul)
+#else
+  "GHC.Integer.Type.timesInteger"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (integerToIntegerLiteral (i*j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerNegate)
+#else
+  "GHC.Integer.Type.negateInteger"
+#endif
+    | [i] <- integerLiterals' args
+    -> reduce (integerToIntegerLiteral (negate i))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerDiv)
+#else
+  "GHC.Integer.Type.divInteger"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce $ catchDivByZero (integerToIntegerLiteral (i `div` j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerMod)
+#else
+  "GHC.Integer.Type.modInteger"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce $ catchDivByZero (integerToIntegerLiteral (i `mod` j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerQuot)
+#else
+  "GHC.Integer.Type.quotInteger"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce $ catchDivByZero (integerToIntegerLiteral (i `quot` j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerRem)
+#else
+  "GHC.Integer.Type.remInteger"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce $ catchDivByZero (integerToIntegerLiteral (i `rem` j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerDivMod#)
+#else
+  "GHC.Integer.Type.divModInteger"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> let (_,tyView -> TyConApp ubTupTcNm [liftedKi,_,intTy,_]) = splitFunForallTy ty
+           (Just ubTupTc) = UniqMap.lookup ubTupTcNm tcm
+           [ubTupDc] = tyConDataCons ubTupTc
+           (d,m) = divMod i j
+       in  reduce $
+           mkApps (Data ubTupDc) [ Right liftedKi, Right liftedKi
+                                 , Right intTy,    Right intTy
+                                 , Left $ catchDivByZero (Literal (IntegerLiteral d))
+                                 , Left $ catchDivByZero (Literal (IntegerLiteral m))
+                                 ]
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerGt)
+#else
+  "GHC.Integer.Type.gtInteger"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i > j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerGe)
+#else
+  "GHC.Integer.Type.geInteger"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i >= j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerEq)
+#else
+  "GHC.Integer.Type.eqInteger"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i == j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerNe)
+#else
+  "GHC.Integer.Type.neqInteger"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i /= j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerLt)
+#else
+  "GHC.Integer.Type.ltInteger"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i < j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerLe)
+#else
+  "GHC.Integer.Type.leInteger"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i <= j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerGt#)
+#else
+  "GHC.Integer.Type.gtInteger#"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (boolToIntLiteral (i > j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerGe#)
+#else
+  "GHC.Integer.Type.geInteger#"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (boolToIntLiteral (i >= j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerEq#)
+#else
+  "GHC.Integer.Type.eqInteger#"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (boolToIntLiteral (i == j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerNe#)
+#else
+  "GHC.Integer.Type.neqInteger#"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (boolToIntLiteral (i /= j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerLt#)
+#else
+  "GHC.Integer.Type.ltInteger#"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (boolToIntLiteral (i < j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerLe#)
+#else
+  "GHC.Integer.Type.leInteger#"
+#endif
+    | Just (i,j) <- integerLiterals args
+    -> reduce (boolToIntLiteral (i <= j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerCompare)
+#else
+  "GHC.Integer.Type.compareInteger" -- :: Integer -> Integer -> Ordering
+#endif
+    | [i, j] <- integerLiterals' args
+    -> let -- Get the required result type (viewed as an applied type constructor name)
+           (_,tyView -> TyConApp tupTcNm []) = splitFunForallTy ty
+           -- Find the type constructor from the name
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           -- Get the data constructors of that type
+           -- The type is 'Ordering', so they are: 'LT', 'EQ', 'GT'
+           [ltDc, eqDc, gtDc] = tyConDataCons tupTc
+           -- Do the actual compile-time evaluation
+           ordVal = compareInteger i j
+        in reduce $ case ordVal of
+            LT -> Data ltDc
+            EQ -> Data eqDc
+            GT -> Data gtDc
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerShiftR#)
+    | [iV, Lit (WordLiteral j)] <- args
+#else
+  "GHC.Integer.Type.shiftRInteger"
+    | [iV, Lit (IntLiteral j)] <- args
+#endif
+    , [i] <- integerLiterals' [iV]
+    -> reduce (integerToIntegerLiteral (i `shiftR` fromInteger j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerShiftL#)
+    | [iV, Lit (WordLiteral j)] <- args
+#else
+  "GHC.Integer.Type.shiftLInteger"
+    | [iV, Lit (IntLiteral j)] <- args
+#endif
+    , [i] <- integerLiterals' [iV]
+    -> reduce (integerToIntegerLiteral (i `shiftL` fromInteger j))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerFromWord#)
+#else
+  "GHC.Integer.Type.wordToInteger"
+#endif
+    | [Lit (WordLiteral w)] <- args
+    -> reduce (Literal (IntegerLiteral w))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerToWord#)
+#else
+  "GHC.Integer.Type.integerToWord"
+#endif
+    | [i] <- integerLiterals' args
+    -> reduce (integerToWordLiteral i)
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerTestBit#) -- :: Integer -> Int# -> Int#
+    | [Lit (IntegerLiteral i), Lit (WordLiteral j)] <- args
+    -> reduce (boolToIntLiteral (testBit i (fromInteger j)))
+#else
+  "GHC.Integer.Type.testBitInteger" -- :: Integer -> Int# -> Bool
+    | [Lit (IntegerLiteral i), Lit (IntLiteral j)] <- args
+    -> reduce (boolToBoolLiteral tcm ty (testBit i (fromInteger j)))
+#endif
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.NS)
+    | [Lit (WordLiteral w)] <- args
+    -> reduce (Literal (NaturalLiteral w))
+  $(namePat 'GHC.Num.NB)
+    | [Lit (ByteArrayLiteral (BA.ByteArray ba))] <- args
+    -> reduce (Literal (NaturalLiteral (IP ba)))
+    | [Lit l] <- args
+    -> error ("NB: " <> show l)
+  $(namePat 'GHC.Num.Integer.IS)
+    | [Lit (IntLiteral i)] <- args
+    -> reduce (Literal (IntegerLiteral i))
+  $(namePat 'GHC.Num.Integer.IP)
+    | [Lit (ByteArrayLiteral (BA.ByteArray ba))] <- args
+    -> reduce (Literal (IntegerLiteral (IP ba)))
+    | [Lit l] <- args
+    -> error ("IP: " <> show l)
+  $(namePat 'GHC.Num.Integer.IN)
+    | [Lit (ByteArrayLiteral (BA.ByteArray ba))] <- args
+    -> reduce (Literal (IntegerLiteral (IN ba)))
+    | [Lit l] <- args
+    -> error ("IN: " <> show l)
+#else
+  $(namePat 'GHC.Natural.NatS#)
+    | [Lit (WordLiteral w)] <- args
+    -> reduce (Literal (NaturalLiteral w))
+#endif
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerFromNatural)
+#else
+  $(namePat 'GHC.Natural.naturalToInteger)
+#endif
+    | [i] <- naturalLiterals' args
+    -> reduce (Literal (IntegerLiteral (toInteger i)))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerToNatural)
+#else
+  $(namePat 'GHC.Natural.naturalFromInteger)
+#endif
+    | [i] <- integerLiterals' args
+    ->
+     let nTy = snd (splitFunForallTy ty) in
+     reduce (checkNaturalRange1 nTy i id)
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerToNaturalClamp)
+    | [i] <- integerLiterals' args
+    -> if i < 0 then
+         reduce (naturalToNaturalLiteral 0)
+       else
+         reduce (naturalToNaturalLiteral (fromInteger i))
+
+  $(namePat 'GHC.Num.Integer.integerToNaturalThrow)
+    | [i] <- integerLiterals' args
+    -> let nTy = snd (splitFunForallTy ty) in
+       reduce (checkNaturalRange1 nTy i id)
+#endif
+
+#if MIN_VERSION_base(4,17,0) || WORD_SIZE_IN_BITS < 64
+  $(namePat 'GHC.Num.Integer.integerToInt64#)
+    | [i] <- integerLiterals' args
+    -> reduce (integerToInt64Literal i)
+
+  $(namePat 'GHC.Num.Integer.integerToWord64#)
+    | [i] <- integerLiterals' args
+    -> reduce (integerToWord64Literal i)
+
+#if MIN_VERSION_base(4,17,0)
+  $(namePat 'GHC.Num.Integer.integerFromWord64#)
+    | [w] <- word64Literals' args
+    -> reduce (Literal (IntegerLiteral w))
+#endif
+#endif
+
+#if !MIN_VERSION_base(4,15,0)
+  -- GHC.shiftLNatural --- XXX: Fragile worker of GHC.shiflLNatural
+  "GHC.Natural.$wshiftLNatural"
+    | [nV,iV] <- args
+    , [n] <- naturalLiterals' [nV]
+    , [i] <- fromInteger <$> intLiterals' [iV]
+    ->
+     let nTy = snd (splitFunForallTy ty) in
+     reduce (checkNaturalRange1 nTy n ((flip shiftL) i))
+#endif
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.naturalAdd)
+#else
+  $(namePat 'GHC.Natural.plusNatural)
+#endif
+    | Just (i,j) <- naturalLiterals args
+    ->
+     let nTy = snd (splitFunForallTy ty) in
+     reduce (checkNaturalRange2 nTy i j (+))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.naturalMul)
+#else
+  $(namePat 'GHC.Natural.timesNatural)
+#endif
+    | Just (i,j) <- naturalLiterals args
+    ->
+     let nTy = snd (splitFunForallTy ty) in
+     reduce (checkNaturalRange2 nTy i j (*))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Natural.naturalSubUnsafe)
+    | Just (i,j) <- naturalLiterals args
+    ->
+     let nTy = snd (splitFunForallTy ty) in
+     reduce (checkNaturalRange nTy [i, j] (\[i', j'] ->
+      naturalToNaturalLiteral (naturalSubUnsafe i' j')))
+
+  $(namePat 'GHC.Num.naturalSubThrow)
+    | Just (i,j) <- naturalLiterals args
+    ->
+     let nTy = snd (splitFunForallTy ty) in
+     reduce (checkNaturalRange nTy [i, j] (\[i', j'] ->
+                case minusNaturalMaybe i' j' of
+                  Nothing -> checkNaturalRange1 nTy (-1) id
+                  Just n -> naturalToNaturalLiteral n))
+#else
+  $(namePat 'GHC.Natural.minusNatural)
+    | Just (i,j) <- naturalLiterals args
+    ->
+     let nTy = snd (splitFunForallTy ty) in
+     reduce (checkNaturalRange nTy [i, j] (\[i', j'] ->
+                case minusNaturalMaybe i' j' of
+                  Nothing -> checkNaturalRange1 nTy (-1) id
+                  Just n -> naturalToNaturalLiteral n))
+#endif
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.naturalFromWord#)
+#else
+  $(namePat 'GHC.Natural.wordToNatural#)
+#endif
+    | [Lit (WordLiteral w)] <- args
+    ->
+     let nTy = snd (splitFunForallTy ty) in
+     reduce (checkNaturalRange1 nTy w id)
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.naturalToWord#)
+    | [i] <- naturalLiterals' args
+    -> reduce (integerToWordLiteral i)
+
+  $(namePat 'GHC.Num.naturalQuot)
+    | Just (i,j) <- naturalLiterals args
+    ->
+     let nTy = snd (splitFunForallTy ty) in
+     reduce (checkNaturalRange2 nTy i j quot)
+
+  $(namePat 'GHC.Num.naturalRem)
+    | Just (i,j) <- naturalLiterals args
+    ->
+     let nTy = snd (splitFunForallTy ty) in
+     reduce (checkNaturalRange2 nTy i j rem)
+#endif
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.naturalQuotRem#) -- :: Natural -> Natural -> (#Natural, Natural#)
+    | [i, j] <- naturalLiterals' args
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           (q,r) = quotRem (fromInteger i) (fromInteger j)
+    in reduce $
+         mkApps (Data tupDc) (map Right tyArgs ++
+                [ Left $ catchDivByZero (naturalToNaturalLiteral q)
+                , Left $ catchDivByZero (naturalToNaturalLiteral r)])
+#endif
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.naturalGcd)
+#else
+  $(namePat 'GHC.Natural.gcdNatural)
+#endif
+    | Just (i,j) <- naturalLiterals args
+    ->
+     let nTy = snd (splitFunForallTy ty) in
+     reduce (checkNaturalRange2 nTy i j gcd)
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.naturalLcm)
+    | Just (i,j) <- naturalLiterals args
+    ->
+     let nTy = snd (splitFunForallTy ty) in
+     reduce (checkNaturalRange2 nTy i j lcm)
+#endif
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.naturalGt#)
+    | Just (i,j) <- naturalLiterals args
+    -> reduce (boolToIntLiteral (i > j))
+
+  $(namePat 'GHC.Num.naturalGe#)
+    | Just (i,j) <- naturalLiterals args
+    -> reduce (boolToIntLiteral (i >= j))
+
+  $(namePat 'GHC.Num.naturalEq#)
+    | Just (i,j) <- naturalLiterals args
+    -> reduce (boolToIntLiteral (i == j))
+
+  $(namePat 'GHC.Num.naturalNe#)
+    | Just (i,j) <- naturalLiterals args
+    -> reduce (boolToIntLiteral (i /= j))
+
+  $(namePat 'GHC.Num.naturalLt#)
+    | Just (i,j) <- naturalLiterals args
+    -> reduce (boolToIntLiteral (i < j))
+
+  $(namePat 'GHC.Num.naturalLe#)
+    | Just (i,j) <- naturalLiterals args
+    -> reduce (boolToIntLiteral (i <= j))
+
+  $(namePat 'GHC.Num.naturalShiftL#)
+    | [iV, Lit (WordLiteral j)] <- args
+    , [i] <- naturalLiterals' [iV]
+    -> reduce (naturalToNaturalLiteral (fromInteger (i `shiftL` fromInteger j)))
+
+  $(namePat 'GHC.Num.naturalShiftR#)
+    | [iV, Lit (WordLiteral j)] <- args
+    , [i] <- naturalLiterals' [iV]
+    -> reduce (naturalToNaturalLiteral (fromInteger (i `shiftR` fromInteger j)))
+
+  $(namePat 'GHC.Num.naturalCompare)
+    | [i, j] <- naturalLiterals' args
+    -> let -- Get the required result type (viewed as an applied type constructor name)
+           (_,tyView -> TyConApp tupTcNm []) = splitFunForallTy ty
+           -- Find the type constructor from the name
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           -- Get the data constructors of that type
+           -- The type is 'Ordering', so they are: 'LT', 'EQ', 'GT'
+           [ltDc, eqDc, gtDc] = tyConDataCons tupTc
+           -- Do the actual compile-time evaluation
+           ordVal = compareInteger i j
+        in reduce $ case ordVal of
+            LT -> Data ltDc
+            EQ -> Data eqDc
+            GT -> Data gtDc
+
+  $(namePat 'GHC.Num.naturalSignum)
+    | [i] <- naturalLiterals' args
+    -> reduce (Literal (NaturalLiteral (signum i)))
+
+  "GHC.Num.Natural.$wnaturalSignum"
+    | [i] <- naturalLiterals' args
+    -> reduce (Literal (WordLiteral (signum i)))
+#endif
+
+  -- GHC.Real.^  -- XXX: Very fragile
+  --   ^_f, $wf, $wf1 are specialisations of the internal function f in the implementation of (^) in GHC.Real
+  "GHC.Real.^_f"  -- :: Integer -> Integer -> Integer
+    | [i,j] <- integerLiterals' args
+    -> reduce (integerToIntegerLiteral $ i ^ j)
+  "GHC.Real.$wf"  -- :: Integer -> Int# -> Integer
+    | [iV, Lit (IntLiteral j)] <- args
+    , [i] <- integerLiterals' [iV]
+    -> reduce (integerToIntegerLiteral $ i ^ j)
+  "GHC.Real.$wf1" -- :: Int# -> Int# -> Int#
+    | [Lit (IntLiteral i), Lit (IntLiteral j)] <- args
+    -> reduce (integerToIntLiteral $ i ^ j)
+  "GHC.Internal.Real.^_$s$spowImpl2" -- :: Int# -> Integer -> Integer
+    | [intLiteral -> Just j, integerLiteral -> Just i] <- args
+    -> reduce (integerToIntLiteral $ i ^ j)
+  "GHC.Internal.Real.$w$spowImpl" -- :: Integer -> Int# -> Integer
+    | [integerLiteral -> Just i, intLiteral -> Just j] <- args
+    -> reduce (integerToIntLiteral $ i ^ j)
+  "GHC.Internal.Real.$w$spowImpl1" -- :: Int# -> Int# -> Integer
+    | [intLiteral -> Just i, intLiteral -> Just j] <- args
+    -> reduce (integerToIntLiteral $ i ^ j)
+  "GHC.Real.^_$s$spowImpl2" -- :: Int# -> Integer -> Integer
+    | [intLiteral -> Just j, integerLiteral -> Just i] <- args
+    -> reduce (integerToIntLiteral $ i ^ j)
+  "GHC.Real.$w$spowImpl" -- :: Integer -> Int# -> Integer
+    | [integerLiteral -> Just i, intLiteral -> Just j] <- args
+    -> reduce (integerToIntLiteral $ i ^ j)
+  "GHC.Real.$w$spowImpl1" -- :: Int# -> Int# -> Integer
+    | [intLiteral -> Just i, intLiteral -> Just j] <- args
+    -> reduce (integerToIntLiteral $ i ^ j)
+  "GHC.Real.^_$sf2" -- :: Int# -> Integer -> Integer
+    | [intLiteral -> Just j, integerLiteral -> Just i] <- args
+    -> reduce (integerToIntLiteral $ i ^ j)
+
+  -- Type level ^    -- XXX: Very fragile
+  -- These is are specialized versions of ^_f, named by some combination of ghc and singletons.
+  "Data.Singletons.TypeLits.Internal.$fSingI->^@#@$_f" -- ghc-8.6.5, singletons-2.5.1
+    | [i,j] <- naturalLiterals' args
+    -> reduce (Literal (NaturalLiteral (i ^ j)))
+  "Data.Singletons.TypeLits.Internal.%^_f"             -- ghc-8.8.1, singletons-2.6
+    | [i,j] <- naturalLiterals' args
+    -> reduce (Literal (NaturalLiteral (i ^ j)))
+
+  -- XXX: Does it make sense to match on a @NaturalLiteral@ here?
+  $(namePat 'GHC.TypeLits.natVal)
+    | [Lit (NaturalLiteral n), _] <- args
+    -> reduce (integerToIntegerLiteral n)
+
+  $(namePat 'GHC.TypeNats.natVal)
+    | [Lit (NaturalLiteral n), _] <- args
+    -> reduce (Literal (NaturalLiteral n))
+
+  $(namePat 'GHC.TypeNats.someNatVal)
+    | [Lit (NaturalLiteral n)] <- args
+    -> let resTy = getResultTy tcm ty tys
+        in reduce (mkSomeNat tcm n resTy)
+
+  -- XXX: Does it make sense to match on a @NaturalLiteral@ here?
+  $(namePat 'GHC.TypeLits.someNatVal)
+    | [Lit (NaturalLiteral n)] <- args
+    -> let resTy = getResultTy tcm ty tys
+        in reduce (mkSomeNat tcm n resTy)
+
+  $(namePat 'GHC.Types.I#)
+    | isSubj
+    , [Lit (IntLiteral i)] <- args
+    ->  let (_,tyView -> TyConApp intTcNm []) = splitFunForallTy ty
+            (Just intTc) = UniqMap.lookup intTcNm tcm
+            [intDc] = tyConDataCons intTc
+        in  reduce (mkApps (Data intDc) [Left (Literal (IntLiteral i))])
+
+  $(namePat 'GHC.Int.I8#)
+    | isSubj
+#if MIN_VERSION_base(4,16,0)
+    , [Lit (Int8Literal i)] <- args
+#else
+    , [Lit (IntLiteral i)] <- args
+#endif
+    ->  let (_,tyView -> TyConApp intTcNm []) = splitFunForallTy ty
+            (Just intTc) = UniqMap.lookup intTcNm tcm
+            [intDc] = tyConDataCons intTc
+#if MIN_VERSION_base(4,16,0)
+        in  reduce (mkApps (Data intDc) [Left (Literal (Int8Literal i))])
+#else
+        in  reduce (mkApps (Data intDc) [Left (Literal (IntLiteral i))])
+#endif
+  $(namePat 'GHC.Int.I16#)
+    | isSubj
+#if MIN_VERSION_base(4,16,0)
+    , [Lit (Int16Literal i)] <- args
+#else
+    , [Lit (IntLiteral i)] <- args
+#endif
+    ->  let (_,tyView -> TyConApp intTcNm []) = splitFunForallTy ty
+            (Just intTc) = UniqMap.lookup intTcNm tcm
+            [intDc] = tyConDataCons intTc
+#if MIN_VERSION_base(4,16,0)
+        in  reduce (mkApps (Data intDc) [Left (Literal (Int16Literal i))])
+#else
+        in  reduce (mkApps (Data intDc) [Left (Literal (IntLiteral i))])
+#endif
+  $(namePat 'GHC.Int.I32#)
+    | isSubj
+#if MIN_VERSION_base(4,16,0)
+    , [Lit (Int32Literal i)] <- args
+#else
+    , [Lit (IntLiteral i)] <- args
+#endif
+    ->  let (_,tyView -> TyConApp intTcNm []) = splitFunForallTy ty
+            (Just intTc) = UniqMap.lookup intTcNm tcm
+            [intDc] = tyConDataCons intTc
+#if MIN_VERSION_base(4,16,0)
+        in  reduce (mkApps (Data intDc) [Left (Literal (Int32Literal i))])
+#else
+        in  reduce (mkApps (Data intDc) [Left (Literal (IntLiteral i))])
+#endif
+  $(namePat 'GHC.Int.I64#)
+    | isSubj
+#if MIN_VERSION_base(4,16,0)
+    , [Lit (Int64Literal i)] <- args
+#else
+    , [Lit (IntLiteral i)] <- args
+#endif
+    ->  let (_,tyView -> TyConApp intTcNm []) = splitFunForallTy ty
+            (Just intTc) = UniqMap.lookup intTcNm tcm
+            [intDc] = tyConDataCons intTc
+#if MIN_VERSION_base(4,16,0)
+        in  reduce (mkApps (Data intDc) [Left (Literal (Int64Literal i))])
+#else
+        in  reduce (mkApps (Data intDc) [Left (Literal (IntLiteral i))])
+#endif
+
+  $(namePat 'GHC.Word.W8#)
+    | isSubj
+#if MIN_VERSION_base(4,16,0)
+    , [Lit (Word8Literal c)] <- args
+#else
+    , [Lit (WordLiteral c)] <- args
+#endif
+    ->  let (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
+            (Just wordTc) = UniqMap.lookup wordTcNm tcm
+            [wordDc] = tyConDataCons wordTc
+#if MIN_VERSION_base(4,16,0)
+        in  reduce (mkApps (Data wordDc) [Left (Literal (Word8Literal c))])
+#else
+        in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral c))])
+#endif
+  $(namePat 'GHC.Word.W16#)
+    | isSubj
+#if MIN_VERSION_base(4,16,0)
+    , [Lit (Word16Literal c)] <- args
+#else
+    , [Lit (WordLiteral c)] <- args
+#endif
+    ->  let (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
+            (Just wordTc) = UniqMap.lookup wordTcNm tcm
+            [wordDc] = tyConDataCons wordTc
+#if MIN_VERSION_base(4,16,0)
+        in  reduce (mkApps (Data wordDc) [Left (Literal (Word16Literal c))])
+#else
+        in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral c))])
+#endif
+  $(namePat 'GHC.Word.W32#)
+    | isSubj
+#if MIN_VERSION_base(4,16,0)
+    , [Lit (Word32Literal c)] <- args
+#else
+    , [Lit (WordLiteral c)] <- args
+#endif
+    ->  let (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
+            (Just wordTc) = UniqMap.lookup wordTcNm tcm
+            [wordDc] = tyConDataCons wordTc
+#if MIN_VERSION_base(4,16,0)
+        in  reduce (mkApps (Data wordDc) [Left (Literal (Word32Literal c))])
+#else
+        in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral c))])
+#endif
+  $(namePat 'GHC.Word.W64#)
+    | isSubj
+#if MIN_VERSION_base(4,16,0)
+    , [Lit (Word64Literal c)] <- args
+#else
+    , [Lit (WordLiteral c)] <- args
+#endif
+    ->  let (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
+            (Just wordTc) = UniqMap.lookup wordTcNm tcm
+            [wordDc] = tyConDataCons wordTc
+#if MIN_VERSION_base(4,16,0)
+        in  reduce (mkApps (Data wordDc) [Left (Literal (Word64Literal c))])
+#else
+        in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral c))])
+#endif
+
+  $(namePat 'GHC.Types.W#)
+    | isSubj
+    , [Lit (WordLiteral i)] <- args
+    ->  let (_,tyView -> TyConApp intTcNm []) = splitFunForallTy ty
+            (Just intTc) = UniqMap.lookup intTcNm tcm
+            [intDc] = tyConDataCons intTc
+        in  reduce (mkApps (Data intDc) [Left (Literal (WordLiteral i))])
+
+  "GHC.Float.$w$sfromRat''" -- XXX: Very fragile
+    | [Lit (IntLiteral _minEx)
+      ,Lit (IntLiteral matDigs)
+      ,nV
+      ,dV] <- args
+    , [n,d] <- integerLiterals' [nV,dV]
+    -> case fromInteger matDigs of
+          matDigs'
+            | matDigs' == floatDigits (undefined :: Float)
+            -> reduce (Literal (FloatLiteral (floatToWord (fromRational (n :% d)))))
+            | matDigs' == floatDigits (undefined :: Double)
+            -> reduce (Literal (DoubleLiteral (doubleToWord (fromRational (n :% d)))))
+          _ -> error $ $(curLoc) ++ "GHC.Float.$w$sfromRat'': Not a Float or Double"
+
+  "GHC.Float.$w$sfromRat''1" -- XXX: Very fragile
+    | [Lit (IntLiteral _minEx)
+      ,Lit (IntLiteral matDigs)
+      ,nV
+      ,dV] <- args
+    , [n,d] <- integerLiterals' [nV,dV]
+    -> case fromInteger matDigs of
+          matDigs'
+            | matDigs' == floatDigits (undefined :: Float)
+            -> reduce (Literal (FloatLiteral (floatToWord (fromRational (n :% d)))))
+            | matDigs' == floatDigits (undefined :: Double)
+            -> reduce (Literal (DoubleLiteral (doubleToWord (fromRational (n :% d)))))
+          _ -> error $ $(curLoc) ++ "GHC.Float.$w$sfromRat'': Not a Float or Double"
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerSignum#)
+#else
+  "GHC.Integer.Type.$wsignumInteger" -- XXX: Not super-fragile, but still..
+#endif
+    | [i] <- integerLiterals' args
+    -> reduce (Literal (IntLiteral (signum i)))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerSignum)
+#else
+  "GHC.Integer.Type.signumInteger"
+#endif
+    | [i] <- integerLiterals' args
+    -> reduce (Literal (IntegerLiteral (signumInteger i)))
+
+#if MIN_VERSION_base(4,15,0)
+  "GHC.Num.Integer.$wintegerSignum"
+    | [i] <- integerLiterals' args
+    -> reduce (Literal (IntLiteral (signum i)))
+#endif
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerAbs)
+#else
+  "GHC.Integer.Type.absInteger"
+#endif
+    | [i] <- integerLiterals' args
+    -> reduce (Literal (IntegerLiteral (absInteger i)))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerBit#)
+    | [i] <- wordLiterals' args
+#else
+  "GHC.Integer.Type.bitInteger"
+    | [i] <- intLiterals' args
+#endif
+    -> reduce (Literal (IntegerLiteral (bit (fromInteger i))))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerComplement)
+#else
+  "GHC.Integer.Type.complementInteger"
+#endif
+    | [i] <- integerLiterals' args
+    -> reduce (Literal (IntegerLiteral (complementInteger i)))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerOr)
+#else
+  "GHC.Integer.Type.orInteger"
+#endif
+    | [i, j] <- integerLiterals' args
+    -> reduce (Literal (IntegerLiteral (orInteger i j)))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerXor)
+#else
+  "GHC.Integer.Type.xorInteger"
+#endif
+    | [i, j] <- integerLiterals' args
+    -> reduce (Literal (IntegerLiteral (xorInteger i j)))
+
+#if MIN_VERSION_base(4,15,0)
+  $(namePat 'GHC.Num.Integer.integerAnd)
+#else
+  "GHC.Integer.Type.andInteger"
+#endif
+    | [i, j] <- integerLiterals' args
+    -> reduce (Literal (IntegerLiteral (andInteger i j)))
+
+#if !MIN_VERSION_base(4,15,0)
+  "GHC.Integer.Type.doubleFromInteger"
+    | [i] <- integerLiterals' args
+    -> reduce (Literal (DoubleLiteral (doubleToWord (fromInteger i))))
+#endif
+
+#if MIN_VERSION_base(4,17,0)
+  "GHC.Num.Integer.$wintegerFromInt64#"
+    | [i] <- int64Literals' args
+    -> reduce . Literal $ IntLiteral i
+#endif
+
+  $(namePat 'GHC.Base.eqString)
+    | [PrimVal _ _ [Lit (StringLiteral s1)]
+      ,PrimVal _ _ [Lit (StringLiteral s2)]
+      ] <- args
+    -> reduce (boolToBoolLiteral tcm ty (s1 == s2))
+    | otherwise -> error (show args)
+
+  $(namePat 'GHC.Base.quotInt)
+    | [ DC intDc [Left (Literal (IntLiteral i))]
+      , DC _     [Left (Literal (IntLiteral j))]
+      ] <- args
+    -> reduce (App (Data intDc) (Literal (IntLiteral (i `quot` j))))
+
+  $(namePat 'GHC.Base.remInt)
+    | [ DC intDc [Left (Literal (IntLiteral i))]
+      , DC _     [Left (Literal (IntLiteral j))]
+      ] <- args
+    -> reduce (App (Data intDc) (Literal (IntLiteral (i `rem` j))))
+
+  $(namePat 'GHC.Base.divInt)
+    | [ DC intDc [Left (Literal (IntLiteral i))]
+      , DC _     [Left (Literal (IntLiteral j))]
+      ] <- args
+    -> reduce (App (Data intDc) (Literal (IntLiteral (i `div` j))))
+
+
+  $(namePat 'GHC.Base.modInt)
+    | [ DC intDc [Left (Literal (IntLiteral i))]
+      , DC _     [Left (Literal (IntLiteral j))]
+      ] <- args
+    -> reduce (App (Data intDc) (Literal (IntLiteral (i `mod` j))))
+
+  $(namePat 'Clash.Class.BitPack.Internal.packDouble#) -- :: Double -> BitVector 64
+    | [DC _ [Left arg]] <- args
+    , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
+    , mach2@Machine{mStack=[],mTerm=Literal (DoubleLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
+    -> let resTyInfo = extractTySizeInfo tcm ty tys
+        in Just $ mach2
+             { mStack = mStack mach
+             , mTerm = mkBitVectorLit' resTyInfo 0 (toInteger $ (pack :: Word64 -> BitVector 64) i)
+             }
+
+  $(namePat 'Clash.Class.BitPack.Internal.packFloat#) -- :: Float -> BitVector 32
+    | [DC _ [Left arg]] <- args
+    , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
+    , mach2@Machine{mStack=[],mTerm=Literal (FloatLiteral i)} <- whnf eval tcm True (setTerm arg $ stackClear mach)
+    -> let resTyInfo = extractTySizeInfo tcm ty tys
+        in Just $ mach2
+             { mStack = mStack mach
+             , mTerm = mkBitVectorLit' resTyInfo 0 (toInteger $ (pack :: Word32 -> BitVector 32) i)
+             }
+
+  $(namePat 'Clash.Class.BitPack.Internal.unpackFloat#)
+    | [i] <- bitVectorLiterals' args
+    -> let resTy = getResultTy tcm ty tys
+           val = unpack (toBV i :: BitVector 32)
+        in reduce (mkFloatCLit tcm val resTy)
+
+  $(namePat 'Clash.Class.BitPack.Internal.unpackDouble#)
+    | [i] <- bitVectorLiterals' args
+    -> let resTy = getResultTy tcm ty tys
+           val = unpack (toBV i :: BitVector 64)
+        in reduce (mkDoubleCLit tcm val resTy)
+
+  $(namePat 'Clash.Sized.Internal.BitVector.xToBV)
+    | isSubj
+    , Just (nTy, kn) <- extractKnownNat tcm tys
+    -- The second argument to `xToBV` is always going to be suspended.
+    -- See Note [Lazy primitives]
+    , [ _, (Suspend arg) ] <- args
+    , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
+    , mach1@Machine{mStack=[],mTerm=argWHNF} <-
+        whnf eval tcm True (setTerm arg (stackClear mach))
+    , let undefBitVector =
+            Just $ mach1
+                 { mStack = mStack mach
+                 , mTerm  = mkBitVectorLit ty nTy kn (bit (fromInteger kn)-1) 0
+                 }
+    -> case isX argWHNF of
+         Left _ -> undefBitVector
+         _ -> case collectArgs argWHNF of
+           (Prim p,_) | primName p `elem` undefinedXPrims -> undefBitVector
+           _ -> Just $ mach1
+                     { mStack = mStack mach
+                     , mTerm  = argWHNF
+                     }
+
+  -- expIndex#
+  --   :: KnownNat m
+  --   => Index m
+  --   -> SNat n
+  --   -> Index (n^m)
+  $(namePat 'Clash.Class.Exp.expIndex#)
+    | [b] <- indexLiterals' args
+    , [(_mTy, km), (_, e)] <- extractKnownNats tcm tys
+    -> reduce (mkIndexLit ty (LitTy (NumTy (km^e))) (km^e) (b^e))
+
+  -- expSigned#
+  --   :: KnownNat m
+  --   => Signed m
+  --   -> SNat n
+  --   -> Signed (n*m)
+  $(namePat 'Clash.Class.Exp.expSigned#)
+    | [b] <- signedLiterals' args
+    , [(_mTy, km), (_, e)] <- extractKnownNats tcm tys
+    -> reduce (mkSignedLit ty (LitTy (NumTy (km*e))) (km*e) (b^e))
+
+  -- expUnsigned#
+  --   :: KnownNat m
+  --   => Unsigned m
+  --   -> SNat n
+  --   -> Unsigned m
+  $(namePat 'Clash.Class.Exp.expUnsigned#)
+    | [b] <- unsignedLiterals' args
+    , [(_mTy, km), (_, e)] <- extractKnownNats tcm tys
+    -> reduce (mkUnsignedLit ty (LitTy (NumTy (km*e))) (km*e) (b^e))
+
+  $(namePat 'Clash.Promoted.Nat.powSNat)
+    | [Right a, Right b] <- map (runExcept . tyNatSize tcm) tys
+    -> let c = case a of
+                 2 -> 1 `shiftL` (fromInteger b)
+                 _ -> a ^ b
+           (_,tyView -> TyConApp snatTcNm _) = splitFunForallTy ty
+           (Just snatTc) = UniqMap.lookup snatTcNm tcm
+           [snatDc] = tyConDataCons snatTc
+       in  reduce $
+           mkApps (Data snatDc) [ Right (LitTy (NumTy c))
+                                , Left (Literal (NaturalLiteral c))]
+
+  $(namePat 'Clash.Promoted.Nat.flogBaseSNat)
+    | [Right a, Right b] <- map (runExcept . tyNatSize tcm) tys
+    , Just c <- flogBase a b
+    , let c' = toInteger c
+    -> let (_,tyView -> TyConApp snatTcNm _) = splitFunForallTy ty
+           (Just snatTc) = UniqMap.lookup snatTcNm tcm
+           [snatDc] = tyConDataCons snatTc
+       in  reduce $
+           mkApps (Data snatDc) [ Right (LitTy (NumTy c'))
+                                , Left (Literal (NaturalLiteral c'))]
+
+  $(namePat 'Clash.Promoted.Nat.clogBaseSNat)
+    | [Right a, Right b] <- map (runExcept . tyNatSize tcm) tys
+    , Just c <- clogBase a b
+    , let c' = toInteger c
+    -> let (_,tyView -> TyConApp snatTcNm _) = splitFunForallTy ty
+           (Just snatTc) = UniqMap.lookup snatTcNm tcm
+           [snatDc] = tyConDataCons snatTc
+       in  reduce $
+           mkApps (Data snatDc) [ Right (LitTy (NumTy c'))
+                                , Left (Literal (NaturalLiteral c'))]
+    | otherwise
+    -> error ("clogBaseSNat: args = " <> show args <> ", tys = " <> show tys)
+
+  $(namePat 'Clash.Promoted.Nat.logBaseSNat)
+    | [Right a, Right b] <- map (runExcept . tyNatSize tcm) tys
+    , Just c <- flogBase a b
+    , let c' = toInteger c
+    -> let (_,tyView -> TyConApp snatTcNm _) = splitFunForallTy ty
+           (Just snatTc) = UniqMap.lookup snatTcNm tcm
+           [snatDc] = tyConDataCons snatTc
+       in  reduce $
+           mkApps (Data snatDc) [ Right (LitTy (NumTy c'))
+                                , Left (Literal (NaturalLiteral c'))]
+
+------------
+-- BitVector
+------------
+-- Constructor
+  $(namePat 'Clash.Sized.Internal.BitVector.BV)
+    | [Right _] <- map (runExcept . tyNatSize tcm) tys
+    , Just (m,i) <- integerLiterals args
+    -> let resTyInfo = extractTySizeInfo tcm ty tys
+       in  reduce (mkBitVectorLit' resTyInfo m i)
+
+  $(namePat 'Clash.Sized.Internal.BitVector.Bit)
+    | Just (m,i) <- integerLiterals args
+    -> reduce (mkBitLit ty m i)
+
+-- Initialization
+  $(namePat 'Clash.Sized.Internal.BitVector.size#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    -> let (_,tyView -> TyConApp intTcNm _) = splitFunForallTy ty
+           (Just intTc) = UniqMap.lookup intTcNm tcm
+           [intCon] = tyConDataCons intTc
+       in  reduce (mkApps (Data intCon) [Left (Literal (IntLiteral kn))])
+  $(namePat 'Clash.Sized.Internal.BitVector.maxIndex#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    -> let (_,tyView -> TyConApp intTcNm _) = splitFunForallTy ty
+           (Just intTc) = UniqMap.lookup intTcNm tcm
+           [intCon] = tyConDataCons intTc
+       in  reduce (mkApps (Data intCon) [Left (Literal (IntLiteral (kn-1)))])
+
+-- Construction
+  $(namePat 'Clash.Sized.Internal.BitVector.high)
+    -> reduce (mkBitLit ty 0 1)
+  $(namePat 'Clash.Sized.Internal.BitVector.low)
+    -> reduce (mkBitLit ty 0 0)
+
+  $(namePat 'Clash.Sized.Internal.BitVector.undefined#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    -> let resTyInfo = extractTySizeInfo tcm ty tys
+           mask = bit (fromInteger kn) - 1
+       in reduce (mkBitVectorLit' resTyInfo mask 0)
+
+-- Eq
+  $(namePat 'Clash.Sized.Internal.BitVector.eq##) | [(0,i),(0,j)] <- bitLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i == j))
+  $(namePat 'Clash.Sized.Internal.BitVector.neq##) | [(0,i),(0,j)] <- bitLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i /= j))
+
+-- Ord
+  $(namePat 'Clash.Sized.Internal.BitVector.lt##) | [(0,i),(0,j)] <- bitLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i <  j))
+  $(namePat 'Clash.Sized.Internal.BitVector.ge##) | [(0,i),(0,j)] <- bitLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i >= j))
+  $(namePat 'Clash.Sized.Internal.BitVector.gt##) | [(0,i),(0,j)] <- bitLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i >  j))
+  $(namePat 'Clash.Sized.Internal.BitVector.le##) | [(0,i),(0,j)] <- bitLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i <= j))
+
+-- Enum
+  $(namePat 'Clash.Sized.Internal.BitVector.toEnum##)
+    | [i] <- intCLiterals' args
+    -> let Bit msk val = BitVector.toEnum## (fromInteger i)
+       in reduce (mkBitLit ty (toInteger msk) (toInteger val))
+
+-- Bits
+  $(namePat 'Clash.Sized.Internal.BitVector.and##)
+    | [i,j] <- bitLiterals args
+    -> let Bit msk val = BitVector.and## (toBit i) (toBit j)
+       in reduce (mkBitLit ty (toInteger msk) (toInteger val))
+  $(namePat 'Clash.Sized.Internal.BitVector.or##)
+    | [i,j] <- bitLiterals args
+    -> let Bit msk val = BitVector.or## (toBit i) (toBit j)
+       in reduce (mkBitLit ty (toInteger msk) (toInteger val))
+  $(namePat 'Clash.Sized.Internal.BitVector.xor##)
+    | [i,j] <- bitLiterals args
+    -> let Bit msk val = BitVector.xor## (toBit i) (toBit j)
+       in reduce (mkBitLit ty (toInteger msk) (toInteger val))
+
+  $(namePat 'Clash.Sized.Internal.BitVector.complement##)
+    | [i] <- bitLiterals args
+    -> let Bit msk val = BitVector.complement## (toBit i)
+       in reduce (mkBitLit ty (toInteger msk) (toInteger val))
+
+-- Pack
+  $(namePat 'Clash.Sized.Internal.BitVector.pack#)
+    | [(msk,i)] <- bitLiterals args
+    -> let resTyInfo = extractTySizeInfo tcm ty tys
+       in  reduce (mkBitVectorLit' resTyInfo msk i)
+
+  $(namePat 'Clash.Sized.Internal.BitVector.unpack#)
+    | [(msk,i)] <- bitVectorLiterals' args
+    -> reduce (mkBitLit ty msk i)
+
+-- Concatenation
+  $(namePat '(Clash.Sized.Internal.BitVector.++#)) -- :: KnownNat m => BitVector n -> BitVector m -> BitVector (n + m)
+    | Just (_,m) <- extractKnownNat tcm tys
+    , [(mski,i),(mskj,j)] <- bitVectorLiterals' args
+    -> let val = i `shiftL` fromInteger m .|. j
+           msk = mski `shiftL` fromInteger m .|. mskj
+           resTyInfo = extractTySizeInfo tcm ty tys
+       in reduce (mkBitVectorLit' resTyInfo msk val)
+
+-- Reduction
+  $(namePat 'Clash.Sized.Internal.BitVector.reduceAnd#) -- :: KnownNat n => BitVector n -> Bit
+    | [i] <- bitVectorLiterals' args
+    , Just (_, kn) <- extractKnownNat tcm tys
+    -> let resTy = getResultTy tcm ty tys
+           val = reifyNat kn (op (toBV i))
+       in reduce (mkBitLit resTy 0 val)
+    where
+      op :: KnownNat n => BitVector n -> Proxy n -> Integer
+      op u _ = toInteger (BitVector.reduceAnd# u)
+  $(namePat 'Clash.Sized.Internal.BitVector.reduceOr#) -- :: KnownNat n => BitVector n -> Bit
+    | [i] <- bitVectorLiterals' args
+    , Just (_, kn) <- extractKnownNat tcm tys
+    -> let resTy = getResultTy tcm ty tys
+           val = reifyNat kn (op (toBV i))
+       in reduce (mkBitLit resTy 0 val)
+    where
+      op :: KnownNat n => BitVector n -> Proxy n -> Integer
+      op u _ = toInteger (BitVector.reduceOr# u)
+  $(namePat 'Clash.Sized.Internal.BitVector.reduceXor#) -- :: KnownNat n => BitVector n -> Bit
+    | [i] <- bitVectorLiterals' args
+    , Just (_, kn) <- extractKnownNat tcm tys
+    -> let resTy = getResultTy tcm ty tys
+           val = reifyNat kn (op (toBV i))
+       in reduce (mkBitLit resTy 0 val)
+    where
+      op :: KnownNat n => BitVector n -> Proxy n -> Integer
+      op u _ = toInteger (BitVector.reduceXor# u)
+
+
+-- Indexing
+  $(namePat 'Clash.Sized.Internal.BitVector.index#) -- :: KnownNat n => BitVector n -> Int -> Bit
+    | Just (_,kn,i,j) <- bitVectorLitIntLit tcm tys args
+      -> let resTy = getResultTy tcm ty tys
+             (msk,val) = reifyNat kn (op (toBV i) (fromInteger j))
+         in reduce (mkBitLit resTy msk val)
+      where
+        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
+        op u i _ = (toInteger m, toInteger v)
+          where Bit m v = (BitVector.index# u i)
+  $(namePat 'Clash.Sized.Internal.BitVector.replaceBit#) -- :: :: KnownNat n => BitVector n -> Int -> Bit -> BitVector n
+    | Just (_, n) <- extractKnownNat tcm tys
+    , [ _
+      , PrimVal bvP _ [_, Lit (NaturalLiteral mskBv), Lit (IntegerLiteral bv)]
+      , valArgs -> Just [Literal (IntLiteral i)]
+      , PrimVal bP _ [Lit (WordLiteral mskB), Lit (IntegerLiteral b)]
+      ] <- args
+    , primName bvP == showt 'Clash.Sized.Internal.BitVector.fromInteger#
+    , primName bP  == showt 'Clash.Sized.Internal.BitVector.fromInteger##
+      -> let resTyInfo = extractTySizeInfo tcm ty tys
+             (mskVal,val) = reifyNat n (op (BV (fromInteger mskBv) (fromInteger bv))
+                                           (fromInteger i)
+                                           (Bit (fromInteger mskB) (fromInteger b)))
+      in reduce (mkBitVectorLit' resTyInfo mskVal val)
+      where
+        op :: KnownNat n => BitVector n -> Int -> Bit -> Proxy n -> (Integer,Integer)
+        -- op bv i b _ = (BitVector.unsafeMask res, BitVector.unsafeToInteger res)
+        op bv i b _ = splitBV (BitVector.replaceBit# bv i b)
+  $(namePat 'Clash.Sized.Internal.BitVector.setSlice#)
+  -- :: SNat (m+1+i) -> BitVector (m + 1 + i) -> SNat m -> SNat n -> BitVector (m + 1 - n) -> BitVector (m + 1 + i)
+    | mTy : iTy : nTy : _ <- tys
+    , Right m <- runExcept (tyNatSize tcm mTy)
+    , Right iN <- runExcept (tyNatSize tcm iTy)
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    , [i,j] <- bitVectorLiterals' args
+    -> let BV msk val = BitVector.setSlice# (unsafeSNat (m+1+iN)) (toBV i) (unsafeSNat m) (unsafeSNat n) (toBV j)
+           resTyInfo = extractTySizeInfo tcm ty tys
+       in  reduce (mkBitVectorLit' resTyInfo (toInteger msk) (toInteger val))
+  $(namePat 'Clash.Sized.Internal.BitVector.slice#)
+  -- :: BitVector (m + 1 + i) -> SNat m -> SNat n -> BitVector (m + 1 - n)
+    | mTy : _ : nTy : _ <- tys
+    , Right m <- runExcept (tyNatSize tcm mTy)
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    , [i] <- bitVectorLiterals' args
+    -> let BV msk val = BitVector.slice# (toBV i) (unsafeSNat m) (unsafeSNat n)
+           resTyInfo = extractTySizeInfo tcm ty tys
+       in  reduce (mkBitVectorLit' resTyInfo (toInteger msk) (toInteger val))
+  $(namePat 'Clash.Sized.Internal.BitVector.split#) -- :: forall n m. KnownNat n => BitVector (m + n) -> (BitVector m, BitVector n)
+    | nTy : mTy : _ <- tys
+    , Right n <-  runExcept (tyNatSize tcm nTy)
+    , Right m <-  runExcept (tyNatSize tcm mTy)
+    , [(mski,i)] <- bitVectorLiterals' args
+    -> let ty' = piResultTys tcm ty tys
+           (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty'
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           bvTy : _ = tyArgs
+           valM = i `shiftR` fromInteger n
+           mskM = mski `shiftR` fromInteger n
+           valN = i .&. mask
+           mskN = mski .&. mask
+           mask = bit (fromInteger n) - 1
+    in reduce $
+       mkApps (Data tupDc) (map Right tyArgs ++
+                [ Left (mkBitVectorLit bvTy mTy m mskM valM)
+                , Left (mkBitVectorLit bvTy nTy n mskN valN)])
+
+  $(namePat 'Clash.Sized.Internal.BitVector.msb#) -- :: forall n. KnownNat n => BitVector n -> Bit
+    | [i] <- bitVectorLiterals' args
+    , Just (_, kn) <- extractKnownNat tcm tys
+    -> let resTy = getResultTy tcm ty tys
+           (msk,val) = reifyNat kn (op (toBV i))
+       in reduce (mkBitLit resTy (toInteger msk) (toInteger val))
+    where
+      op :: KnownNat n => BitVector n -> Proxy n -> (Word,Word)
+      op u _ = (unsafeMask# res, BitVector.unsafeToInteger# res)
+        where
+          res = BitVector.msb# u
+  $(namePat 'Clash.Sized.Internal.BitVector.lsb#) -- :: BitVector n -> Bit
+    | [i] <- bitVectorLiterals' args
+    -> let resTy = getResultTy tcm ty tys
+           Bit msk val = BitVector.lsb# (toBV i)
+    in reduce (mkBitLit resTy (toInteger msk) (toInteger val))
+
+
+-- Eq
+  -- eq#, neq# :: KnownNat n => BitVector n -> BitVector n -> Bool
+  $(namePat 'Clash.Sized.Internal.BitVector.eq#)
+    | nTy : _ <- tys
+    , Right 0 <- runExcept (tyNatSize tcm nTy)
+    -> reduce (boolToBoolLiteral tcm ty True)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2Bool BitVector.eq# ty tcm args)
+    -> reduce val
+
+  $(namePat 'Clash.Sized.Internal.BitVector.neq#)
+    | nTy : _ <- tys
+    , Right 0 <- runExcept (tyNatSize tcm nTy)
+    -> reduce (boolToBoolLiteral tcm ty False)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2Bool BitVector.neq# ty tcm args)
+    -> reduce val
+
+-- Ord
+  -- lt#,ge#,gt#,le# :: KnownNat n => BitVector n -> BitVector n -> Bool
+  $(namePat 'Clash.Sized.Internal.BitVector.lt#)
+    | nTy : _ <- tys
+    , Right 0 <- runExcept (tyNatSize tcm nTy)
+    -> reduce (boolToBoolLiteral tcm ty False)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2Bool BitVector.lt# ty tcm args)
+    -> reduce val
+  $(namePat 'Clash.Sized.Internal.BitVector.ge#)
+    | nTy : _ <- tys
+    , Right 0 <- runExcept (tyNatSize tcm nTy)
+    -> reduce (boolToBoolLiteral tcm ty True)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2Bool BitVector.ge# ty tcm args)
+    -> reduce val
+  $(namePat 'Clash.Sized.Internal.BitVector.gt#)
+    | nTy : _ <- tys
+    , Right 0 <- runExcept (tyNatSize tcm nTy)
+    -> reduce (boolToBoolLiteral tcm ty False)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2Bool BitVector.gt# ty tcm args)
+    -> reduce val
+  $(namePat 'Clash.Sized.Internal.BitVector.le#)
+    | nTy : _ <- tys
+    , Right 0 <- runExcept (tyNatSize tcm nTy)
+    -> reduce (boolToBoolLiteral tcm ty True)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2Bool BitVector.le# ty tcm args)
+    -> reduce val
+
+-- Enum
+
+  $(namePat 'Clash.Sized.Internal.BitVector.toEnum#)
+    | let resTyInfo@(_,_,kn) = extractTySizeInfo tcm ty tys
+    , Just val <- reifyNat kn (liftInteger2BitVector (BitVector.toEnum# . fromInteger) resTyInfo args)
+    -> reduce val
+
+  $(namePat 'Clash.Sized.Internal.BitVector.fromEnum#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , let resTy = getResultTy tcm ty tys
+    , Just val <- reifyNat kn (liftBitVector2CInt tcm resTy (toInteger . BitVector.fromEnum#) args)
+    -> reduce val
+
+-- Bounded
+  $(namePat 'Clash.Sized.Internal.BitVector.minBound#)
+    | Just (nTy,len) <- extractKnownNat tcm tys
+    -> reduce (mkBitVectorLit ty nTy len 0 0)
+  $(namePat 'Clash.Sized.Internal.BitVector.maxBound#)
+    | Just (litTy,mb) <- extractKnownNat tcm tys
+    -> let maxB = (2 ^ mb) - 1
+       in  reduce (mkBitVectorLit ty litTy mb 0 maxB)
+
+-- Num
+  $(namePat '(Clash.Sized.Internal.BitVector.+#))
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2 (BitVector.+#) ty tcm tys args)
+    -> reduce val
+  $(namePat '(Clash.Sized.Internal.BitVector.-#))
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2 (BitVector.-#) ty tcm tys args)
+    -> reduce val
+  $(namePat '(Clash.Sized.Internal.BitVector.*#))
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2 (BitVector.*#) ty tcm tys args)
+    -> reduce val
+  $(namePat 'Clash.Sized.Internal.BitVector.negate#)
+    | Just (nTy, kn) <- extractKnownNat tcm tys
+    , [i] <- bitVectorLiterals' args
+    -> let (msk,val) = reifyNat kn (op (toBV i))
+    in reduce (mkBitVectorLit ty nTy kn msk val)
+    where
+      op :: KnownNat n => BitVector n -> Proxy n -> (Integer,Integer)
+      op u _ = splitBV (BitVector.negate# u)
+
+-- ExtendingNum
+  $(namePat 'Clash.Sized.Internal.BitVector.plus#) -- :: (KnownNat n, KnownNat m) => BitVector m -> BitVector n -> BitVector (Max m n + 1)
+    | [(0,i),(0,j)] <- bitVectorLiterals' args
+    -> let ty' = piResultTys tcm ty tys
+           (_,resTy) = splitFunForallTy ty'
+           (TyConApp _ [resSizeTy]) = tyView resTy
+           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
+       in  reduce (mkBitVectorLit resTy resSizeTy resSizeInt 0 (i+j))
+
+  $(namePat 'Clash.Sized.Internal.BitVector.minus#)
+    | [(0,i),(0,j)] <- bitVectorLiterals' args
+    -> let ty' = piResultTys tcm ty tys
+           (_,resTy) = splitFunForallTy ty'
+           (TyConApp _ [resSizeTy]) = tyView resTy
+           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
+           val = reifyNat resSizeInt (runSizedF (BitVector.-#) i j)
+      in  reduce (mkBitVectorLit resTy resSizeTy resSizeInt 0 val)
+
+  $(namePat 'Clash.Sized.Internal.BitVector.times#)
+    | [(0,i),(0,j)] <- bitVectorLiterals' args
+    -> let ty' = piResultTys tcm ty tys
+           (_,resTy) = splitFunForallTy ty'
+           (TyConApp _ [resSizeTy]) = tyView resTy
+           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
+       in  reduce (mkBitVectorLit resTy resSizeTy resSizeInt 0 (i*j))
+
+-- Integral
+  $(namePat 'Clash.Sized.Internal.BitVector.quot#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2 (BitVector.quot#) ty tcm tys args)
+    -> reduce $ catchDivByZero val
+  $(namePat 'Clash.Sized.Internal.BitVector.rem#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2 (BitVector.rem#) ty tcm tys args)
+    -> reduce $ catchDivByZero val
+  $(namePat 'Clash.Sized.Internal.BitVector.toInteger#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , [i] <- bitVectorLiterals' args
+    -> let val = reifyNat kn (op (toBV i))
+    in reduce (integerToIntegerLiteral val)
+    where
+      op :: KnownNat n => BitVector n -> Proxy n -> Integer
+      op u _ = BitVector.toInteger# u
+
+-- Bits
+  $(namePat 'Clash.Sized.Internal.BitVector.and#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2 (BitVector.and#) ty tcm tys args)
+    -> reduce val
+  $(namePat 'Clash.Sized.Internal.BitVector.or#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2 (BitVector.or#) ty tcm tys args)
+    -> reduce val
+  $(namePat 'Clash.Sized.Internal.BitVector.xor#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftBitVector2 (BitVector.xor#) ty tcm tys args)
+    -> reduce val
+
+  $(namePat 'Clash.Sized.Internal.BitVector.complement#)
+    | [i] <- bitVectorLiterals' args
+    , Just (nTy, kn) <- extractKnownNat tcm tys
+    -> let (msk,val) = reifyNat kn (op (toBV i))
+    in reduce (mkBitVectorLit ty nTy kn msk val)
+    where
+      op :: KnownNat n => BitVector n -> Proxy n -> (Integer,Integer)
+      op u _ = splitBV $ BitVector.complement# u
+
+  $(namePat 'Clash.Sized.Internal.BitVector.shiftL#)
+    | Just (nTy,kn,i,j) <- bitVectorLitIntLit tcm tys args
+      -> let (msk,val) = reifyNat kn (op (toBV i) (fromInteger j))
+      in reduce (mkBitVectorLit ty nTy kn msk val)
+      where
+        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
+        op u i _ = splitBV (BitVector.shiftL# u i)
+  $(namePat 'Clash.Sized.Internal.BitVector.shiftR#)
+    | Just (nTy,kn,i,j) <- bitVectorLitIntLit tcm tys args
+      -> let (msk,val) = reifyNat kn (op (toBV i) (fromInteger j))
+      in reduce (mkBitVectorLit ty nTy kn msk val)
+      where
+        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
+        op u i _ = splitBV (BitVector.shiftR# u i)
+  $(namePat 'Clash.Sized.Internal.BitVector.rotateL#)
+    | Just (nTy,kn,i,j) <- bitVectorLitIntLit tcm tys args
+      -> let (msk,val) = reifyNat kn (op (toBV i) (fromInteger j))
+      in reduce (mkBitVectorLit ty nTy kn msk val)
+      where
+        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
+        op u i _ = splitBV (BitVector.rotateL# u i)
+  $(namePat 'Clash.Sized.Internal.BitVector.rotateR#)
+    | Just (nTy,kn,i,j) <- bitVectorLitIntLit tcm tys args
+      -> let (msk,val) = reifyNat kn (op (toBV i) (fromInteger j))
+      in reduce (mkBitVectorLit ty nTy kn msk val)
+      where
+        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
+        op u i _ = splitBV (BitVector.rotateR# u i)
+
+-- truncateB
+  $(namePat 'Clash.Sized.Internal.BitVector.truncateB#) -- forall a b . KnownNat a => BitVector (a + b) -> BitVector a
+    | aTy  : _ <- tys
+    , Right ka <- runExcept (tyNatSize tcm aTy)
+    , [(mski,i)] <- bitVectorLiterals' args
+    -> let bitsKeep = (bit (fromInteger ka)) - 1
+           val = i .&. bitsKeep
+           msk = mski .&. bitsKeep
+    in reduce (mkBitVectorLit ty aTy ka msk val)
+
+--------
+-- Index
+--------
+-- BitPack
+  $(namePat 'Clash.Sized.Internal.Index.pack#)
+    | nTy : _ <- tys
+    , Right _ <- runExcept (tyNatSize tcm nTy)
+    , [i] <- indexLiterals' args
+    -> let resTyInfo = extractTySizeInfo tcm ty tys
+       in  reduce (mkBitVectorLit' resTyInfo 0 i)
+  $(namePat 'Clash.Sized.Internal.Index.unpack#)
+    | Just (nTy,kn) <- extractKnownNat tcm tys
+    , [(0,i)] <- bitVectorLiterals' args
+    -> reduce (mkIndexLit ty nTy kn i)
+
+-- Eq
+  $(namePat 'Clash.Sized.Internal.Index.eq#) | Just (i,j) <- indexLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i == j))
+  $(namePat 'Clash.Sized.Internal.Index.neq#) | Just (i,j) <- indexLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i /= j))
+
+-- Ord
+  $(namePat 'Clash.Sized.Internal.Index.lt#)
+    | Just (i,j) <- indexLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i < j))
+  $(namePat 'Clash.Sized.Internal.Index.ge#)
+    | Just (i,j) <- indexLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i >= j))
+  $(namePat 'Clash.Sized.Internal.Index.gt#)
+    | Just (i,j) <- indexLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i > j))
+  $(namePat 'Clash.Sized.Internal.Index.le#)
+    | Just (i,j) <- indexLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i <= j))
+
+-- Enum
+  $(namePat 'Clash.Sized.Internal.Index.toEnum#)
+    | [i] <- intCLiterals' args
+    , Just (nTy, mb) <- extractKnownNat tcm tys
+    -> reduce (mkIndexLit ty nTy mb i)
+
+  $(namePat 'Clash.Sized.Internal.Index.fromEnum#)
+    | [i] <- indexLiterals' args
+    -> let resTy = getResultTy tcm ty tys
+        in reduce (mkIntCLit tcm i resTy)
+
+-- Bounded
+  $(namePat 'Clash.Sized.Internal.Index.maxBound#)
+    | Just (nTy,mb) <- extractKnownNat tcm tys
+    -> reduce (mkIndexLit ty nTy mb (mb - 1))
+
+-- Num
+  $(namePat '(Clash.Sized.Internal.Index.+#))
+    | Just (nTy,kn) <- extractKnownNat tcm tys
+    , [i,j] <- indexLiterals' args
+    -> reduce (mkIndexLit ty nTy kn (i + j))
+  $(namePat '(Clash.Sized.Internal.Index.-#))
+    | Just (nTy,kn) <- extractKnownNat tcm tys
+    , [i,j] <- indexLiterals' args
+    -> reduce (mkIndexLit ty nTy kn (i - j))
+  $(namePat '(Clash.Sized.Internal.Index.*#))
+    | Just (nTy,kn) <- extractKnownNat tcm tys
+    , [i,j] <- indexLiterals' args
+    -> reduce (mkIndexLit ty nTy kn (i * j))
+
+-- ExtendingNum
+  $(namePat 'Clash.Sized.Internal.Index.plus#)
+    | mTy : nTy : _ <- tys
+    , Right _ <- runExcept (tyNatSize tcm mTy)
+    , Right _ <- runExcept (tyNatSize tcm nTy)
+    , Just (i,j) <- indexLiterals args
+    -> let resTyInfo = extractTySizeInfo tcm ty tys
+       in  reduce (mkIndexLit' resTyInfo (i + j))
+  $(namePat 'Clash.Sized.Internal.Index.minus#)
+    | mTy : nTy : _ <- tys
+    , Right _ <- runExcept (tyNatSize tcm mTy)
+    , Right _ <- runExcept (tyNatSize tcm nTy)
+    , Just (i,j) <- indexLiterals args
+    -> let resTyInfo = extractTySizeInfo tcm ty tys
+       in  reduce (mkIndexLit' resTyInfo (i - j))
+  $(namePat 'Clash.Sized.Internal.Index.times#)
+    | mTy : nTy : _ <- tys
+    , Right _ <- runExcept (tyNatSize tcm mTy)
+    , Right _ <- runExcept (tyNatSize tcm nTy)
+    , Just (i,j) <- indexLiterals args
+    -> let resTyInfo = extractTySizeInfo tcm ty tys
+       in  reduce (mkIndexLit' resTyInfo (i * j))
+
+-- Integral
+  $(namePat 'Clash.Sized.Internal.Index.quot#)
+    | Just (nTy,kn) <- extractKnownNat tcm tys
+    , Just (i,j) <- indexLiterals args
+    -> reduce $ catchDivByZero (mkIndexLit ty nTy kn (i `quot` j))
+  $(namePat 'Clash.Sized.Internal.Index.rem#)
+    | Just (nTy,kn) <- extractKnownNat tcm tys
+    , Just (i,j) <- indexLiterals args
+    -> reduce $ catchDivByZero (mkIndexLit ty nTy kn (i `rem` j))
+  $(namePat 'Clash.Sized.Internal.Index.toInteger#)
+    | [PrimVal p _ [_, Lit (IntegerLiteral i)]] <- args
+    , primName p == showt 'Clash.Sized.Internal.Index.fromInteger#
+    -> reduce (integerToIntegerLiteral i)
+
+-- Resize
+  $(namePat 'Clash.Sized.Internal.Index.resize#)
+    | Just (mTy,m) <- extractKnownNat tcm tys
+    , [i] <- indexLiterals' args
+    -> reduce (mkIndexLit ty mTy m i)
+
+---------
+-- Signed
+---------
+  $(namePat 'Clash.Sized.Internal.Signed.size#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    -> let (_,tyView -> TyConApp intTcNm _) = splitFunForallTy ty
+           (Just intTc) = UniqMap.lookup intTcNm tcm
+           [intCon] = tyConDataCons intTc
+       in  reduce (mkApps (Data intCon) [Left (Literal (IntLiteral kn))])
+
+-- BitPack
+  $(namePat 'Clash.Sized.Internal.Signed.pack#)
+    | Just (nTy, kn) <- extractKnownNat tcm tys
+    , [i] <- signedLiterals' args
+    -> let val = reifyNat kn (op (fromInteger i))
+       in reduce (mkBitVectorLit ty nTy kn 0 val)
+    where
+        op :: KnownNat n => Signed n -> Proxy n -> Integer
+        op s _ = toInteger (Signed.pack# s)
+  $(namePat 'Clash.Sized.Internal.Signed.unpack#)
+    | Just (nTy, kn) <- extractKnownNat tcm tys
+    , [(0,i)] <- bitVectorLiterals' args
+    -> let val = reifyNat kn (op (fromInteger i))
+       in reduce (mkSignedLit ty nTy kn val)
+    where
+        op :: KnownNat n => BitVector n -> Proxy n -> Integer
+        op s _ = toInteger (Signed.unpack# s)
+
+-- Eq
+  $(namePat 'Clash.Sized.Internal.Signed.eq#) | Just (i,j) <- signedLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i == j))
+  $(namePat 'Clash.Sized.Internal.Signed.neq#) | Just (i,j) <- signedLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i /= j))
+
+-- Ord
+  $(namePat 'Clash.Sized.Internal.Signed.lt#) | Just (i,j) <- signedLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i <  j))
+  $(namePat 'Clash.Sized.Internal.Signed.ge#) | Just (i,j) <- signedLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i >= j))
+  $(namePat 'Clash.Sized.Internal.Signed.gt#) | Just (i,j) <- signedLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i >  j))
+  $(namePat 'Clash.Sized.Internal.Signed.le#) | Just (i,j) <- signedLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i <= j))
+
+-- Enum
+  $(namePat 'Clash.Sized.Internal.Signed.toEnum#)
+    | [i] <- intCLiterals' args
+    , Just (litTy, mb) <- extractKnownNat tcm tys
+    -> reduce (mkSignedLit ty litTy mb i)
+
+  $(namePat 'Clash.Sized.Internal.Signed.fromEnum#)
+    | [i] <- signedLiterals' args
+    -> let resTy = getResultTy tcm ty tys
+        in reduce (mkIntCLit tcm i resTy)
+
+-- Bounded
+  $(namePat 'Clash.Sized.Internal.Signed.minBound#)
+    | Just (litTy,mb) <- extractKnownNat tcm tys
+    -> let minB = negate (2 ^ (mb - 1))
+       in  reduce (mkSignedLit ty litTy mb minB)
+  $(namePat 'Clash.Sized.Internal.Signed.maxBound#)
+    | Just (litTy,mb) <- extractKnownNat tcm tys
+    -> let maxB = (2 ^ (mb - 1)) - 1
+       in reduce (mkSignedLit ty litTy mb maxB)
+
+-- Num
+  $(namePat '(Clash.Sized.Internal.Signed.+#))
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftSigned2 (Signed.+#) ty tcm tys args)
+    -> reduce (val)
+  $(namePat '(Clash.Sized.Internal.Signed.-#))
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftSigned2 (Signed.-#) ty tcm tys args)
+    -> reduce (val)
+  $(namePat '(Clash.Sized.Internal.Signed.*#))
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftSigned2 (Signed.*#) ty tcm tys args)
+    -> reduce (val)
+  $(namePat 'Clash.Sized.Internal.Signed.negate#)
+    | Just (nTy, kn) <- extractKnownNat tcm tys
+    , [i] <- signedLiterals' args
+    -> let val = reifyNat kn (op (fromInteger i))
+    in reduce (mkSignedLit ty nTy kn val)
+    where
+      op :: KnownNat n => Signed n -> Proxy n -> Integer
+      op s _ = toInteger (Signed.negate# s)
+  $(namePat 'Clash.Sized.Internal.Signed.abs#)
+    | Just (nTy, kn) <- extractKnownNat tcm tys
+    , [i] <- signedLiterals' args
+    -> let val = reifyNat kn (op (fromInteger i))
+    in reduce (mkSignedLit ty nTy kn val)
+    where
+      op :: KnownNat n => Signed n -> Proxy n -> Integer
+      op s _ = toInteger (Signed.abs# s)
+
+-- ExtendingNum
+  $(namePat 'Clash.Sized.Internal.Signed.plus#)
+    | Just (i,j) <- signedLiterals args
+    -> let ty' = piResultTys tcm ty tys
+           (_,resTy) = splitFunForallTy ty'
+           (TyConApp _ [resSizeTy]) = tyView resTy
+           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
+       in  reduce (mkSignedLit resTy resSizeTy resSizeInt (i+j))
+
+  $(namePat 'Clash.Sized.Internal.Signed.minus#)
+    | Just (i,j) <- signedLiterals args
+    -> let ty' = piResultTys tcm ty tys
+           (_,resTy) = splitFunForallTy ty'
+           (TyConApp _ [resSizeTy]) = tyView resTy
+           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
+       in  reduce (mkSignedLit resTy resSizeTy resSizeInt (i-j))
+
+  $(namePat 'Clash.Sized.Internal.Signed.times#)
+    | Just (i,j) <- signedLiterals args
+    -> let ty' = piResultTys tcm ty tys
+           (_,resTy) = splitFunForallTy ty'
+           (TyConApp _ [resSizeTy]) = tyView resTy
+           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
+       in  reduce (mkSignedLit resTy resSizeTy resSizeInt (i*j))
+
+-- Integral
+  $(namePat 'Clash.Sized.Internal.Signed.quot#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftSigned2 (Signed.quot#) ty tcm tys args)
+    -> reduce $ catchDivByZero val
+  $(namePat 'Clash.Sized.Internal.Signed.rem#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftSigned2 (Signed.rem#) ty tcm tys args)
+    -> reduce $ catchDivByZero val
+  $(namePat 'Clash.Sized.Internal.Signed.div#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftSigned2 (Signed.div#) ty tcm tys args)
+    -> reduce $ catchDivByZero val
+  $(namePat 'Clash.Sized.Internal.Signed.mod#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftSigned2 (Signed.mod#) ty tcm tys args)
+    -> reduce $ catchDivByZero val
+  $(namePat 'Clash.Sized.Internal.Signed.toInteger#)
+    | [PrimVal p _ [_, Lit (IntegerLiteral i)]] <- args
+    , primName p == showt 'Clash.Sized.Internal.Signed.fromInteger#
+    -> reduce (integerToIntegerLiteral i)
+
+-- Bits
+  $(namePat 'Clash.Sized.Internal.Signed.and#)
+    | [i,j] <- signedLiterals' args
+    , Just (nTy, kn) <- extractKnownNat tcm tys
+    -> reduce (mkSignedLit ty nTy kn (i .&. j))
+  $(namePat 'Clash.Sized.Internal.Signed.or#)
+    | [i,j] <- signedLiterals' args
+    , Just (nTy, kn) <- extractKnownNat tcm tys
+    -> reduce (mkSignedLit ty nTy kn (i .|. j))
+  $(namePat 'Clash.Sized.Internal.Signed.xor#)
+    | [i,j] <- signedLiterals' args
+    , Just (nTy, kn) <- extractKnownNat tcm tys
+    -> reduce (mkSignedLit ty nTy kn (i `xor` j))
+
+  $(namePat 'Clash.Sized.Internal.Signed.complement#)
+    | [i] <- signedLiterals' args
+    , Just (nTy, kn) <- extractKnownNat tcm tys
+    -> let val = reifyNat kn (op (fromInteger i))
+    in reduce (mkSignedLit ty nTy kn val)
+    where
+      op :: KnownNat n => Signed n -> Proxy n -> Integer
+      op u _ = toInteger (Signed.complement# u)
+
+  $(namePat 'Clash.Sized.Internal.Signed.shiftL#)
+    | Just (nTy,kn,i,j) <- signedLitIntLit tcm tys args
+      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
+      in reduce (mkSignedLit ty nTy kn val)
+      where
+        op :: KnownNat n => Signed n -> Int -> Proxy n -> Integer
+        op u i _ = toInteger (Signed.shiftL# u i)
+  $(namePat 'Clash.Sized.Internal.Signed.shiftR#)
+    | Just (nTy,kn,i,j) <- signedLitIntLit tcm tys args
+      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
+      in reduce (mkSignedLit ty nTy kn val)
+      where
+        op :: KnownNat n => Signed n -> Int -> Proxy n -> Integer
+        op u i _ = toInteger (Signed.shiftR# u i)
+  $(namePat 'Clash.Sized.Internal.Signed.rotateL#)
+    | Just (nTy,kn,i,j) <- signedLitIntLit tcm tys args
+      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
+      in reduce (mkSignedLit ty nTy kn val)
+      where
+        op :: KnownNat n => Signed n -> Int -> Proxy n -> Integer
+        op u i _ = toInteger (Signed.rotateL# u i)
+  $(namePat 'Clash.Sized.Internal.Signed.rotateR#)
+    | Just (nTy,kn,i,j) <- signedLitIntLit tcm tys args
+      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
+      in reduce (mkSignedLit ty nTy kn val)
+      where
+        op :: KnownNat n => Signed n -> Int -> Proxy n -> Integer
+        op u i _ = toInteger (Signed.rotateR# u i)
+
+-- Resize
+  $(namePat 'Clash.Sized.Internal.Signed.resize#) -- forall m n. (KnownNat n, KnownNat m) => Signed n -> Signed m
+    | mTy : nTy : _ <- tys
+    , Right mInt <- runExcept (tyNatSize tcm mTy)
+    , Right nInt <- runExcept (tyNatSize tcm nTy)
+    , [i] <- signedLiterals' args
+    -> let val | nInt <= mInt = extended
+               | otherwise    = truncated
+           extended  = i
+           mask      = 1 `shiftL` fromInteger (mInt - 1)
+           i'        = i `mod` mask
+           truncated = if testBit i (fromInteger nInt - 1)
+                          then (i' - mask)
+                          else i'
+       in reduce (mkSignedLit ty mTy mInt val)
+  $(namePat 'Clash.Sized.Internal.Signed.truncateB#) -- KnownNat m => Signed (m + n) -> Signed m
+    | Just (mTy, km) <- extractKnownNat tcm tys
+    , [i] <- signedLiterals' args
+    -> let bitsKeep = (bit (fromInteger km)) - 1
+           val = i .&. bitsKeep
+    in reduce (mkSignedLit ty mTy km val)
+
+-- SaturatingNum
+-- No need to manually evaluate Clash.Sized.Internal.Signed.minBoundSym#
+-- It is just implemented in terms of other primitives.
+
+
+-----------
+-- Unsigned
+-----------
+  $(namePat 'Clash.Sized.Internal.Unsigned.size#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    -> let (_,ty') = splitFunForallTy ty
+           (TyConApp intTcNm _) = tyView ty'
+           (Just intTc) = UniqMap.lookup intTcNm tcm
+           [intCon] = tyConDataCons intTc
+       in  reduce (mkApps (Data intCon) [Left (Literal (IntLiteral kn))])
+
+-- BitPack
+  $(namePat 'Clash.Sized.Internal.Unsigned.pack#)
+    | Just (nTy, kn) <- extractKnownNat tcm tys
+    , [i] <- unsignedLiterals' args
+    -> reduce (mkBitVectorLit ty nTy kn 0 i)
+  $(namePat 'Clash.Sized.Internal.Unsigned.unpack#)
+    | Just (nTy, kn) <- extractKnownNat tcm tys
+    , [i] <- bitVectorLiterals' args
+    -> let val = reifyNat kn (op (toBV i))
+    in reduce (mkUnsignedLit ty nTy kn val)
+    where
+      op :: KnownNat n => BitVector n -> Proxy n -> Integer
+      op u _ = toInteger (Unsigned.unpack# u)
+
+-- Eq
+  $(namePat 'Clash.Sized.Internal.Unsigned.eq#) | Just (i,j) <- unsignedLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i == j))
+  $(namePat 'Clash.Sized.Internal.Unsigned.neq#) | Just (i,j) <- unsignedLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i /= j))
+
+-- Ord
+  $(namePat 'Clash.Sized.Internal.Unsigned.lt#) | Just (i,j) <- unsignedLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i <  j))
+  $(namePat 'Clash.Sized.Internal.Unsigned.ge#) | Just (i,j) <- unsignedLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i >= j))
+  $(namePat 'Clash.Sized.Internal.Unsigned.gt#) | Just (i,j) <- unsignedLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i >  j))
+  $(namePat 'Clash.Sized.Internal.Unsigned.le#) | Just (i,j) <- unsignedLiterals args
+    -> reduce (boolToBoolLiteral tcm ty (i <= j))
+
+-- Enum
+  $(namePat 'Clash.Sized.Internal.Unsigned.toEnum#)
+    | [i] <- intCLiterals' args
+    , Just (litTy, mb) <- extractKnownNat tcm tys
+    -> reduce (mkUnsignedLit ty litTy mb i)
+
+  $(namePat 'Clash.Sized.Internal.Unsigned.fromEnum#)
+    | [i] <- unsignedLiterals' args
+    -> let resTy = getResultTy tcm ty tys
+        in reduce (mkIntCLit tcm i resTy)
+
+-- Bounded
+  $(namePat 'Clash.Sized.Internal.Unsigned.minBound#)
+    | Just (nTy,len) <- extractKnownNat tcm tys
+    -> reduce (mkUnsignedLit ty nTy len 0)
+  $(namePat 'Clash.Sized.Internal.Unsigned.maxBound#)
+    | Just (litTy,mb) <- extractKnownNat tcm tys
+    -> let maxB = (2 ^ mb) - 1
+       in  reduce (mkUnsignedLit ty litTy mb maxB)
+
+-- Num
+  $(namePat '(Clash.Sized.Internal.Unsigned.+#))
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftUnsigned2 (Unsigned.+#) ty tcm tys args)
+    -> reduce val
+  $(namePat '(Clash.Sized.Internal.Unsigned.-#))
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftUnsigned2 (Unsigned.-#) ty tcm tys args)
+    -> reduce val
+  $(namePat '(Clash.Sized.Internal.Unsigned.*#))
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftUnsigned2 (Unsigned.*#) ty tcm tys args)
+    -> reduce val
+  $(namePat 'Clash.Sized.Internal.Unsigned.negate#)
+    | Just (nTy, kn) <- extractKnownNat tcm tys
+    , [i] <- unsignedLiterals' args
+    -> let val = reifyNat kn (op (fromInteger i))
+    in reduce (mkUnsignedLit ty nTy kn val)
+    where
+      op :: KnownNat n => Unsigned n -> Proxy n -> Integer
+      op u _ = toInteger (Unsigned.negate# u)
+
+-- ExtendingNum
+  $(namePat 'Clash.Sized.Internal.Unsigned.plus#) -- :: Unsigned m -> Unsigned n -> Unsigned (Max m n + 1)
+    | Just (i,j) <- unsignedLiterals args
+    -> let ty' = piResultTys tcm ty tys
+           (_,resTy) = splitFunForallTy ty'
+           (TyConApp _ [resSizeTy]) = tyView resTy
+           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
+       in  reduce (mkUnsignedLit resTy resSizeTy resSizeInt (i+j))
+
+  $(namePat 'Clash.Sized.Internal.Unsigned.minus#)
+    | [i,j] <- unsignedLiterals' args
+    -> let ty' = piResultTys tcm ty tys
+           (_,resTy) = splitFunForallTy ty'
+           (TyConApp _ [resSizeTy]) = tyView resTy
+           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
+           val = reifyNat resSizeInt (runSizedF (Unsigned.-#) i j)
+      in   reduce (mkUnsignedLit resTy resSizeTy resSizeInt val)
+
+  $(namePat 'Clash.Sized.Internal.Unsigned.times#)
+    | Just (i,j) <- unsignedLiterals args
+    -> let ty' = piResultTys tcm ty tys
+           (_,resTy) = splitFunForallTy ty'
+           (TyConApp _ [resSizeTy]) = tyView resTy
+           Right resSizeInt = runExcept (tyNatSize tcm resSizeTy)
+       in  reduce (mkUnsignedLit resTy resSizeTy resSizeInt (i*j))
+
+-- Integral
+  $(namePat 'Clash.Sized.Internal.Unsigned.quot#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftUnsigned2 (Unsigned.quot#) ty tcm tys args)
+    -> reduce $ catchDivByZero val
+  $(namePat 'Clash.Sized.Internal.Unsigned.rem#)
+    | Just (_, kn) <- extractKnownNat tcm tys
+    , Just val <- reifyNat kn (liftUnsigned2 (Unsigned.rem#) ty tcm tys args)
+    -> reduce $ catchDivByZero val
+  $(namePat 'Clash.Sized.Internal.Unsigned.toInteger#)
+    | [PrimVal p _ [_, Lit (IntegerLiteral i)]] <- args
+    , primName p == showt 'Clash.Sized.Internal.Unsigned.fromInteger#
+    -> reduce (integerToIntegerLiteral i)
+
+-- Bits
+  $(namePat 'Clash.Sized.Internal.Unsigned.and#)
+    | Just (i,j) <- unsignedLiterals args
+    , Just (nTy, kn) <- extractKnownNat tcm tys
+    -> reduce (mkUnsignedLit ty nTy kn (i .&. j))
+  $(namePat 'Clash.Sized.Internal.Unsigned.or#)
+    | Just (i,j) <- unsignedLiterals args
+    , Just (nTy, kn) <- extractKnownNat tcm tys
+    -> reduce (mkUnsignedLit ty nTy kn (i .|. j))
+  $(namePat 'Clash.Sized.Internal.Unsigned.xor#)
+    | Just (i,j) <- unsignedLiterals args
+    , Just (nTy, kn) <- extractKnownNat tcm tys
+    -> reduce (mkUnsignedLit ty nTy kn (i `xor` j))
+
+  $(namePat 'Clash.Sized.Internal.Unsigned.complement#)
+    | [i] <- unsignedLiterals' args
+    , Just (nTy, kn) <- extractKnownNat tcm tys
+    -> let val = reifyNat kn (op (fromInteger i))
+    in reduce (mkUnsignedLit ty nTy kn val)
+    where
+      op :: KnownNat n => Unsigned n -> Proxy n -> Integer
+      op u _ = toInteger (Unsigned.complement# u)
+
+  $(namePat 'Clash.Sized.Internal.Unsigned.shiftL#) -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
+    | Just (nTy,kn,i,j) <- unsignedLitIntLit tcm tys args
+      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
+      in reduce (mkUnsignedLit ty nTy kn val)
+      where
+        op :: KnownNat n => Unsigned n -> Int -> Proxy n -> Integer
+        op u i _ = toInteger (Unsigned.shiftL# u i)
+  $(namePat 'Clash.Sized.Internal.Unsigned.shiftR#) -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
+    | Just (nTy,kn,i,j) <- unsignedLitIntLit tcm tys args
+      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
+      in reduce (mkUnsignedLit ty nTy kn val)
+      where
+        op :: KnownNat n => Unsigned n -> Int -> Proxy n -> Integer
+        op u i _ = toInteger (Unsigned.shiftR# u i)
+  $(namePat 'Clash.Sized.Internal.Unsigned.rotateL#) -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
+    | Just (nTy,kn,i,j) <- unsignedLitIntLit tcm tys args
+      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
+      in reduce (mkUnsignedLit ty nTy kn val)
+      where
+        op :: KnownNat n => Unsigned n -> Int -> Proxy n -> Integer
+        op u i _ = toInteger (Unsigned.rotateL# u i)
+  $(namePat 'Clash.Sized.Internal.Unsigned.rotateR#) -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
+    | Just (nTy,kn,i,j) <- unsignedLitIntLit tcm tys args
+      -> let val = reifyNat kn (op (fromInteger i) (fromInteger j))
+      in reduce (mkUnsignedLit ty nTy kn val)
+      where
+        op :: KnownNat n => Unsigned n -> Int -> Proxy n -> Integer
+        op u i _ = toInteger (Unsigned.rotateR# u i)
+
+-- Resize
+  $(namePat 'Clash.Sized.Internal.Unsigned.resize#) -- forall n m . KnownNat m => Unsigned n -> Unsigned m
+    | _ : mTy : _ <- tys
+    , Right km <- runExcept (tyNatSize tcm mTy)
+    , [i] <- unsignedLiterals' args
+    -> let bitsKeep = (bit (fromInteger km)) - 1
+           val = i .&. bitsKeep
+    in reduce (mkUnsignedLit ty mTy km val)
+
+-- Conversions
+  $(namePat 'Clash.Sized.Internal.Unsigned.unsignedToWord)
+    | isSubj
+    , [a] <- unsignedLiterals' args
+    -> let b = Unsigned.unsignedToWord (U (fromInteger a))
+           (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
+           (Just wordTc) = UniqMap.lookup wordTcNm tcm
+           [wordDc] = tyConDataCons wordTc
+       in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral (toInteger b)))])
+
+  $(namePat 'Clash.Sized.Internal.Unsigned.unsigned8toWord8)
+    | isSubj
+    , [a] <- unsignedLiterals' args
+    -> let b = Unsigned.unsigned8toWord8 (U (fromInteger a))
+           (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
+           (Just wordTc) = UniqMap.lookup wordTcNm tcm
+           [wordDc] = tyConDataCons wordTc
+       in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral (toInteger b)))])
+
+  $(namePat 'Clash.Sized.Internal.Unsigned.unsigned16toWord16)
+    | isSubj
+    , [a] <- unsignedLiterals' args
+    -> let b = Unsigned.unsigned16toWord16 (U (fromInteger a))
+           (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
+           (Just wordTc) = UniqMap.lookup wordTcNm tcm
+           [wordDc] = tyConDataCons wordTc
+       in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral (toInteger b)))])
+
+  $(namePat 'Clash.Sized.Internal.Unsigned.unsigned32toWord32)
+    | isSubj
+    , [a] <- unsignedLiterals' args
+    -> let b = Unsigned.unsigned32toWord32 (U (fromInteger a))
+           (_,tyView -> TyConApp wordTcNm []) = splitFunForallTy ty
+           (Just wordTc) = UniqMap.lookup wordTcNm tcm
+           [wordDc] = tyConDataCons wordTc
+       in  reduce (mkApps (Data wordDc) [Left (Literal (WordLiteral (toInteger b)))])
+
+  $(namePat 'Clash.Annotations.BitRepresentation.Deriving.dontApplyInHDL)
+    | isSubj
+    , f : a : _ <- args
+    -> reduceWHNF (mkApps (valToTerm f) [Left (valToTerm a)])
+
+--------
+-- RTree
+--------
+  $(namePat 'Clash.Sized.RTree.textract)
+    | isSubj
+    , [DC _ tArgs] <- args
+    -> reduceWHNF (Either.lefts tArgs !! 1)
+
+  $(namePat 'Clash.Sized.RTree.tsplit)
+    | isSubj
+    , dTy : aTy : _ <- tys
+    , [DC _ tArgs] <- args
+    , (tyArgs,tyView -> TyConApp tupTcNm _) <- splitFunForallTy ty
+    , TyConApp treeTcNm _ <- tyView (Either.rights tyArgs !! 0)
+    -> let (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc]      = tyConDataCons tupTc
+       in  reduce $
+           mkApps (Data tupDc)
+                  [Right (mkTyConApp treeTcNm [dTy,aTy])
+                  ,Right (mkTyConApp treeTcNm [dTy,aTy])
+                  ,Left (Either.lefts tArgs !! 1)
+                  ,Left (Either.lefts tArgs !! 2)
+                  ]
+
+  $(namePat 'Clash.Sized.RTree.tdfold)
+    | isSubj
+    , pTy : kTy : aTy : _ <- tys
+    , _ : p : f : g : ts : _ <- args
+    , DC _ tArgs <- ts
+    , Right k' <- runExcept (tyNatSize tcm kTy)
+    -> case k' of
+         0 -> reduceWHNF (mkApps (valToTerm f) [Left (Either.lefts tArgs !! 1)])
+         _ -> let k'ty = LitTy (NumTy (k'-1))
+                  (tyArgs,_)  = splitFunForallTy ty
+                  (tyArgs',_) = splitFunForallTy (Either.rights tyArgs !! 3)
+                  TyConApp snatTcNm _ = tyView (Either.rights tyArgs' !! 0)
+                  Just snatTc = UniqMap.lookup snatTcNm tcm
+                  [snatDc]    = tyConDataCons snatTc
+              in  reduceWHNF $
+                  mkApps (valToTerm g)
+                         [Right k'ty
+                         ,Left (mkApps (Data snatDc)
+                                       [Right k'ty
+                                       ,Left (Literal (NaturalLiteral (k'-1)))])
+                         ,Left (mkApps (Prim pInfo)
+                                       [Right pTy
+                                       ,Right k'ty
+                                       ,Right aTy
+                                       ,Left (Literal (NaturalLiteral (k'-1)))
+                                       ,Left (valToTerm p)
+                                       ,Left (valToTerm f)
+                                       ,Left (valToTerm g)
+                                       ,Left (Either.lefts tArgs !! 1)
+                                       ])
+                         ,Left (mkApps (Prim pInfo)
+                                       [Right pTy
+                                       ,Right k'ty
+                                       ,Right aTy
+                                       ,Left (Literal (NaturalLiteral (k'-1)))
+                                       ,Left (valToTerm p)
+                                       ,Left (valToTerm f)
+                                       ,Left (valToTerm g)
+                                       ,Left (Either.lefts tArgs !! 2)
+                                       ])
+                         ]
+
+  $(namePat 'Clash.Sized.RTree.treplicate)
+    | isSubj
+    , let ty' = piResultTys tcm ty tys
+    , (_,tyView -> TyConApp treeTcNm [lenTy,argTy]) <- splitFunForallTy ty'
+    , Right len <- runExcept (tyNatSize tcm lenTy)
+    -> let (Just treeTc) = UniqMap.lookup treeTcNm tcm
+           [lrCon,brCon] = tyConDataCons treeTc
+       in  reduce (mkRTree lrCon brCon argTy len (replicate (2^len) (valToTerm (last args))))
+
+---------
+-- Vector
+---------
+  $(namePat 'Clash.Sized.Vector.length) -- :: KnownNat n => Vec n a -> Int
+    | isSubj
+    , [nTy, _] <- tys
+    , Right n <-runExcept (tyNatSize tcm nTy)
+    -> let (_, tyView -> TyConApp intTcNm _) = splitFunForallTy ty
+           (Just intTc) = UniqMap.lookup intTcNm tcm
+           [intCon] = tyConDataCons intTc
+       in  reduce (mkApps (Data intCon) [Left (Literal (IntLiteral (toInteger n)))])
+
+  -- XXX: Not a thing anymore?
+  "Clash.Sized.Vector.maxIndex"
+    | isSubj
+    , [nTy, _] <- tys
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> let (_, tyView -> TyConApp intTcNm _) = splitFunForallTy ty
+           (Just intTc) = UniqMap.lookup intTcNm tcm
+           [intCon] = tyConDataCons intTc
+       in  reduce (mkApps (Data intCon) [Left (Literal (IntLiteral (toInteger (n - 1))))])
+
+-- Indexing
+  -- XXX: Not exported
+  "Clash.Sized.Vector.index_int" -- :: KnownNat n => Vec n a -> Int
+    | nTy : aTy : _  <- tys
+    , _ : xs : i : _ <- args
+    , DC intDc [Left (Literal (IntLiteral i'))] <- i
+    -> if i' < 0
+          then Nothing
+          else case xs of
+                 DC _ vArgs  -> case runExcept (tyNatSize tcm nTy) of
+                    Right 0  -> Nothing
+                    Right n' ->
+                      if i' == 0
+                         then reduceWHNF (Either.lefts vArgs !! 1)
+                         else reduceWHNF $
+                              mkApps (Prim pInfo)
+                                     [Right (LitTy (NumTy (n'-1)))
+                                     ,Right aTy
+                                     ,Left (Literal (NaturalLiteral (n'-1)))
+                                     ,Left (Either.lefts vArgs !! 2)
+                                     ,Left (mkApps (Data intDc)
+                                                   [Left (Literal (IntLiteral (i'-1)))])
+                                     ]
+                    _ -> Nothing
+                 _ -> Nothing
+  $(namePat 'Clash.Sized.Vector.head) -- :: Vec (n+1) a -> a
+    | isSubj
+    , [DC _ vArgs] <- args
+    -> reduceWHNF (Either.lefts vArgs !! 1)
+  $(namePat 'Clash.Sized.Vector.last) -- :: Vec (n+1) a -> a
+    | isSubj
+    , [DC _ vArgs] <- args
+    , (Right _ : Right aTy : Right nTy : _) <- vArgs
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> if n == 0
+          then reduceWHNF (Either.lefts vArgs !! 1)
+          else reduceWHNF
+                (mkApps (Prim pInfo)
+                                     [Right (LitTy (NumTy (n-1)))
+                                     ,Right aTy
+                                     ,Left (Either.lefts vArgs !! 2)
+                                     ])
+-- - Sub-vectors
+  $(namePat 'Clash.Sized.Vector.tail) -- :: Vec (n+1) a -> Vec n a
+    | isSubj
+    , [DC _ vArgs] <- args
+    -> reduceWHNF (Either.lefts vArgs !! 2)
+  $(namePat 'Clash.Sized.Vector.init) -- :: Vec (n+1) a -> Vec n a
+    | isSubj
+    , [DC consCon vArgs] <- args
+    , (Right _ : Right aTy : Right nTy : _) <- vArgs
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> if n == 0
+          then reduceWHNF (Either.lefts vArgs !! 2)
+          else reduce $
+               mkVecCons consCon aTy n
+                  (Either.lefts vArgs !! 1)
+                  (mkApps (Prim pInfo)
+                                       [Right (LitTy (NumTy (n-1)))
+                                       ,Right aTy
+                                       ,Left (Either.lefts vArgs !! 2)])
+  $(namePat 'Clash.Sized.Vector.select) -- :: (CmpNat (i+s) (s*n) ~ GT) => SNat f -> SNat s -> SNat n -> Vec (f + i) a -> Vec n a
+    | isSubj
+    , iTy : sTy : nTy : fTy : aTy : _ <- tys
+    , eq : f : s : n : xs : _ <- args
+    , Right n' <- runExcept (tyNatSize tcm nTy)
+    , Right f' <- runExcept (tyNatSize tcm fTy)
+    , Right i' <- runExcept (tyNatSize tcm iTy)
+    , Right s' <- runExcept (tyNatSize tcm sTy)
+    , DC _ vArgs <- xs
+    -> case n' of
+         0 -> reduce (mkVecNil nilCon aTy)
+         _ -> case f' of
+          0 -> let splitAtCall =
+                    mkApps (splitAtPrim snatTcNm vecTcNm)
+                           [Right sTy
+                           ,Right (LitTy (NumTy (i'-s')))
+                           ,Right aTy
+                           ,Left (valToTerm s)
+                           ,Left (valToTerm xs)
+                           ]
+                   fVecTy = mkTyConApp vecTcNm [sTy,aTy]
+                   iVecTy = mkTyConApp vecTcNm [LitTy (NumTy (i'-s')),aTy]
+                   -- Guaranteed no capture, so okay to use unsafe name generation
+                   fNm    = mkUnsafeSystemName "fxs" 0
+                   iNm    = mkUnsafeSystemName "ixs" 1
+                   fId    = mkLocalId fVecTy fNm
+                   iId    = mkLocalId iVecTy iNm
+                   tupPat = DataPat tupDc [] [fId,iId]
+                   iAlt   = (tupPat, (Var iId))
+               in  reduce $
+                   mkVecCons consCon aTy n' (Either.lefts vArgs !! 1) $
+                   mkApps (Prim pInfo)
+                          [Right (LitTy (NumTy (i'-s')))
+                          ,Right sTy
+                          ,Right (LitTy (NumTy (n'-1)))
+                          ,Right (LitTy (NumTy 0))
+                          ,Right aTy
+                          ,Left (valToTerm eq)
+                          ,Left (Literal (NaturalLiteral 0))
+                          ,Left (valToTerm s)
+                          ,Left (Literal (NaturalLiteral (n'-1)))
+                          ,Left (Case splitAtCall iVecTy [iAlt])
+                          ]
+          _ -> let splitAtCall =
+                    mkApps (splitAtPrim snatTcNm vecTcNm)
+                           [Right fTy
+                           ,Right iTy
+                           ,Right aTy
+                           ,Left (valToTerm f)
+                           ,Left (valToTerm xs)
+                           ]
+                   fVecTy = mkTyConApp vecTcNm [fTy,aTy]
+                   iVecTy = mkTyConApp vecTcNm [iTy,aTy]
+                   -- Guaranteed no capture, so okay to use unsafe name generation
+                   fNm    = mkUnsafeSystemName "fxs" 0
+                   iNm    = mkUnsafeSystemName "ixs" 1
+                   fId    = mkLocalId fVecTy fNm
+                   iId    = mkLocalId iVecTy iNm
+                   tupPat = DataPat tupDc [] [fId,iId]
+                   iAlt   = (tupPat, (Var iId))
+               in  reduceWHNF $
+                   mkApps (Prim pInfo)
+                     [Right iTy
+                     ,Right sTy
+                     ,Right nTy
+                     ,Right (LitTy (NumTy 0))
+                     ,Right aTy
+                     ,Left (valToTerm eq)
+                     ,Left (Literal (NaturalLiteral 0))
+                     ,Left (valToTerm s)
+                     ,Left (valToTerm n)
+                     ,Left (Case splitAtCall iVecTy [iAlt])
+                     ]
+    where
+      (tyArgs,tyView -> TyConApp vecTcNm _) = splitFunForallTy ty
+      Just vecTc          = UniqMap.lookup vecTcNm tcm
+      [nilCon,consCon]    = tyConDataCons vecTc
+      TyConApp snatTcNm _ = tyView (Either.rights tyArgs !! 1)
+      tupTcNm            = ghcTyconToTyConName (tupleTyCon Boxed 2)
+      (Just tupTc)       = UniqMap.lookup tupTcNm tcm
+      [tupDc]            = tyConDataCons tupTc
+-- - Splitting
+  $(namePat 'Clash.Sized.Vector.splitAt) -- :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a)
+    | isSubj
+    , (DC snatDc (Right mTy:_)):_ <- args
+    , Right m <- runExcept (tyNatSize tcm mTy)
+    -> let _:nTy:aTy:_ = tys
+           -- Get the tuple data-constructor
+           ty1 = piResultTys tcm ty tys
+           (_,tyView -> TyConApp tupTcNm tyArgs@(tyArg:_)) = splitFunForallTy ty1
+           (Just tupTc)       = UniqMap.lookup tupTcNm tcm
+           [tupDc]            = tyConDataCons tupTc
+           -- Get the vector data-constructors
+           TyConApp vecTcNm _ = tyView tyArg
+           Just vecTc         = UniqMap.lookup vecTcNm tcm
+           [nilCon,consCon]   = tyConDataCons vecTc
+           -- Recursive call to @splitAt@
+           splitAtRec v =
+            mkApps (Prim pInfo)
+                   [Right (LitTy (NumTy (m-1)))
+                   ,Right nTy
+                   ,Right aTy
+                   ,Left (mkApps (Data snatDc)
+                                 [ Right (LitTy (NumTy (m-1)))
+                                 , Left  (Literal (NaturalLiteral (m-1)))])
+                   ,Left v
+                   ]
+           -- Projection either the first or second field of the recursive
+           -- call to @splitAt@
+           splitAtSelR v = Case (splitAtRec v)
+           m1VecTy = mkTyConApp vecTcNm [LitTy (NumTy (m-1)),aTy]
+           nVecTy  = mkTyConApp vecTcNm [nTy,aTy]
+           -- Guaranteed no capture, so okay to use unsafe name generation
+           lNm     = mkUnsafeSystemName "l" 0
+           rNm     = mkUnsafeSystemName "r" 1
+           lId     = mkLocalId m1VecTy lNm
+           rId     = mkLocalId nVecTy rNm
+           tupPat  = DataPat tupDc [] [lId,rId]
+           lAlt    = (tupPat, (Var lId))
+           rAlt    = (tupPat, (Var rId))
+
+       in case m of
+         -- (Nil,v)
+         0 -> reduce $
+              mkApps (Data tupDc) $ (map Right tyArgs) ++
+                [ Left (mkVecNil nilCon aTy)
+                , Left (valToTerm (last args))
+                ]
+         -- (x:xs) <- v
+         m' | DC _ vArgs <- last args
+            -- (x:fst (splitAt (m-1) xs),snd (splitAt (m-1) xs))
+            -> case Either.lefts vArgs of
+                (_ : x : xs : _) ->
+                  reduce $
+                    mkApps (Data tupDc) $ (map Right tyArgs) ++
+                      [ Left (mkVecCons consCon aTy m' x
+                                (splitAtSelR xs m1VecTy [lAlt]))
+                      , Left (splitAtSelR xs nVecTy [rAlt])
+                      ]
+                _ ->
+                  -- v actually reduces to Nil and not Cons, this only happens
+                  -- when 'n' would reduce to a negative number; the complement
+                  -- of 'm'.
+                  --
+                  -- See Clash issue: https://github.com/clash-lang/clash-compiler/issues/2831
+                  let resTy = getResultTy tcm ty tys
+                   in reduce (TyApp (Prim NP.undefined) resTy)
+
+         -- v doesn't reduce to a data-constructor
+         _  -> Nothing
+
+  $(namePat 'Clash.Sized.Vector.unconcat) -- :: KnownNat n => SNamt m -> Vec (n * m) a -> Vec n (Vec m a)
+    | isSubj
+    , kn : snat : v : _  <- args
+    , nTy : mTy : aTy :_ <- tys
+    , Lit (NaturalLiteral n) <- kn
+    -> let ( Either.rights -> argTys, tyView -> TyConApp vecTcNm _) =
+              splitFunForallTy ty
+           Just vecTc = UniqMap.lookup vecTcNm tcm
+           [nilCon,consCon]   = tyConDataCons vecTc
+           tupTcNm            = ghcTyconToTyConName (tupleTyCon Boxed 2)
+           (Just tupTc)       = UniqMap.lookup tupTcNm tcm
+           [tupDc]            = tyConDataCons tupTc
+           TyConApp snatTcNm _ = tyView (argTys !! 1)
+           n1mTy  = mkTyConApp typeNatMul
+                        [mkTyConApp typeNatSub [nTy,LitTy (NumTy 1)]
+                        ,mTy]
+           splitAtCall =
+            mkApps (splitAtPrim snatTcNm vecTcNm)
+                   [Right mTy
+                   ,Right n1mTy
+                   ,Right aTy
+                   ,Left (valToTerm snat)
+                   ,Left (valToTerm v)
+                   ]
+           mVecTy   = mkTyConApp vecTcNm [mTy,aTy]
+           n1mVecTy = mkTyConApp vecTcNm [n1mTy,aTy]
+           -- Guaranteed no capture, so okay to use unsafe name generation
+           asNm     = mkUnsafeSystemName "as" 0
+           bsNm     = mkUnsafeSystemName "bs" 1
+           asId     = mkLocalId mVecTy asNm
+           bsId     = mkLocalId n1mVecTy bsNm
+           tupPat   = DataPat tupDc [] [asId,bsId]
+           asAlt    = (tupPat, (Var asId))
+           bsAlt    = (tupPat, (Var bsId))
+
+       in  case n of
+         0 -> reduce (mkVecNil nilCon mVecTy)
+         _ -> reduce $
+              mkVecCons consCon mVecTy n
+                (Case splitAtCall mVecTy [asAlt])
+                (mkApps (Prim pInfo)
+                    [Right (LitTy (NumTy (n-1)))
+                    ,Right mTy
+                    ,Right aTy
+                    ,Left (Literal (NaturalLiteral (n-1)))
+                    ,Left (valToTerm snat)
+                    ,Left (Case splitAtCall n1mVecTy [bsAlt])])
+-- Construction
+-- - initialisation
+  $(namePat 'Clash.Sized.Vector.replicate) -- :: SNat n -> a -> Vec n a
+    | isSubj
+    , let ty' = piResultTys tcm ty tys
+    , let (_,resTy) = splitFunForallTy ty'
+    , (TyConApp vecTcNm [lenTy,argTy]) <- tyView resTy
+    , Right len <- runExcept (tyNatSize tcm lenTy)
+    -> let (Just vecTc) = UniqMap.lookup vecTcNm tcm
+           [nilCon,consCon] = tyConDataCons vecTc
+       in  reduce $
+           mkVec nilCon consCon argTy len
+                 (replicate (fromInteger len) (valToTerm (last args)))
+-- - Concatenation
+  $(namePat '(Clash.Sized.Vector.++)) -- :: Vec n a -> Vec m a -> Vec (n + m) a
+    | isSubj
+    , (DC dc vArgs):_ <- args
+    , Right nTy : Right aTy : _ <- vArgs
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> case n of
+         0  -> reduce (valToTerm (last args))
+         n' | (_ : _ : mTy : _) <- tys
+            , Right m <- runExcept (tyNatSize tcm mTy)
+            -> -- x : (xs ++ ys)
+               reduce $
+               mkVecCons dc aTy (n' + m) (Either.lefts vArgs !! 1)
+                 (mkApps (Prim pInfo)
+                                      [Right (LitTy (NumTy (n'-1)))
+                                      ,Right aTy
+                                      ,Right mTy
+                                      ,Left (Either.lefts vArgs !! 2)
+                                      ,Left (valToTerm (last args))
+                                      ])
+         _ -> Nothing
+  $(namePat 'Clash.Sized.Vector.concat) -- :: Vec n (Vec m a) -> Vec (n * m) a
+    | isSubj
+    , (nTy : mTy : aTy : _)  <- tys
+    , (xs : _)               <- args
+    , DC dc vArgs <- xs
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> case n of
+        0 -> reduce (mkVecNil dc aTy)
+        _ | _ : h' : t : _ <- Either.lefts  vArgs
+          , (_,tyView -> TyConApp vecTcNm _) <- splitFunForallTy ty
+          -> reduceWHNF $
+             mkApps (vecAppendPrim vecTcNm)
+                    [Right mTy
+                    ,Right aTy
+                    ,Right $ mkTyConApp typeNatMul
+                      [mkTyConApp typeNatSub [nTy,LitTy (NumTy 1)], mTy]
+                    ,Left h'
+                    ,Left $ mkApps (Prim pInfo)
+                      [ Right (LitTy (NumTy (n-1)))
+                      , Right mTy
+                      , Right aTy
+                      , Left t
+                      ]
+                    ]
+        _ -> Nothing
+
+-- Modifying vectors
+  "Clash.Sized.Vector.replace_int" -- :: KnownNat n => Vec n a -> Int -> a -> Vec n a
+    | nTy : aTy : _  <- tys
+    , _ : xs : i : a : _ <- args
+    , DC intDc [Left (Literal (IntLiteral i'))] <- i
+    -> if i' < 0
+          then Nothing
+          else case xs of
+                 DC vecTcNm vArgs -> case runExcept (tyNatSize tcm nTy) of
+                    Right 0  -> Nothing
+                    Right n' ->
+                      if i' == 0
+                         then reduce (mkVecCons vecTcNm aTy n' (valToTerm a) (Either.lefts vArgs !! 2))
+                         else reduce $
+                              mkVecCons vecTcNm aTy n' (Either.lefts vArgs !! 1)
+                                (mkApps (Prim pInfo)
+                                        [Right (LitTy (NumTy (n'-1)))
+                                        ,Right aTy
+                                        ,Left (Literal (NaturalLiteral (n'-1)))
+                                        ,Left (Either.lefts vArgs !! 2)
+                                        ,Left (mkApps (Data intDc)
+                                                      [Left (Literal (IntLiteral (i'-1)))])
+                                        ,Left (valToTerm a)
+                                        ])
+                    _ -> Nothing
+                 _ -> Nothing
+
+-- - specialized permutations
+  $(namePat 'Clash.Sized.Vector.reverse) -- :: Vec n a -> Vec n a
+    | isSubj
+    , nTy : aTy : _  <- tys
+    , [DC vecDc vArgs] <- args
+    -> case runExcept (tyNatSize tcm nTy) of
+         Right 0 -> reduce (mkVecNil vecDc aTy)
+         Right n
+           | (_,tyView -> TyConApp vecTcNm _) <- splitFunForallTy ty
+           , let (Just vecTc) = UniqMap.lookup vecTcNm tcm
+           , let [nilCon,consCon] = tyConDataCons vecTc
+           -> reduceWHNF $
+              mkApps (vecAppendPrim vecTcNm)
+                [Right (LitTy (NumTy (n-1)))
+                ,Right aTy
+                ,Right (LitTy (NumTy 1))
+                ,Left (mkApps (Prim pInfo)
+                              [Right (LitTy (NumTy (n-1)))
+                              ,Right aTy
+                              ,Left (Either.lefts vArgs !! 2)
+                              ])
+                ,Left (mkVec nilCon consCon aTy 1 [Either.lefts vArgs !! 1])
+                ]
+         _ -> Nothing
+  $(namePat 'Clash.Sized.Vector.transpose) -- :: KnownNat n => Vec m (Vec n a) -> Vec n (Vec m a)
+    | isSubj
+    , nTy : mTy : aTy : _ <- tys
+    , kn : xss : _ <- args
+    , (_,tyView -> TyConApp vecTcNm _) <- splitFunForallTy ty
+    , DC _ vArgs <- xss
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    , Right m <- runExcept (tyNatSize tcm mTy)
+    -> case m of
+      0 -> let (Just vecTc)     = UniqMap.lookup vecTcNm tcm
+               [nilCon,consCon] = tyConDataCons vecTc
+           in  reduce $
+               mkVec nilCon consCon (mkTyConApp vecTcNm [mTy,aTy]) n
+                (replicate (fromInteger n) (mkVec nilCon consCon aTy 0 []))
+      m' -> let (Just vecTc)     = UniqMap.lookup vecTcNm tcm
+                [_,consCon] = tyConDataCons vecTc
+                Just (consCoTy : _) = dataConInstArgTys consCon
+                                        [mTy,aTy,LitTy (NumTy (m'-1))]
+            in  reduceWHNF $
+                mkApps (vecZipWithPrim vecTcNm)
+                       [ Right aTy
+                       , Right (mkTyConApp vecTcNm [LitTy (NumTy (m'-1)),aTy])
+                       , Right (mkTyConApp vecTcNm [mTy,aTy])
+                       , Right nTy
+                       , Left  (mkApps (Data consCon)
+                                       [Right mTy
+                                       ,Right aTy
+                                       ,Right (LitTy (NumTy (m'-1)))
+                                       ,Left (primCo consCoTy)
+                                       ])
+                       , Left  (Either.lefts vArgs !! 1)
+                       , Left  (mkApps (Prim pInfo)
+                                       [ Right nTy
+                                       , Right (LitTy (NumTy (m'-1)))
+                                       , Right aTy
+                                       , Left  (valToTerm kn)
+                                       , Left  (Either.lefts vArgs !! 2)
+                                       ])
+                       ]
+
+  $(namePat 'Clash.Sized.Vector.rotateLeftS) -- :: KnownNat n => Vec n a -> SNat d -> Vec n a
+    | nTy : aTy : _ : _ <- tys
+    , kn : xs : d : _ <- args
+    , DC dc vArgs <- xs
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> case n of
+         0  -> reduce (mkVecNil dc aTy)
+         n' | DC snatDc [_,Left d'] <- d
+            , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
+            , mach2@Machine{mStack=[],mTerm=Literal (NaturalLiteral d2)} <- whnf eval tcm isSubj (setTerm d' $ stackClear mach)
+            -> case (d2 `mod` n) of
+                 0  -> reduce (valToTerm xs)
+                 d3 -> let (_,tyView -> TyConApp vecTcNm _) = splitFunForallTy ty
+                           (Just vecTc)     = UniqMap.lookup vecTcNm tcm
+                           [nilCon,consCon] = tyConDataCons vecTc
+                       in  reduceWHNF' mach2 $
+                           mkApps (Prim pInfo)
+                                  [Right nTy
+                                  ,Right aTy
+                                  ,Right (LitTy (NumTy (d3-1)))
+                                  ,Left (valToTerm kn)
+                                  ,Left (mkApps (vecAppendPrim vecTcNm)
+                                                [Right (LitTy (NumTy (n'-1)))
+                                                ,Right aTy
+                                                ,Right (LitTy (NumTy 1))
+                                                ,Left  (Either.lefts vArgs !! 2)
+                                                ,Left  (mkVec nilCon consCon aTy 1 [Either.lefts vArgs !! 1])])
+                                  ,Left (mkApps (Data snatDc)
+                                                [Right (LitTy (NumTy (d3-1)))
+                                                ,Left  (Literal (NaturalLiteral (d3-1)))])
+                                  ]
+         _  -> Nothing
+
+  $(namePat 'Clash.Sized.Vector.rotateRightS) -- :: KnownNat n => Vec n a -> SNat d -> Vec n a
+    | isSubj
+    , nTy : aTy : _ : _ <- tys
+    , kn : xs : d : _ <- args
+    , DC dc _ <- xs
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> case n of
+         0  -> reduce (mkVecNil dc aTy)
+         n' | DC snatDc [_,Left d'] <- d
+            , eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
+            , mach2@Machine{mStack=[],mTerm=Literal (NaturalLiteral d2)} <- whnf eval tcm isSubj (setTerm d' $ stackClear mach)
+            -> case (d2 `mod` n) of
+                 0  -> reduce (valToTerm xs)
+                 d3 -> let (_,tyView -> TyConApp vecTcNm _) = splitFunForallTy ty
+                       in  reduceWHNF' mach2 $
+                           mkApps (Prim pInfo)
+                                  [Right nTy
+                                  ,Right aTy
+                                  ,Right (LitTy (NumTy (d3-1)))
+                                  ,Left (valToTerm kn)
+                                  ,Left (mkVecCons dc aTy n
+                                          (mkApps (vecLastPrim vecTcNm)
+                                                  [Right (LitTy (NumTy (n'-1)))
+                                                  ,Right aTy
+                                                  ,Left  (valToTerm xs)])
+                                          (mkApps (vecInitPrim vecTcNm)
+                                                  [Right (LitTy (NumTy (n'-1)))
+                                                  ,Right aTy
+                                                  ,Left (valToTerm xs)]))
+                                  ,Left (mkApps (Data snatDc)
+                                                [Right (LitTy (NumTy (d3-1)))
+                                                ,Left  (Literal (NaturalLiteral (d3-1)))])
+                                  ]
+         _  -> Nothing
+-- Element-wise operations
+-- - mapping
+  $(namePat 'Clash.Sized.Vector.map) -- :: (a -> b) -> Vec n a -> Vec n b
+    | isSubj
+    , DC dc vArgs <- args !! 1
+    , aTy : bTy : nTy : _ <- tys
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> case n of
+         0  -> reduce (mkVecNil dc bTy)
+         n' -> reduce $
+               mkVecCons dc bTy n'
+                 (mkApps (valToTerm (args !! 0)) [Left (Either.lefts vArgs !! 1)])
+                 (mkApps (Prim pInfo)
+                                      [Right aTy
+                                      ,Right bTy
+                                      ,Right (LitTy (NumTy (n' - 1)))
+                                      ,Left (valToTerm (args !! 0))
+                                      ,Left (Either.lefts vArgs !! 2)])
+  $(namePat 'Clash.Sized.Vector.imap) -- :: forall n a b . KnownNat n => (Index n -> a -> b) -> Vec n a -> Vec n b
+    | isSubj
+    , nTy : aTy : bTy : _ <- tys
+    , (tyArgs,tyView -> TyConApp vecTcNm _) <- splitFunForallTy ty
+    , let (tyArgs',_) = splitFunForallTy (Either.rights tyArgs !! 1)
+    , TyConApp indexTcNm _ <- tyView (Either.rights tyArgs' !! 0)
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    , let iLit = mkIndexLit (Either.rights tyArgs' !! 0) nTy n 0
+    -> reduceWHNF $
+       mkApps (Prim (PrimInfo "Clash.Sized.Vector.imap_go" (vecImapGoTy vecTcNm indexTcNm) WorkNever SingleResult NoUnfolding))
+              [Right nTy
+              ,Right nTy
+              ,Right aTy
+              ,Right bTy
+              ,Left (valToTerm (args !! 1))
+              ,Left (valToTerm (args !! 2))
+              ,Left iLit
+              ]
+
+  "Clash.Sized.Vector.imap_go"
+    | isSubj
+    , nTy : mTy : aTy : bTy : _ <- tys
+    , f : xs : (Suspend nArg) : _ <- args
+    , DC dc vArgs <- xs
+    , Right n' <- runExcept (tyNatSize tcm nTy)
+    , Right m <- runExcept (tyNatSize tcm mTy)
+    -> case m of
+         0  -> reduce (mkVecNil dc bTy)
+         m'
+          | eval <- Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
+          , mach1@Machine{mStack=[],mTerm=n} <-
+              whnf eval tcm True (setTerm nArg (stackClear mach))
+          ->  let (tyArgs,_) = splitFunForallTy ty
+                  TyConApp indexTcNm _ = tyView (Either.rights tyArgs !! 2)
+                  iLit = mkIndexLit (Either.rights tyArgs !! 2) nTy n' 1
+               in Just $ flip setTerm (mach1 {mStack = mStack mach}) $ mkVecCons dc bTy m'
+                 (mkApps (valToTerm f) [Left n,Left (Either.lefts vArgs !! 1)])
+                 (mkApps (Prim pInfo)
+                         [Right nTy
+                         ,Right (LitTy (NumTy (m'-1)))
+                         ,Right aTy
+                         ,Right bTy
+                         ,Left (valToTerm f)
+                         ,Left (Either.lefts vArgs !! 2)
+                         ,Left (mkApps (Prim (PrimInfo (showt '(Clash.Sized.Internal.Index.+#)) (indexAddTy indexTcNm) WorkVariable SingleResult NoUnfolding))
+                                       [Right nTy
+                                       ,Left (Literal (NaturalLiteral n'))
+                                       ,Left n
+                                       ,Left iLit
+                                       ])
+                         ])
+          | otherwise
+          -> Nothing
+
+  -- :: forall n a. KnownNat n => (a -> a) -> a -> Vec n a
+  $(namePat 'Clash.Sized.Vector.iterateI)
+    | isSubj
+    , [nTy, aTy] <- tys
+    , [_n, f, a] <- args
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    ->
+      let
+        TyConApp vecTcNm _ = tyView (getResultTy tcm ty tys)
+        Just vecTc = UniqMap.lookup vecTcNm tcm
+        [nilCon, consCon] = tyConDataCons vecTc
+      in case n of
+         0 -> reduce (mkVecNil nilCon aTy)
+         _ -> reduce $
+          mkVecCons consCon aTy n
+            (valToTerm a)
+            (mkApps
+              (Prim pInfo)
+              [ Right (LitTy (NumTy (n - 1)))
+              , Right aTy
+              , Left (valToTerm (Lit (NaturalLiteral (n - 1))))
+              , Left (valToTerm f)
+              , Left (mkApps (valToTerm f) [Left (valToTerm a)])
+              ])
+
+-- - Zipping
+  $(namePat 'Clash.Sized.Vector.zipWith) -- :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c
+    | isSubj
+    , aTy : bTy : cTy : nTy : _ <- tys
+    , f : xs : ys : _   <- args
+    , DC dc vArgs <- xs
+    , (_,tyView -> TyConApp vecTcNm _) <- splitFunForallTy ty
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> case n of
+         0  -> reduce (mkVecNil dc cTy)
+         n' -> reduce $ mkVecCons dc cTy n'
+                 (mkApps (valToTerm f)
+                            [Left (Either.lefts vArgs !! 1)
+                            ,Left (mkApps (vecHeadPrim vecTcNm)
+                                    [Right (LitTy (NumTy (n'-1)))
+                                    ,Right bTy
+                                    ,Left  (valToTerm ys)
+                                    ])
+                            ])
+                 (mkApps (Prim pInfo)
+                                      [Right aTy
+                                      ,Right bTy
+                                      ,Right cTy
+                                      ,Right (LitTy (NumTy (n' - 1)))
+                                      ,Left (valToTerm f)
+                                      ,Left (Either.lefts vArgs !! 2)
+                                      ,Left (mkApps (vecTailPrim vecTcNm)
+                                                    [Right (LitTy (NumTy (n'-1)))
+                                                    ,Right bTy
+                                                    ,Left (valToTerm ys)
+                                                    ])])
+
+-- Folding
+  $(namePat 'Clash.Sized.Vector.foldr) -- :: (a -> b -> b) -> b -> Vec n a -> b
+    | isSubj
+    , aTy : bTy : nTy : _ <- tys
+    , f : z : xs : _ <- args
+    , DC _ vArgs <- xs
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> case n of
+         0 -> reduce (valToTerm z)
+         _ -> reduceWHNF $
+              mkApps (valToTerm f)
+                     [Left (Either.lefts vArgs !! 1)
+                     ,Left (mkApps (Prim pInfo)
+                                   [Right aTy
+                                   ,Right bTy
+                                   ,Right (LitTy (NumTy (n-1)))
+                                   ,Left  (valToTerm f)
+                                   ,Left  (valToTerm z)
+                                   ,Left  (Either.lefts vArgs !! 2)
+                                   ])
+                     ]
+  $(namePat 'Clash.Sized.Vector.fold) -- :: (a -> a -> a) -> Vec (n + 1) a -> a
+    | isSubj
+    , nTy : aTy :  _ <- tys
+    , f : vs : _ <- args
+    , DC _ vArgs <- vs
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> case n of
+         0 -> reduceWHNF (Either.lefts vArgs !! 1)
+         _ -> let (tyArgs,_)         = splitFunForallTy ty
+                  TyConApp vecTcNm _ = tyView (Either.rights tyArgs !! 1)
+                  tupTcNm      = ghcTyconToTyConName (tupleTyCon Boxed 2)
+                  (Just tupTc) = UniqMap.lookup tupTcNm tcm
+                  [tupDc]      = tyConDataCons tupTc
+                  n'     = n+1
+                  m      = n' `div` 2
+                  n1     = n' - m
+                  mTy    = LitTy (NumTy m)
+                  m'ty   = LitTy (NumTy (m-1))
+                  n1mTy  = LitTy (NumTy n1)
+                  n1m'ty = LitTy (NumTy (n1-1))
+                  splitAtCall =
+                   mkApps (Prim (PrimInfo "Clash.Sized.Vector.fold_split" (foldSplitAtTy vecTcNm) WorkNever SingleResult NoUnfolding))
+                          [Right mTy
+                          ,Right n1mTy
+                          ,Right aTy
+                          ,Left (Literal (NaturalLiteral m))
+                          ,Left (valToTerm vs)
+                          ]
+                  mVecTy   = mkTyConApp vecTcNm [mTy,aTy]
+                  n1mVecTy = mkTyConApp vecTcNm [n1mTy,aTy]
+                  -- Guaranteed no capture, so okay to use unsafe name generation
+                  asNm     = mkUnsafeSystemName "as" 0
+                  bsNm     = mkUnsafeSystemName "bs" 1
+                  asId     = mkLocalId mVecTy asNm
+                  bsId     = mkLocalId n1mVecTy bsNm
+                  tupPat   = DataPat tupDc [] [asId,bsId]
+                  asAlt    = (tupPat, (Var asId))
+                  bsAlt    = (tupPat, (Var bsId))
+              in  reduceWHNF $
+                  mkApps (valToTerm f)
+                         [Left (mkApps (Prim pInfo)
+                                       [Right m'ty
+                                       ,Right aTy
+                                       ,Left (valToTerm f)
+                                       ,Left (Case splitAtCall mVecTy [asAlt])
+                                       ])
+                         ,Left (mkApps (Prim pInfo)
+                                       [Right n1m'ty
+                                       ,Right aTy
+                                       ,Left  (valToTerm f)
+                                       ,Left  (Case splitAtCall n1mVecTy [bsAlt])
+                                       ])
+                         ]
+
+
+  "Clash.Sized.Vector.fold_split" -- :: Natural -> Vec (m + n) a -> (Vec m a, Vec n a)
+    | isSubj
+    , mTy : nTy : aTy : _ <- tys
+    , Right m <- runExcept (tyNatSize tcm mTy)
+    -> let -- Get the tuple data-constructor
+           ty1 = piResultTys tcm ty tys
+           (_,tyView -> TyConApp tupTcNm tyArgs@(tyArg:_)) = splitFunForallTy ty1
+           (Just tupTc)       = UniqMap.lookup tupTcNm tcm
+           [tupDc]            = tyConDataCons tupTc
+           -- Get the vector data-constructors
+           TyConApp vecTcNm _ = tyView tyArg
+           Just vecTc         = UniqMap.lookup vecTcNm tcm
+           [nilCon,consCon]   = tyConDataCons vecTc
+           -- Recursive call to @splitAt@
+           splitAtRec v =
+            mkApps (Prim pInfo)
+                   [Right (LitTy (NumTy (m-1)))
+                   ,Right nTy
+                   ,Right aTy
+                   ,Left (Literal (NaturalLiteral (m-1)))
+                   ,Left v
+                   ]
+           -- Projection either the first or second field of the recursive
+           -- call to @splitAt@
+           splitAtSelR v = Case (splitAtRec v)
+           m1VecTy = mkTyConApp vecTcNm [LitTy (NumTy (m-1)),aTy]
+           nVecTy  = mkTyConApp vecTcNm [nTy,aTy]
+           -- Guaranteed no capture, so okay to use unsafe name generation
+           lNm     = mkUnsafeSystemName "l" 0
+           rNm     = mkUnsafeSystemName "r" 1
+           lId     = mkLocalId m1VecTy lNm
+           rId     = mkLocalId nVecTy rNm
+           tupPat  = DataPat tupDc [] [lId,rId]
+           lAlt    = (tupPat, (Var lId))
+           rAlt    = (tupPat, (Var rId))
+       in case m of
+         -- (Nil,v)
+         0 -> reduce $
+              mkApps (Data tupDc) $ (map Right tyArgs) ++
+                [ Left (mkVecNil nilCon aTy)
+                , Left (valToTerm (last args))
+                ]
+         -- (x:xs) <- v
+         m' | DC _ vArgs <- last args
+            -- (x:fst (splitAt (m-1) xs),snd (splitAt (m-1) xs))
+            -> reduce $
+               mkApps (Data tupDc) $ (map Right tyArgs) ++
+                 [ Left (mkVecCons consCon aTy m' (Either.lefts vArgs !! 1)
+                           (splitAtSelR (Either.lefts vArgs !! 2) m1VecTy [lAlt]))
+                 , Left (splitAtSelR (Either.lefts vArgs !! 2) nVecTy [rAlt])
+                 ]
+         -- v doesn't reduce to a data-constructor
+         _  -> Nothing
+-- - Specialised folds
+  $(namePat 'Clash.Sized.Vector.dfold)
+    | isSubj
+    , pTy : kTy : aTy : _ <- tys
+    , _ : p : f : z : xs : _ <- args
+    , DC _ vArgs <- xs
+    , Right k' <- runExcept (tyNatSize tcm kTy)
+    -> case k'  of
+         0 -> reduce (valToTerm z)
+         _ -> let (tyArgs,_)  = splitFunForallTy ty
+                  (tyArgs',_) = splitFunForallTy (Either.rights tyArgs !! 2)
+                  TyConApp snatTcNm _ = tyView (Either.rights tyArgs' !! 0)
+                  Just snatTc = UniqMap.lookup snatTcNm tcm
+                  [snatDc]    = tyConDataCons snatTc
+                  k'ty        = LitTy (NumTy (k'-1))
+              in  reduceWHNF $
+                  mkApps (valToTerm f)
+                         [Right k'ty
+                         ,Left (mkApps (Data snatDc)
+                                       [Right k'ty
+                                       ,Left (Literal (NaturalLiteral (k'-1)))])
+                         ,Left (Either.lefts vArgs !! 1)
+                         ,Left (mkApps (Prim pInfo)
+                                       [Right pTy
+                                       ,Right k'ty
+                                       ,Right aTy
+                                       ,Left (Literal (NaturalLiteral (k'-1)))
+                                       ,Left (valToTerm p)
+                                       ,Left (valToTerm f)
+                                       ,Left (valToTerm z)
+                                       ,Left (Either.lefts vArgs !! 2)
+                                       ])
+                         ]
+  $(namePat 'Clash.Sized.Vector.dtfold)
+    | isSubj
+    , pTy : kTy : aTy : _ <- tys
+    , _ : p : f : g : xs : _ <- args
+    , DC _ vArgs <- xs
+    , Right k' <- runExcept (tyNatSize tcm kTy)
+    -> case k' of
+         0 -> reduceWHNF (mkApps (valToTerm f) [Left (Either.lefts vArgs !! 1)])
+         _ -> let (tyArgs,_)  = splitFunForallTy ty
+                  TyConApp vecTcNm _ = tyView (Either.rights tyArgs !! 4)
+                  (tyArgs',_) = splitFunForallTy (Either.rights tyArgs !! 3)
+                  TyConApp snatTcNm _ = tyView (Either.rights tyArgs' !! 0)
+                  Just snatTc = UniqMap.lookup snatTcNm tcm
+                  [snatDc]    = tyConDataCons snatTc
+                  tupTcNm     = ghcTyconToTyConName (tupleTyCon Boxed 2)
+                  (Just tupTc) = UniqMap.lookup tupTcNm tcm
+                  [tupDc]     = tyConDataCons tupTc
+                  k'ty        = LitTy (NumTy (k'-1))
+                  k2ty        = LitTy (NumTy (2^(k'-1)))
+                  splitAtCall =
+                   mkApps (splitAtPrim snatTcNm vecTcNm)
+                          [Right k2ty
+                          ,Right k2ty
+                          ,Right aTy
+                          ,Left (mkApps (Data snatDc)
+                                        [Right k2ty
+                                        ,Left (Literal (NaturalLiteral (2^(k'-1))))])
+                          ,Left (valToTerm xs)
+                          ]
+                  xsSVecTy = mkTyConApp vecTcNm [k2ty,aTy]
+                  -- Guaranteed no capture, so okay to use unsafe name generation
+                  xsLNm    = mkUnsafeSystemName "xsL" 0
+                  xsRNm    = mkUnsafeSystemName "xsR" 1
+                  xsLId    = mkLocalId k2ty xsLNm
+                  xsRId    = mkLocalId k2ty xsRNm
+                  tupPat   = DataPat tupDc [] [xsLId,xsRId]
+                  asAlt    = (tupPat, (Var xsLId))
+                  bsAlt    = (tupPat, (Var xsRId))
+              in  reduceWHNF $
+                  mkApps (valToTerm g)
+                         [Right k'ty
+                         ,Left (mkApps (Data snatDc)
+                                       [Right k'ty
+                                       ,Left (Literal (NaturalLiteral (k'-1)))])
+                         ,Left (mkApps (Prim pInfo)
+                                       [Right pTy
+                                       ,Right k'ty
+                                       ,Right aTy
+                                       ,Left (Literal (NaturalLiteral (k'-1)))
+                                       ,Left (valToTerm p)
+                                       ,Left (valToTerm f)
+                                       ,Left (valToTerm g)
+                                       ,Left (Case splitAtCall xsSVecTy [asAlt])])
+                         ,Left (mkApps (Prim pInfo)
+                                       [Right pTy
+                                       ,Right k'ty
+                                       ,Right aTy
+                                       ,Left (Literal (NaturalLiteral (k'-1)))
+                                       ,Left (valToTerm p)
+                                       ,Left (valToTerm f)
+                                       ,Left (valToTerm g)
+                                       ,Left (Case splitAtCall xsSVecTy [bsAlt])])
+                         ]
+-- Misc
+  $(namePat 'Clash.Sized.Vector.lazyV)
+    | isSubj
+    , nTy : aTy : _ <- tys
+    , _ : xs : _ <- args
+    , (_,tyView -> TyConApp vecTcNm _) <- splitFunForallTy ty
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> case n of
+         0  -> let (Just vecTc) = UniqMap.lookup vecTcNm tcm
+                   [nilCon,_]   = tyConDataCons vecTc
+               in  reduce (mkVecNil nilCon aTy)
+         n' -> let (Just vecTc) = UniqMap.lookup vecTcNm tcm
+                   [_,consCon]  = tyConDataCons vecTc
+               in  reduce $ mkVecCons consCon aTy n'
+                     (mkApps (vecHeadPrim vecTcNm)
+                             [ Right (LitTy (NumTy (n' - 1)))
+                             , Right aTy
+                             , Left  (valToTerm xs)
+                             ])
+                     (mkApps (Prim pInfo)
+                             [ Right (LitTy (NumTy (n' - 1)))
+                             , Right aTy
+                             , Left  (Literal (NaturalLiteral (n'-1)))
+                             , Left  (mkApps (vecTailPrim vecTcNm)
+                                             [ Right (LitTy (NumTy (n'-1)))
+                                             , Right aTy
+                                             , Left  (valToTerm xs)
+                                             ])
+                             ])
+-- Traversable
+  $(namePat 'Clash.Sized.Vector.traverse#)
+    | isSubj
+    , aTy : fTy : bTy : nTy : _ <- tys
+    , apDict : f : xs : _ <- args
+    , DC dc vArgs <- xs
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> case n of
+         0 -> let (pureF,ids') = runPEM (mkSelectorCase $(curLoc) is0 tcm (valToTerm apDict) 1 1) ids
+              in  reduceWHNF' (mach { mSupply = ids' }) $
+                  mkApps pureF
+                         [Right (mkTyConApp (vecTcNm) [nTy,bTy])
+                         ,Left  (mkVecNil dc bTy)]
+         _ -> let ((fmapF,apF),ids') = flip runPEM ids $ do
+                    fDict  <- mkSelectorCase $(curLoc) is0 tcm (valToTerm apDict) 1 0
+                    fmapF' <- mkSelectorCase $(curLoc) is0 tcm fDict 1 0
+                    apF'   <- mkSelectorCase $(curLoc) is0 tcm (valToTerm apDict) 1 2
+                    return (fmapF',apF')
+                  n'ty = LitTy (NumTy (n-1))
+                  Just (consCoTy : _) = dataConInstArgTys dc [nTy,bTy,n'ty]
+              in  reduceWHNF' (mach { mSupply = ids' }) $
+                  mkApps apF
+                         [Right (mkTyConApp vecTcNm [n'ty,bTy])
+                         ,Right (mkTyConApp vecTcNm [nTy,bTy])
+                         ,Left (mkApps fmapF
+                                       [Right bTy
+                                       ,Right (mkFunTy (mkTyConApp vecTcNm [n'ty,bTy])
+                                                       (mkTyConApp vecTcNm [nTy,bTy]))
+                                       ,Left (mkApps (Data dc)
+                                                     [Right nTy
+                                                     ,Right bTy
+                                                     ,Right n'ty
+                                                     ,Left (primCo consCoTy)])
+                                       ,Left (mkApps (valToTerm f)
+                                                     [Left (Either.lefts vArgs !! 1)])
+                                       ])
+                         ,Left (mkApps (Prim pInfo)
+                                       [Right aTy
+                                       ,Right fTy
+                                       ,Right bTy
+                                       ,Right n'ty
+                                       ,Left (valToTerm apDict)
+                                       ,Left (valToTerm f)
+                                       ,Left (Either.lefts vArgs !! 2)
+                                       ])
+                         ]
+    where
+      (tyArgs,_)         = splitFunForallTy ty
+      TyConApp vecTcNm _ = tyView (Either.rights tyArgs !! 2)
+      (ids, is0) = (mSupply mach, mScopeNames mach)
+
+-- BitPack
+  $(namePat 'Clash.Sized.Vector.concatBitVector#)
+    | isSubj
+    , nTy : mTy : _ <- tys
+    , _  : km  : v : _ <- args
+    , DC _ vArgs <- v
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> case n of
+         0  -> let resTyInfo = extractTySizeInfo tcm ty tys
+               in  reduce (mkBitVectorLit' resTyInfo 0 0)
+         n' | Right m <- runExcept (tyNatSize tcm mTy)
+            , (_,tyView -> TyConApp bvTcNm _) <- splitFunForallTy ty
+            -> reduceWHNF $
+               mkApps (bvAppendPrim bvTcNm)
+                 [ Right (mkTyConApp typeNatMul [LitTy (NumTy (n'-1)),mTy])
+                 , Right mTy
+                 , Left (Literal (NaturalLiteral ((n'-1)*m)))
+                 , Left (Either.lefts vArgs !! 1)
+                 , Left (mkApps (Prim pInfo)
+                                [ Right (LitTy (NumTy (n'-1)))
+                                , Right mTy
+                                , Left (Literal (NaturalLiteral (n'-1)))
+                                , Left (valToTerm km)
+                                , Left (Either.lefts vArgs !! 2)
+                                ])
+                 ]
+         _ -> Nothing
+  $(namePat 'Clash.Sized.Vector.unconcatBitVector#)
+    | isSubj
+    , nTy : mTy : _  <- tys
+    , _  : km  : bv : _ <- args
+    , (_,tyView -> TyConApp vecTcNm [_,bvMTy]) <- splitFunForallTy ty
+    , TyConApp bvTcNm _ <- tyView bvMTy
+    , Right n <- runExcept (tyNatSize tcm nTy)
+    -> case n of
+         0 ->
+          let (Just vecTc) = UniqMap.lookup vecTcNm tcm
+              [nilCon,_] = tyConDataCons vecTc
+          in  reduce (mkVecNil nilCon (mkTyConApp bvTcNm [mTy]))
+         n' | Right m <- runExcept (tyNatSize tcm mTy) ->
+          let Just vecTc  = UniqMap.lookup vecTcNm tcm
+              [_,consCon] = tyConDataCons vecTc
+              tupTcNm     = ghcTyconToTyConName (tupleTyCon Boxed 2)
+              Just tupTc  = UniqMap.lookup tupTcNm tcm
+              [tupDc]     = tyConDataCons tupTc
+              splitCall   =
+                mkApps (bvSplitPrim bvTcNm)
+                       [ Right (mkTyConApp typeNatMul [LitTy (NumTy (n'-1)),mTy])
+                       , Right mTy
+                       , Left (Literal (NaturalLiteral ((n'-1)*m)))
+                       , Left (valToTerm bv)
+                       ]
+              mBVTy       = mkTyConApp bvTcNm [mTy]
+              n1BVTy      = mkTyConApp bvTcNm
+                              [mkTyConApp typeNatMul
+                                [LitTy (NumTy (n'-1))
+                                ,mTy]]
+              -- Guaranteed no capture, so okay to use unsafe name generation
+              xNm         = mkUnsafeSystemName "x" 0
+              bvNm        = mkUnsafeSystemName "bv'" 1
+              xId         = mkLocalId mBVTy xNm
+              bvId        = mkLocalId n1BVTy bvNm
+              tupPat      = DataPat tupDc [] [xId,bvId]
+              xAlt        = (tupPat, (Var xId))
+              bvAlt       = (tupPat, (Var bvId))
+
+          in  reduce $ mkVecCons consCon (mkTyConApp bvTcNm [mTy]) n'
+                (Case splitCall mBVTy [xAlt])
+                (mkApps (Prim pInfo)
+                        [ Right (LitTy (NumTy (n'-1)))
+                        , Right mTy
+                        , Left (Literal (NaturalLiteral (n'-1)))
+                        , Left (valToTerm km)
+                        , Left (Case splitCall n1BVTy [bvAlt])
+                        ])
+         _ -> Nothing
+#if MIN_VERSION_ghc(9,4,0)
+  "Data.Text.Show.$wunpackCStringAscii#"
+    | [Lit (StringLiteral addr)] <- args
+    , Text.Text (Text.ByteArray ba) _off len <- Text.pack addr
+    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
+           (Just tupTc) = UniqMap.lookup tupTcNm tcm
+           [tupDc] = tyConDataCons tupTc
+           ret     = mkApps (Data tupDc) (map Right tyArgs ++
+                    [ Left (Literal (ByteArrayLiteral (BA.ByteArray ba)))
+                    , Left (Literal (IntLiteral 0))
+                    , Left (Literal (IntLiteral (toInteger len)))])
+        in reduce ret
+  -- XXX: Does not seem to exist?
+  "GHC.Magic.noinlineConstraint"
+    | [arg] <- args
+    -> reduce (valToTerm arg)
+#if MIN_VERSION_base(4,18,0)
+  $(namePat 'GHC.TypeNats.withSomeSNat)
+    | Lit (NaturalLiteral n) : fun : _ <- args
+    , _ : funTy : _ <- Either.rights (fst (splitFunForallTy ty))
+    , (tyView -> TyConApp snatTcNm _) : _ <- Either.rights (fst (splitFunForallTy funTy))
+    , Just snatTc <- UniqMap.lookup snatTcNm tcm
+    , [snatDc] <- tyConDataCons snatTc
+    -> let nTy = LitTy (NumTy n)
+           snat = mkApps (Data snatDc) [Right nTy, Left (Literal (NaturalLiteral n))]
+           ret = mkApps (valToTerm fun) [Right nTy, Left snat]
+        in reduce ret
+#endif
+  -- XXX: Does not seem to exist?
+  "GHC.Magic.nospec"
+    | [arg] <- args
+    -> reduce (valToTerm arg)
+  "GHC.Float.$wproperFractionDouble"
+    | _ : Lit (DoubleLiteral d) : _ <- args
+    , [sty@(tyView -> TyConApp signedTcNm [nTy@(LitTy (NumTy kn))])] <- tys
+    , nameOcc signedTcNm == showt ''Signed
+    , (_, tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
+    , Just tupTc <- UniqMap.lookup tupTcNm tcm
+    , [tupDc] <- tyConDataCons tupTc
+    -> let (sn, d1) = reifyNat kn (\p -> first toInteger (op p (wordToDouble d)))
+           ret = mkApps (Data tupDc) (map Right tyArgs ++
+                  [ Left (mkSignedLit sty nTy kn sn)
+                  , Left (mkDoubleCLit tcm (doubleToWord d1) (last tyArgs))
+                  ])
+        in reduce ret
+    where
+      op :: KnownNat n => Proxy n -> Double -> (Signed n, Double)
+      op _ = properFraction
+  "GHC.Internal.Float.$wproperFractionDouble"
+    | _ : Lit (DoubleLiteral d) : _ <- args
+    , [sty@(tyView -> TyConApp signedTcNm [nTy@(LitTy (NumTy kn))])] <- tys
+    , nameOcc signedTcNm == showt ''Clash.Sized.Internal.Signed.Signed
+    , (_, tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
+    , Just tupTc <- UniqMap.lookup tupTcNm tcm
+    , [tupDc] <- tyConDataCons tupTc
+    -> let (sn, d1) = reifyNat kn (\p -> first toInteger (op p (wordToDouble d)))
+           ret = mkApps (Data tupDc) (map Right tyArgs ++
+                  [ Left (mkSignedLit sty nTy kn sn)
+                  , Left (mkDoubleCLit tcm (doubleToWord d1) (last tyArgs))
+                  ])
+        in reduce ret
+    where
+      op :: KnownNat n => Proxy n -> Double -> (Signed n, Double)
+      op _ = properFraction
+#endif
+  _ -> Nothing
+  where
+    ty = primType pInfo
+
+    checkNaturalRange1 nTy i f =
+      checkNaturalRange nTy [i]
+        (\[i'] -> naturalToNaturalLiteral (f i'))
+
+    checkNaturalRange2 nTy i j f =
+      checkNaturalRange nTy [i, j]
+        (\[i', j'] -> naturalToNaturalLiteral (f i' j'))
+
+    -- Check given integer's range. If any of them are less than zero, give up
+    -- and return an undefined type.
+    checkNaturalRange
+      :: Type
+      -- Type of GHC.Natural.Natural ^
+      -> [Integer]
+      -> ([Natural] -> Term)
+      -> Term
+    checkNaturalRange nTy natsAsInts f =
+      if any (<0) natsAsInts then
+        TyApp (Prim NP.undefined) nTy
+      else
+        f (map fromInteger natsAsInts)
+
+    reduce :: Term -> Maybe Machine
+    reduce e = case isX e of
+      Left msg -> trace (unlines ["Warning: Not evaluating constant expression:", show (primName pInfo), "Because doing so generates an XException:", msg]) Nothing
+      Right e' -> Just (setTerm e' mach)
+
+    reduceWHNF e =
+      let eval = Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
+          mach1@Machine{mStack=[]} = whnf eval tcm isSubj (setTerm e $ stackClear mach)
+      in Just $ mach1 { mStack = mStack mach }
+
+    reduceWHNF' mach1 e =
+      let eval = Evaluator ghcStep ghcUnwind ghcPrimStep ghcPrimUnwind
+          mach2@Machine{mStack=[]} = whnf eval tcm isSubj (setTerm e mach1)
+       in Just $ mach2 { mStack = mStack mach }
+
+    makeUndefinedIf :: Exception e => (e -> Bool) -> Term -> Term
+    makeUndefinedIf wantToHandle tm =
+      case unsafeDupablePerformIO $ tryJust selectException (evaluate $ force tm) of
+        Right b -> b
+        Left e -> trace (msg e) (TyApp (Prim NP.undefined) resTy)
+      where
+        resTy = getResultTy tcm ty tys
+        selectException e | wantToHandle e = Just e
+                          | otherwise = Nothing
+        msg e = unlines ["Warning: caught exception: \"" ++ show e ++ "\" while trying to evaluate: "
+                        , showPpr (mkApps (Prim pInfo) (map (Left . valToTerm) args))
+                        ]
+
+    catchDivByZero = makeUndefinedIf (==DivideByZero)
+
+-- Helper functions for literals
+
+pairOf :: (Value -> Maybe a) -> [Value] -> Maybe (a, a)
+pairOf f [x, y] = (,) <$> f x <*> f y
+pairOf _ _ = Nothing
+
+listOf :: (Value -> Maybe a) -> [Value] -> [a]
+listOf = mapMaybe
+
+wrapUnsigned :: Integer -> Integer -> Integer
+wrapUnsigned n i = i `mod` sz
+ where
+  sz = 1 `shiftL` fromInteger n
+
+wrapSigned :: Integer -> Integer -> Integer
+wrapSigned n i = if n == 0 then 0 else res
+ where
+  mask = 1 `shiftL` fromInteger (n - 1)
+  res  = case divMod i mask of
+           (s,i1) | even s    -> i1
+                  | otherwise -> i1 - mask
+
+doubleLiterals' :: [Value] -> [Word64]
+doubleLiterals' = listOf doubleLiteral
+
+doubleLiteral :: Value -> Maybe Word64
+doubleLiteral v = case v of
+  Lit (DoubleLiteral i) -> Just i
+  _ -> Nothing
+
+floatLiterals' :: [Value] -> [Word32]
+floatLiterals' = listOf floatLiteral
+
+floatLiteral :: Value -> Maybe Word32
+floatLiteral v = case v of
+  Lit (FloatLiteral i) -> Just i
+  _ -> Nothing
+
+integerLiterals :: [Value] -> Maybe (Integer, Integer)
+integerLiterals = pairOf integerLiteral
+
+integerLiteral :: Value -> Maybe Integer
+integerLiteral v =
+  case v of
+    Lit (IntegerLiteral i) -> Just i
+    DC dc [Left (Literal (IntLiteral i))]
+      | dcTag dc == 1
+      -> Just i
+    DC dc [Left (Literal (ByteArrayLiteral (BA.ByteArray ba)))]
+      | dcTag dc == 2
+#if MIN_VERSION_base(4,15,0)
+      -> Just (IP ba)
+#else
+      -> Just (Jp# (BN# ba))
+#endif
+      | dcTag dc == 3
+#if MIN_VERSION_base(4,15,0)
+      -> Just (IN ba)
+#else
+      -> Just (Jn# (BN# ba))
+#endif
+    _ -> Nothing
+
+naturalLiterals :: [Value] -> Maybe (Integer, Integer)
+naturalLiterals = pairOf naturalLiteral
+
+naturalLiteral :: Value -> Maybe Integer
+naturalLiteral v =
+  case v of
+    Lit (NaturalLiteral i) -> Just i
+    DC dc [Left (Literal (WordLiteral i))]
+      | dcTag dc == 1
+      -> Just i
+    DC dc [Left (Literal (ByteArrayLiteral (BA.ByteArray ba)))]
+      | dcTag dc == 2
+#if MIN_VERSION_base(4,15,0)
+      -> Just (IP ba)
+#else
+      -> Just (Jp# (BN# ba))
+#endif
+    _ -> Nothing
+
+integerLiterals' :: [Value] -> [Integer]
+integerLiterals' = listOf integerLiteral
+
+naturalLiterals' :: [Value] -> [Integer]
+naturalLiterals' = listOf naturalLiteral
+
+intLiterals :: [Value] -> Maybe (Integer,Integer)
+intLiterals = pairOf intLiteral
+
+intLiterals' :: [Value] -> [Integer]
+intLiterals' = listOf intLiteral
+
+intCLiterals' :: [Value] -> [Integer]
+intCLiterals' = listOf intCLiteral
+
+intLiteral :: Value -> Maybe Integer
+intLiteral x = case x of
+  Lit (IntLiteral i) -> Just i
+  _ -> Nothing
+
+#if MIN_VERSION_base(4,16,0)
+int8Literals' :: [Value] -> [Integer]
+int8Literals' = listOf int8Literal
+
+int8Literal :: Value -> Maybe Integer
+int8Literal x = case x of
+  Lit (Int8Literal i) -> Just i
+  _ -> Nothing
+
+int16Literals' :: [Value] -> [Integer]
+int16Literals' = listOf int16Literal
+
+int16Literal :: Value -> Maybe Integer
+int16Literal x = case x of
+  Lit (Int16Literal i) -> Just i
+  _ -> Nothing
+
+int32Literals' :: [Value] -> [Integer]
+int32Literals' = listOf int32Literal
+
+int32Literal :: Value -> Maybe Integer
+int32Literal x = case x of
+  Lit (Int32Literal i) -> Just i
+  _ -> Nothing
+
+#if MIN_VERSION_base(4,17,0)
+int64Literals' :: [Value] -> [Integer]
+int64Literals' = listOf int64Literal
+
+int64Literal :: Value -> Maybe Integer
+int64Literal x = case x of
+  Lit (Int64Literal i) -> Just i
+  _ -> Nothing
+#endif
+#endif
+
+intCLiteral :: Value -> Maybe Integer
+intCLiteral v = case v of
+  (DC _ [Left (Literal (IntLiteral i))]) -> Just i
+  _ -> Nothing
+
+intCLiterals :: [Value] -> Maybe (Integer, Integer)
+intCLiterals = pairOf intCLiteral
+
+wordLiterals :: [Value] -> Maybe (Integer,Integer)
+wordLiterals = pairOf wordLiteral
+
+wordLiterals' :: [Value] -> [Integer]
+wordLiterals' = listOf wordLiteral
+
+wordLiteral :: Value -> Maybe Integer
+wordLiteral x = case x of
+  Lit (WordLiteral i) -> Just i
+  _ -> Nothing
+
+#if MIN_VERSION_base(4,16,0)
+word8Literals' :: [Value] -> [Integer]
+word8Literals' = listOf word8Literal
+
+word8Literal :: Value -> Maybe Integer
+word8Literal x = case x of
+  Lit (Word8Literal i) -> Just i
+  _ -> Nothing
+
+word16Literals' :: [Value] -> [Integer]
+word16Literals' = listOf word16Literal
+
+word16Literal :: Value -> Maybe Integer
+word16Literal x = case x of
+  Lit (Word16Literal i) -> Just i
+  _ -> Nothing
+
+word32Literals' :: [Value] -> [Integer]
+word32Literals' = listOf word32Literal
+
+word32Literal :: Value -> Maybe Integer
+word32Literal x = case x of
+  Lit (Word32Literal i) -> Just i
+  _ -> Nothing
+#endif
+
+word64Literals' :: [Value] -> [Integer]
+word64Literals' = listOf word64Literal
+
+#if MIN_VERSION_base(4,17,0)
+word64Literal :: Value -> Maybe Integer
+word64Literal x = case x of
+  Lit (Word64Literal i) -> Just i
+  _ -> Nothing
+#else
+-- Prior to GHC 9.4 Word64# didn't exist, 64 bit primitives took Word# instead
+word64Literal :: Value -> Maybe Integer
+word64Literal= wordLiteral
+#endif
+
+charLiterals :: [Value] -> Maybe (Char,Char)
+charLiterals = pairOf charLiteral
+
+charLiterals' :: [Value] -> [Char]
+charLiterals' = listOf charLiteral
+
+charLiteral :: Value -> Maybe Char
+charLiteral x = case x of
+  Lit (CharLiteral c) -> Just c
+  _ -> Nothing
+
+sizedLiterals :: Text -> [Value] -> Maybe (Integer,Integer)
+sizedLiterals szCon = pairOf (sizedLiteral szCon)
+
+sizedLiterals' :: Text -> [Value] -> [Integer]
+sizedLiterals' szCon = listOf (sizedLiteral szCon)
+
+sizedLiteral :: Text -> Value -> Maybe Integer
+sizedLiteral szCon val = case val of
+  PrimVal p _ [_, Lit (IntegerLiteral i)]
+    | primName p == szCon -> Just i
+  _ -> Nothing
+
+bitLiterals
+  :: [Value]
+  -> [(Integer,Integer)]
+bitLiterals = map normalizeBit . mapMaybe go
+ where
+  normalizeBit (msk,v) = (msk .&. 1, v .&. 1)
+  go val = case val of
+    PrimVal p _ [Lit (WordLiteral m), Lit (IntegerLiteral i)]
+      | primName p == showt 'Clash.Sized.Internal.BitVector.fromInteger##
+      -> Just (m,i)
+    _ -> Nothing
+
+indexLiterals, signedLiterals, unsignedLiterals
+  :: [Value] -> Maybe (Integer,Integer)
+indexLiterals     = sizedLiterals (showt 'Clash.Sized.Internal.Index.fromInteger#)
+signedLiterals    = sizedLiterals (showt 'Clash.Sized.Internal.Signed.fromInteger#)
+unsignedLiterals  = sizedLiterals (showt 'Clash.Sized.Internal.Unsigned.fromInteger#)
+
+indexLiterals', signedLiterals', unsignedLiterals'
+  :: [Value] -> [Integer]
+indexLiterals'     = sizedLiterals' (showt 'Clash.Sized.Internal.Index.fromInteger#)
+signedLiterals'    = sizedLiterals' (showt 'Clash.Sized.Internal.Signed.fromInteger#)
+unsignedLiterals'  = sizedLiterals' (showt 'Clash.Sized.Internal.Unsigned.fromInteger#)
+
+bitVectorLiterals'
+  :: [Value] -> [(Integer,Integer)]
+bitVectorLiterals' = listOf bitVectorLiteral
+
+bitVectorLiteral :: Value -> Maybe (Integer, Integer)
+bitVectorLiteral val = case val of
+  (PrimVal p _ [_, Lit (NaturalLiteral m), Lit (IntegerLiteral i)])
+    | primName p == showt 'Clash.Sized.Internal.BitVector.fromInteger# -> Just (m, i)
+  _ -> Nothing
+
+toBV :: (Integer,Integer) -> BitVector n
+toBV (mask,val) = BV (fromInteger mask) (fromInteger val)
+
+splitBV :: BitVector n -> (Integer,Integer)
+splitBV (BV msk val) = (toInteger msk, toInteger val)
+
+toBit :: (Integer,Integer) -> Bit
+toBit (mask,val) = Bit (fromInteger mask) (fromInteger val)
+
+valArgs
+  :: Value
+  -> Maybe [Term]
+valArgs v =
+  case v of
+    PrimVal _ _ vs -> Just (fmap valToTerm vs)
+    DC _ args -> Just (Either.lefts args)
+    _ -> Nothing
+
+-- Tries to match literal arguments to a function like
+--   (Unsigned.shiftL#  :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n)
+sizedLitIntLit
+  :: Text -> TyConMap -> [Type] -> [Value]
+  -> Maybe (Type,Integer,Integer,Integer)
+sizedLitIntLit szCon tcm tys args
+  | Just (nTy,kn) <- extractKnownNat tcm tys
+  , [_
+    ,PrimVal p _ [_,Lit (IntegerLiteral i)]
+    ,valArgs -> Just [Literal (IntLiteral j)]
+    ] <- args
+  , primName p == szCon
+  = Just (nTy,kn,i,j)
+  | otherwise
+  = Nothing
+
+signedLitIntLit, unsignedLitIntLit
+  :: TyConMap -> [Type] -> [Value]
+  -> Maybe (Type,Integer,Integer,Integer)
+signedLitIntLit    = sizedLitIntLit (showt 'Clash.Sized.Internal.Signed.fromInteger#)
+unsignedLitIntLit  = sizedLitIntLit (showt 'Clash.Sized.Internal.Unsigned.fromInteger#)
+
+bitVectorLitIntLit
+  :: TyConMap -> [Type] -> [Value]
+  -> Maybe (Type,Integer,(Integer,Integer),Integer)
+bitVectorLitIntLit tcm tys args
+  | Just (nTy,kn) <- extractKnownNat tcm tys
+  , [_
+    ,PrimVal p _ [_,Lit (NaturalLiteral m),Lit (IntegerLiteral i)]
+    ,valArgs -> Just [Literal (IntLiteral j)]
+    ] <- args
+  , primName p == showt 'Clash.Sized.Internal.BitVector.fromInteger#
+  = Just (nTy,kn,(m,i),j)
+  | otherwise
+  = Nothing
+
+mkIntCLit :: TyConMap -> Integer -> Type -> Term
+mkIntCLit tcm lit resTy =
+  App (Data intDc) (Literal (IntLiteral lit))
+ where
+  (_, tyView -> TyConApp intTcNm []) = splitFunForallTy resTy
+  Just intTc = UniqMap.lookup intTcNm tcm
+  [intDc] = tyConDataCons intTc
+
+mkFloatCLit :: TyConMap -> Word32 -> Type -> Term
+mkFloatCLit tcm lit resTy =
+  App (Data floatDc) (Literal (FloatLiteral lit))
+ where
+  (_, tyView -> TyConApp floatTcNm []) = splitFunForallTy resTy
+  (Just floatTc) = UniqMap.lookup floatTcNm tcm
+  [floatDc] = tyConDataCons floatTc
+
+mkDoubleCLit :: TyConMap -> Word64 -> Type -> Term
+mkDoubleCLit tcm lit resTy =
+  App (Data doubleDc) (Literal (DoubleLiteral lit))
+ where
+  (_, tyView -> TyConApp doubleTcNm []) = splitFunForallTy resTy
+  (Just doubleTc) = UniqMap.lookup doubleTcNm tcm
+  [doubleDc] = tyConDataCons doubleTc
+
+mkSomeNat :: TyConMap -> Integer -> Type -> Term
+mkSomeNat tcm lit resTy =
+  mkApps (Data someNatDc)
+         [ Right (LitTy (NumTy lit))
+         , Left (Literal (NaturalLiteral lit))
+         , Left proxy
+         ]
+ where
+  -- Get the SomeNat data constructor
+  TyConApp someNatTcNm [] = tyView resTy
+  (Just someNatTc) = UniqMap.lookup someNatTcNm tcm
+  [someNatDc] = tyConDataCons someNatTc
+
+  -- Get the Proxy data constructor
+  (_:_:Right (tyView -> TyConApp proxyTcNm [natTy,_]):_,_) =
+    splitFunForallTy (dcType someNatDc)
+  (Just proxyTc) = UniqMap.lookup proxyTcNm tcm
+  [proxyDc] = tyConDataCons proxyTc
+
+  -- Build the Proxy argument
+  proxy = mkApps (Data proxyDc)
+                 [ Right natTy
+                 , Right (LitTy (NumTy lit))
+                 ]
+
+-- From an argument list to function of type
+--   forall n. KnownNat n => ...
+-- extract (nTy,nInt)
+-- where nTy is the Type of n
+-- and   nInt is its value as an Integer
+extractKnownNat :: TyConMap -> [Type] -> Maybe (Type, Integer)
+extractKnownNat tcm tys = case tys of
+  nTy : _ | Right nInt <- runExcept (tyNatSize tcm nTy)
+    -> Just (nTy, nInt)
+  _ -> Nothing
+
+-- From an argument list to function of type
+--   forall n m o .. . (KnownNat n, KnownNat m, KnownNat o, ..) => ...
+-- extract [(nTy,nInt), (mTy,mInt), (oTy,oInt)]
+-- where nTy is the Type of n
+-- and   nInt is its value as an Integer
+extractKnownNats :: TyConMap -> [Type] -> [(Type, Integer)]
+extractKnownNats tcm =
+  mapMaybe (extractKnownNat tcm . pure)
+
+-- Construct a constant term of a sized type
+mkSizedLit
+  :: (Type -> Term)
+  -- ^ Type constructor?
+  -> Type
+  -- ^ Result type
+  -> Type
+  -- ^ forall n.
+  -> Integer
+  -- ^ KnownNat n
+  -> Integer
+  -- ^ Value to construct
+  -> Term
+mkSizedLit conPrim ty nTy kn val =
+  mkApps
+    (conPrim sTy)
+    [ Right nTy
+    , Left (Literal (NaturalLiteral kn))
+    , Left (Literal (IntegerLiteral val)) ]
+ where
+    (_,sTy) = splitFunForallTy ty
+
+mkBitLit
+  :: Type
+  -- ^ Result type
+  -> Integer
+  -- ^ Mask
+  -> Integer
+  -- ^ Value
+  -> Term
+mkBitLit ty msk val =
+  mkApps (bConPrim sTy) [ Left (Literal (WordLiteral (msk .&. 1)))
+                        , Left (Literal (IntegerLiteral (val .&. 1)))]
+  where
+    (_,sTy) = splitFunForallTy ty
+
+mkSignedLit, mkUnsignedLit
+  :: Type
+  -- Result type
+  -> Type
+  -- forall n.
+  -> Integer
+  -- KnownNat n
+  -> Integer
+  -- Value
+  -> Term
+mkSignedLit    = mkSizedLit signedConPrim
+mkUnsignedLit  = mkSizedLit unsignedConPrim
+
+mkBitVectorLit
+  :: Type
+  -- ^ Result type
+  -> Type
+  -- ^ forall n.
+  -> Integer
+  -- ^ KnownNat n
+  -> Integer
+  -- ^ mask
+  -> Integer
+  -- ^ Value to construct
+  -> Term
+mkBitVectorLit ty nTy kn mask val
+  = mkApps (bvConPrim sTy)
+           [Right nTy
+           ,Left (Literal (NaturalLiteral kn))
+           ,Left (Literal (NaturalLiteral mask))
+           ,Left (Literal (IntegerLiteral val))]
+  where
+    (_,sTy) = splitFunForallTy ty
+
+mkIndexLitE
+  :: Type
+  -- ^ Result type
+  -> Type
+  -- ^ forall n.
+  -> Integer
+  -- ^ KnownNat n
+  -> Integer
+  -- ^ Value to construct
+  -> Either Term Term
+  -- ^ Either undefined (if given value is out of bounds of given type) or term
+  -- representing literal
+mkIndexLitE rTy nTy kn val
+  | val >= 0
+  , val < kn
+  = Right (mkSizedLit indexConPrim rTy nTy kn val)
+  | otherwise
+  = Left (TyApp (Prim NP.undefined) (mkTyConApp indexTcNm [nTy]))
+  where
+    TyConApp indexTcNm _ = tyView (snd (splitFunForallTy rTy))
+
+mkIndexLit
+  :: Type
+  -- ^ Result type
+  -> Type
+  -- ^ forall n.
+  -> Integer
+  -- ^ KnownNat n
+  -> Integer
+  -- ^ Value to construct
+  -> Term
+mkIndexLit rTy nTy kn val =
+  either id id (mkIndexLitE rTy nTy kn val)
+
+mkBitVectorLit'
+  :: (Type, Type, Integer)
+  -- ^ (result type, forall n., KnownNat n)
+  -> Integer
+  -- ^ Mask
+  -> Integer
+  -- ^ Value
+  -> Term
+mkBitVectorLit' (ty,nTy,kn) = mkBitVectorLit ty nTy kn
+
+mkIndexLit'
+  :: (Type, Type, Integer)
+  -- ^ (result type, forall n., KnownNat n)
+  -> Integer
+  -- ^ value
+  -> Term
+mkIndexLit' (rTy,nTy,kn) = mkIndexLit rTy nTy kn
+
+boolToIntLiteral :: Bool -> Term
+boolToIntLiteral b = if b then Literal (IntLiteral 1) else Literal (IntLiteral 0)
+
+boolToBoolLiteral :: TyConMap -> Type -> Bool -> Term
+boolToBoolLiteral tcm ty b =
+ let (_,tyView -> TyConApp boolTcNm []) = splitFunForallTy ty
+     (Just boolTc) = UniqMap.lookup boolTcNm tcm
+     [falseDc,trueDc] = tyConDataCons boolTc
+     retDc = if b then trueDc else falseDc
+ in  Data retDc
+
+charToCharLiteral :: Char -> Term
+charToCharLiteral = Literal . CharLiteral
+
+integerToIntLiteral :: Integer -> Term
+integerToIntLiteral = Literal . IntLiteral . toInteger . (fromInteger :: Integer -> Int) -- for overflow behavior
+
+integerToWordLiteral :: Integer -> Term
+integerToWordLiteral = Literal . WordLiteral . toInteger . (fromInteger :: Integer -> Word) -- for overflow behavior
+
+#if MIN_VERSION_base(4,17,0) || WORD_SIZE_IN_BITS < 64
+integerToInt64Literal :: Integer -> Term
+integerToInt64Literal = Literal . Int64Literal . toInteger . (fromInteger :: Integer -> Int64) -- for overflow behavior
+
+integerToWord64Literal :: Integer -> Term
+integerToWord64Literal = Literal . Word64Literal . toInteger . (fromInteger :: Integer -> Word64) -- for overflow behavior
+#endif
+
+integerToIntegerLiteral :: Integer -> Term
+integerToIntegerLiteral = Literal . IntegerLiteral
+
+naturalToNaturalLiteral :: Natural -> Term
+naturalToNaturalLiteral = Literal . NaturalLiteral . toInteger
+
+bConPrim :: Type -> Term
+bConPrim (tyView -> TyConApp bTcNm _)
+  = Prim (PrimInfo (showt 'Clash.Sized.Internal.BitVector.fromInteger##) funTy WorkNever SingleResult NoUnfolding)
+  where
+    funTy      = foldr1 mkFunTy [wordPrimTy,integerPrimTy,mkTyConApp bTcNm []]
+bConPrim _ = error $ $(curLoc) ++ "called with incorrect type"
+
+bvConPrim :: Type -> Term
+bvConPrim (tyView -> TyConApp bvTcNm _)
+  = Prim (PrimInfo (showt 'Clash.Sized.Internal.BitVector.fromInteger#) (ForAllTy nTV funTy) WorkNever SingleResult NoUnfolding)
+  where
+    funTy = foldr1 mkFunTy [naturalPrimTy,naturalPrimTy,integerPrimTy,mkTyConApp bvTcNm [nVar]]
+    nName = mkUnsafeSystemName "n" 0
+    nVar  = VarTy nTV
+    nTV   = mkTyVar typeNatKind nName
+bvConPrim _ = error $ $(curLoc) ++ "called with incorrect type"
+
+indexConPrim :: Type -> Term
+indexConPrim (tyView -> TyConApp indexTcNm _)
+  = Prim (PrimInfo (showt 'Clash.Sized.Internal.Index.fromInteger#) (ForAllTy nTV funTy) WorkNever SingleResult NoUnfolding)
+  where
+    funTy        = foldr1 mkFunTy [naturalPrimTy,integerPrimTy,mkTyConApp indexTcNm [nVar]]
+    nName      = mkUnsafeSystemName "n" 0
+    nVar       = VarTy nTV
+    nTV        = mkTyVar typeNatKind nName
+indexConPrim _ = error $ $(curLoc) ++ "called with incorrect type"
+
+signedConPrim :: Type -> Term
+signedConPrim (tyView -> TyConApp signedTcNm _)
+  = Prim (PrimInfo (showt 'Clash.Sized.Internal.Signed.fromInteger#) (ForAllTy nTV funTy) WorkNever SingleResult NoUnfolding)
+  where
+    funTy        = foldr1 mkFunTy [naturalPrimTy,integerPrimTy,mkTyConApp signedTcNm [nVar]]
+    nName      = mkUnsafeSystemName "n" 0
+    nVar       = VarTy nTV
+    nTV        = mkTyVar typeNatKind nName
+signedConPrim _ = error $ $(curLoc) ++ "called with incorrect type"
+
+unsignedConPrim :: Type -> Term
+unsignedConPrim (tyView -> TyConApp unsignedTcNm _)
+  = Prim (PrimInfo (showt 'Clash.Sized.Internal.Unsigned.fromInteger#) (ForAllTy nTV funTy) WorkNever SingleResult NoUnfolding)
+  where
+    funTy        = foldr1 mkFunTy [naturalPrimTy,integerPrimTy,mkTyConApp unsignedTcNm [nVar]]
+    nName        = mkUnsafeSystemName "n" 0
+    nVar         = VarTy nTV
+    nTV          = mkTyVar typeNatKind nName
+unsignedConPrim _ = error $ $(curLoc) ++ "called with incorrect type"
+
+
+-- |  Lift a binary function over 'Unsigned' values to be used as literal Evaluator
+--
+--
+liftUnsigned2 :: KnownNat n
+              => (Unsigned n -> Unsigned n -> Unsigned n)
+              -> Type
+              -> TyConMap
+              -> [Type]
+              -> [Value]
+              -> (Proxy n -> Maybe Term)
+liftUnsigned2 = liftSized2 unsignedLiterals' mkUnsignedLit
+
+liftSigned2 :: KnownNat n
+              => (Signed n -> Signed n -> Signed n)
+              -> Type
+              -> TyConMap
+              -> [Type]
+              -> [Value]
+              -> (Proxy n -> Maybe Term)
+liftSigned2 = liftSized2 signedLiterals' mkSignedLit
+
+liftBitVector2 :: KnownNat n
+              => (BitVector n -> BitVector n -> BitVector n)
+              -> Type
+              -> TyConMap
+              -> [Type]
+              -> [Value]
+              -> (Proxy n -> Maybe Term)
+liftBitVector2  f ty tcm tys args _p
+  | Just (nTy, kn) <- extractKnownNat tcm tys
+  , [i,j] <- bitVectorLiterals' args
+  = let BV mask val = f (toBV i) (toBV j)
+    in Just $ mkBitVectorLit ty nTy kn (toInteger mask) (toInteger val)
+  | otherwise = Nothing
+
+liftBitVector2Bool :: KnownNat n
+              => (BitVector n -> BitVector n -> Bool)
+              -> Type
+              -> TyConMap
+              -> [Value]
+              -> (Proxy n -> Maybe Term)
+liftBitVector2Bool  f ty tcm args _p
+  | [i,j] <- bitVectorLiterals' args
+  = let val = f (toBV i) (toBV j)
+    in Just $ boolToBoolLiteral tcm ty val
+  | otherwise = Nothing
+
+liftInteger2BitVector
+  :: KnownNat n
+  => (Integer -> BitVector n)
+  -> (Type, Type, Integer)
+  -> [Value]
+  -> (Proxy n -> Maybe Term)
+liftInteger2BitVector f resTyInfo args _p
+  | [i] <- intCLiterals' args
+  = let BV msk val = f i
+     in Just (mkBitVectorLit' resTyInfo (toInteger msk) (toInteger val))
+
+  | otherwise
+  = Nothing
+
+liftBitVector2CInt
+  :: KnownNat n
+  => TyConMap
+  -> Type
+  -> (BitVector n -> Integer)
+  -> [Value]
+  -> (Proxy n -> Maybe Term)
+liftBitVector2CInt tcm resTy f args _p
+  | [i] <- bitVectorLiterals' args
+  = let val = f (toBV i)
+     in Just $ mkIntCLit tcm val resTy
+  | otherwise
+  = Nothing
+
+liftSized2 :: (KnownNat n, Integral (sized n))
+           => ([Value] -> [Integer])
+              -- ^ literal argument extraction function
+           -> (Type -> Type -> Integer -> Integer -> Term)
+              -- ^ literal contruction function
+           -> (sized n -> sized n -> sized n)
+           -> Type
+           -> TyConMap
+           -> [Type]
+           -> [Value]
+           -> (Proxy n -> Maybe Term)
+liftSized2 extractLitArgs mkLit f ty tcm tys args p
+  | Just (nTy, kn) <- extractKnownNat tcm tys
+  , [i,j] <- extractLitArgs args
+  = let val = runSizedF f i j p
+    in Just $ mkLit ty nTy kn val
+  | otherwise = Nothing
+
+-- | Helper to run a function over sized types on integers
+--
+-- This only works on function of type (sized n -> sized n -> sized n)
+-- The resulting function must be executed with reifyNat
+runSizedF
+  :: (KnownNat n, Integral (sized n))
+  => (sized n -> sized n -> sized n)
+  -- ^ function to run
+  -> Integer
+  -- ^ first  argument
+  -> Integer
+  -- ^ second argument
+  -> (Proxy n -> Integer)
+runSizedF f i j _ = toInteger $ f (fromInteger i) (fromInteger j)
+
+extractTySizeInfo :: TyConMap -> Type -> [Type] -> (Type, Type, Integer)
+extractTySizeInfo tcm ty tys = (resTy,resSizeTy,resSize)
+  where
+    ty' = piResultTys tcm ty tys
+    (_,resTy) = splitFunForallTy ty'
+    TyConApp _ [resSizeTy] = tyView resTy
+    Right resSize = runExcept (tyNatSize tcm resSizeTy)
+
+getResultTy
+  :: TyConMap
+  -> Type
+  -> [Type]
+  -> Type
+getResultTy tcm ty tys = resTy
+ where
+  ty' = piResultTys tcm ty tys
+  (_,resTy) = splitFunForallTy ty'
+
+liftDDI :: (Double# -> Double# -> Int#) -> [Value] -> Maybe Term
+liftDDI f args = case doubleLiterals' args of
+  [i,j] -> Just $ runDDI f i j
+  _     -> Nothing
+liftDDD :: (Double# -> Double# -> Double#) -> [Value] -> Maybe Term
+liftDDD f args = case doubleLiterals' args of
+  [i,j] -> Just $ runDDD f i j
+  _     -> Nothing
+liftDD  :: (Double# -> Double#) -> [Value] -> Maybe Term
+liftDD  f args = case doubleLiterals' args of
+  [i]   -> Just $ runDD f i
+  _     -> Nothing
+runDDI :: (Double# -> Double# -> Int#) -> Word64 -> Word64 -> Term
+runDDI f i j
+  = let !(D# a) = wordToDouble i
+        !(D# b) = wordToDouble j
+        r = f a b
+    in  Literal . IntLiteral . toInteger $ I# r
+runDDD :: (Double# -> Double# -> Double#) -> Word64 -> Word64 -> Term
+runDDD f i j
+  = let !(D# a) = wordToDouble i
+        !(D# b) = wordToDouble j
+        r = f a b
+    in  Literal . DoubleLiteral . doubleToWord $ D# r
+runDD :: (Double# -> Double#) -> Word64 -> Term
+runDD f i
+  = let !(D# a) = wordToDouble i
+        r = f a
+    in  Literal . DoubleLiteral . doubleToWord $ D# r
+
+liftFFI :: (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
+liftFFI f args = case floatLiterals' args of
+  [i,j] -> Just $ runFFI f i j
+  _     -> Nothing
+liftFFF :: (Float# -> Float# -> Float#) -> [Value] -> Maybe Term
+liftFFF f args = case floatLiterals' args of
+  [i,j] -> Just $ runFFF f i j
+  _     -> Nothing
+liftFF  :: (Float# -> Float#) -> [Value] -> Maybe Term
+liftFF  f args = case floatLiterals' args of
+  [i]   -> Just $ runFF f i
+  _     -> Nothing
+runFFI :: (Float# -> Float# -> Int#) -> Word32 -> Word32 -> Term
+runFFI f i j
+  = let !(F# a) = wordToFloat i
+        !(F# b) = wordToFloat j
+        r = f a b
+    in  Literal . IntLiteral . toInteger $ I# r
+runFFF :: (Float# -> Float# -> Float#) -> Word32 -> Word32 -> Term
+runFFF f i j
+  = let !(F# a) = wordToFloat i
+        !(F# b) = wordToFloat j
+        r = f a b
+    in  Literal . FloatLiteral . floatToWord $ F# r
+runFF :: (Float# -> Float#) -> Word32 -> Term
+runFF f i
+  = let !(F# a) = wordToFloat i
+        r = f a
+    in  Literal . FloatLiteral . floatToWord $ F# r
+
+#if MIN_VERSION_base(4,16,0)
+liftI8 :: (Int8# -> Int8# -> Int8#) -> [Value] -> Maybe Term
+liftI8 f args = case int8Literals' args of
+  [i,j] ->
+    let !(I8# a) = fromInteger i
+        !(I8# b) = fromInteger j
+     in Just (Literal (Int8Literal (toInteger (I8# (f a b)))))
+  _ -> Nothing
+
+liftI8I :: (Int8# -> Int# -> Int8#) -> [Value] -> Maybe Term
+liftI8I f args = case args of
+  [Lit (Int8Literal i),Lit (IntLiteral j)] ->
+    let !(I8# a) = fromInteger i
+        !(I# b) = fromInteger j
+     in Just (Literal (Int8Literal (toInteger (I8# (f a b)))))
+  _ -> Nothing
+
+liftI8RI :: (Int8# -> Int8# -> Int#) -> [Value] -> Maybe Term
+liftI8RI f args = case int8Literals' args of
+  [i,j] ->
+    let !(I8# a) = fromInteger i
+        !(I8# b) = fromInteger j
+     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
+  _ -> Nothing
+
+liftI16 :: (Int16# -> Int16# -> Int16#) -> [Value] -> Maybe Term
+liftI16 f args = case int16Literals' args of
+  [i,j] ->
+    let !(I16# a) = fromInteger i
+        !(I16# b) = fromInteger j
+     in Just (Literal (Int16Literal (toInteger (I16# (f a b)))))
+  _ -> Nothing
+
+liftI16I :: (Int16# -> Int# -> Int16#) -> [Value] -> Maybe Term
+liftI16I f args = case args of
+  [Lit (Int16Literal i),Lit (IntLiteral j)] ->
+    let !(I16# a) = fromInteger i
+        !(I# b) = fromInteger j
+     in Just (Literal (Int16Literal (toInteger (I16# (f a b)))))
+  _ -> Nothing
+
+liftI16RI :: (Int16# -> Int16# -> Int#) -> [Value] -> Maybe Term
+liftI16RI f args = case int16Literals' args of
+  [i,j] ->
+    let !(I16# a) = fromInteger i
+        !(I16# b) = fromInteger j
+     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
+  _ -> Nothing
+
+liftI32 :: (Int32# -> Int32# -> Int32#) -> [Value] -> Maybe Term
+liftI32 f args = case int32Literals' args of
+  [i,j] ->
+    let !(I32# a) = fromInteger i
+        !(I32# b) = fromInteger j
+     in Just (Literal (Int32Literal (toInteger (I32# (f a b)))))
+  _ -> Nothing
+
+liftI32I :: (Int32# -> Int# -> Int32#) -> [Value] -> Maybe Term
+liftI32I f args = case args of
+  [Lit (Int32Literal i),Lit (IntLiteral j)] ->
+    let !(I32# a) = fromInteger i
+        !(I# b) = fromInteger j
+     in Just (Literal (Int32Literal (toInteger (I32# (f a b)))))
+  _ -> Nothing
+
+liftI32RI :: (Int32# -> Int32# -> Int#) -> [Value] -> Maybe Term
+liftI32RI f args = case int32Literals' args of
+  [i,j] ->
+    let !(I32# a) = fromInteger i
+        !(I32# b) = fromInteger j
+     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
+  _ -> Nothing
+
+#if MIN_VERSION_base(4,17,0)
+liftI64 :: (Int64# -> Int64# -> Int64#) -> [Value] -> Maybe Term
+liftI64 f args = case int64Literals' args of
+  [i,j] ->
+    let !(I64# a) = fromInteger i
+        !(I64# b) = fromInteger j
+     in Just (Literal (Int64Literal (toInteger (I64# (f a b)))))
+  _ -> Nothing
+
+liftI64I :: (Int64# -> Int# -> Int64#) -> [Value] -> Maybe Term
+liftI64I f args = case args of
+  [Lit (Int64Literal i),Lit (IntLiteral j)] ->
+    let !(I64# a) = fromInteger i
+        !(I# b) = fromInteger j
+     in Just (Literal (Int64Literal (toInteger (I64# (f a b)))))
+  _ -> Nothing
+
+liftI64RI :: (Int64# -> Int64# -> Int#) -> [Value] -> Maybe Term
+liftI64RI f args = case int64Literals' args of
+  [i,j] ->
+    let !(I64# a) = fromInteger i
+        !(I64# b) = fromInteger j
+     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
+  _ -> Nothing
+#endif
+
+liftW8 :: (Word8# -> Word8# -> Word8#) -> [Value] -> Maybe Term
+liftW8 f args = case word8Literals' args of
+  [i,j] ->
+    let !(W8# a) = fromInteger i
+        !(W8# b) = fromInteger j
+     in Just (Literal (Word8Literal (toInteger (W8# (f a b)))))
+  _ -> Nothing
+
+liftW8I :: (Word8# -> Int# -> Word8#) -> [Value] -> Maybe Term
+liftW8I f args = case args of
+  [Lit (Word8Literal i),Lit (IntLiteral j)] ->
+    let !(W8# a) = fromInteger i
+        !(I# b) = fromInteger j
+     in Just (Literal (Word8Literal (toInteger (W8# (f a b)))))
+  _ -> Nothing
+
+liftW8RI :: (Word8# -> Word8# -> Int#) -> [Value] -> Maybe Term
+liftW8RI f args = case word8Literals' args of
+  [i,j] ->
+    let !(W8# a) = fromInteger i
+        !(W8# b) = fromInteger j
+     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
+  _ -> Nothing
+
+liftW16 :: (Word16# -> Word16# -> Word16#) -> [Value] -> Maybe Term
+liftW16 f args = case word16Literals' args of
+  [i,j] -> let !(W16# a) = fromInteger i
+               !(W16# b) = fromInteger j
+            in Just (Literal (Word16Literal (toInteger (W16# (f a b)))))
+  _ -> Nothing
+
+liftW16I :: (Word16# -> Int# -> Word16#) -> [Value] -> Maybe Term
+liftW16I f args = case args of
+  [Lit (Word16Literal i),Lit (IntLiteral j)] ->
+    let !(W16# a) = fromInteger i
+        !(I# b) = fromInteger j
+     in Just (Literal (Word16Literal (toInteger (W16# (f a b)))))
+  _ -> Nothing
+
+liftW16RI :: (Word16# -> Word16# -> Int#) -> [Value] -> Maybe Term
+liftW16RI f args = case word16Literals' args of
+  [i,j] ->
+    let !(W16# a) = fromInteger i
+        !(W16# b) = fromInteger j
+     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
+  _ -> Nothing
+
+liftW32 :: (Word32# -> Word32# -> Word32#) -> [Value] -> Maybe Term
+liftW32 f args = case word32Literals' args of
+  [i,j] -> let !(W32# a) = fromInteger i
+               !(W32# b) = fromInteger j
+            in Just (Literal (Word32Literal (toInteger (W32# (f a b)))))
+  _ -> Nothing
+
+liftW32I :: (Word32# -> Int# -> Word32#) -> [Value] -> Maybe Term
+liftW32I f args = case args of
+  [Lit (Word32Literal i),Lit (IntLiteral j)] ->
+    let !(W32# a) = fromInteger i
+        !(I# b) = fromInteger j
+     in Just (Literal (Word32Literal (toInteger (W32# (f a b)))))
+  _ -> Nothing
+
+liftW32RI :: (Word32# -> Word32# -> Int#) -> [Value] -> Maybe Term
+liftW32RI f args = case word32Literals' args of
+  [i,j] ->
+    let !(W32# a) = fromInteger i
+        !(W32# b) = fromInteger j
+     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
+  _ -> Nothing
+
+#if MIN_VERSION_base(4,17,0)
+liftW64 :: (Word64# -> Word64# -> Word64#) -> [Value] -> Maybe Term
+liftW64 f args = case word64Literals' args of
+  [i,j] -> let !(W64# a) = fromInteger i
+               !(W64# b) = fromInteger j
+            in Just (Literal (Word64Literal (toInteger (W64# (f a b)))))
+  _ -> Nothing
+
+liftW64I :: (Word64# -> Int# -> Word64#) -> [Value] -> Maybe Term
+liftW64I f args = case args of
+  [Lit (Word64Literal i),Lit (IntLiteral j)] ->
+    let !(W64# a) = fromInteger i
+        !(I# b) = fromInteger j
+     in Just (Literal (Word64Literal (toInteger (W64# (f a b)))))
+  _ -> Nothing
+
+liftW64RI :: (Word64# -> Word64# -> Int#) -> [Value] -> Maybe Term
+liftW64RI f args = case word64Literals' args of
+  [i,j] ->
+    let !(W64# a) = fromInteger i
+        !(W64# b) = fromInteger j
+     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
+  _ -> Nothing
+#endif
+#endif
+
+splitAtPrim
+  :: TyConName
+  -- ^ SNat TyCon name
+  -> TyConName
+  -- ^ Vec TyCon name
+  -> Term
+splitAtPrim snatTcNm vecTcNm =
+  Prim (PrimInfo (showt 'Clash.Sized.Vector.splitAt) (splitAtTy snatTcNm vecTcNm) WorkNever SingleResult NoUnfolding)
+
+splitAtTy
+  :: TyConName
+  -- ^ SNat TyCon name
+  -> TyConName
+  -- ^ Vec TyCon name
+  -> Type
+splitAtTy snatNm vecNm =
+  ForAllTy mTV (
+  ForAllTy nTV (
+  ForAllTy aTV (
+  mkFunTy
+    (mkTyConApp snatNm [VarTy mTV])
+    (mkFunTy
+      (mkTyConApp vecNm
+                  [mkTyConApp typeNatAdd
+                    [VarTy mTV
+                    ,VarTy nTV]
+                  ,VarTy aTV])
+      (mkTyConApp tupNm
+                  [mkTyConApp vecNm
+                              [VarTy mTV
+                              ,VarTy aTV]
+                  ,mkTyConApp vecNm
+                              [VarTy nTV
+                              ,VarTy aTV]])))))
+  where
+    mTV   = mkTyVar typeNatKind (mkUnsafeSystemName "m" 0)
+    nTV   = mkTyVar typeNatKind (mkUnsafeSystemName "n" 1)
+    aTV   = mkTyVar liftedTypeKind (mkUnsafeSystemName "a" 2)
+    tupNm = ghcTyconToTyConName (tupleTyCon Boxed 2)
+
+foldSplitAtTy
+  :: TyConName
+  -- ^ Vec TyCon name
+  -> Type
+foldSplitAtTy vecNm =
+  ForAllTy mTV (
+  ForAllTy nTV (
+  ForAllTy aTV (
+  mkFunTy
+    naturalPrimTy
+    (mkFunTy
+      (mkTyConApp vecNm
+                  [mkTyConApp typeNatAdd
+                    [VarTy mTV
+                    ,VarTy nTV]
+                  ,VarTy aTV])
+      (mkTyConApp tupNm
+                  [mkTyConApp vecNm
+                              [VarTy mTV
+                              ,VarTy aTV]
+                  ,mkTyConApp vecNm
+                              [VarTy nTV
+                              ,VarTy aTV]])))))
+  where
+    mTV   = mkTyVar typeNatKind (mkUnsafeSystemName "m" 0)
+    nTV   = mkTyVar typeNatKind (mkUnsafeSystemName "n" 1)
+    aTV   = mkTyVar liftedTypeKind (mkUnsafeSystemName "a" 2)
+    tupNm = ghcTyconToTyConName (tupleTyCon Boxed 2)
+
+vecAppendPrim
+  :: TyConName
+  -- ^ Vec TyCon name
+  -> Term
+vecAppendPrim vecNm =
+  Prim (PrimInfo (showt '(Clash.Sized.Vector.++)) (vecAppendTy vecNm) WorkNever SingleResult NoUnfolding)
+
+vecAppendTy
+  :: TyConName
+  -- ^ Vec TyCon name
+  -> Type
+vecAppendTy vecNm =
+    ForAllTy nTV (
+    ForAllTy aTV (
+    ForAllTy mTV (
+    mkFunTy
+      (mkTyConApp vecNm [VarTy nTV
+                        ,VarTy aTV
+                        ])
+      (mkFunTy
+         (mkTyConApp vecNm [VarTy mTV
+                           ,VarTy aTV
+                           ])
+         (mkTyConApp vecNm [mkTyConApp typeNatAdd
+                              [VarTy nTV
+                              ,VarTy mTV]
+                           ,VarTy aTV
+                           ])))))
+  where
+    nTV = mkTyVar typeNatKind (mkUnsafeSystemName "n" 0)
+    aTV = mkTyVar liftedTypeKind (mkUnsafeSystemName "a" 1)
+    mTV = mkTyVar typeNatKind (mkUnsafeSystemName "m" 2)
+
+vecZipWithPrim
+  :: TyConName
+  -- ^ Vec TyCon name
+  -> Term
+vecZipWithPrim vecNm =
+  Prim (PrimInfo (showt 'Clash.Sized.Vector.zipWith) (vecZipWithTy vecNm) WorkNever SingleResult NoUnfolding)
+
+vecZipWithTy
+  :: TyConName
+  -- ^ Vec TyCon name
+  -> Type
+vecZipWithTy vecNm =
+  ForAllTy aTV (
+  ForAllTy bTV (
+  ForAllTy cTV (
+  ForAllTy nTV (
+  mkFunTy
+    (mkFunTy aTy (mkFunTy bTy cTy))
+    (mkFunTy
+      (mkTyConApp vecNm [nTy,aTy])
+      (mkFunTy
+        (mkTyConApp vecNm [nTy,bTy])
+        (mkTyConApp vecNm [nTy,cTy])))))))
+  where
+    aTV = mkTyVar liftedTypeKind (mkUnsafeSystemName "a" 0)
+    bTV = mkTyVar liftedTypeKind (mkUnsafeSystemName "b" 1)
+    cTV = mkTyVar liftedTypeKind (mkUnsafeSystemName "c" 2)
+    nTV = mkTyVar typeNatKind (mkUnsafeSystemName "n" 3)
+    aTy = VarTy aTV
+    bTy = VarTy bTV
+    cTy = VarTy cTV
+    nTy = VarTy nTV
+
+vecImapGoTy
+  :: TyConName
+  -- ^ Vec TyCon name
+  -> TyConName
+  -- ^ Index TyCon name
+  -> Type
+vecImapGoTy vecTcNm indexTcNm =
+  ForAllTy nTV (
+  ForAllTy mTV (
+  ForAllTy aTV (
+  ForAllTy bTV (
+  mkFunTy fTy
+       (mkFunTy vecATy (mkFunTy indexTy vecBTy))))))
+  where
+    nTV = mkTyVar typeNatKind (mkUnsafeSystemName "n" 0)
+    mTV = mkTyVar typeNatKind (mkUnsafeSystemName "m" 1)
+    aTV = mkTyVar liftedTypeKind (mkUnsafeSystemName "a" 2)
+    bTV = mkTyVar liftedTypeKind (mkUnsafeSystemName "b" 3)
+    indexTy = mkTyConApp indexTcNm [nTy]
+    nTy = VarTy nTV
+    mTy = VarTy mTV
+    fTy = mkFunTy indexTy (mkFunTy aTy bTy)
+    aTy = VarTy aTV
+    bTy = VarTy bTV
+    vecATy = mkTyConApp vecTcNm [mTy,aTy]
+    vecBTy = mkTyConApp vecTcNm [mTy,bTy]
+
+indexAddTy
+  :: TyConName
+  -- ^ Index TyCon name
+  -> Type
+indexAddTy indexTcNm =
+  ForAllTy nTV (
+  mkFunTy naturalPrimTy (mkFunTy indexTy (mkFunTy indexTy indexTy)))
+  where
+    nTV     = mkTyVar typeNatKind (mkUnsafeSystemName "n" 0)
+    indexTy = mkTyConApp indexTcNm [VarTy nTV]
+
+bvAppendPrim
+  :: TyConName
+  -- ^ BitVector TyCon Name
+  -> Term
+bvAppendPrim bvTcNm =
+  Prim (PrimInfo (showt '(Clash.Sized.Internal.BitVector.++#)) (bvAppendTy bvTcNm) WorkNever SingleResult NoUnfolding)
+
+bvAppendTy
+  :: TyConName
+  -- ^ BitVector TyCon Name
+  -> Type
+bvAppendTy bvNm =
+  ForAllTy mTV (
+  ForAllTy nTV (
+  mkFunTy naturalPrimTy (mkFunTy
+    (mkTyConApp bvNm [VarTy nTV])
+    (mkFunTy
+      (mkTyConApp bvNm [VarTy mTV])
+      (mkTyConApp bvNm [mkTyConApp typeNatAdd
+                          [VarTy nTV
+                          ,VarTy mTV]])))))
+  where
+    mTV = mkTyVar typeNatKind (mkUnsafeSystemName "m" 0)
+    nTV = mkTyVar typeNatKind (mkUnsafeSystemName "n" 1)
+
+bvSplitPrim
+  :: TyConName
+  -- ^ BitVector TyCon Name
+  -> Term
+bvSplitPrim bvTcNm =
+  Prim (PrimInfo (showt 'Clash.Sized.Internal.BitVector.split#) (bvSplitTy bvTcNm) WorkNever SingleResult NoUnfolding)
 
 bvSplitTy
   :: TyConName
