GHC panics while compiling fetchAndIntArray# / fetchOrIntArray#.
[ 5 of 13] Compiling Data.Bit.MutableTSghc: panic! (the 'impossible' happened) (GHC version 8.8.1 for x86_64-apple-darwin): Can't find weight for edge that should have one triple (nQaY, nQwj, sKLs) updates [(cPjA, nQwR, sL5U), (cPjx, nQwQ, sL5U), ... (cOPS, nQwl, sKKV), (cOPy, nQwk, sKLs), (nQaY, nQwj, sKLs), ... (cOEj, nQv2, sKED), (cOEm, nQv1, sKED)] Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1159:37 in ghc:Outputable pprPanic, called at compiler/nativeGen/CFG.hs:423:11 in ghc:CFG
This will fail with an error message, quoted above.
Sorry for such a broad description; at the moment I do not have time to whittle it down. I suspect that the problematic piece is in Data.Bit.InternalTS:
let W# andMask# = hiMask lenMod W# orMask# = x .&. loMask lenModprimitive $ \state -> let !(# state', _ #) = fetchAndIntArray# mba loIx# (word2Int# andMask#) state in let !(# state'', _ #) = fetchOrIntArray# mba loIx# (word2Int# orMask#) state' in (# state'', () #)
Expected behavior
I expect this package to compile successfully.
Environment
GHC version used: 8.8.1 for x86_64-apple-darwin
It seems to be a regression since GHC 8.6.5, as witnessed by these Travis builds:
Here is a one-module reproducer that depends on only primitive and vector:
{-# LANGUAGE BangPatterns #-}{-# LANGUAGE MagicHash #-}{-# LANGUAGE MultiParamTypeClasses #-}{-# LANGUAGE TypeFamilies #-}{-# LANGUAGE UnboxedTuples #-}moduleBugwhereimportControl.Monad.PrimitiveimportControl.Monad.STimportData.BitsimportData.Primitive.ByteArrayimportqualifiedData.Vector.GenericasVimportqualifiedData.Vector.Generic.MutableasMVimportqualifiedData.Vector.UnboxedasUimportqualifiedData.Vector.Unboxed.MutableasMUimportGHC.Exts-- | Reverse the order of bits in-place.---- >>> Data.Vector.Unboxed.modify reverseInPlace (read "[1,1,0,1,0]")-- [0,1,0,1,1]reverseInPlace::PrimMonadm=>U.MVector(PrimStatem)Bit->m()reverseInPlacexs|len==0=pure()|otherwise=loop0wherelen=MU.lengthxsloop!i|i'<=j'=dox<-readWordxsiy<-readWordxsj'writeWordxsi(reverseWordy)writeWordxsj'(reverseWordx)loopi'|i'<j=doletw=(j-i)`shiftR`1k=j-wx<-readWordxsiy<-readWordxskwriteWordxsi(meldw(reversePartialWordwy)x)writeWordxsk(meldw(reversePartialWordwx)y)loopi'|otherwise=doletw=j-ix<-readWordxsiwriteWordxsi(meldw(reversePartialWordwx)x)where!j=len-i!i'=i+wordSize!j'=j-wordSize{-# SPECIALIZE reverseInPlace :: U.MVector s Bit -> ST s () #-}------- Data.Bit.Internal-----newtypeBit=Bit{unBit::Bool}instanceU.UnboxBit-- Ints are offset and length in bitsdatainstanceU.MVectorsBit=BitMVec!Int!Int!(MutableByteArrays)datainstanceU.VectorBit=BitVec!Int!Int!ByteArrayreadWord::PrimMonadm=>U.MVector(PrimStatem)Bit->Int->mWordreadWord!(BitMVec_0_)_=pure0readWord!(BitMVecofflen'arr)!i'=doletlen=off+len'i=off+i'nMod=modWordSizeiloIx=divWordSizeiloWord<-readByteArrayarrloIxifnMod==0thenpureloWordelseifloIx==divWordSize(len-1)thenpure(loWord`unsafeShiftR`nMod)elsedohiWord<-readByteArrayarr(loIx+1)pure$(loWord`unsafeShiftR`nMod).|.(hiWord`unsafeShiftL`(wordSize-nMod)){-# SPECIALIZE readWord :: U.MVector s Bit -> Int -> ST s Word #-}{-# INLINE readWord #-}writeWord::PrimMonadm=>U.MVector(PrimStatem)Bit->Int->Word->m()writeWord!(BitMVec_0_)__=pure()writeWord!(BitMVecofflen'arr@(MutableByteArraymba))!i'!x@(W#x#)=doletlen=off+len'lenMod=modWordSizeleni=off+i'nMod=modWordSizeiloIx@(I#loIx#)=divWordSizeiifnMod==0theniflen>=i+wordSizethenprimitive$\state->(#atomicWriteIntArray#mbaloIx#(word2Int#x#)state,()#)elsedoletW#andMask#=hiMasklenModW#orMask#=x.&.loMasklenModprimitive$\state->let!(#state',_#)=fetchAndIntArray#mbaloIx#(word2Int#andMask#)stateinlet!(#state'',_#)=fetchOrIntArray#mbaloIx#(word2Int#orMask#)state'in(#state'',()#)elseifloIx==divWordSize(len-1)thendoloWord<-readByteArrayarrloIxiflenMod==0thenwriteByteArrayarrloIx$(loWord.&.loMasknMod).|.(x`unsafeShiftL`nMod)elsewriteByteArrayarrloIx$(loWord.&.(loMasknMod.|.hiMasklenMod)).|.((x`unsafeShiftL`nMod).&.loMasklenMod)elsedoloWord<-readByteArrayarrloIxwriteByteArrayarrloIx$(loWord.&.loMasknMod).|.(x`unsafeShiftL`nMod)hiWord<-readByteArrayarr(loIx+1)writeByteArrayarr(loIx+1)$(hiWord.&.hiMasknMod).|.(x`unsafeShiftR`(wordSize-nMod)){-# SPECIALIZE writeWord :: U.MVector s Bit -> Int -> Word -> ST s () #-}{-# INLINE writeWord #-}instanceMV.MVectorU.MVectorBitwhere{-# INLINE basicLength #-}basicLength(BitMVec_n_)=ninstanceV.VectorU.VectorBitwhere------- Data.Bit.Utils-----wordSize::IntwordSize=finiteBitSize(0::Word)lgWordSize::IntlgWordSize=casewordSizeof32->564->6_->error"wordsToBytes: unknown architecture"divWordSize::Bitsa=>a->adivWordSizex=unsafeShiftRxlgWordSize{-# INLINE divWordSize #-}modWordSize::Int->IntmodWordSizex=x.&.(wordSize-1){-# INLINE modWordSize #-}wordsToBytes::Int->IntwordsToBytesns=casewordSizeof32->ns`unsafeShiftL`264->ns`unsafeShiftL`3_->error"wordsToBytes: unknown architecture"mask::Int->Wordmaskb=mwherem|b>=finiteBitSizem=complement0|b<0=0|otherwise=bitb-1meld::Int->Word->Word->Wordmeldblohi=(lo.&.m).|.(hi.&.complementm)wherem=maskb{-# INLINE meld #-}reverseWord::Word->WordreverseWordx0=x6wherex1=((x0.&.0x5555555555555555)`shiftL`1).|.((x0.&.0xAAAAAAAAAAAAAAAA)`shiftR`1)x2=((x1.&.0x3333333333333333)`shiftL`2).|.((x1.&.0xCCCCCCCCCCCCCCCC)`shiftR`2)x3=((x2.&.0x0F0F0F0F0F0F0F0F)`shiftL`4).|.((x2.&.0xF0F0F0F0F0F0F0F0)`shiftR`4)x4=((x3.&.0x00FF00FF00FF00FF)`shiftL`8).|.((x3.&.0xFF00FF00FF00FF00)`shiftR`8)x5=((x4.&.0x0000FFFF0000FFFF)`shiftL`16).|.((x4.&.0xFFFF0000FFFF0000)`shiftR`16)x6=((x5.&.0x00000000FFFFFFFF)`shiftL`32).|.((x5.&.0xFFFFFFFF00000000)`shiftR`32)reversePartialWord::Int->Word->WordreversePartialWordnw|n>=wordSize=reverseWordw|otherwise=reverseWordw`shiftR`(wordSize-n)loMask::Int->WordloMaskn=1`unsafeShiftL`n-1{-# INLINE loMask #-}hiMask::Int->WordhiMaskn=complement(1`unsafeShiftL`n-1){-# INLINE hiMask #-}
Here is self-contained example with zero external dependencies:
{-# LANGUAGE BangPatterns #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE MagicHash #-}{-# LANGUAGE MultiParamTypeClasses #-}{-# LANGUAGE TypeFamilies #-}{-# LANGUAGE UnboxedTuples #-}moduleBug(reverseInPlace)whereimportControl.Monad.STimportData.BitsimportGHC.ExtsimportGHC.ST(ST(..))reverseInPlace::PrimMonadm=>UMVector(PrimStatem)Bit->m()reverseInPlacexs|len==0=pure()|otherwise=loop0wherelen=ulengthxsloop!i|i'<=j'=dox<-readWordxsiy<-readWordxsj'writeWordxsi(reverseWordy)writeWordxsj'(reverseWordx)loopi'|i'<j=doletw=(j-i)`shiftR`1k=j-wx<-readWordxsiy<-readWordxskwriteWordxsi(meldw(reversePartialWordwy)x)writeWordxsk(meldw(reversePartialWordwx)y)loopi'|otherwise=doletw=j-ix<-readWordxsiwriteWordxsi(meldw(reversePartialWordwx)x)where!j=len-i!i'=i+wordSize!j'=j-wordSize{-# SPECIALIZE reverseInPlace :: UMVector s Bit -> ST s () #-}newtypeBit=Bit{unBit::Bool}instanceUnboxBitdatainstanceUMVectorsBit=BitMVec!Int!Int!(MutableByteArrays)datainstanceUVectorBit=BitVec!Int!Int!ByteArrayreadWord::PrimMonadm=>UMVector(PrimStatem)Bit->Int->mWordreadWord!(BitMVec_0_)_=pure0readWord!(BitMVecofflen'arr)!i'=doletlen=off+len'i=off+i'nMod=modWordSizeiloIx=divWordSizeiloWord<-readByteArrayarrloIxifnMod==0thenpureloWordelseifloIx==divWordSize(len-1)thenpure(loWord`unsafeShiftR`nMod)elsedohiWord<-readByteArrayarr(loIx+1)pure$(loWord`unsafeShiftR`nMod).|.(hiWord`unsafeShiftL`(wordSize-nMod)){-# SPECIALIZE readWord :: UMVector s Bit -> Int -> ST s Word #-}{-# INLINE readWord #-}writeWord::PrimMonadm=>UMVector(PrimStatem)Bit->Int->Word->m()writeWord!(BitMVec_0_)__=pure()writeWord!(BitMVecofflen'arr@(MutableByteArraymba))!i'!x@(W#x#)=doletlen=off+len'lenMod=modWordSizeleni=off+i'nMod=modWordSizeiloIx@(I#loIx#)=divWordSizeiifnMod==0theniflen>=i+wordSizethenprimitive$\state->(#atomicWriteIntArray#mbaloIx#(word2Int#x#)state,()#)elsedoletW#andMask#=hiMasklenModW#orMask#=x.&.loMasklenModprimitive$\state->let!(#state',_#)=fetchAndIntArray#mbaloIx#(word2Int#andMask#)stateinlet!(#state'',_#)=fetchOrIntArray#mbaloIx#(word2Int#orMask#)state'in(#state'',()#)elseifloIx==divWordSize(len-1)thendoloWord<-readByteArrayarrloIxiflenMod==0thenwriteByteArrayarrloIx$(loWord.&.loMasknMod).|.(x`unsafeShiftL`nMod)elsewriteByteArrayarrloIx$(loWord.&.(loMasknMod.|.hiMasklenMod)).|.((x`unsafeShiftL`nMod).&.loMasklenMod)elsedoloWord<-readByteArrayarrloIxwriteByteArrayarrloIx$(loWord.&.loMasknMod).|.(x`unsafeShiftL`nMod)hiWord<-readByteArrayarr(loIx+1)writeByteArrayarr(loIx+1)$(hiWord.&.hiMasknMod).|.(x`unsafeShiftR`(wordSize-nMod)){-# SPECIALIZE writeWord :: UMVector s Bit -> Int -> Word -> ST s () #-}{-# INLINE writeWord #-}instanceGMVectorUMVectorBitwhere{-# INLINE basicLength #-}basicLength(BitMVec_n_)=ninstanceGVectorUVectorBitwherewordSize::IntwordSize=finiteBitSize(0::Word)lgWordSize::IntlgWordSize=casewordSizeof32->564->6_->error"wordsToBytes: unknown architecture"divWordSize::Bitsa=>a->adivWordSizex=unsafeShiftRxlgWordSize{-# INLINE divWordSize #-}modWordSize::Int->IntmodWordSizex=x.&.(wordSize-1){-# INLINE modWordSize #-}mask::Int->Wordmaskb=mwherem|b>=finiteBitSizem=complement0|b<0=0|otherwise=bitb-1meld::Int->Word->Word->Wordmeldblohi=(lo.&.m).|.(hi.&.complementm)wherem=maskb{-# INLINE meld #-}reverseWord::Word->WordreverseWordx0=x6wherex1=((x0.&.0x5555555555555555)`shiftL`1).|.((x0.&.0xAAAAAAAAAAAAAAAA)`shiftR`1)x2=((x1.&.0x3333333333333333)`shiftL`2).|.((x1.&.0xCCCCCCCCCCCCCCCC)`shiftR`2)x3=((x2.&.0x0F0F0F0F0F0F0F0F)`shiftL`4).|.((x2.&.0xF0F0F0F0F0F0F0F0)`shiftR`4)x4=((x3.&.0x00FF00FF00FF00FF)`shiftL`8).|.((x3.&.0xFF00FF00FF00FF00)`shiftR`8)x5=((x4.&.0x0000FFFF0000FFFF)`shiftL`16).|.((x4.&.0xFFFF0000FFFF0000)`shiftR`16)x6=((x5.&.0x00000000FFFFFFFF)`shiftL`32).|.((x5.&.0xFFFFFFFF00000000)`shiftR`32)reversePartialWord::Int->Word->WordreversePartialWordnw|n>=wordSize=reverseWordw|otherwise=reverseWordw`shiftR`(wordSize-n)loMask::Int->WordloMaskn=1`unsafeShiftL`n-1{-# INLINE loMask #-}hiMask::Int->WordhiMaskn=complement(1`unsafeShiftL`n-1){-# INLINE hiMask #-}classGMVectorvawherebasicLength::vsa->Intglength::GMVectorva=>vsa->Int{-# INLINE glength #-}glength=basicLengthtypefamilyGMutable(v::*->*)::*->*->*classGMVector(GMutablev)a=>GVectorvadatafamilyUMVectorsadatafamilyUVectoraclass(GVectorUVectora,GMVectorUMVectora)=>UnboxatypeinstanceGMutableUVector=UMVectorulength::Unboxa=>UMVectorsa->Int{-# INLINE ulength #-}ulength=glengthdataByteArray=ByteArrayByteArray#dataMutableByteArrays=MutableByteArray(MutableByteArray#s)readByteArray::(Prima,PrimMonadm)=>MutableByteArray(PrimStatem)->Int->ma{-# INLINE readByteArray #-}readByteArray(MutableByteArrayarr#)(I#i#)=primitive(readByteArray#arr#i#)writeByteArray::(Prima,PrimMonadm)=>MutableByteArray(PrimStatem)->Int->a->m(){-# INLINE writeByteArray #-}writeByteArray(MutableByteArrayarr#)(I#i#)x=primitive_(writeByteArray#arr#i#x)classPrimawherereadByteArray#::MutableByteArray#s->Int#->State#s->(#State#s,a#)writeByteArray#::MutableByteArray#s->Int#->a->State#s->State#sinstancePrimWordwherereadByteArray#arr#i#s#=casereadWordArray#arr#i#s#of(#s1#,x##)->(#s1#,W#x##)writeByteArray#arr#i#(W#x#)s#=writeWordArray#arr#i#x#s#classMonadm=>PrimMonadmwheretypePrimStatemprimitive::(State#(PrimStatem)->(#State#(PrimStatem),a#))->mainstancePrimMonad(STs)wheretypePrimState(STs)=sprimitive=ST{-# INLINE primitive #-}primitive_::PrimMonadm=>(State#(PrimStatem)->State#(PrimStatem))->m(){-# INLINE primitive_ #-}primitive_f=primitive(\s#->casefs#ofs'#->(#s'#,()#))
I've got some bad news: commit c1bd07cd didn't actually fix this issue. Or rather, commit c1bd07cd happened to fix the super-minimized codeGen/should_compile/T17334 test case, but it did not fix the panic in the program in #17334 (comment 228073) (nor does it fix the panic in the bitvec library itself). I'm reopening the ticket accordingly.