Trying to compact typeclass dictionaries being carried around by constructors

Compact.cmm.diff

diff --git a/rts/Compact.cmm b/rts/Compact.cmm
index 72ad4dd437..a4b2d9b2ef 100644
--- a/rts/Compact.cmm
+++ b/rts/Compact.cmm
@@ -121,17 +121,49 @@ eval:
     }
 
     // We shouldn't see any functions, if this data structure was NFData.
+
+    case
+        FUN_STATIC: {
+
+        (should) = ccall shouldCompact(compact "ptr", p "ptr");
+        if (should == SHOULDCOMPACT_IN_CNF || should == SHOULDCOMPACT_STATIC) {
+            P_[pp] = p; return();
+        } else {
+            ccall barf("should was something else");
+        }
+    }
+
+    case
+        FUN: {
+        ccall barf("FUN");
+    }
+    case
+        FUN_1_0: {
+        ccall barf("FUN_1_0");
+    }
+    case
+        FUN_0_1: {
+        ccall barf("FUN_0_1");
+    }
+    case
+        FUN_2_0: {
+        ccall barf("FUN_2_0");
+    }
+    case
+        FUN_1_1: {
+        ccall barf("FUN_1_1");
+    }
+    case
+        FUN_0_2: {
+        ccall barf("FUN_0_2");
+    }
+    case
+        BCO: {
+        ccall barf("BCO");
+    }
     case
-        FUN,
-        FUN_1_0,
-        FUN_0_1,
-        FUN_2_0,
-        FUN_1_1,
-        FUN_0_2,
-        FUN_STATIC,
-        BCO,
         PAP: {
-        jump stg_raisezh(base_GHCziIOziException_cannotCompactFunction_closure);
+        ccall barf("PAP");
     }
 
     case ARR_WORDS: {

Main.hs

#!/usr/bin/env stack
-- stack --resolver nightly-2017-08-20 --install-ghc runghc
{-# LANGUAGE GADTs, StandaloneDeriving #-}
module Main where

import GHC.Compact

data Showable a where
  Showable :: Show a => a -> Showable a

deriving instance Show (Showable a)

one :: Showable Int
one = Showable 1

nums :: Showable [Int]
nums = Showable [1, 2, 3, 4]

main :: IO ()
main = do
  cOne <- compact one
  print (getCompact cOne)
  cNums <- compact nums
  print (getCompact cNums)

Results.txt

# When building with -O0, GHC appears to allocate the TC dictionary for (ShowList ShowInt) on the heap
./inplace/bin/ghc-stage2 -O0 Main.hs -o test-compact
[1 of 1] Compiling Main             ( Main.hs, Main.o )
Linking test-compact ...

chris in ~/ghc
 + ./test-compact
Showable 1
test-compact: internal error: FUN_1_0
    (GHC version 8.3.20170825 for x86_64_apple_darwin)
    Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug
Abort trap: 6

chris in ~/ghc
 + rm Main.hi Main.o test-compact

# When building with -O2, GHC appears to statically allocate the TC dictionary for (ShowList ShowInt)
chris in ~/ghc
 + ./inplace/bin/ghc-stage2 -O2 Main.hs -o test-compact
[1 of 1] Compiling Main             ( Main.hs, Main.o )
Linking test-compact ...

chris in ~/ghc
 + ./test-compact
Showable 1
Showable [1,2,3,4]