Created
August 25, 2017 18:06
-
-
Save cdparks/790abefe9a5436664c167efdfa1c83d8 to your computer and use it in GitHub Desktop.
Trying to compact typeclass dictionaries being carried around by constructors
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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: { |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/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) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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