Don't track free variables in STG syntax by default

Summary:
Currently, `CoreToStg` annotates `StgRhsClosure`s with their set of non-global
free variables.  This free variable information is only needed in the final
code generation step (i.e. `StgCmm.codeGen`), which leads to transformations
such as `StgCse` and `StgUnarise` having to maintain this information.

This is tiresome and unnecessary, so this patch introduces a trees-to-grow-like
approach that only introduces the free variable set into the syntax tree in the
code gen pass, along with a free variable analysis on STG terms to generate
that information.

Fixes #15754.

Reviewers: simonpj, osa1, bgamari, simonmar

Reviewed By: osa1

Subscribers: rwbarton, carter

GHC Trac Issues: #15754

Differential Revision: https://phabricator.haskell.org/D5324

1 files changed, 12 insertions, 8 deletions

diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 004bf90c67..dba122fd0c 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -44,6 +44,7 @@ import Name
 import Module
 import ListSetOps
 import Util
+import UniqSet ( nonDetEltsUniqSet )
 import BasicTypes
 import Outputable
 import FastString
@@ -64,7 +65,7 @@ cgTopRhsClosure :: DynFlags
                 -> CostCentreStack      -- Optional cost centre annotation
                 -> UpdateFlag
                 -> [Id]                 -- Args
-                -> StgExpr
+                -> CgStgExpr
                 -> (CgIdInfo, FCode ())
 
 cgTopRhsClosure dflags rec id ccs upd_flag args body =
@@ -121,7 +122,7 @@ cgTopRhsClosure dflags rec id ccs upd_flag args body =
 --              Non-top-level bindings
 ------------------------------------------------------------------------
 
-cgBind :: StgBinding -> FCode ()
+cgBind :: CgStgBinding -> FCode ()
 cgBind (StgNonRec name rhs)
   = do  { (info, fcode) <- cgRhs name rhs
         ; addBindC info
@@ -190,7 +191,7 @@ cgBind (StgRec pairs)
  -}
 
 cgRhs :: Id
-      -> StgRhs
+      -> CgStgRhs
       -> FCode (
                  CgIdInfo         -- The info for this binding
                , FCode CmmAGraph  -- A computation which will generate the
@@ -206,9 +207,12 @@ cgRhs id (StgRhsCon cc con args)
       -- see Note [Post-unarisation invariants] in UnariseStg
 
 {- See Note [GC recovery] in compiler/codeGen/StgCmmClosure.hs -}
-cgRhs id (StgRhsClosure cc fvs upd_flag args body)
+cgRhs id (StgRhsClosure fvs cc upd_flag args body)
   = do dflags <- getDynFlags
-       mkRhsClosure dflags id cc (nonVoidIds fvs) upd_flag args body
+       mkRhsClosure dflags id cc (nonVoidIds (nonDetEltsUniqSet fvs)) upd_flag args body
+       -- It's OK to use nonDetEltsUniqSet here because we're not aiming for
+       -- bit-for-bit determinism.
+       -- See Note [Unique Determinism and code generation]
 
 ------------------------------------------------------------------------
 --              Non-constructor right hand sides
@@ -218,7 +222,7 @@ mkRhsClosure :: DynFlags -> Id -> CostCentreStack
              -> [NonVoid Id]                    -- Free vars
              -> UpdateFlag
              -> [Id]                            -- Args
-             -> StgExpr
+             -> CgStgExpr
              -> FCode (CgIdInfo, FCode CmmAGraph)
 
 {- mkRhsClosure looks for two special forms of the right-hand side:
@@ -436,7 +440,7 @@ closureCodeBody :: Bool            -- whether this is a top-level binding
                 -> CostCentreStack -- Optional cost centre attached to closure
                 -> [NonVoid Id]    -- incoming args to the closure
                 -> Int             -- arity, including void args
-                -> StgExpr
+                -> CgStgExpr
                 -> [(NonVoid Id, ByteOff)] -- the closure's free vars
                 -> FCode ()
 
@@ -560,7 +564,7 @@ mkSlowEntryCode bndr cl_info arg_regs -- function closure is already in `Node'
 
 -----------------------------------------
 thunkCode :: ClosureInfo -> [(NonVoid Id, ByteOff)] -> CostCentreStack
-          -> LocalReg -> Int -> StgExpr -> FCode ()
+          -> LocalReg -> Int -> CgStgExpr -> FCode ()
 thunkCode cl_info fv_details _cc node arity body
   = do { dflags <- getDynFlags
        ; let node_points = nodeMustPointToIt dflags (closureLFInfo cl_info)