ghc core

==================== Tidy Core ====================
Result size of Tidy Core
  = {terms: 155, types: 289, coercions: 37, joins: 1/3}

-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$trModule4 :: Addr#
$trModule4 = "main"#

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$trModule3 :: TrName
$trModule3 = TrNameS $trModule4

-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$trModule2 :: Addr#
$trModule2 = "Main"#

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$trModule1 :: TrName
$trModule1 = TrNameS $trModule2

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$trModule :: Module
$trModule = Module $trModule3 $trModule1

-- RHS size: {terms: 133, types: 259, coercions: 28, joins: 1/3}
main1 :: State# RealWorld -> (# State# RealWorld, () #)
main1
  = \ (s :: State# RealWorld) ->
      case newMutVar# (I# 0#) s of { (# ipv, ipv1 #) ->
      case async2
             rawForkIO
             (letrec {
                loop1 :: State# RealWorld -> (# State# RealWorld, Any #)
                loop1
                  = \ (s1 :: State# RealWorld) ->
                      case readMutVar# ipv1 s1 of { (# ipv2, ipv3 #) ->
                      case {__pkg_ccall base-4.13.0.0 State# RealWorld
                           -> (# State# RealWorld, Int# #)}
                             realWorld#
                      of
                      { (# ds2, ds3 #) ->
                      join {
                        $w$j :: State# RealWorld -> (# State# RealWorld, Any #)
                        $w$j (w :: State# RealWorld)
                          = case writeMutVar# ipv1 (case ipv3 of { I# x -> I# (+# x 1#) }) w
                            of s2#
                            { __DEFAULT ->
                            case ipv3 of { I# x ->
                            case ># x 10000000# of {
                              __DEFAULT -> case loop1 s2# of { (# ipv4, ipv5 #) -> loop1 ipv4 };
                              1# ->
                                case error
                                       ((PushCallStack
                                           (unpackCString# "error"#)
                                           (SrcLoc
                                              (unpackCString# $trModule4)
                                              (unpackCString# $trModule2)
                                              (unpackCString# "Leak2.hs"#)
                                              (I# 17#)
                                              (I# 21#)
                                              (I# 17#)
                                              (I# 33#))
                                           EmptyCallStack)
                                        `cast` <Co:4>)
                                       (unpackCString# "done"#)
                                of wild2 {
                                }
                            }
                            }
                            } } in
                      case ds3 of {
                        __DEFAULT ->
                          case threadDelay1 (I# 1#) ipv2 of { (# ipv4, ipv5 #) ->
                          jump $w$j ipv4
                          };
                        0# -> case delay# 1# ipv2 of s' { __DEFAULT -> jump $w$j s' }
                      }
                      }
                      }; } in
              loop1 `cast` <Co:5>)
             ipv
      of
      { (# ipv2, ipv3 #) ->
      let {
        f :: STM (Either SomeException Any)
        f = case ipv3 of { Async dt w -> w } } in
      case catch#
             (atomically# (f `cast` <Co:6>))
             (\ (e1 :: SomeException) (eta :: State# RealWorld) ->
                case e1 of wild { SomeException @ e2 $dException1 e3 ->
                case eqTypeRep
                       (($p1Exception $dException1) `cast` <Co:4>)
                       $fExceptionBlockedIndefinitelyOnSTM3
                of {
                  Nothing -> raiseIO# wild eta;
                  Just ds2 ->
                    case ds2 of { HRefl co co1 ->
                    case e3 `cast` <Co:3> of { BlockedIndefinitelyOnSTM ->
                    atomically# (f `cast` <Co:6>) eta
                    }
                    }
                }
                })
             ipv2
      of
      { (# ipv4, ipv5 #) ->
      (# ipv4, () #)
      }
      }
      }

-- RHS size: {terms: 1, types: 0, coercions: 3, joins: 0/0}
main :: IO ()
main = main1 `cast` <Co:3>

-- RHS size: {terms: 2, types: 1, coercions: 3, joins: 0/0}
main2 :: State# RealWorld -> (# State# RealWorld, () #)
main2 = runMainIO1 (main1 `cast` <Co:3>)

-- RHS size: {terms: 1, types: 0, coercions: 3, joins: 0/0}
main :: IO ()
main = main2 `cast` <Co:3>