    {-
    (c) The GRASP/AQUA Project, Glasgow University, 1993-1998

    \section[SimplStg]{Driver for simplifying @STG@ programs}
    -}

    {-# LANGUAGE CPP #-}

    module SimplStg ( stg2stg ) where

    #include "HsVersions.h"

    import GhcPrelude

    import StgSyn

    import StgLint          ( lintStgTopBindings )
    import StgStats         ( showStgStats )
    import UnariseStg       ( unarise )
    import StgCse           ( stgCse )

    import DynFlags
    import ErrUtils
    import SrcLoc
    import UniqSupply       ( mkSplitUniqSupply )
    import Outputable
    import Control.Monad

    stg2stg :: DynFlags                  -- includes spec of what stg-to-stg passes to do
            -> [StgTopBinding]           -- input...
            -> IO [StgTopBinding]        -- output program

    stg2stg dflags binds
      = do  { showPass dflags "Stg2Stg"
            ; us <- mkSplitUniqSupply 'g'

            ; when (dopt Opt_D_verbose_stg2stg dflags)
                   (putLogMsg dflags NoReason SevDump noSrcSpan
                      (defaultDumpStyle dflags) (text "VERBOSE STG-TO-STG:"))

            ; binds' <- end_pass "Stg2Stg" binds

                    -- Do the main business!
            ; processed_binds <- foldM do_stg_pass binds' (getStgToDo dflags)

            ; dumpIfSet_dyn dflags Opt_D_dump_stg "Pre unarise:"
                            (pprStgTopBindings processed_binds)

            ; let un_binds = stg_linter True "Unarise"
                             $ unarise us processed_binds

            ; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:"
                            (pprStgTopBindings un_binds)

            ; return un_binds
       }

      where
        stg_linter unarised
          | gopt Opt_DoStgLinting dflags = lintStgTopBindings unarised
          | otherwise                    = \ _whodunnit binds -> binds

        -------------------------------------------
        do_stg_pass binds to_do
          = case to_do of
              D_stg_stats ->
                 trace (showStgStats binds)
                 end_pass "StgStats" binds

              StgCSE ->
                 {-# SCC "StgCse" #-}
                 let
                     binds' = stgCse binds
                 in
                 end_pass "StgCse" binds'

        end_pass what binds2
          = do -- report verbosely, if required
               dumpIfSet_dyn dflags Opt_D_verbose_stg2stg what
                  (vcat (map ppr binds2))
               return (stg_linter False what binds2)

    -- -----------------------------------------------------------------------------
    -- StgToDo:  abstraction of stg-to-stg passes to run.

    -- | Optional Stg-to-Stg passes.
    data StgToDo
      = StgCSE
      | D_stg_stats

    -- | Which optional Stg-to-Stg passes to run. Depends on flags, ways etc.
    getStgToDo :: DynFlags -> [StgToDo]
    getStgToDo dflags
      = [ StgCSE                   | gopt Opt_StgCSE dflags] ++
        [ D_stg_stats              | stg_stats ]
      where
            stg_stats = gopt Opt_StgStats dflags