Commits

dafis  committed b643fd3

Newtypes to display in full precision

  • Participants
  • Parent commits 82fa6a3

Comments (0)

Files changed (1)

File Text/FShow/RealFloat.hs

     , fshowFFloat
     , fshowGFloat
     , Double7(..)
+    , FullDouble(..)
     , Float7(..)
+    , FullFloat(..)
     ) where
 
 import GHC.Show
+import GHC.Read
 import GHC.Float (showSignedFloat)
 import Text.FShow.RealFloat.Internals
 
   fshowsPrec p  = showSignedFloat fshowFloat p
   fshowList     = showList__ (fshowsPrec 0)
 
+-- | newtype wrapper for 'Double'. The 'Show' (and 'FShow') instance
+--   displays all significant digits.
+newtype FullDouble = FD { unFD :: Double }
+  deriving (Eq, Ord, Num, Fractional, Real, RealFrac, Floating, RealFloat)
+
+instance DispFloat FullDouble where
+  decDigits (FD x)  = case decodeFloat x of
+                        (_,e) -> case ((53+e)*8651) `quot` 28738 of
+                                   q | e >= 0    -> q+2
+                                     | e > (-53) -> q+1-e
+                                     | otherwise -> q-e
+  binExp _          = 52
+
+instance Show FullDouble where
+  showsPrec p = showSignedFloat fshowFloat p
+
+instance FShow FullDouble where
+  fshowsPrec p = showSignedFloat fshowFloat p
+  fshowList     = showList__ (fshowsPrec 0)
+
+instance Read FullDouble where
+  readPrec = fmap FD readPrec
+  readListPrec = readListPrecDefault
+
 -- | newtype wrapper for 'Float'. The 'Show' (and 'FShow') instance
 --   displays numbers rounded to seven significant digits.
 newtype Float7 = F7 Float
   fshowsPrec p  = showSignedFloat fshowFloat p
   fshowList     = showList__ (fshowsPrec 0)
 
+-- | newtype wrapper for 'Double'. The 'Show' (and 'FShow') instance
+--   displays all significant digits.
+newtype FullFloat = FF { unFF :: Float }
+  deriving (Eq, Ord, Num, Fractional, Real, RealFrac, Floating, RealFloat)
+
+instance DispFloat FullFloat where
+  decDigits (FF x)  = case decodeFloat x of
+                        (_,e) -> case ((24+e)*8651) `quot` 28738 of
+                                   q | e >= 0    -> q+2
+                                     | e > (-24) -> q+1-e
+                                     | otherwise -> q-e
+  binExp _          = 23
+
+instance Show FullFloat where
+  showsPrec p = showSignedFloat fshowFloat p
+
+instance FShow FullFloat where
+  fshowsPrec p = showSignedFloat fshowFloat p
+  fshowList     = showList__ (fshowsPrec 0)
+
+instance Read FullFloat where
+  readPrec = fmap FF readPrec
+  readListPrec = readListPrecDefault
+
 {-
     The code below is a minor modification of code from GHC.Float
     and Numeric from the base package. The GHC Licence is included