ref: 653921c9a3819e1b0260f72ef1e2eb44db8a34fc
parent: 1ae323f927922ea500097175e2dfebaa1776cb15
author: Lennart Augustsson <lennart@augustsson.net>
date: Fri Apr 26 10:48:44 EDT 2024
Make Float and Double different types.
--- /dev/null
+++ b/lib/Data/Double.hs
@@ -1,0 +1,92 @@
+module Data.Double(Double) where
+import Prelude()
+import Primitives
+import Data.Bool
+import Data.Eq
+import Data.FloatW
+import Data.Floating
+import Data.Fractional
+import Data.Function
+import Data.List
+import Data.Num
+import Data.Ord
+import Data.Real
+import Data.RealFloat
+import Data.RealFrac
+import Text.Read
+import Text.Show
+
+-- XXX I should really implement newtype deriving...
+
+newtype Double = D FloatW
+unD :: Double -> FloatW
+unD (D x) = x
+
+un :: (FloatW -> FloatW) -> (Double -> Double)
+un f x = D (f (unD x))
+
+bin :: (FloatW -> FloatW -> FloatW) -> (Double -> Double -> Double)
+bin f x y = D (f (unD x) (unD y))
+
+cmp :: (FloatW -> FloatW -> Bool) -> (Double -> Double -> Bool)
+cmp f x y = f (unD x) (unD y)
+
+instance Num Double where
+ (+) = bin (+)
+ (-) = bin (-)
+ (*) = bin (*)
+ negate = un negate
+ abs = un abs
+ signum = un signum
+ fromInteger = D . fromInteger
+
+instance Fractional Double where
+ (/) = bin (/)
+ fromRational = D . fromRational
+
+instance Eq Double where
+ (==) = cmp (==)
+ (/=) = cmp (/=)
+
+instance Ord Double where
+ (<) = cmp (<)
+ (<=) = cmp (<=)
+ (>) = cmp (>)
+ (>=) = cmp (>=)
+
+instance Show Double where
+ showsPrec p = showsPrec p . unD
+
+instance Read Double where
+ readsPrec p = map (\ (x, s) -> (D x, s)) . readsPrec p
+
+instance Real Double where
+ toRational = toRational . unD
+
+instance RealFrac Double where
+ properFraction x = (a, D b) where (a, b) = properFraction (unD x)
+
+instance Floating Double where
+ pi = D pi
+ log = un log
+ exp = un exp
+ sqrt = un sqrt
+ sin = un sin
+ cos = un cos
+ tan = un tan
+ asin = un asin
+ acos = un acos
+ atan = un atan
+
+instance RealFloat Double where
+ floatRadix = floatRadix . unD
+ floatDigits = floatDigits . unD
+ floatRange = floatRange . unD
+ decodeFloat = decodeFloat . unD
+ encodeFloat e = D . encodeFloat e
+ isNaN = isNaN . unD
+ isInfinite = isInfinite . unD
+ isDenormalized = isDenormalized . unD
+ isNegativeZero = isNegativeZero . unD
+ isIEEE = isIEEE . unD
+ atan2 = bin atan2
--- /dev/null
+++ b/lib/Data/Float.hs
@@ -1,0 +1,92 @@
+module Data.Float(Float) where
+import Prelude()
+import Primitives
+import Data.Bool
+import Data.Eq
+import Data.FloatW
+import Data.Floating
+import Data.Fractional
+import Data.Function
+import Data.List
+import Data.Num
+import Data.Ord
+import Data.Real
+import Data.RealFloat
+import Data.RealFrac
+import Text.Read
+import Text.Show
+
+-- XXX I should really implement newtype deriving...
+
+newtype Float = D FloatW
+unD :: Float -> FloatW
+unD (D x) = x
+
+un :: (FloatW -> FloatW) -> (Float -> Float)
+un f x = D (f (unD x))
+
+bin :: (FloatW -> FloatW -> FloatW) -> (Float -> Float -> Float)
+bin f x y = D (f (unD x) (unD y))
+
+cmp :: (FloatW -> FloatW -> Bool) -> (Float -> Float -> Bool)
+cmp f x y = f (unD x) (unD y)
+
+instance Num Float where
+ (+) = bin (+)
+ (-) = bin (-)
+ (*) = bin (*)
+ negate = un negate
+ abs = un abs
+ signum = un signum
+ fromInteger = D . fromInteger
+
+instance Fractional Float where
+ (/) = bin (/)
+ fromRational = D . fromRational
+
+instance Eq Float where
+ (==) = cmp (==)
+ (/=) = cmp (/=)
+
+instance Ord Float where
+ (<) = cmp (<)
+ (<=) = cmp (<=)
+ (>) = cmp (>)
+ (>=) = cmp (>=)
+
+instance Show Float where
+ showsPrec p = showsPrec p . unD
+
+instance Read Float where
+ readsPrec p = map (\ (x, s) -> (D x, s)) . readsPrec p
+
+instance Real Float where
+ toRational = toRational . unD
+
+instance RealFrac Float where
+ properFraction x = (a, D b) where (a, b) = properFraction (unD x)
+
+instance Floating Float where
+ pi = D pi
+ log = un log
+ exp = un exp
+ sqrt = un sqrt
+ sin = un sin
+ cos = un cos
+ tan = un tan
+ asin = un asin
+ acos = un acos
+ atan = un atan
+
+instance RealFloat Float where
+ floatRadix = floatRadix . unD
+ floatDigits = floatDigits . unD
+ floatRange = floatRange . unD
+ decodeFloat = decodeFloat . unD
+ encodeFloat e = D . encodeFloat e
+ isNaN = isNaN . unD
+ isInfinite = isInfinite . unD
+ isDenormalized = isDenormalized . unD
+ isNegativeZero = isNegativeZero . unD
+ isIEEE = isIEEE . unD
+ atan2 = bin atan2
--- a/lib/Prelude.hs
+++ b/lib/Prelude.hs
@@ -46,10 +46,12 @@
import Data.Bool(Bool(..), (&&), (||), not, otherwise)
import Data.Bounded(Bounded(..))
import Data.Char(Char, String)
+import Data.Double(Double)
import Data.FloatW(FloatW)
import Data.Either(Either(..), either)
import Data.Enum(Enum(..))
import Data.Eq(Eq(..))
+import Data.Float(Float)
import Data.Floating(Floating(..))
import Data.Fractional(Fractional(..), (^^))
import Data.Function(id, const, (.), flip, ($), seq, ($!), until, curry, uncurry, asTypeOf)
@@ -88,6 +90,3 @@
-- So we can detect mhs vs ghc
usingMhs :: Bool
usingMhs = True
-
-type Float = FloatW
-type Double = FloatW
--
⑨