Trying to compact typeclass dictionaries being carried around by constructors
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: { |
#!/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) |
# 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] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment