[GHC] #13242: Panic "StgCmmEnv: variable not found" with ApplicativeDo and ExistentialQuantification

[GHC]

#13242: Panic "StgCmmEnv: variable not found" with ApplicativeDo and
ExistentialQuantification
-------------------------------------+-------------------------------------
        Reporter:  ljli              |                Owner:  simonmar
            Type:  bug               |               Status:  new
        Priority:  highest           |            Milestone:
       Component:  Compiler          |              Version:  8.1
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------
Changes (by simonpj):

 * priority:  normal => highest
 * owner:   => simonmar


Comment:

 Simon M: this is an outright bug somewhere in `ApplicativeDo`.  Using
 `-dcore-lint` nails it immediately in the output of the desugarer:
 {{{
 *** Core Lint errors : in result of Desugar (before optimization) ***
 <no location info>: warning:
     In the expression: >>=
                          @ (ST s)
                          $dMonad_aRm
                          @ (STRef s Integer)
                          @ ()
                          (newSTRef @ Integer @ s 1)
                          (\ (ref_aFs :: STRef s Integer) ->
                             >>
                               @ (ST s)
                               $dMonad_a12S
                               @ Integer
                               @ ()
                               (readSTRef @ s @ Integer ref_aFs)
                               (return @ (ST s) $dMonad_a131 @ () ()))
     $dMonad_aRm :: Monad m_aRl[tau:3]
     [LclId] is out of scope
 <no location info>: warning:
     In the expression: >>=
                          @ (ST s)
                          $dMonad_aRm
                          @ (STRef s Integer)
                          @ ()
                          (newSTRef @ Integer @ s 1)
                          (\ (ref_aFs :: STRef s Integer) ->
                             >>
                               @ (ST s)
                               $dMonad_a12S
                               @ Integer
                               @ ()
                               (readSTRef @ s @ Integer ref_aFs)
                               (return @ (ST s) $dMonad_a131 @ () ()))
     Argument value doesn't match argument type:
     Fun type:
         Monad (ST s) => forall a b. ST s a -> (a -> ST s b) -> ST s b
     Arg type: Monad m_aRl[tau:3]
     Arg: $dMonad_aRm
 *** Offending Program ***
 Rec {
 $tcA :: TyCon
 [LclIdX]
 $tcA =
   TyCon
     4740327979976134328##
     15826189822472469109##
     $trModule
     (TrNameS "A"#)

 $tc'A :: TyCon
 [LclIdX]
 $tc'A =
   TyCon
     9840332441209672147##
     16375955839481284679##
     $trModule
     (TrNameS "'A"#)

 $trModule :: Module
 [LclIdX]
 $trModule = Module (TrNameS "main"#) (TrNameS "T13242"#)

 st :: forall s. ST s ()
 [LclIdX]
 st =
   \ (@ s_aQu) ->
     let {
       $dApplicative_aR0 :: Applicative (ST s)
       [LclId]
       $dApplicative_aR0 = $fApplicativeST @ s } in
     let {
       $dApplicative_aR7 :: Applicative (ST s)
       [LclId]
       $dApplicative_aR7 = $dApplicative_aR0 } in
     let {
       $dFunctor_aQK :: Functor (ST s)
       [LclId]
       $dFunctor_aQK = $fFunctorST @ s } in
     <*>
       @ (ST s)
       $dApplicative_aR0
       @ ()
       @ ()
       (fmap
          @ (ST s)
          $dFunctor_aQK
          @ A
          @ (() -> ())
          (\ (ds_d13u :: A) (ds_d13v :: ()) ->
             case ds_d13u of wild_00 { A @ a_aRa ds_d13w ->
             let {
               $dNum_a12O :: Num Integer
               [LclId]
               $dNum_a12O = $fNumInteger } in
             let {
               $dMonad_aRm :: Monad (ST s)
               [LclId]
               $dMonad_aRm = $fMonadST @ s } in
             let {
               $dMonad_a12S :: Monad (ST s)
               [LclId]
               $dMonad_a12S = $dMonad_aRm } in
             let {
               $dMonad_a131 :: Monad (ST s)
               [LclId]
               $dMonad_a131 = $dMonad_aRm } in
             let {
               ds_d13x :: ()
               [LclId]
               ds_d13x = ds_d13v } in
             case ds_d13x of wild_00 { () -> () }
             })
          ($ @ 'LiftedRep
             @ A
             @ (ST s A)
             (pure @ (ST s) $dApplicative_aR7 @ A)
             (A @ Bool True)))
       (>>=
          @ (ST s)
          $dMonad_aRm
          @ (STRef s Integer)
          @ ()
          (newSTRef @ Integer @ s 1)
          (\ (ref_aFs :: STRef s Integer) ->
             >>
               @ (ST s)
               $dMonad_a12S
               @ Integer
               @ ()
               (readSTRef @ s @ Integer ref_aFs)
               (return @ (ST s) $dMonad_a131 @ () ())))
 end Rec }
 }}}

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13242#comment:1>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler