[Git][ghc/ghc][master] Filter out nontrivial substituted expressions in substTickish

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu Jul 6 16:12:37 UTC 2023



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


Commits:
6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00
Filter out nontrivial substituted expressions in substTickish

Fixes #23272

- - - - -


20 changed files:

- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Subst.hs
- docs/users_guide/debugging.rst
- libraries/base/tests/IO/all.T
- libraries/base/tests/all.T
- testsuite/tests/codeGen/should_run/all.T
- testsuite/tests/concurrent/should_run/all.T
- testsuite/tests/ghc-api/target-contents/all.T
- testsuite/tests/ghci/scripts/all.T
- testsuite/tests/numeric/should_run/all.T
- testsuite/tests/primops/should_run/all.T
- testsuite/tests/programs/jtod_circint/test.T
- testsuite/tests/rts/all.T
- testsuite/tests/simplCore/T9646/test.T
- + testsuite/tests/simplCore/should_compile/T23272.hs
- + testsuite/tests/simplCore/should_compile/T23272.script
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/th/all.T
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_run/all.T


Changes:

=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -64,7 +64,7 @@ import GHC.Builtin.PrimOps ( PrimOp (SeqOp) )
 import GHC.Builtin.Types.Prim( realWorldStatePrimTy )
 import GHC.Builtin.Names( runRWKey )
 
-import GHC.Data.Maybe   ( isNothing, orElse )
+import GHC.Data.Maybe   ( isNothing, orElse, mapMaybe )
 import GHC.Data.FastString
 import GHC.Unit.Module ( moduleName )
 import GHC.Utils.Outputable
@@ -1436,7 +1436,7 @@ simplTick env tickish expr cont
 
   simplTickish env tickish
     | Breakpoint ext n ids modl <- tickish
-          = Breakpoint ext n (map (getDoneId . substId env) ids) modl
+          = Breakpoint ext n (mapMaybe (getDoneId . substId env) ids) modl
     | otherwise = tickish
 
   -- Push type application and coercion inside a tick
@@ -1447,8 +1447,9 @@ simplTick env tickish expr cont
     where (inc,outc) = splitCont c
   splitCont other = (mkBoringStop (contHoleType other), other)
 
-  getDoneId (DoneId id)  = id
-  getDoneId (DoneEx e _) = getIdFromTrivialExpr e -- Note [substTickish] in GHC.Core.Subst
+  getDoneId (DoneId id)  = Just id
+  getDoneId (DoneEx (Var id) _) = Just id
+  getDoneId (DoneEx e _) = getIdFromTrivialExpr_maybe e -- Note [substTickish] in GHC.Core.Subst
   getDoneId other = pprPanic "getDoneId" (ppr other)
 
 -- Note [case-of-scc-of-case]


=====================================
compiler/GHC/Core/Subst.hs
=====================================
@@ -592,9 +592,9 @@ substDVarSet subst@(Subst _ _ tv_env cv_env) fvs
 ------------------
 substTickish :: Subst -> CoreTickish -> CoreTickish
 substTickish subst (Breakpoint ext n ids modl)
-   = Breakpoint ext n (map do_one ids) modl
+   = Breakpoint ext n (mapMaybe do_one ids) modl
  where
