[GHC] #11126: Entered absent arg in a Repa program

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Incorrect result Unknown/Multiple | at runtime Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Consider the following program. {{{#!hs module Main where import Data.Array.Repa data Stuff = !(Array U DIM1 Double) `With` !Double deriving Show through :: Maybe Double -> Stuff -> Stuff m `through` (a `With` _) = let b = a +^ (negate `smap` sumS (extend (Z :. All :. (1 :: Int)) a)) c = maybe b (const (negate `smap` a)) m in computeUnboxedS c `With` sumAllS b main :: IO () main = print $ Just 1 `through` (fromListUnboxed (Z :. 1) [1] `With` 1) }}} It should produce the following result once run. {{{#!hs AUnboxed (Z :. 1) (fromList [-1.0]) `With` 0.0 }}} However, when built using `repa-3.4.0.1` and compiled with the options `-O3 -Wall -funfolding-keeness-factor1000 -funfolding-use-threshold1000`, it crashes as follows. {{{#!hs Main: Oops! Entered absent arg arr2 Array D DIM1 Double }}} Adding `-fno-strictness` to the compiler options or removing strictness annotations from the code makes the problem disappear, so this looks like a strictness analyzer problem. The libraries used were * `QuickCheck-2.8.1`, * `array-0.5.1.0`, * `base-4.8.1.0`, * `bytestring-0.10.6.0`, * `containers-0.5.6.2`, * `deepseq-1.4.1.1`, * `ghc-prim-0.4.0.0`, * `integer-gmp-1.0.0.0`, * `pretty-1.1.2.0`, * `primitive-0.6`, * `random-1.1`, * `repa-3.4.0.1`, * `template-haskell-2.10.0.0`, * `tf-random-0.5`, * `time-1.5.0.1`, * `transformers-0.4.2.0` and * `vector-0.10.12.3`. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by thomie): I can not reproduce this bug with HEAD. To reproduce with ghc-7.10.2, `cabal install repa`, and compile the above example with `-O -funfolding-use-threshold=90` (`-funfolding-use- threshold=80` makes the bug go away). Maybe it is fixed. But I can't be certain: change the example ever so slightly, and the bug is not reproducible with ghc-7.10.2 either. Adding this as a test is difficult, because it depends on `repa`, and we don't want to add that to the testsuite. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: Type: bug | Status: new Priority: highest | Milestone: 8.0.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * priority: normal => highest * milestone: => 8.0.1 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: Type: bug | Status: new Priority: highest | Milestone: 8.0.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Can anyone reproduce this on HEAD or 8.0.1? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: Type: bug | Status: new Priority: highest | Milestone: 8.0.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): At the moment we can't reproduce this with 8.0.1 or HEAD, so we don't propose to fix it. tuplanolla: can you try with the release candidate for 8.0? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: Type: bug | Status: new Priority: highest | Milestone: 8.0.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by jscholl): I have a theory what is happening here: The important values here are {{{arr2}}} and some value called {{{get}}}. In the original definition {{{get}}} evaluates {{{arr2}}} and uses some component of it. Now {{{arr2}}} just is some tuple type ({{{ADelayed}}}) with two lazy fields. It is constructed by evaluating another value {{{arr}}} and then building this tuple. The second field of the tuple is just a thunk. So the simplifier inlines {{{arr2}}} in {{{get}}} and thus avoids building the tuple thing of {{{arr2}}}. Now the last reference to {{{arr2}}} was dropped. In the next run the simplifier replaces {{{arr2}}} with {{{absentError}}}. Shortly after that a reference to {{{arr2}}} appears again in the code. So what went wrong? {{{get}}} had an unfolding! In this unfolding it mentions {{{arr2}}} and the simplifier spots a position where it wants to inline {{{get}}}. Now we have a reference to {{{arr2}}} again because the unoptimized version of {{{get}}} is inlined. But this time we will optimize in a different way as {{{arr2}}} was incorrectly changed to {{{absentError}}}. So the main question would be: Does the compiler consider unfoldings when determining whether a value is unused and thus can be replaced by {{{absentError}}}? If not this could be the culprit. Sadly the bug relies on a very specific order of events in the compiler, so it will be hard to find a smaller test case for this. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program
-------------------------------------+-------------------------------------
Reporter: tuplanolla | Owner:
Type: bug | Status: new
Priority: highest | Milestone: 8.0.1
Component: Compiler | Version: 7.10.2
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
Type of failure: Incorrect result | Unknown/Multiple
at runtime | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by jscholl):
I could halfway reproduce this: The following program has an intermediate
state where a value ({{{arr2}}}) is marked with {{{

#11126: Entered absent arg in a Repa program
-------------------------------------+-------------------------------------
Reporter: tuplanolla | Owner:
Type: bug | Status: new
Priority: highest | Milestone: 8.0.1
Component: Compiler | Version: 7.10.2
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
Type of failure: Incorrect result | Unknown/Multiple
at runtime | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Changes (by jscholl):
* Attachment "Unfold.hs" added.
program with wrong intermediate

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: Type: bug | Status: new Priority: highest | Milestone: 8.0.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by jscholl): * Attachment "UnfoldDump" added. core2core log when compiling Unfold.hs -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: Type: bug | Status: new Priority: highest | Milestone: 8.0.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj):
So the main question would be: Does the compiler consider unfoldings when determining whether a value is unused and thus can be replaced by `absentError`?
I'm very impressed. You've waded though the swamp and indeed I think you have nailed a culprit. Whether it is ''the'' culprit in the original program I don't know, but this does look wrong. Just to lay it out, we have {{{ f x = let arr2 = ... let getIt :: Int -> Int [Unf = { Src=InlineStable, Tmpl=..arr2... }] getIt n = ...(no arr2)... in ... }}} So `arr2` is not used in `getIt`'s RHS (presumably because `arr2` has already been inlined into it, but it ''is'' used in `getIt`'s ''unfolding''. Moreover, it's a "stable" unfolding, meaning that it stays unaffected by transformations in `getIt`'s RHS. So the following sequence could happen * Strictness analysis thinks that `arr2` is unused * Worker-wrapper replaces its binding with `arr2 = absentError "blah"` * `getIt` is inlined at some call site, and lo! `arr2` is resurrected. Hmm. Now you have exposed this so well, it's clear that the demand analyser should take account of the free vars of the unfolding, at least so far as absence analysis is concerned. I'll look at how to do that. Most helpful. Please apply your forensic powers to other bugs :-). -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:7 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: Type: bug | Status: new Priority: high | Milestone: 8.0.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * priority: highest => high Comment: Right, now we understand what is going on. It's pretty difficult to tickle it and it seems OK in 8.0. So let's not make it a release blocker. Simon -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:8 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: Type: bug | Status: new Priority: high | Milestone: 8.0.2 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.0.1 => 8.0.2 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:9 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: Type: bug | Status: new Priority: high | Milestone: 8.2.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.0.2 => 8.2.1 Comment: nomeata, simonpj, was there ever any motion in the direction of a fix here? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:10 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: Type: bug | Status: new Priority: high | Milestone: 8.2.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Simon says, * It's rather rare so we just want to always account for unfolding's free variables in absence analysis * "When doing strictness analysis we don't want to make it appear that it will be used lazily if it's used strictness" -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:11 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: (none) Type: bug | Status: patch Priority: high | Milestone: 8.2.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3221 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => patch * differential: => Phab:D3221 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:12 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: bgamari Type: bug | Status: patch Priority: high | Milestone: 8.2.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3221 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * owner: (none) => bgamari -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:13 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: bgamari Type: bug | Status: patch Priority: high | Milestone: 8.4.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3221 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.2.1 => 8.4.1 Comment: While I have a patch for this, it breaks occurrence analysis and I doubt I'll have time to fix it before 8.2.1. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:14 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: bgamari Type: bug | Status: patch Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3221 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.4.1 => 8.6.1 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:15 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: (none) Type: bug | Status: patch Priority: high | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3221 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * owner: bgamari => (none) * milestone: 8.6.1 => Comment: I've not looked at this in some time. Unassigning. The patch is still there and still breaks one-shot analysis. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:16 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: (none) Type: bug | Status: patch Priority: high | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3221 Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): This is an error that came up repeatedly when I worked on my own usage analysis (which includes absence analysis). It was caused by RULEs (orphans and associated ones) and/or unfoldings in module `Lib` referencing otherwise absent/dead bindings, so that some binding (e.g. specialisations of an exported binding) that appeared to be dead could suddenly become alive when a specialisation fired in some client module `Main`. That lead to such an absent error, spread over multiple modules. FWIW, this won't frequently occur with the current demand analyser, because it assumes that *all* top-level bindings are alive instead of trying hard to find the minimal set, like the occurence analyser does. But this may pop up again e.g. for Call Arity, where the assumption is that only exported ids are such 'usage roots'. The disregard for RULEs and Unfoldings could lead, in theory, to a situation where we eta-expand a binding from arity 2 to arity 3 because every considered live call allows that, but some call in a RULE or Unfolding might still only have arity 2. Like in #10176, this could make bindings too lazy for their own good. The (naive) fix of treating Unfoldings/RULEs as an additional RHS of a binding (`if ? then orig_rhs else unfolding`) had detrimental effect on the precision of my usage analysis. I suspect this is the case here, too? In the end, I decided not to include the fix in order to be comparable to Call Arity and demand analysis, which is quite a shame. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:17 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: bgamari Type: bug | Status: patch Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3221 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * owner: (none) => bgamari * milestone: => 8.6.1 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:18 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program
-------------------------------------+-------------------------------------
Reporter: tuplanolla | Owner: bgamari
Type: bug | Status: patch
Priority: high | Milestone: 8.8.1
Component: Compiler | Version: 7.10.2
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
Type of failure: Incorrect result | Unknown/Multiple
at runtime | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s): Phab:D3221
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by Krzysztof Gogolewski

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: bgamari Type: bug | Status: patch Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3221 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): The patch in comment:20 does ''not'' fix the bug in this ticket, which is accurately diagnosed in comment:5. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:21 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11126: Entered absent arg in a Repa program -------------------------------------+------------------------------------- Reporter: tuplanolla | Owner: bgamari Type: bug | Status: patch Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 7.10.2 Resolution: | Keywords: | DemandAnalysis Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3221 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => DemandAnalysis -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11126#comment:22 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC