[Git][ghc/ghc][wip/T18151] HsToCore: Eta expand left sections

[Ben Gamari]

Ben Gamari pushed to branch wip/T18151 at Glasgow Haskell Compiler / GHC


Commits:
9ccb4dba by Ben Gamari at 2020-05-10T21:53:34-04:00
HsToCore: Eta expand left sections

Strangely, the comment next to this code already alluded to the fact
that even simply eta-expanding will sacrifice laziness. It's quite
unclear how we regressed so far.

See #18151.

- - - - -


2 changed files:

- compiler/GHC/HsToCore/Expr.hs
- testsuite/tests/deSugar/should_run/all.T


Changes:

=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -338,26 +338,25 @@ Then we get
 That 'g' in the 'in' part is an evidence variable, and when
 converting to core it must become a CO.
 
+
+Note [Desugaring operator sections]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Operator sections.  At first it looks as if we can convert
-\begin{verbatim}
-        (expr op)
-\end{verbatim}
+    (expr op)
 to
-\begin{verbatim}
-        \x -> op expr x
-\end{verbatim}
+    \x -> op expr x
 
 But no!  expr might be a redex, and we can lose laziness badly this
 way.  Consider
-\begin{verbatim}
-        map (expr op) xs
-\end{verbatim}
-for example.  So we convert instead to
-\begin{verbatim}
-        let y = expr in \x -> op y x
-\end{verbatim}
+    map (expr op) xs
+for example.
+
+So we convert instead to
+    let y = expr in \x -> op y x
 If \tr{expr} is actually just a variable, say, then the simplifier
 will sort it out.
+
+See #18151.
 -}
 
 dsExpr e@(OpApp _ e1 op e2)
@@ -366,17 +365,24 @@ dsExpr e@(OpApp _ e1 op e2)
        ; dsWhenNoErrs (mapM dsLExprNoLP [e1, e2])
                       (\exprs' -> mkCoreAppsDs (text "opapp" <+> ppr e) op' exprs') }
 
-dsExpr (SectionL _ expr op)       -- Desugar (e !) to ((!) e)
-  = do { op' <- dsLExpr op
-       ; dsWhenNoErrs (dsLExprNoLP expr)
-                      (\expr' -> mkCoreAppDs (text "sectionl" <+> ppr expr) op' expr') }
+-- dsExpr (SectionL op expr)  ===  (expr `op`)  ~>  \y -> op expr y
+--
+-- See Note [Desugaring operator sections]
+dsExpr e@(SectionL _ expr op) = do
+    core_op <- dsLExpr op
+    let (x_ty:y_ty:_, _) = splitFunTys (exprType core_op)
+    x_core <- dsLExpr expr
+    dsWhenNoErrs (mapM newSysLocalDsNoLP [x_ty, y_ty])
+                 (\[x_id, y_id] -> bindNonRec x_id x_core $
+                                   Lam y_id (mkCoreAppsDs (text "sectionl" <+> ppr e)
+                                                          core_op [Var x_id, Var y_id]))
 
--- dsLExpr (SectionR op expr)   -- \ x -> op x expr
+-- dsExpr (SectionR op expr)  === (`op` expr)  ~>  \x -> op x expr
+--
+-- See Note [Desugaring operator sections]
 dsExpr e@(SectionR _ op expr) = do
     core_op <- dsLExpr op
-    -- for the type of x, we need the type of op's 2nd argument
     let (x_ty:y_ty:_, _) = splitFunTys (exprType core_op)
-        -- See comment with SectionL
     y_core <- dsLExpr expr
     dsWhenNoErrs (mapM newSysLocalDsNoLP [x_ty, y_ty])
                  (\[x_id, y_id] -> bindNonRec y_id y_core $


=====================================
testsuite/tests/deSugar/should_run/all.T
=====================================
@@ -63,4 +63,4 @@ test('T11601', exit_code(1), compile_and_run, [''])
 test('T11747', normal, compile_and_run, ['-dcore-lint'])
 test('T12595', normal, compile_and_run, [''])
 test('T13285', normal, compile_and_run, [''])
-test('T18151', expect_broken(18151), compile_and_run, [''])
+test('T18151', normal, compile_and_run, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ccb4dbafcf433e6bc2ec62ae08827309ee66582

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ccb4dbafcf433e6bc2ec62ae08827309ee66582
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/20200510/c348a16d/attachment-0001.html>