-    do_one = getIdFromTrivialExpr . lookupIdSubst subst
+    do_one = getIdFromTrivialExpr_maybe . lookupIdSubst subst
 substTickish _subst other = other
 
 {- Note [Substitute lazily]
@@ -649,6 +649,13 @@ Second, we have to ensure that we never try to substitute a literal
 for an Id in a breakpoint.  We ensure this by never storing an Id with
 an unlifted type in a Breakpoint - see GHC.HsToCore.Ticks.mkTickish.
 Breakpoints can't handle free variables with unlifted types anyway.
+
+These measures are only reliable with unoptimized code.
+Since we can now enable optimizations for GHCi with
+ at -fno-unoptimized-core-for-interpreter -O@, nontrivial expressions can be
+substituted, e.g. by specializations.
+Therefore we resort to discarding free variables from breakpoints when this
+situation occurs.
 -}
 
 {-


=====================================
docs/users_guide/debugging.rst
=====================================
@@ -1203,3 +1203,9 @@ Other
     This option can be used to override this check, e.g.
     ``ghci -O2 -fno-unoptimized-core-for-interpreter``.
     It is not recommended for normal use and can cause a compiler panic.
+
+    Note that this has an effect on the debugger interface: With optimizations
+    in play, free variables in breakpoints may now be substituted with complex
+    expressions.
+    Those cannot be stored in breakpoints, so any free variable that refers to
+    optimized code will not be inspectable when this flag is enabled.


=====================================
libraries/base/tests/IO/all.T
=====================================
@@ -96,7 +96,6 @@ test('hGetBuf001',
      [ when(fast(), skip)
      , expect_fail_if_windows
      , js_broken(22374)
-     , expect_broken_for(23272, ['ghci-opt'])
      , req_process
      ],
      compile_and_run, ['-package unix'])


=====================================
libraries/base/tests/all.T
=====================================
@@ -49,7 +49,7 @@ test('isValidNatural', normal, compile_and_run, [''])
 
 # need to add -K64m to the compiler opts, so that GHCi gets it too
 test('ioref001',
-     [when(fast(), skip),extra_run_opts('+RTS -K64m -RTS'), expect_broken_for(23272, ['ghci-opt'])],
+     [when(fast(), skip),extra_run_opts('+RTS -K64m -RTS')],
      compile_and_run,
      ['+RTS -K64m -RTS'])
 
@@ -250,7 +250,7 @@ test('T11334a', normal, compile_and_run, [''])
 test('T11555', normal, compile_and_run, [''])
 test('T12494', normal, compile_and_run, [''])
 test('T12852', [when(opsys('mingw32'), skip), js_broken(22374), req_process], compile_and_run, [''])
-test('lazySTexamples', expect_broken_for(23272, ['ghci-opt']), compile_and_run, [''])
+test('lazySTexamples', normal, compile_and_run, [''])
 test('T11760', [req_ghc_smp,
                req_target_smp,
                only_ways(['threaded1', 'threaded2', 'nonmoving_thr'])],
@@ -304,7 +304,7 @@ test('T19719', normal, compile_and_run, [''])
 test('T20107', extra_run_opts('+RTS -M50M'), compile_and_run, ['-package bytestring'])
 test('T22816', normal, compile_and_run, [''])
 test('trace', normal, compile_and_run, [''])
-test('listThreads', expect_broken_for(23272, ['ghci-opt']), compile_and_run, [''])
+test('listThreads', normal, compile_and_run, [''])
 test('listThreads1', omit_ghci, compile_and_run, [''])
 test('inits1tails1', normal, compile_and_run, [''])
 test('CLC149', normal, compile, [''])


=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -69,7 +69,7 @@ test('cgrun060',
 test('cgrun061', normal, compile_and_run, [''])
 test('cgrun062', normal, compile_and_run, [''])
 test('cgrun063', normal, compile_and_run, [''])
-test('cgrun064', expect_broken_for(23272, ['ghci-opt']), compile_and_run, [''])
+test('cgrun064', normal, compile_and_run, [''])
 test('cgrun065', normal, compile_and_run, [''])
 test('cgrun066', normal, compile_and_run, [''])
 test('cgrun067', [extra_files(['Cgrun067A.hs'])], compile_and_run, [''])
@@ -140,9 +140,9 @@ test('CgStaticPointersNoFullLazyness', [when(doing_ghci(), extra_hc_opts('-fobje
 test('StaticArraySize', [when(doing_ghci(), extra_hc_opts('-fobject-code'))],
      compile_and_run, ['-O2'])
 test('StaticByteArraySize', normal, compile_and_run, ['-O2'])
-test('CopySmallArray', expect_broken_for(23272, ['ghci-opt']), compile_and_run, [''])
+test('CopySmallArray', normal, compile_and_run, [''])
 test('SizeOfSmallArray', normal, compile_and_run, [''])
-test('NewSmallArray', expect_broken_for(23272, ['ghci-opt']), compile_and_run, [''])
+test('NewSmallArray', normal, compile_and_run, [''])
 test('T9001', normal, compile_and_run, [''])
 test('T9013', normal,
      compile_and_run, [''])
@@ -223,5 +223,5 @@ test('T20640a', normal, compile_and_run, [''])
 test('T20640b', normal, compile_and_run, [''])
 test('T22296',[only_ways(llvm_ways)
               ,unless(arch('x86_64'), skip)],compile_and_run,[''])
-test('T22798', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-fregs-graph'])
+test('T22798', normal, compile_and_run, ['-fregs-graph'])
 test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds'])


=====================================
testsuite/tests/concurrent/should_run/all.T
=====================================
@@ -81,7 +81,7 @@ test('T5611a', fragile(12751), compile_and_run, [''])
 test('T5238', normal, compile_and_run, [''])
 test('T5866', exit_code(1), compile_and_run, [''])
 
-test('readMVar1', expect_broken_for(23272, ['ghci-opt']), compile_and_run, [''])
+test('readMVar1', normal, compile_and_run, [''])
 test('readMVar2', normal, compile_and_run, [''])
 test('readMVar3', normal, compile_and_run, [''])
 test('tryReadMVar1', normal, compile_and_run, [''])
@@ -149,7 +149,7 @@ test('conc016', [omit_ways(concurrent_ways)  # see comment in conc016.hs
 test('conc017', normal, compile_and_run, [''])
 test('conc017a', normal, compile_and_run, [''])
 test('conc018', normal, compile_and_run, [''])
-test('conc019', [extra_run_opts('+RTS -K16m -RTS'), expect_broken_for(23272, ['ghci-opt'])], compile_and_run, [''])
+test('conc019', [extra_run_opts('+RTS -K16m -RTS')], compile_and_run, [''])
 test('conc020', normal, compile_and_run, [''])
 test('conc021',
   [ omit_ghci, exit_code(1)


=====================================
testsuite/tests/ghc-api/target-contents/all.T
=====================================
@@ -1,7 +1,6 @@
 test('TargetContents',
      [ extra_run_opts('"' + config.libdir + '"')
      , js_broken(22362)
-     , expect_broken_for(23272, ['ghci-opt'])
      , req_process
      ]
      , compile_and_run,


=====================================
testsuite/tests/ghci/scripts/all.T
=====================================
@@ -277,7 +277,7 @@ test('T13420', normal, ghci_script, ['T13420.script'])
 test('T13466', normal, ghci_script, ['T13466.script'])
 test('GhciCurDir', normal, ghci_script, ['GhciCurDir.script'])
 test('T13591', expect_broken(13591), ghci_script, ['T13591.script'])
-test('T13699', expect_broken_for(23272, ['ghci-opt']), ghci_script, ['T13699.script'])
+test('T13699', normal, ghci_script, ['T13699.script'])
 test('T13988', normal, ghci_script, ['T13988.script'])
 test('T13997', [extra_run_opts('-fobject-code')], ghci_script, ['T13997.script'])
 test('T13407', normal, ghci_script, ['T13407.script'])
@@ -319,7 +319,7 @@ test('T16876', normal, ghci_script, ['T16876.script'])
 test('T17345', normal, ghci_script, ['T17345.script'])
 test('T17384', normal, ghci_script, ['T17384.script'])
 test('T17403', normal, ghci_script, ['T17403.script'])
-test('T17431', expect_broken_for(23272, ['ghci-opt']), ghci_script, ['T17431.script'])
+test('T17431', normal, ghci_script, ['T17431.script'])
 test('T17500', [extra_run_opts('-ddump-to-file -ddump-bcos')], ghci_script, ['T17500.script'])
 test('T17549', normal, ghci_script, ['T17549.script'])
 test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'),


=====================================
testsuite/tests/numeric/should_run/all.T
=====================================
@@ -57,7 +57,7 @@ test('T7014', js_skip, makefile_test, [])
 
 test('T7233', normal, compile_and_run, [''])
 test('NumDecimals', normal, compile_and_run, [''])
-test('T8726', expect_broken_for(23272, ['ghci-opt']), compile_and_run, [''])
+test('T8726', normal, compile_and_run, [''])
 test('CarryOverflow', normal, compile_and_run, [''])
 test('T9407', normal, compile_and_run, [''])
 test('T9810', normal, compile_and_run, [''])


=====================================
testsuite/tests/primops/should_run/all.T
=====================================
@@ -60,7 +60,6 @@ test('UnliftedWeakPtr', normal, compile_and_run, [''])
 test('FMA_Primops'
     , [ when(have_cpu_feature('fma'), extra_hc_opts('-mfma'))
       , js_skip # JS backend doesn't have an FMA implementation
-      , expect_broken_for(23272, ['ghci-opt'])
       ]
      , compile_and_run, [''])
 test('FMA_ConstantFold'


=====================================
testsuite/tests/programs/jtod_circint/test.T
=====================================
@@ -1,4 +1,4 @@
 
-test('jtod_circint', [extra_files(['Bit.hs', 'LogFun.hs', 'Main.hs', 'Signal.hs']), expect_broken_for(23272, ['ghci-opt']),
+test('jtod_circint', [extra_files(['Bit.hs', 'LogFun.hs', 'Main.hs', 'Signal.hs']),
                       when(fast(), skip)], multimod_compile_and_run,
      ['Main', ''])


=====================================
testsuite/tests/rts/all.T
=====================================
@@ -143,7 +143,6 @@ test('stack003', [ omit_ghci, # parameter 50000 is not passed
 # Test that +RTS -K0 (e.g. no stack limit) parses correctly
 test('stack004', [ extra_run_opts('+RTS -K0 -RTS')
                  , js_broken(22374)
-                 , expect_broken_for(23272, ['ghci-opt'])
                  , expect_broken_for(14913, ['ghci'])
                  ], compile_and_run, [''])
 
@@ -265,7 +264,6 @@ test('T7037', req_c, makefile_test, ['T7037'])
 test('T7087', exit_code(1), compile_and_run, [''])
 test('T7160', [ # finalization order is different in the nonmoving
                 omit_ways(['nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc', 'nonmoving_thr_sanity'])
-              , expect_broken_for(23272, ['ghci-opt'])
               , js_broken(22261)
               ], compile_and_run, [''])
 
@@ -285,7 +283,7 @@ test('T7227', [extra_run_opts('+RTS -tT7227.stat --machine-readable -RTS')],
 
 test('T7636', [ exit_code(1), extra_run_opts('100000') ], compile_and_run, [''] )
 
-test('stablename001', [expect_fail_for(['hpc']), expect_broken_for(23272, ['ghci-opt'])], compile_and_run, [''])
+test('stablename001', [expect_fail_for(['hpc'])], compile_and_run, [''])
 # hpc should fail this, because it tags every variable occurrence with
 # a different tick.  It's probably a bug if it works, hence expect_fail.
 


=====================================
testsuite/tests/simplCore/T9646/test.T
=====================================
@@ -1,4 +1,4 @@
 
 test('T9646', [extra_files(['Main.hs', 'Natural.hs', 'StrictPrim.hs', 'Type.hs']),
-               when(fast(), skip), expect_broken_for(23272, ['ghci-opt'])],
+               when(fast(), skip)],
      multimod_compile_and_run, ['Main -ddump-simpl -ddump-to-file', ''])


=====================================
testsuite/tests/simplCore/should_compile/T23272.hs
=====================================
@@ -0,0 +1,9 @@
+module T23272 where
+
+class C a where
+instance C () where
+
+bug :: (forall a. C a => a -> a) -> ()
+bug g = f ()
+  where
+    f x = seq (g x) undefined


=====================================
testsuite/tests/simplCore/should_compile/T23272.script
=====================================
@@ -0,0 +1 @@
+:load T23272


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -489,3 +489,4 @@ test('T23491b', [extra_files(['T23491.hs']), grep_errmsg(r'Float inwards')], mul
 test('T23491c', [extra_files(['T23491.hs']), grep_errmsg(r'Liberate case')], multimod_compile, ['T23491', '-fliberate-case -ddump-liberate-case'])
 test('T23491d', [extra_files(['T23491.hs']), grep_errmsg(r'Static argument')], multimod_compile, ['T23491', '-fstatic-argument-transformation -ddump-static-argument-transformation'])
 test('T23074', normal, compile, ['-O -ddump-rules'])
+test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script'])


=====================================
testsuite/tests/th/all.T
=====================================
@@ -327,8 +327,8 @@ test('T10596', normal, compile, ['-v0'])
 test('T10598_TH', normal, compile, ['-v0 -dsuppress-uniques -ddump-splices'])
 test('T10620', normal, compile_and_run, ['-v0'])
 test('T10638', normal, compile_fail, ['-v0'])
-test('T10697_decided_1', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-v0'])
-test('T10697_decided_2', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-XStrictData -v0'])
+test('T10697_decided_1', normal, compile_and_run, ['-v0'])
+test('T10697_decided_2', normal, compile_and_run, ['-XStrictData -v0'])
 test('T10697_decided_3', normal, compile_and_run, ['-XStrictData -funbox-strict-fields -O2 -v0'])
 test('T10697_source', [], multimod_compile_and_run,
      ['T10697_source', '-w ' + config.ghc_th_way_flags])


=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -693,7 +693,7 @@ test('UnlifNewUnify', normal, compile, [''])
 test('UnliftedNewtypesLPFamily', normal, compile, [''])
 test('UnliftedNewtypesDifficultUnification', normal, compile, [''])
 test('LevPolyResult', normal, compile, [''])
-test('T16832', expect_broken_for(23272, ['ghci-opt']), ghci_script, ['T16832.script'])
+test('T16832', normal, ghci_script, ['T16832.script'])
 test('T15772', normal, compile, [''])
 test('T16995', normal, compile, [''])
 test('T17007', normal, compile, [''])


=====================================
testsuite/tests/typecheck/should_run/all.T
=====================================
@@ -76,10 +76,10 @@ test('IPRun', normal, compile_and_run, [''])
 test('IPLocation', normal, compile_and_run, [''])
 test('T10845', normal, compile_and_run, [''])
 test('T10846', normal, compile_and_run, [''])
-test('T16646', expect_broken_for(23272, ['ghci-opt']), compile_and_run, [''])
+test('T16646', normal, compile_and_run, [''])
 
 # Support files for T1735 are in directory T1735_Help/
-test('T1735', expect_broken_for(23272, ['ghci-opt']), multimod_compile_and_run, ['T1735',''])
+test('T1735', normal, multimod_compile_and_run, ['T1735',''])
 
 # The following two tests no longer compile
 # See Note [Inferring principal types] in Ghc.Tc.Solver



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6fdcf969db85f3fe64123ba150e9226a0d2995cd

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6fdcf969db85f3fe64123ba150e9226a0d2995cd
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/20230706/c7f40826/attachment-0001.html>


More information about the ghc-commits mailing list