#14430: lintUnfolding does not allow unfoldings to jump to enclosing join points -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- 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: , 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 #) {- Arity: 2, Strictness: , 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 #) {- Arity: 3, Strictness: , 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 #) {- 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 #) {- Arity: 1, Strictness: -} = \ (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 #) {- Arity: 3, Strictness: , 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 #) {- 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:TcIface }}} When 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 -- Ticket URL: GHC The Glasgow Haskell Compiler