add GHC.HetMet.{hetmet_kappa,hetmet_kappa_app}
[ghc-base.git] / Data / Fixed.hs
index d38bfac..cd44092 100644 (file)
@@ -1,5 +1,9 @@
+{-# LANGUAGE CPP #-}
 {-# OPTIONS -Wall -fno-warn-unused-binds #-}
 
+#ifndef __NHC__
+{-# LANGUAGE DeriveDataTypeable #-}
+#endif
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Fixed
@@ -35,12 +39,16 @@ module Data.Fixed
 ) where
 
 import Prelude -- necessary to get dependencies right
+import Data.Char
+import Data.List
 #ifndef __NHC__
 import Data.Typeable
 import Data.Data
 #endif
 
+#ifndef __NHC__
 default () -- avoid any defaulting shenanigans
+#endif
 
 -- | generalisation of 'div' to any instance of Real
 div' :: (Real a,Integral b) => a -> a -> b
@@ -150,9 +158,30 @@ showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZe
     maxnum = 10 ^ digits
     fracNum = div (d * maxnum) res
 
+readsFixed :: (HasResolution a) => ReadS (Fixed a)
+readsFixed = readsSigned
+    where readsSigned ('-' : xs) = [ (negate x, rest)
+                                   | (x, rest) <- readsUnsigned xs ]
+          readsSigned xs = readsUnsigned xs
+          readsUnsigned xs = case span isDigit xs of
+                             ([], _) -> []
+                             (is, xs') ->
+                                 let i = fromInteger (read is)
+                                 in case xs' of
+                                    '.' : xs'' ->
+                                        case span isDigit xs'' of
+                                        ([], _) -> []
+                                        (js, xs''') ->
+                                            let j = fromInteger (read js)
+                                                l = genericLength js :: Integer
+                                            in [(i + (j / (10 ^ l)), xs''')]
+                                    _ -> [(i, xs')]
+
 instance (HasResolution a) => Show (Fixed a) where
     show = showFixed False
 
+instance (HasResolution a) => Read (Fixed a) where
+    readsPrec _ = readsFixed
 
 data E0 = E0
 #ifndef __NHC__