#5341: signals004(profasm) core lint error
---------------------------------+------------------------------------------
Reporter: igloo | Owner: simonpj
Type: bug | Status: new
Priority: highest | Milestone: 7.2.1
Component: Compiler | Version: 7.0.3
Keywords: | Testcase:
Blockedby: | Difficulty:
Os: Unknown/Multiple | Blocking:
Architecture: Unknown/Multiple | Failure: None/Unknown
---------------------------------+------------------------------------------
Description changed by igloo:
Old description:
> 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
> }}}
>
> {{{
> *** 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 ***
> }}}
New description:
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 ***
}}}
--
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/5341#comment:1>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
