diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index 25b3a656eb5b5b26a2884153d610e401171da5da..fd263fc98d05b0dbf7c8adcb1faa3a93ac554192 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -888,13 +888,13 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
            (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys
            return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1)
       | otherwise
-      = case typePrimRepArgs ty of
-          rep_ty :| [] ->  do
+      = case typePrimRep ty of
+          [rep_ty] -> do
             (ptr_i, arr_i, term0)  <- go_rep ptr_i arr_i ty rep_ty
             (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys
             return (ptr_i, arr_i, term0 : terms1)
-          rep_ty :| rep_tys -> do
-           (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i (rep_ty:rep_tys)
+          rep_tys -> do
+           (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys
            (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys
            return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1)
 
diff --git a/testsuite/tests/ghci.debugger/scripts/T24306.hs b/testsuite/tests/ghci.debugger/scripts/T24306.hs
new file mode 100644
index 0000000000000000000000000000000000000000..e6e6960f77a861d3d4b117c97222484012b36843
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T24306.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE UnboxedTuples, UnliftedNewtypes, DataKinds, MagicHash #-}
+module T24306 where
+
+import GHC.Exts
+
+newtype A = MkA (# #)
+data T = T Int# A Int#
+
+x = T 1# (MkA (# #)) 2#
diff --git a/testsuite/tests/ghci.debugger/scripts/T24306.script b/testsuite/tests/ghci.debugger/scripts/T24306.script
new file mode 100644
index 0000000000000000000000000000000000000000..3a7f4d65ee75dfe6e4c38f3ac898d231da60ffc8
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T24306.script
@@ -0,0 +1,2 @@
+:load T24306
+:force x
diff --git a/testsuite/tests/ghci.debugger/scripts/T24306.stdout b/testsuite/tests/ghci.debugger/scripts/T24306.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..85c00ff9c0cc3a9b43db3ae46816443457dde2dd
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T24306.stdout
@@ -0,0 +1 @@
+x = T 1 (MkA (##)) 2
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index f31bc603283cae14402adfc65ccbc7b6242499b3..010129e1a7cbdfc33552d204aefc68e3d24f1599 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -140,3 +140,4 @@ test('break030',
   ['break030.script'],
 )
 test('T23057', [only_ghci, extra_hc_opts('-fno-break-points')], ghci_script, ['T23057.script'])
+test('T24306', normal, ghci_script, ['T24306.script'])