STG scope error
StgRhsClosure can contain duplicated names in its free variable and argument list.
Example bug: libraries/integer-gmp/src/GHC/Integer/Type.hs
GHC HEAD and 8.2.2 has this issue.
I have not checked with other versions.
I've extended the STG linter to do scope checking. See the patch attached.
To reproduce:
- patch GHC head:
git apply StgScopeCheck.patch
- make sure every compiled stg is linted: add the following to
mk/build.mk
\\
GhcStage2HcOpts += -dstg-lint
GhcLibHcOpts += -dstg-lint
GhcRtsHcOpts += -dstg-lint
- compile GHC HEAD
Background info: I've found this issue because I'm using GHC as a Haskell fronted for my whole program compiler project. I work on The GRIN Compiler (https://github.com/grin-tech) where GHC/GRIN compiles STG to GRIN.
No child items are currently assigned. Use child items to break down this issue into smaller parts.
Relates to
- #157548.8.15
Activity
- Sebastian Graf mentioned in issue #15754 (closed)
mentioned in issue #15754 (closed)
- Csaba Hruska changed weight to 5
changed weight to 5
- Csaba Hruska added Tbug Trac import labels
added Tbug Trac import labels
- Author
Attached file
StgScopeCheck.patch
(download). - Author
Attached file
stg-error.out.gz
(download). - Csaba Hruska changed the description
changed the description
- Author
- Author
The interesting part for
libraries/integer-gmp/src/GHC/Integer/Type.hs
is:<no location info>: warning: [in body of lambda with binders wild_sgiz :: Int#] ipv_sgiw :: Integer is duplicated (Uniq) <no location info>: warning: [in body of lambda with binders wild_sgiz :: Int#] ipv1_sgix :: Integer is duplicated (Uniq) <no location info>: warning: [in body of lambda with binders wild1_sgiB :: Int#] ipv_sgiw :: Integer is duplicated (Uniq) <no location info>: warning: [in body of lambda with binders wild1_sgiB :: Int#] ipv1_sgix :: Integer is duplicated (Uniq)
divModInteger [InlPrag=NOINLINE] :: Integer -> Integer -> (# Integer, Integer #) [GblId, Arity=2, Str=<L,U><S,U>, Unf=OtherCon []] = [] \r [n_sgit d_sgiu] case quotRemInteger n_sgit d_sgiu of qr_sgiv [Occ=Once] { (#,#) ipv_sgiw [Occ=Once] ipv1_sgix -> let-no-escape { $j3_sgiy [Occ=Once*!T[1], Dmd=<C(S),1*C1(U(U,U))>] :: Int# -> (# Integer, Integer #) [LclId[JoinId(1)], Arity=1, Str=<S,U>, Unf=OtherCon []] = sat-only [d_sgiu ipv_sgiw ipv1_sgix ipv_sgiw ipv1_sgix] \r [wild_sgiz] let-no-escape { $j4_sgiA [Occ=Once*!T[1], Dmd=<C(S),1*C1(U(U,U))>] :: Int# -> (# Integer, Integer #) [LclId[JoinId(1)], Arity=1, Str=<S,U>, Unf=OtherCon []] = sat-only [d_sgiu ipv_sgiw ipv1_sgix ipv_sgiw ipv1_sgix wild_sgiz] \r [wild1_sgiB] case negateInt# [wild_sgiz] of sat_sgiC [Occ=Once] {
- Author
Maybe my proposed STG scope checker is too strict. It does not allow name shadowing, but I can refine it further.\\
But the code above is definitely a bug as it contains duplicates in the closure binder list.
- Developer
Sebastian, would you feel up to looking into this? Thanks!
- Sebastian Graf assigned to @sgraf812
assigned to @sgraf812
- Developer
Sure will do! I could reproduce this.
- Developer
The
Void# is redefined
errors are related to shadowing. As you pointed out, that's a little too strict.The other errors, due to duplicated occs, are more concerning. This happens after unarisation. This is the offending STG before unarise:
case GHC.Integer.Type.quotRemInteger n_sf5G d_sf5H of qr_sf5I [Occ=Once] { (#,#) ipv_sf5J [Occ=Once] ipv1_sf5K -> let-no-escape { $j3_sf5L [Occ=Once*!T[1], Dmd=<C(S),1*C1(U(U,U))>] :: GHC.Prim.Int# -> (# GHC.Integer.Type.Integer, GHC.Integer.Type.Integer #) [LclId[JoinId(1)], Arity=1, Str=<S,U>, Unf=OtherCon []] = sat-only [d_sf5H qr_sf5I ipv_sf5J ipv1_sf5K] \r [wild_sf5M] -> ...
Unarise splits the occurrence of
qr_sf5I
into its constituentsipv_sf5J
andipv1_sf5K
without looking for duplicates:case quotRemInteger n_sf5G d_sf5H of qr_sf5I [Occ=Once] { (#,#) ipv_sf5J [Occ=Once] ipv1_sf5K -> let-no-escape { $j3_sf5L [Occ=Once*!T[1], Dmd=<C(S),1*C1(U(U,U))>] :: Int# -> (# Integer, Integer #) [LclId[JoinId(1)], Arity=1, Str=<S,U>, Unf=OtherCon []] = sat-only [d_sf5H ipv_sf5J ipv1_sf5K ipv_sf5J ipv1_sf5K] \r [wild_sf5M] ...
Let's see where...
- Developer
- Author
Attached file
StgScopeCheck2.patch
(download). - Author
I've improved the scope checking:
- allows unique name shadowing (nested scopes)
- checks OccName duplications only for exported top-level names
- check Unique duplications for StgRhsClosure, StgRec, DataAlt
I've attached the improved linter patch. (StgScopeCheck2.patch). It requires the
nub
fix.Using this improvements I've got new errors:
buggy source: libraries/base/Data/Type/Equality.hs *** Stg Lint ErrMsgs: in Unarise *** <no location info>: warning: [in body of lambda with binders void_0E :: Void#, void_0E :: Void#] void_0E :: Void# is duplicated (Uniq) *** Offending Program *** HRefl :: forall k2 k2 (a :: k2) (b :: k2). (k2 ~# k2) -> (b ~# a) -> a :~~: b [GblId[DataCon], Arity=2, Caf=NoCafRefs, Str=<L,U><L,U>m, Unf=OtherCon []] = [] \r [void_0E void_0E] HRefl [];
- Author
Or do we want to accept this as some kind of name shadowing?
- Author
Another one:
libraries/containers/Data/Sequence/Internal.hs
*** Stg Lint ErrMsgs: in StgCse *** <no location info>: warning: [in body of lambda with binders eta2_s1rRb :: Int] n_s1rR0 :: (Seq a_afnp, Seq a_afnp) is duplicated (Uniq) *** Offending Program *** let { sat_s1rUG [Occ=OnceT[0]] :: Int -> (Seq a_afnp, Seq a_afnp) [LclId] = [n_s1rR0 wild_s1rR1 dt_s1rR4 n_s1rR0 lvl175_s1rR9 lvl176_s1rTS lvl177_s1rTT lvl178_s1rTU lvl179_s1rTV] \r [i_s1rTW]
- Developer
Hmm. I'm inclined to accept the shadowing, it's like nested lambdas, after all. Also, since free var occurrences never were a problem before (presumably because
StgToCmm
nubs them anyway) and since there are plans in #15754 (closed) to get rid of that field altogether, I'm not sure if this really is a sensible thing to lint for.No doubt, the STG is extremely fishy, but if we are going to remove FV occs from
StgRhsClosure
anyway, I don't see great value in fixing these non-severe bugs. Simon is free to overrule me here, in which case I'd be happy to fix this. - Author
I did the linter to understand the semantics. Because it's clearly unintuitive with the unique name shadowing in the free var and binder list and in general. Anyway with this insight now I can write my STG to GRIN transformation. :)
- Sebastian Graf closed
closed
- Developer
Great! Have fun and re-open if this doesn't work for you.
Trac metadata
Trac field Value Resolution Unresolved → ResolvedWon'tFix - Developer
Yes, let's execute on #15754 (closed).
- Author
Attached file
StgScopeCheck3.patch
(download). - Ben Gamari added Pnormal label
added Pnormal label