Skip to content

Instantly share code, notes, and snippets.

@cdparks
Created August 25, 2017 18:06
Show Gist options
  • Save cdparks/790abefe9a5436664c167efdfa1c83d8 to your computer and use it in GitHub Desktop.
Save cdparks/790abefe9a5436664c167efdfa1c83d8 to your computer and use it in GitHub Desktop.
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