DynFlag to disable let-floating; -fno-float-out, -fno-float-out-top-level CLI flags (#13663)

Addresses #13663 (closed)

• are either individually buildable or squashed
• have commit messages which describe what they do (referring to [Notes][notes] and tickets using #NNNN syntax when appropriate)
• have added source comments describing your change. For larger changes you likely should add a [Note][notes] and cross-reference it from the relevant places.
• add a testcase to the testsuite.

module Test where

import Control.Applicative

topEntity :: [((),())]
topEntity = (,) <$> outport1 <*> outport2
  where
    (outport1, outResp1) = gpio (decodeReq 1 req)
    (outport2, outResp2) = gpio (decodeReq 2 req)
    ramResp              = ram  (decodeReq 0 req)

    req = core $ (<|>) <$> ramResp <*> ((<|>) <$> outResp1 <*> outResp2)

core :: [Maybe ()] -> [()]
core = fmap (maybe () id)
{-# NOINLINE core #-}

ram :: [()] -> [Maybe ()]
ram = fmap pure
{-# NOINLINE ram #-}

decodeReq :: Integer -> [()] -> [()]
decodeReq 0 = fmap (const ())
decodeReq 1 = id
decodeReq _ = fmap id
{-# NOINLINE decodeReq #-}

gpio :: [()] -> ([()],[Maybe ()])
gpio i = (i,pure <$> i)
{-# NOINLINE gpio #-}

vanessa@vanessa-desktop /development/work/ghc 🌸 _build/ghc-stage1 -O0 -fno-float-out-top-level -ddump-simpl -dsuppress-all Test.hs
[1 of 1] Compiling Test             ( Test.hs, Test.o )

==================== Tidy Core ====================
Result size of Tidy Core
  = {terms: 110, types: 177, coercions: 0, joins: 0/3}

$trModule = Module (TrNameS "main"#) (TrNameS "Test"#)

gpio
  = \ i_amK ->
      (i_amK, <$> $fFunctor[] (pure $fApplicativeMaybe) i_amK)

decodeReq
  = \ ds_dY6 ->
      case == $fEqInteger ds_dY6 (IS 0#) of {
        False ->
          case == $fEqInteger ds_dY6 (IS 1#) of {
            False -> fmap $fFunctor[] id;
            True -> id
          };
        True -> fmap $fFunctor[] (const ())
      }

ram = fmap $fFunctor[] (pure $fApplicativeMaybe)

core = fmap $fFunctor[] (maybe () id)

topEntity
  = letrec {
      ds_dYh = gpio (decodeReq (IS 1#) req_aWD);
      ds1_dYi = gpio (decodeReq (IS 2#) req_aWD);
      req_aWD
        = $ core
            (<*>
               $fApplicative[]
               (<$>
                  $fFunctor[]
                  (<|> $fAlternativeMaybe)
                  (ram (decodeReq (IS 0#) req_aWD)))
               (<*>
                  $fApplicative[]
                  (<$>
                     $fFunctor[]
                     (<|> $fAlternativeMaybe)
                     (case ds_dYh of { (outport1_aWz, outResp1_X2) -> outResp1_X2 }))
                  (case ds1_dYi of { (outport2_aWJ, outResp2_X2) ->
                   outResp2_X2
                   }))); } in
    <*>
      $fApplicative[]
      (<$>
         $fFunctor[]
         (\ ds2_dYf ds3_dYg -> (ds2_dYf, ds3_dYg))
         (case ds_dYh of { (outport1_aWz, outResp1_X2) -> outport1_aWz }))
      (case ds1_dYi of { (outport2_aWJ, outResp2_X2) -> outport2_aWJ })

...which confirms that it does what we wanted in the linked issue.

If you don't pass the -fno-float-top-level flag, it does as before, viz.

vanessa@vanessa-desktop /development/work/ghc 🌸 _build/ghc-stage1 -O0 -ddump-simpl -dsuppress-all Test.hs
[1 of 1] Compiling Test             ( Test.hs, Test.o )

==================== Tidy Core ====================
Result size of Tidy Core
  = {terms: 118, types: 181, coercions: 0, joins: 0/0}

$trModule1_rYn = "main"#

$trModule2_rYo = TrNameS $trModule1_rYn

$trModule3_rYp = "Test"#

$trModule4_rYq = TrNameS $trModule3_rYp

$trModule = Module $trModule2_rYo $trModule4_rYq

gpio
  = \ i_amK ->
      (i_amK, <$> $fFunctor[] (pure $fApplicativeMaybe) i_amK)

decodeReq
  = \ ds2_dY6 ->
      case == $fEqInteger ds2_dY6 (IS 0#) of {
        False ->
          case == $fEqInteger ds2_dY6 (IS 1#) of {
            False -> fmap $fFunctor[] id;
            True -> id
          };
        True -> fmap $fFunctor[] (const ())
      }

ram = fmap $fFunctor[] (pure $fApplicativeMaybe)

core = fmap $fFunctor[] (maybe () id)

Rec {
ds_rYr = gpio (decodeReq (IS 1#) req_rYt)

ds1_rYs = gpio (decodeReq (IS 2#) req_rYt)

req_rYt
  = $ core
      (<*>
         $fApplicative[]
         (<$>
            $fFunctor[]
            (<|> $fAlternativeMaybe)
            (ram (decodeReq (IS 0#) req_rYt)))
         (<*>
            $fApplicative[]
            (<$>
               $fFunctor[]
               (<|> $fAlternativeMaybe)
               (case ds_rYr of { (outport1_aWz, outResp1_X2) -> outResp1_X2 }))
            (case ds1_rYs of { (outport2_aWJ, outResp2_X2) -> outResp2_X2 })))
end Rec }

topEntity
  = <*>
      $fApplicative[]
      (<$>
         $fFunctor[]
         (\ ds2_dYf ds3_dYg -> (ds2_dYf, ds3_dYg))
         (case ds_rYr of { (outport1_aWz, outResp1_X2) -> outport1_aWz }))
      (case ds1_rYs of { (outport2_aWJ, outResp2_X2) -> outport2_aWJ })