Allow primops in a :print (and friends) command. Fix #19394

* For primops from `GHC.Prim` lookup the HValues in `GHC.PrimopWrappers`.
* Add short error messages if a user tries to use a *Non-Id* value or a
  `pseudoop` in a `:print`, `:sprint` or `force`command.
* Add additional test cases for `Magic Ids`.

5 files changed, 54 insertions, 11 deletions

diff --git a/compiler/GHC/ByteCode/Linker.hs b/compiler/GHC/ByteCode/Linker.hs
index 3e36e41073..c9339317d2 100644
--- a/compiler/GHC/ByteCode/Linker.hs
+++ b/compiler/GHC/ByteCode/Linker.hs
@@ -28,6 +28,7 @@ import GHCi.ResolvedBCO
 import GHCi.BreakArray
 
 import GHC.Builtin.PrimOps
+import GHC.Builtin.Names
 
 import GHC.Unit.Types
 import GHC.Unit.Module.Name
@@ -184,7 +185,11 @@ nameToCLabel :: Name -> String -> FastString
 nameToCLabel n suffix = mkFastString label
   where
     encodeZ = zString . zEncodeFS
-    (Module pkgKey modName) = assert (isExternalName n) $ nameModule n
+    (Module pkgKey modName) = assert (isExternalName n) $ case nameModule n of
+        -- Primops are exported from GHC.Prim, their HValues live in GHC.PrimopWrappers
+        -- See Note [Primop wrappers] in GHC.Builtin.PrimOps.
+        mod | mod == gHC_PRIM -> gHC_PRIMOPWRAPPERS
+        mod -> mod
     packagePart = encodeZ (unitFS pkgKey)
     modulePart  = encodeZ (moduleNameFS modName)
     occPart     = encodeZ (occNameFS (nameOccName n))
diff --git a/compiler/GHC/Runtime/Debugger.hs b/compiler/GHC/Runtime/Debugger.hs
index be6241acb8..99f189e079 100644
--- a/compiler/GHC/Runtime/Debugger.hs
+++ b/compiler/GHC/Runtime/Debugger.hs
@@ -38,6 +38,7 @@ import GHC.Utils.Exception
 import GHC.Utils.Logger
 
 import GHC.Types.Id
+import GHC.Types.Id.Make (ghcPrimIds)
 import GHC.Types.Name
 import GHC.Types.Var hiding ( varName )
 import GHC.Types.Var.Set
@@ -47,7 +48,7 @@ import GHC.Types.TyThing
 
 import Control.Monad
 import Control.Monad.Catch as MC
-import Data.List ( (\\) )
+import Data.List ( (\\), partition )
 import Data.Maybe
 import Data.IORef
 
@@ -60,25 +61,46 @@ pprintClosureCommand bindThings force str = do
                  mapM (\w -> GHC.parseName w >>=
                                 mapM GHC.lookupName)
                       (words str)
-  let ids = [id | AnId id <- tythings]
+
+  -- Sort out good and bad tythings for :print and friends
+  let (pprintables, unpprintables) = partition can_pprint tythings
 
   -- Obtain the terms and the recovered type information
+  let ids = [id | AnId id <- pprintables]
   (subst, terms) <- mapAccumLM go emptyTCvSubst ids
 
   -- Apply the substitutions obtained after recovering the types
   modifySession $ \hsc_env ->
     hsc_env{hsc_IC = substInteractiveContext (hsc_IC hsc_env) subst}
 
-  -- Finally, print the Terms
-  unqual  <- GHC.getPrintUnqual
+  -- Finally, print the Results
   docterms <- mapM showTerm terms
-  dflags <- getDynFlags
-  logger <- getLogger
-  liftIO $ (printOutputForUser logger dflags unqual . vcat)
-           (zipWith (\id docterm -> ppr id <+> char '=' <+> docterm)
-                    ids
-                    docterms)
+  let sdocTerms = zipWith (\id docterm -> ppr id <+> char '=' <+> docterm)
+                          ids
+                          docterms
+  printSDocs $ (no_pprint <$> unpprintables) ++ sdocTerms
  where
+   -- Check whether a TyThing can be processed by :print and friends.
+   -- Take only Ids, exclude pseudoops, they don't have any HValues.
+   can_pprint :: TyThing -> Bool                              -- #19394
+   can_pprint (AnId x)
+       | x `notElem` ghcPrimIds = True
+       | otherwise              = False
+   can_pprint _                 = False
+
+   -- Create a short message for a TyThing, that cannot processed by :print
+   no_pprint :: TyThing -> SDoc
+   no_pprint tything = ppr tything <+>
+          text "is not eligible for the :print, :sprint or :force commands."
+
+   -- Helper to print out the results of :print and friends
+   printSDocs :: GhcMonad m => [SDoc] -> m ()
+   printSDocs sdocs = do
+      logger <- getLogger
+      dflags <- getDynFlags
+      unqual <- GHC.getPrintUnqual
+      liftIO $ printOutputForUser logger dflags unqual $ vcat sdocs
+
    -- Do the obtainTerm--bindSuspensions-computeSubstitution dance
    go :: GhcMonad m => TCvSubst -> Id -> m (TCvSubst, Term)
    go subst id = do
diff --git a/testsuite/tests/ghci.debugger/scripts/T19394.script b/testsuite/tests/ghci.debugger/scripts/T19394.script
new file mode 100644
index 0000000000..de01bad9b4
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T19394.script
@@ -0,0 +1,4 @@
+:set -XMagicHash
+import Data.Coerce
+import GHC.Exts
+:print seq coerce error oneShot xor# seq# lazy realWorld# Word8# Int void#
diff --git a/testsuite/tests/ghci.debugger/scripts/T19394.stdout b/testsuite/tests/ghci.debugger/scripts/T19394.stdout
new file mode 100644
index 0000000000..0762c80e0e
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T19394.stdout
@@ -0,0 +1,11 @@
+Identifier ‘seq’ is not eligible for the :print, :sprint or :force commands.
+Identifier ‘coerce’ is not eligible for the :print, :sprint or :force commands.
+Identifier ‘realWorld#’ is not eligible for the :print, :sprint or :force commands.
+Type constructor ‘Word8#’ is not eligible for the :print, :sprint or :force commands.
+Type constructor ‘Int’ is not eligible for the :print, :sprint or :force commands.
+Identifier ‘void#’ is not eligible for the :print, :sprint or :force commands.
+error = (_t1::GHC.Stack.Types.HasCallStack => [Char] -> a)
+oneShot = (_t2::(a -> b) -> a -> b)
+xor# = (_t3::Word# -> Word# -> Word#)
+seq# = (_t4::a -> State# d -> (# State# d, a #))
+lazy = (_t5::a -> a)
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index 8e50e6b35f..42f7fa1c2c 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -128,3 +128,4 @@ test('T2215', normal, ghci_script, ['T2215.script'])
 test('T17989', normal, ghci_script, ['T17989.script'])
 test('T19157', normal, ghci_script, ['T19157.script'])
 test('T19355', normal, ghci_script, ['T19355.script'])
+test('T19394', normal, ghci_script, ['T19394.script'])