voodo magic!

Author: MaximilianAlgehed

src/Constrained/NumOrd.hs

@@ -759,15 +759,47 @@ instance HasDivision Float where
          | otherwise = NumSpecInterval mu' ml'
       ml' = adjustLowerBound <$> ml
       mu' = adjustUpperBound <$> mu
-      adjustLowerBound l = l / a
+      adjustLowerBound l =
+        let r = l / a
+            l' = r * a
+        in
+        if l' < l
+        then r + (l - l') * 2 * signum a
+        else r
 
-      adjustUpperBound u = u / a
+      adjustUpperBound u =
+        let r = u / a
+            u' = r * a
+        in
+        if u < u'
+        then r - (u' - u) * 2 * signum a
+        else r
 
 instance HasDivision Double where
   doDivide = (/)
 
   divideSpec 0 _ = TrueSpec
-  divideSpec a (NumSpecInterval ml mu) = typeSpec $ NumSpecInterval ((/a) <$> ml) ((/a) <$> mu)
+  divideSpec a (NumSpecInterval ml 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 / a
+            l' = r * a
+        in
+        if l' < l
+        then r + (l - l') * 2 * signum a
+        else r
+
+      adjustUpperBound u =
+        let r = u / a
+            u' = r * a
+        in
+        if u < u'
+        then r - (u' - u) * 2 * signum a
+        else r
 
 -- | A type that we can reason numerically about in constraints
 type Numeric a = (HasSpec a, Ord a, Num a, TypeSpec a ~ NumSpec a, MaybeBounded a, HasDivision a)