X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FFixed.hs;h=cd4409295b95c79dbe5ad5ec67034097d5524097;hb=HEAD;hp=bb76e01a3b4c89dc8ab9ffd0d7502f454b2e78e9;hpb=23678400d8eb74b70a42f74cefb76d679369fe21;p=ghc-base.git

diff --git a/Data/Fixed.hs b/Data/Fixed.hs
index bb76e01..cd44092 100644
--- a/Data/Fixed.hs
+++ b/Data/Fixed.hs
@@ -1,5 +1,9 @@
+{-# LANGUAGE CPP #-}
 {-# OPTIONS -Wall -fno-warn-unused-binds #-}
 
+#ifndef __NHC__
+{-# LANGUAGE DeriveDataTypeable #-}
+#endif
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Fixed
@@ -35,6 +39,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 +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__