signals004(profasm) core lint error
signals004(profasm) is giving a core lint error. Here's a slightly cut down version:
import Control.Concurrent
import System.Posix
import Control.Monad
main :: IO ()
main = do
c <- newChan
m <- newEmptyMVar
_ <- forkIO $ do replicateM_ 1000 (install c); putMVar m ()
return ()
install :: Chan () -> IO Handler
install c = do
_ <- installHandler sigUSR1 (Catch (writeChan c ())) Nothing
return undefined
ghc -fforce-recomp -c -O -prof -auto-all -dcore-lint -dcmm-lint signals004.hs
*** Core Lint errors : in result of Simplifier ***
<no location info>:
[RHS of a_s1DC :: GHC.Prim.Int#
-> GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)]
Demand type has 2 arguments, rhs has 0 arguments, a_s1DC
Binder's strictness signature: DmdType LL
*** Offending Program ***
a_s1jF
:: GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
[LclId,
Arity=1,
Str=DmdType L,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
a_s1jF =
\ (s_a1jg [Dmd=Just L] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
__scc {main main:Main !} (# s_a1jg, GHC.Unit.() #)
a_s1jk
:: GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld,
System.Posix.Signals.Handler #)
[LclId,
Arity=1,
Str=DmdType L,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
a_s1jk =
\ (s_a1jg [Dmd=Just L] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
__scc {install main:Main !}
(# s_a1jg, GHC.Err.undefined @ System.Posix.Signals.Handler #)
lvl_s1j7 :: GHC.Types.Int
[LclId,
Str=DmdType m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 10 110}]
lvl_s1j7 = __scc {main main:Main !} GHC.Types.I# 1000
a_s1lB
:: Control.Concurrent.Chan.Chan ()
-> GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
[LclId,
Arity=2,
Str=DmdType LL,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=2, Value=True,
ConLike=True, Cheap=True, Expandable=True, Guidance=NEVER}]
a_s1lB =
\ (c_alj [Dmd=Just L] :: Control.Concurrent.Chan.Chan ())
(s_a1jv [Dmd=Just L] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
letrec {
a_s1DC [Occ=LoopBreaker]
:: GHC.Prim.Int#
-> GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
[LclId,
Str=DmdType LL,
Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=True,
ConLike=True, Cheap=False, Expandable=False,
Guidance=IF_ARGS [] 354 60}]
a_s1DC =
__scc {main main:Main !}
let {
lvl_s1DH :: System.Posix.Signals.Handler
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 70 110}]
lvl_s1DH =
__scc {install main:Main !}
System.Posix.Signals.Catch
((\ (w_a1BE [Dmd=Just L] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
case c_alj
of _
{ Control.Concurrent.Chan.Chan ww_a1BA [Dmd=Just A]
ww_a1BB [Dmd=Just L] ->
Control.Concurrent.Chan.$wa4 @ () ww_a1BB GHC.Unit.() w_a1BE
})
`cast` (Sym (GHC.Types.NTCo:IO <()>)
:: (GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))
~
GHC.Types.IO ())) } in
let {
lvl_s1DG :: System.Posix.Signals.Handler
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 70 110}]
lvl_s1DG =
__scc {install main:Main !}
System.Posix.Signals.Catch
((\ (w_a1BE [Dmd=Just L] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
case c_alj
of _
{ Control.Concurrent.Chan.Chan ww_a1BA [Dmd=Just A]
ww_a1BB [Dmd=Just L] ->
Control.Concurrent.Chan.$wa4 @ () ww_a1BB GHC.Unit.() w_a1BE
})
`cast` (Sym (GHC.Types.NTCo:IO <()>)
:: (GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))
~
GHC.Types.IO ())) } in
\ (m_a1D7 [Dmd=Just L] :: GHC.Prim.Int#)
(eta_B1 [Dmd=Just L] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
case GHC.Prim.<=# m_a1D7 1 of _ {
GHC.Types.False ->
case __scc {install main:Main}
case System.Posix.Signals.$wa
(System.Posix.Signals.sigUSR3
`cast` (Sym (Foreign.C.Types.NTCo:CInt)
:: GHC.Int.Int32 ~ Foreign.C.Types.CInt))
lvl_s1DG
eta_B1
of _ { (# new_s_a1jy [Dmd=Just L], _ #) ->
(__scc {install main:Main !} a_s1jk) new_s_a1jy
}
of _ { (# new_s_a1jy [Dmd=Just L], _ #) ->
a_s1DC (GHC.Prim.-# m_a1D7 1) new_s_a1jy
};
GHC.Types.True ->
case __scc {install main:Main}
case System.Posix.Signals.$wa
(System.Posix.Signals.sigUSR3
`cast` (Sym (Foreign.C.Types.NTCo:CInt)
:: GHC.Int.Int32 ~ Foreign.C.Types.CInt))
lvl_s1DH
eta_B1
of _ { (# new_s_a1jy [Dmd=Just L], _ #) ->
(__scc {install main:Main !} a_s1jk) new_s_a1jy
}
of _ { (# new_s_a1jy [Dmd=Just L], _ #) ->
(# new_s_a1jy, GHC.Unit.() #)
}
}; } in
__scc {main main:Main !}
case GHC.Prim.newMVar# @ GHC.Prim.RealWorld @ () s_a1jv
of _ { (# s2#_a1jM [Dmd=Just L], svar#_a1jN [Dmd=Just L] #) ->
case GHC.Prim.fork#
@ (GHC.Types.IO ())
((\ (eta_a1jR [Dmd=Just L]
:: GHC.Prim.State# GHC.Prim.RealWorld) ->
GHC.Prim.catch#
@ ()
@ GHC.Exception.SomeException
(\ (s_X1k8 [Dmd=Just L] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
case lvl_s1j7 of _ { GHC.Types.I# ww_a1CQ [Dmd=Just L] ->
case GHC.Prim.<=# ww_a1CQ 0 of _ {
GHC.Types.False ->
case a_s1DC ww_a1CQ s_X1k8
of _ { (# new_s_X1kd [Dmd=Just L], _ #) ->
case GHC.Prim.putMVar#
@ GHC.Prim.RealWorld @ () svar#_a1jN GHC.Unit.() new_s_X1kd
of s2#_a1lv [Dmd=Just L] { __DEFAULT ->
(# s2#_a1lv, GHC.Unit.() #)
}
};
GHC.Types.True ->
case GHC.Prim.putMVar#
@ GHC.Prim.RealWorld @ () svar#_a1jN GHC.Unit.() s_X1k8
of s2#_a1lv [Dmd=Just L] { __DEFAULT ->
(# s2#_a1lv, GHC.Unit.() #)
}
}
})
GHC.Conc.Sync.forkIO2
eta_a1jR)
`cast` (Sym (GHC.Types.NTCo:IO <()>)
:: (GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))
~
GHC.Types.IO ()))
s2#_a1jM
of _ { (# s1_a1lh [Dmd=Just L], _ #) ->
(__scc {main main:Main !} a_s1jF) s1_a1lh
}
}
a_s1m6
:: GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
[LclId,
Arity=1,
Str=DmdType L,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [0] 144 0}]
a_s1m6 =
\ (s_a1jv [Dmd=Just L] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
__scc {main main:Main}
case GHC.Prim.newMVar#
@ GHC.Prim.RealWorld @ (Control.Concurrent.Chan.ChItem ()) s_a1jv
of _ { (# s2#_a1lK [Dmd=Just L], svar#_a1lL [Dmd=Just L] #) ->
case GHC.Prim.newMVar#
@ GHC.Prim.RealWorld
@ (GHC.MVar.MVar (Control.Concurrent.Chan.ChItem ()))
s2#_a1lK
of _ { (# s2#1_a1lQ [Dmd=Just L], svar#1_a1lR [Dmd=Just L] #) ->
let {
hole_a1lP :: GHC.MVar.MVar (Control.Concurrent.Chan.ChItem ())
[LclId,
Str=DmdType m,
Unf=Unf{Src=<vanilla>, TopLvl=False, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 10 110}]
hole_a1lP =
GHC.MVar.MVar @ (Control.Concurrent.Chan.ChItem ()) svar#_a1lL } in
case GHC.Prim.putMVar#
@ GHC.Prim.RealWorld
@ (GHC.MVar.MVar (Control.Concurrent.Chan.ChItem ()))
svar#1_a1lR
hole_a1lP
s2#1_a1lQ
of s2#2_a1lT [Dmd=Just L] { __DEFAULT ->
case GHC.Prim.newMVar#
@ GHC.Prim.RealWorld
@ (GHC.MVar.MVar (Control.Concurrent.Chan.ChItem ()))
s2#2_a1lT
of _ { (# s2#3_a1lW [Dmd=Just L], svar#2_a1lX [Dmd=Just L] #) ->
case GHC.Prim.putMVar#
@ GHC.Prim.RealWorld
@ (GHC.MVar.MVar (Control.Concurrent.Chan.ChItem ()))
svar#2_a1lX
hole_a1lP
s2#3_a1lW
of s2#4_a1lZ [Dmd=Just L] { __DEFAULT ->
a_s1lB
(Control.Concurrent.Chan.Chan
@ ()
(GHC.MVar.MVar
@ (GHC.MVar.MVar (Control.Concurrent.Chan.ChItem ())) svar#1_a1lR)
(GHC.MVar.MVar
@ (GHC.MVar.MVar (Control.Concurrent.Chan.ChItem ())) svar#2_a1lX))
s2#4_a1lZ
}
}
}
}
}
a_s1iV
:: GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
[LclId,
Arity=1,
Str=DmdType L,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [0] 30 0}]
a_s1iV =
\ (eta_B1 [Dmd=Just L] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
GHC.TopHandler.runMainIO1
@ ()
(a_s1m6
`cast` (Sym (GHC.Types.NTCo:IO <()>)
:: (GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))
~
GHC.Types.IO ()))
eta_B1
Main.main :: GHC.Types.IO ()
[LclIdX,
Arity=1,
Str=DmdType L,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
Main.main =
a_s1m6
`cast` (Sym (GHC.Types.NTCo:IO <()>)
:: (GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))
~
GHC.Types.IO ())
:Main.main :: GHC.Types.IO ()
[LclIdX,
Arity=1,
Str=DmdType L,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
:Main.main =
a_s1iV
`cast` (Sym (GHC.Types.NTCo:IO <()>)
:: (GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))
~
GHC.Types.IO ())
*** End of Offense ***