Thanks for reporting this bug. Indeed, that seems wrong: mergeNullViews is used in combineConcat which is a local function in the body of patternToQ, and patternToQ is exported by the module. seqTake has an identical usage pattern.
It would be nice to get a smaller reproducer so we can get a better idea of what's going wrong.
The problem seems to be connected to mdo. If I replace it with do, the spurious warnings disappear.
Shrunk file:
{-# LANGUAGE RecursiveDo #-}moduleMain(patternToQ,main)whereimportControl.Monad(liftM2)importControl.Monad.RWS(RWS,runRWS)importData.IntMap.EnumMap2(EnumMap)importData.IntSet.EnumSet2(EnumSet)importText.Regex.TDFA.CommonimportText.Regex.TDFA.Pattern(Pattern(..),starTrans)dataQ=Q{nullQ::NullView,takes::(Position,MaybePosition)}newtypeSetTestInfo=SetTestInfo(EnumMapWhichTest(EnumSetDoPa))instanceSemigroupSetTestInfowhereSetTestInfox<>SetTestInfoy=SetTestInfo(x<>y)instanceMonoidSetTestInfowheremempty=SetTestInfomemptymappend=(<>)typeNullView=[(SetTestInfo,TagList)]dataHandleTag=NoTag|AdviceTagmergeNullViews::NullView->NullView->NullViewmergeNullViewss1s2=do(test1,tag1)<-s1(test2,tag2)<-s2return(mappendtest1test2,mappendtag1tag2)seqTake::(Int,MaybeInt)->(Int,MaybeInt)->(Int,MaybeInt)seqTake(x1,y1)(x2,y2)=(x1+x2,liftM2(+)y1y2)typePM=RWS(MaybeGroupIndex)[EitherTagGroupInfo]([OP]->[OP],Tag)typeHHQ=HandleTag->HandleTag->PMQpatternToQ::CompOption->(Pattern,(GroupIndex,DoPa))->QpatternToQ_(pOrig,_)=tnfawhere(tnfa,_,_)=runRWSmonadstartReaderstartStatemonad=go(starTranspOrig)(Advice0)(Advice1)go::Pattern->HHQgopInm1m2=casepInofPConcatps->combineConcatpsm1m2_->error""startReader::MaybeGroupIndexstartReader=Just0startState::([OP]->[OP],Tag)startState=(id,2)combineConcat::[Pattern]->HHQcombineConcat=foldr1combineSeq.mapgowherecombineSeq::HHQ->HHQ->HHQcombineSeqpFrontpEndm1m2=mdo-- changing this to 'do' fixes the problem(qFront,qEnd)<-liftM2(,)(pFrontm1NoTag)(pEndNoTagm2)return$Q{nullQ=mergeNullViews(nullQqFront)(nullQqEnd),takes=seqTake(takesqFront)(takesqEnd)}main::IO()main=putStrLn"Hello, Haskell!"{- With GHC 9.4 alpha2 and mdoapp/Main.hs:17:10: error: [-Wunused-top-binds, -Werror=unused-top-binds] Defined but not used: data constructor ‘Q’ |17 | data Q = Q | ^...app/Main.hs:18:5: error: [-Wunused-top-binds, -Werror=unused-top-binds] Defined but not used: ‘nullQ’ |18 | { nullQ :: NullView | ^^^^^app/Main.hs:19:5: error: [-Wunused-top-binds, -Werror=unused-top-binds] Defined but not used: ‘takes’ |19 | , takes :: (Position, Maybe Position) | ^^^^^app/Main.hs:37:1: error: [-Wunused-top-binds, -Werror=unused-top-binds] Defined but not used: ‘mergeNullViews’ |37 | mergeNullViews s1 s2 = do | ^^^^^^^^^^^^^^app/Main.hs:43:1: error: [-Wunused-top-binds, -Werror=unused-top-binds] Defined but not used: ‘seqTake’ |43 | seqTake (x1,y1) (x2,y2) = (x1+x2,liftM2 (+) y1 y2) | ^^^^^^^-}
Thanks for the smaller reproducer. I was able to minimise it a bit more:
{-# LANGUAGE RecursiveDo #-}{-# OPTIONS_GHC -Wunused-top-binds #-}moduleT21654(patternToQ)whereimportData.Functor.IdentitymergeNullViews::()->()mergeNullViews_=()patternToQ::()patternToQ=runIdentity$combineSeqwherecombineSeq::Identity()combineSeq=mdo-- changing this to 'do' fixes the problemq<-Identity()return$mergeNullViewsq
Great, @sheaf! After 1 hour of shrinking, I stopped after I found out the culprit (mdo). The problem seems to be systematic.
Wild guess: Maybe it is a fixed-point computation with the wrong initial value "nothing is used" when it should be "all is used".
I believe commit acb188e0 by @mpickering introduced this regression. Fix in !8350 (closed). Thanks for taking the time to boil the reproducer down Andreas, that helped a lot.
Andreas Abelchanged title from Regression in 9.4.1 (alpha2): unused-top-binds reported for used functions to Regression in 9.4.1 (alpha2): unused-top-binds reported for used functions (RecursiveDo)
changed title from Regression in 9.4.1 (alpha2): unused-top-binds reported for used functions to Regression in 9.4.1 (alpha2): unused-top-binds reported for used functions (RecursiveDo)