lintUnfolding does not allow unfoldings to jump to enclosing join points
I am not sure why this does not show up in HEAD but it does show up in my loopification branch. It does look like a bug in GHC to me.
With loopification, I get the following code in the interface of Foreign.C.String:
d5fd65f7834390bebd0e80edc7b8f627
withCAStringLen1 ::
String
-> (CStringLen -> IO a)
-> State# RealWorld
-> (# State# RealWorld, a #)
{- Arity: 3, HasNoCafRefs,
Strictness: <S,U><C(C(S(SL))),C(C1(U(U,U)))><S,U>,
Unfolding: (\ @ a
(str :: String)
(f :: CStringLen -> IO a)
(eta :: State# RealWorld) ->
case lenAcc @ Char str newCAString2 of wild { I# x ->
case newAlignedPinnedByteArray#
@ RealWorld
x
1#
eta of ds2 { (#,#) ipv ipv1 ->
case unsafeFreezeByteArray#
@ RealWorld
ipv1
ipv of ds3 { (#,#) ipv2 ipv3 ->
let {
ptr :: Addr# = byteArrayContents# ipv3
} in
let {
$j :: State# RealWorld -> () -> (# State# RealWorld, a #)
<join 2> {- Arity: 2, Strictness: <S,U><L,A>, Inline: [0],
Unfolding: InlineRule (2, True, False)
(\ (w :: State# RealWorld) (w1 :: ()) ->
case (f (Ptr @ CChar ptr, wild)) `cast` (N:IO[0] <a>_R)
w of ds4 { (#,#) ipv4 ipv5 ->
case touch#
@ 'UnliftedRep
@ ByteArray#
ipv3
ipv4 of s4 { DEFAULT ->
(# s4, ipv5 #) } }) -}
= \ (w :: State# RealWorld)[OneShot] (w1 :: ())[OneShot] ->
case (f (Ptr @ CChar ptr, wild)) `cast` (N:IO[0] <a>_R)
w of ds4 { (#,#) ipv4 ipv5 ->
case touch#
@ 'UnliftedRep
@ ByteArray#
ipv3
ipv4 of s4 { DEFAULT ->
(# s4, ipv5 #) } }
} in
let {
go :: [Char]
-> Int -> State# RealWorld -> (# State# RealWorld, a #)
<join 3> {- Arity: 3, Strictness: <S,1*U><S(S),1*U(U)><S,U>,
Inline: [~],
Unfolding: InlineRule (3, True, False)
(\ (ds :: [Char])[OneShot]
(n :: Int)[OneShot]
(eta1 :: State# RealWorld)[OneShot] ->
letrec {
go :: [Char]
-> Int
-> State# RealWorld
-> (# State# RealWorld, a #)
<join 3> {- Arity: 3 -}
= \ (ds1 :: [Char])
(n1 :: Int)
(eta2 :: State# RealWorld) ->
case ds1 of wild1 {
[] -> case n1 of n2 { I# ipv4 -> $j eta2 () }
: c cs
-> case n1 of wild2 { I# i ->
case c of wild3 { C# c# ->
case writeInt8OffAddr#
@ RealWorld
ptr
i
(narrow8Int# (ord# c#))
eta2 of s2 { DEFAULT ->
go cs (I# (+# i 1#)) s2 } } } }
} in
go ds n eta1) -}
= \ (ds :: [Char])[OneShot]
(n :: Int)[OneShot]
(eta1 :: State# RealWorld)[OneShot] ->
case n of ww { I# ww1 ->
let {
exit :: State# RealWorld -> (# State# RealWorld, a #)
<join 1> {- Arity: 1, Strictness: <S,U> -}
= \ (w :: State# RealWorld)[OneShot] ->
case (f (Ptr @ CChar ptr, wild)) `cast` (N:IO[0] <a>_R)
w of ds4 { (#,#) ipv4 ipv5 ->
case touch#
@ 'UnliftedRep
@ ByteArray#
ipv3
ipv4 of s4 { DEFAULT ->
(# s4, ipv5 #) } }
} in
letrec {
$wgo :: [Char]
-> Int# -> State# RealWorld -> (# State# RealWorld, a #)
<join 3> {- Arity: 3, Strictness: <S,1*U><L,U><S,U>, Inline: [0] -}
= \ (w :: [Char]) (ww2 :: Int#) (w1 :: State# RealWorld) ->
case w of wild1 {
[] -> exit w1
: c cs
-> case c of wild2 { C# c# ->
case writeInt8OffAddr#
@ RealWorld
ptr
ww2
(narrow8Int# (ord# c#))
w1 of s2 { DEFAULT ->
$wgo cs (+# ww2 1#) s2 } } }
} in
$wgo ds ww1 eta1 }
} in
go str newCAString2 ipv2 } } }) -}Note how go references j not only in its RHS, but also in its unfolding.
When loading this interface, I get this error:
HC [stage 1] libraries/base/dist-install/build/System/Posix/Internals.o
ghc-stage1: panic! (the 'impossible' happened)
(GHC version 8.3.20171101 for x86_64-unknown-linux):
Iface Lint failure
In interface for Foreign.C.String
Unfolding of go_a6h7
<no location info>: warning:
In the expression: jump $j_a6gX eta2_a6hS ()
Invalid occurrence of a join variable: $j_a6gX
The binder is either not a join point, or not valid here
go_a6h7 = \ (ds_a6hM [OS=OneShot] :: [Char])
(n_a6hN [OS=OneShot] :: Int)
(eta1_a6hO [OS=OneShot] :: State# RealWorld) ->
joinrec {
go_a6hP
:: [Char]
-> Int -> State# RealWorld -> (# State# RealWorld, a_a6gD #)
[LclId[JoinId(3)], Arity=3]
go_a6hP (ds1_a6hQ :: [Char])
(n1_a6hR :: Int)
(eta2_a6hS :: State# RealWorld)
= case ds1_a6hQ of wild1_a6hT {
[] ->
case n1_a6hR of n2_a6hW { I# ipv4_a6hY ->
jump $j_a6gX eta2_a6hS ()
};
: c_a6i1 cs_a6i2 ->
case n1_a6hR of wild2_a6i4 { I# i_a6i6 ->
case c_a6i1 of wild3_a6i8 { C# c#_a6ia ->
case writeInt8OffAddr#
@ RealWorld ptr_a6gT i_a6i6 (narrow8Int# (ord# c#_a6ia)) eta2_a6hS
of s2_a6ic
{ __DEFAULT ->
jump go_a6hP cs_a6i2 (I# (+# i_a6i6 1#)) s2_a6ic
}
}
}
}; } in
jump go_a6hP ds_a6hM n_a6hN eta1_a6hO
Iface expr = \ (ds :: [Char])[OneShot]
(n :: Int)[OneShot]
(eta1 :: State# RealWorld)[OneShot] ->
letrec {
go :: [Char]
-> Int -> State# RealWorld -> (# State# RealWorld, a #)
<join 3> {- Arity: 3 -}
= \ (ds1 :: [Char]) (n1 :: Int) (eta2 :: State# RealWorld) ->
case ds1 of wild1 {
[] -> case n1 of n2 { I# ipv4 -> $j eta2 () }
: c cs
-> case n1 of wild2 { I# i ->
case c of wild3 { C# c# ->
case writeInt8OffAddr#
@ RealWorld
ptr
i
(narrow8Int# (ord# c#))
eta2 of s2 { DEFAULT ->
go cs (I# (+# i 1#)) s2 } } } }
} in
go ds n eta1
Call stack:
CallStack (from HasCallStack):
callStackDoc, called at compiler/utils/Outputable.hs:1147:37 in ghc:Outputable
pprPanic, called at compiler/iface/TcIface.hs:1664:33 in ghc:TcIfaceWhen reading the code in tcPragExpr I see that it lints the unfolding of go using lintUnfolding, which initializes the LintM with an empty le_joins. But when linting go, the join j is valid, even in the unfolding, isn't it?
Unless of course I just don’t see the problem with the above unfolding, and am barking up the wrong tree.
Anyways, either there is a problem in how we lint the unfoldings, or there is a secret invariant that I violated with my patch
Trac metadata
| Trac field | Value |
|---|---|
| Version | 8.3 |
| Type | Bug |
| TypeOfFailure | OtherFailure |
| Priority | normal |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | |
| Operating system | |
| Architecture |