[Git][ghc/ghc][master] Revert "Avoid desugaring non-recursive lets into recursive lets"

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Mon Jun 26 17:16:56 UTC 2023



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00
Revert "Avoid desugaring non-recursive lets into recursive lets"

This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef.

Fixes #23550

- - - - -


3 changed files:

- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Expr.hs
- testsuite/tests/ghci/should_run/T16096.stdout


Changes:

=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -117,56 +117,10 @@ dsTopLHsBinds binds
     top_level_err bindsType (L loc bind)
       = putSrcSpanDs (locA loc) $
         diagnosticDs (DsTopLevelBindsNotAllowed bindsType bind)
-{-
-Note [Return bindings in dependency order]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The desugarer tries to desugar a non-recursive let-binding to a collection of
-one or more non-recursive let-bindings. The alternative is to generate a letrec
-and wait for the occurrence analyser to sort it out later, but it is pretty easy
-to arrange that the [(Id,CoreExpr)] pairs returned by dsLHsBinds are returned in
-dependency order
-
-It's most important for linear types, where non-recursive lets can be linear
-whereas recursive-let can't. Since we check the output of the desugarer for
-linearity (see also Note [Linting linearity]), desugaring non-recursive lets to
-recursive lets would break linearity checks. An alternative is to refine the
-typing rule for recursive lets so that we don't have to care (see in particular
-#23218 and #18694), but the outcome of this line of work is still unclear. In
-the meantime, being a little precise in the desugarer is cheap. (paragraph
-written on 2023-06-09)
-
-In dsLHSBinds (and dependencies), a single binding can be desugared to multiple
-bindings. For instance because the source binding has the {-# SPECIALIZE #-}
-pragma. In:
-
-f _ = …
- where
-  {-# SPECIALIZE g :: F Int -> F Int #-}
-  g :: C a => F a -> F a
-  g _ = …
-
-The g binding desugars to
-
-let {
-  $sg = … } in
-
-  g
-  [RULES: "SPEC g" g @Int $dC = $sg]
-  g = …
 
-In order to avoid generating a letrec that will immediately be reordered, we
-make sure to return the binding in dependency order [$sg, g].
-
-This only matters when the source binding is non-recursive as recursive bindings
-are always desugared to a single mutually recursive block.
-
--}
 
 -- | Desugar all other kind of bindings, Ids of strict binds are returned to
 -- later be forced in the binding group body, see Note [Desugar Strict binds]
---
--- Invariant: the desugared bindings are returned in dependency order,
--- see Note [Return bindings in dependency order]
 dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)])
 dsLHsBinds binds
   = do { ds_bs <- mapBagM dsLHsBind binds
@@ -180,9 +134,6 @@ dsLHsBind (L loc bind) = do dflags <- getDynFlags
                             putSrcSpanDs (locA loc) $ dsHsBind dflags bind
 
 -- | Desugar a single binding (or group of recursive binds).
---
--- Invariant: the desugared bindings are returned in dependency order,
--- see Note [Return bindings in dependency order]
 dsHsBind :: DynFlags
          -> HsBind GhcTc
          -> DsM ([Id], [(Id,CoreExpr)])
@@ -312,7 +263,7 @@ dsAbsBinds dflags tyvars dicts exports
                                        (isDefaultMethod prags)
                                        (dictArity dicts) rhs
 
-       ; return (force_vars', fromOL spec_binds ++ [main_bind]) } }
+       ; return (force_vars', main_bind : fromOL spec_binds) } }
 
     -- Another common case: no tyvars, no dicts
     -- In this case we can have a much simpler desugaring
@@ -371,7 +322,7 @@ dsAbsBinds dflags tyvars dicts exports
                            -- Kill the INLINE pragma because it applies to
                            -- the user written (local) function.  The global
                            -- Id is just the selector.  Hmm.
-                     ; return (fromOL spec_binds ++ [(global', rhs)]) } }
+                     ; return ((global', rhs) : fromOL spec_binds) } }
 
        ; export_binds_s <- mapM mk_bind (exports ++ extra_exports)
 


=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -160,20 +160,17 @@ ds_val_bind (is_rec, binds) body
           -- NB: bindings have a fixed RuntimeRep, so it's OK to call isUnliftedType
           case prs of
             [] -> return body
-            _  -> return (mkLets (mk_binds is_rec prs) body') }
-            -- We can make a non-recursive let because we make sure to return
-            -- the bindings in dependency order in dsLHsBinds, see Note [Return bindings in dependency order]
-
--- | Helper function. You can use the result of 'mk_binds' with 'mkLets' for
--- instance.
---
---   * @'mk_binds' 'Recursive' binds@ makes a single mutually-recursive
---     bindings with all the rhs/lhs pairs in @binds@
---   * @'mk_binds' 'NonRecursive' binds@ makes one non-recursive binding
---     for each rhs/lhs pairs in @binds@
-mk_binds :: RecFlag -> [(b, (Expr b))] -> [Bind b]
-mk_binds Recursive binds = [Rec binds]
-mk_binds NonRecursive binds = map (uncurry NonRec) binds
+            _  -> return (Let (Rec prs) body') }
+        -- Use a Rec regardless of is_rec.
+        -- Why? Because it allows the binds to be all
+        -- mixed up, which is what happens in one rare case
+        -- Namely, for an AbsBind with no tyvars and no dicts,
+        --         but which does have dictionary bindings.
+        -- See notes with GHC.Tc.Solver.inferLoop [NO TYVARS]
+        -- It turned out that wrapping a Rec here was the easiest solution
+        --
+        -- NB The previous case dealt with unlifted bindings, so we
+        --    only have to deal with lifted ones now; so Rec is ok
 
 ------------------
 dsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr


=====================================
testsuite/tests/ghci/should_run/T16096.stdout
=====================================
@@ -1,6 +1,6 @@
 
 ==================== Desugared ====================
-let {
+letrec {
   x :: [GHC.Types.Int]
   [LclId]
   x = let {
@@ -11,7 +11,7 @@ let {
         x :: [GHC.Types.Int]
         [LclId]
         x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in
-      x } in
+      x; } in
 GHC.Base.returnIO
   @[GHC.Types.Any]
   (GHC.Types.:
@@ -27,7 +27,7 @@ GHC.Base.returnIO
 
 
 ==================== Desugared ====================
-let {
+letrec {
   x :: [GHC.Types.Int]
   [LclId]
   x = let {
@@ -38,7 +38,7 @@ let {
         x :: [GHC.Types.Int]
         [LclId]
         x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in
-      x } in
+      x; } in
 GHC.Base.returnIO
   @[GHC.Types.Any]
   (GHC.Types.:



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/522bd584f71ddeda21efdf0917606ce3d81ec6cc

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/522bd584f71ddeda21efdf0917606ce3d81ec6cc
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230626/264442ff/attachment-0001.html>


More information about the ghc-commits mailing list