[Git][ghc/ghc][master] 3 commits: testsuite: Add test for #18151
Marge Bot
gitlab at gitlab.haskell.org
Mon Jun 1 10:33:48 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
b0c1f2a6 by Ben Gamari at 2020-06-01T06:33:37-04:00
testsuite: Add test for #18151
- - - - -
9a99a178 by Ben Gamari at 2020-06-01T06:33:37-04:00
testsuite: Add test for desugaring of PostfixOperators
- - - - -
2b89ca5b by Ben Gamari at 2020-06-01T06:33:37-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.
- - - - -
6 changed files:
- compiler/GHC/HsToCore/Expr.hs
- + testsuite/tests/deSugar/should_run/DsPostfixOperators.hs
- + testsuite/tests/deSugar/should_run/DsPostfixOperators.stdout
- + testsuite/tests/deSugar/should_run/T18151.hs
- + testsuite/tests/deSugar/should_run/T18151.stdout
- testsuite/tests/deSugar/should_run/all.T
Changes:
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -338,26 +338,47 @@ 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
-will sort it out.
+
+ map (expr `op`) xs
+
+for example. If expr were a redex then eta-expanding naively would
+result in multiple evaluations where the user might only have expected one.
+
+So we convert instead to
+
+ let y = expr in \x -> op y x
+
+Also, note that we must do this for both right and (perhaps surprisingly) left
+sections. Why are left sections necessary? Consider the program (found in #18151),
+
+ seq (True `undefined`) ()
+
+according to the Haskell Report this should reduce to () (as it specifies
+desugaring via eta expansion). However, if we fail to eta expand we will rather
+bottom. Consequently, we must eta expand even in the case of a left section.
+
+If `expr` is actually just a variable, say, then the simplifier
+will inline `y`, eliminating the redundant `let`.
+
+Note that this works even in the case that `expr` is unlifted. In this case
+bindNonRec will automatically do the right thing, giving us:
+
+ case expr of y -> (\x -> op y x)
+
+See #18151.
-}
dsExpr e@(OpApp _ e1 op e2)
@@ -366,17 +387,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
+ (_:_, _) -> 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/DsPostfixOperators.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE PostfixOperators #-}
+
+main :: IO ()
+main = do
+ print (42 `negate`)
=====================================
testsuite/tests/deSugar/should_run/DsPostfixOperators.stdout
=====================================
@@ -0,0 +1,2 @@
+-42
+
=====================================
testsuite/tests/deSugar/should_run/T18151.hs
=====================================
@@ -0,0 +1,10 @@
+-- According to the Report this should reduce to (). However, in #18151 it was
+-- reported that GHC bottoms.
+x :: ()
+x = seq (True `undefined`) ()
+{-# NOINLINE x #-}
+
+main :: IO ()
+main = do
+ print x
+
=====================================
testsuite/tests/deSugar/should_run/T18151.stdout
=====================================
@@ -0,0 +1 @@
+()
\ No newline at end of file
=====================================
testsuite/tests/deSugar/should_run/all.T
=====================================
@@ -57,9 +57,11 @@ test('T10215', normal, compile_and_run, [''])
test('DsStrictData', normal, compile_and_run, [''])
test('DsStrict', normal, compile_and_run, [''])
test('DsStrictLet', normal, compile_and_run, ['-O'])
+test('DsPostfixOperators', normal, compile_and_run, [''])
test('T11193', exit_code(1), compile_and_run, [''])
test('T11572', exit_code(1), compile_and_run, [''])
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', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/389920858e0b9efe5234cb7dac55d06e955768f7...2b89ca5b850b4097447cc4908cbb0631011ce979
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/389920858e0b9efe5234cb7dac55d06e955768f7...2b89ca5b850b4097447cc4908cbb0631011ce979
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/20200601/d0163cdc/attachment-0001.html>
More information about the ghc-commits
mailing list