I took a stab at this but ran into something I don't understand. For recence, the whole implementation of unboxed sums is at
https://github.com/ghc/ghc/compare/master...tibbe:unboxed-sums and the implementation of unarisation is at
https://github.com/ghc/ghc/compare/master...tibbe:unboxed-sums#diff-f5bc1f9e9c230db4cf882bf18368a818.
Running the compiler on the following file:
{-# LANGUAGE UnboxedSums #-}
module Test where
f :: (# Int | Char #) -> Int
f (# x | #) = x
{-# NOINLINE f #-}
g = f (# 1 | #)
Yields an error, like so:
ghc-stage2: panic! (the 'impossible' happened)
(GHC version 7.11.20150912 for x86_64-apple-darwin):
StgCmmEnv: variable not found
ds_svq
local binds for:
ds_gvz
ds_gvA
I probably got something wrong in UnariseStg, but I can't see what. I printed this debug information to see the stg I'm rewriting:
unarise
[f [InlPrag=NOINLINE] :: (#|#) Int Char -> Int
[GblId, Arity=1, Str=DmdType, Unf=OtherCon []] =
\r srt:SRT:[0e :-> patError] [ds_svq]
case ds_svq of _ [Occ=Dead] {
(#_|#) x_svs [Occ=Once] -> x_svs;
(#|_#) _ [Occ=Dead] -> patError "UnboxedSum.hs:5:1-15|function f"#;
};,
g :: Int
[GblId, Str=DmdType] =
\u srt:SRT:[r1 :-> f] []
let {
sat_svu [Occ=Once] :: Int
[LclId, Str=DmdType] =
NO_CCS I#! [1#];
} in
case (#_|#) [sat_svu] of sat_svv { __DEFAULT -> f sat_svv; };]
unariseAlts
[81 :-> [realWorld#], svq :-> [ds_gvz, ds_gvA]]
UbxTup 2
wild_svr
[((#_|#), [x_svs], [True], x_svs),
((#|_#),
[ipv_svt],
[False],
patError "UnboxedSum.hs:5:1-15|function f"#)]
It's ds_svg that's being complained about above. I find that a bit confusing as that variable is never used on any RHS.
Some questions that might help me get there:
- I added a new RepType for unboxed sums, like so:
data RepType = UbxTupleRep [UnaryType]
| UbxSumRep [UnaryType]
| UnaryRep UnaryType
Does this constructor make sense? I store the already flattened representation of the sum in here, rather than having something like [[UnaryType]] and storing each alternative. - In unariseAlts there's a bndr argument. Is that the binder of the scrutinee as a whole (e.g. the 'x' in case e of x { ... -> ... })?
Any other idea what I might have gotten wrong?