[GHC] #15686: Different results depending on if the code was compiled with or without optimizations

[GHC]

#15686: Different results depending on if the code was compiled with or without
optimizations
-------------------------------------+-------------------------------------
           Reporter:  Darwin226      |             Owner:  (none)
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:  8.6.1
          Component:  Compiler       |           Version:  8.2.2
           Keywords:                 |  Operating System:  Windows
       Architecture:  x86_64         |   Type of failure:  Incorrect result
  (amd64)                            |  at runtime
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 The test case consists of three files:

 Main.hs
 {{{#!hs
 {-# LANGUAGE OverloadedLists, BangPatterns #-}
 {-# OPTIONS_GHC -ddump-simpl -dsuppress-all -ddump-to-file #-}
 module Main where

 import Mesh
 import Vec
 import Control.Exception

 main :: IO ()
 main = do
     !_ <- evaluate $ toBondForce (Particle {_position = Vec {_vecX = 0.0,
 _vecY = -20.0}, _mass = 10.0, _velocity = Vec {_vecX = 0.0, _vecY = 3.0}})
 (Particle {_position = Vec {_vecX = 20.0, _vecY = -20.0}, _mass = 10.0,
 _velocity = Vec {_vecX = 0.0, _vecY = 0.0}}) (FixedDistanceBond {_distance
 = 20.0, _strength = 0.5})
     return ()
 }}}

 Vec.hs
 {{{#!hs
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts,
 FunctionalDependencies #-}
 module Vec where

 data Vec = Vec { _vecX :: {-# UNPACK #-}!Double, _vecY :: {-# UNPACK
 #-}!Double }
     deriving (Eq, Ord, Read, Show)

 liftVec :: (Double -> Double -> Double) -> Vec -> Vec -> Vec
 liftVec f (Vec x y) (Vec z w) = Vec (f x z) (f y w)
 {-# INLINE liftVec #-}

 instance Num Vec where
     fromInteger i = Vec (fromInteger i) (fromInteger i)
     (+) a b = liftVec (+) a b
     {-# INLINE (+) #-}
     (*) a b = liftVec (*) a b
     {-# INLINE (*) #-}
     (-) a b = liftVec (-) a b
     {-# INLINE (-) #-}
     signum (Vec x y) = Vec (signum x) (signum y)
     abs (Vec x y) = Vec (abs x) (abs y)
 instance Fractional Vec where
     fromRational r = Vec (fromRational r) (fromRational r)
     (/) = liftVec (/)
     {-# INLINE (/) #-}

 fromDouble :: Double -> Vec
 fromDouble x = Vec x x
 {-# INLINE fromDouble #-}

 class Vector2D v where
     norm :: v -> Double
     normalize :: v -> v
     distance :: v -> v -> Double
     dot :: v -> v -> Double
     project :: v -> v -> v

 instance Vector2D Vec where
     norm (Vec x y) = sqrt (x ** 2 + y ** 2)
     {-# INLINE norm #-}

     normalize v@(Vec x y) = Vec (x / n) (y / n)
         where
         n = norm v
     {-# INLINE normalize #-}

     distance v1 v2 = norm (v2 - v1)
     {-# INLINE distance #-}

     dot (Vec x y) (Vec z w) = x * z + y * w
     {-# INLINE dot #-}

     project tgt v = normTgt * realToFrac (dot normTgt v)
         where normTgt = normalize tgt
     {-# INLINE project #-}

 }}}

 Mesh.hs
 {{{#!hs
 {-# LANGUAGE Strict, RecordWildCards, TemplateHaskell, BangPatterns #-}
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts,
 FunctionalDependencies #-}
 {-# OPTIONS_GHC -ddump-simpl -dsuppress-all -ddump-to-file #-}
 module Mesh where

 import Vec
 import Debug.Trace

 data Particle = Particle
     { _position :: {-# UNPACK #-}!Vec
     , _mass :: {-# UNPACK #-}!Double
     , _velocity :: {-# UNPACK #-}!Vec }
     deriving (Eq, Ord, Read, Show)

 data Bond = FixedDistanceBond
     { _distance :: {-# UNPACK #-}!Double
     , _strength :: {-# UNPACK #-}!Double }
     deriving (Eq, Ord, Read, Show)

 toBondForce :: Particle -> Particle -> Bond -> Vec
 toBondForce Particle{..} !p2 FixedDistanceBond{..} =
     traceShow (show (Mesh._position p2, dir)) $ dir * fromDouble
 (actualDist - _distance) * fromDouble _strength - project dir velDiff *
 0.1
     where
     posDiff = Mesh._position p2 - _position
     dir = normalize posDiff
     actualDist = norm posDiff
     velDiff = _velocity - Mesh._velocity p2

 }}}

 Compiling Main.hs with optimizations (-O2) and running the program
 produces the output "(Vec {_vecX = 20.0, _vecY = 0.0},Vec {_vecX = 1.0,
 _vecY = 0.0})" while compiling without optimizations produces "(Vec {_vecX
 = 20.0, _vecY = -20.0},Vec {_vecX = 1.0, _vecY = 0.0})" which is correct.

 Further observations:
 Changing `traceShow (show (Mesh._position p2, dir))` to `traceShow (show
 (Mesh._position p2))` makes the code perform correctly even with
 optimizations.
 The core output looks correct to me even with optimizations.

 I can't test with other GHC versions on Windows, but I know I can't
 reproduce this with GHC 8.4 on Linux and I think it also doesn't reproduce
 with 8.2 on Linux.

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15686>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler