even more vooodo!

Author: MaximilianAlgehed

src/Constrained/NumOrd.hs

@@ -730,24 +730,32 @@ instance {-# OVERLAPPABLE #-} (HasSpec a, MaybeBounded a, Integral a, TypeSpec a
   doDivide = div
 
   divideSpec 0 _ = TrueSpec
-  -- TODO This is all wrong and hence the tests are all wrong
   divideSpec a (NumSpecInterval (unionWithMaybe max lowerBound -> ml) (unionWithMaybe min upperBound -> mu)) = typeSpec ts
     where
       ts | a > 0 = NumSpecInterval ml' mu'
          | otherwise = NumSpecInterval mu' ml'
       ml' = adjustLowerBound <$> ml
       mu' = adjustUpperBound <$> mu
-      adjustLowerBound l =
-        let r = l `div` a in
-        if r * a < l
-        then r + signum a
-        else r
 
-      adjustUpperBound u =
-        let r = u `div` a in
-        if r * a > u
-        then r - signum a
-        else r
+      -- NOTE: negate has different overflow semantics than div, so that's why we use negate below...
+
+      adjustLowerBound l
+        | a == 1 = l
+        | a == -1 = negate l
+        | otherwise =
+          let r = l `div` a in
+          if r * a < l
+          then r + signum a
+          else r
+
+      adjustUpperBound u
+        | a == 1  = u
+        | a == -1 = negate u
+        | otherwise =
+          let r = u `div` a in
+          if r * a > u
+          then r - signum a
+          else r
 
 instance HasDivision Float where
   doDivide = (/)