[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:
453aa853 by Ben Gamari at 2020-05-24T22:17:02-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.
 
-Operator sections.  At first it looks as if we can convert
-\begin{verbatim}
-        (expr op)
-\end{verbatim}
-to
-\begin{verbatim}
-        \x -> op expr x
-\end{verbatim}
+
+Note [Desugaring operator sections]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+At first it looks as if we can convert
+    (expr op)
+naively to
+    \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}
-If \tr{expr} is actually just a variable, say, then the simplifier
+    map (expr op) xs
+for example.
+
+So we convert instead to
+    let y = expr in \x -> op y x
+If `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,35 @@ 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') }
-
--- dsLExpr (SectionR op expr)   -- \ x -> op x expr
+-- dsExpr (SectionL op expr)  ===  (expr `op`)  ~>  \y -> op expr y
+--
+-- See Note [Desugaring operator sections].
+-- N.B. this also must handle postfix operator sections due to -XPostfixOperators.
+dsExpr e@(SectionL _ expr op) = do
+    core_op <- dsLExpr op
+    x_core <- dsLExpr expr
+    case splitFunTys (exprType core_op) of
+      -- Binary operator section
+      (x_ty:y_ty:_, _) -> do
+        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]))
+
+      -- Postfix operator section
+      (x_ty:_, _) -> do
+        return $ mkCoreAppDs (text "sectionl" <+> ppr e) core_op x_core
+
+      _ -> pprPanic "dsExpr(SectionL)" (ppr e)
+
+-- 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
=====================================
@@ -64,4 +64,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/453aa8531411380cc227a117f64f4d8a1a99aa24

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/453aa8531411380cc227a117f64f4d8a1a99aa24
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/20200524/7928fd6a/attachment-0001.html>