X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FFixed.hs;fp=Data%2FFixed.hs;h=98d212defda15f778e4b6bdf69cc7cb957bee6a6;hb=b67a3cfb689ed881cb663a0cf78aeab725d55e35;hp=bb76e01a3b4c89dc8ab9ffd0d7502f454b2e78e9;hpb=d05ee4e82cea5d9ff651bdd7ac65b9908c0ae20e;p=ghc-base.git

diff --git a/Data/Fixed.hs b/Data/Fixed.hs
index bb76e01..98d212d 100644
--- a/Data/Fixed.hs
+++ b/Data/Fixed.hs
@@ -35,6 +35,8 @@ 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
@@ -152,9 +154,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__