Rules to make genericLength strict for Int/Integer lengths, see #2962

[ghc-base.git] / Data / Data.hs

diff --git a/Data/Data.hs b/Data/Data.hs
index eaa6ae2..8c746dd 100644 (file)
--- a/Data/Data.hs
+++ b/Data/Data.hs
@@ -76,7 +76,9 @@ module Data.Data (
         -- ** Constructors
         mkConstr,       -- :: DataType -> String -> Fixity -> Constr
         mkIntConstr,    -- :: DataType -> Integer -> Constr
-        mkFloatConstr,  -- :: DataType -> Double  -> Constr
+        mkFloatConstr,  -- :: DataType -> Double -> Constr
+        mkIntegralConstr,-- :: (Integral a) => DataType -> a -> Constr
+        mkRealConstr,   -- :: (Real a) => DataType -> a -> Constr
         mkStringConstr, -- :: DataType -> String  -> Constr
         mkCharConstr,   -- :: DataType -> Char -> Constr
         -- ** Observers
@@ -499,11 +501,9 @@ instance Eq Constr where
 
 
 -- | Public representation of datatypes
-{-# DEPRECATED StringRep "Use CharRep instead" #-}
 data DataRep = AlgRep [Constr]
              | IntRep
              | FloatRep
-             | StringRep -- ^ Deprecated. Please use 'CharRep' instead.
              | CharRep
              | NoRep
 
@@ -512,11 +512,9 @@ data DataRep = AlgRep [Constr]
 
 
 -- | Public representation of constructors
-{-# DEPRECATED StringConstr "Use CharConstr instead" #-}
 data ConstrRep = AlgConstr    ConIndex
                | IntConstr    Integer
-               | FloatConstr  Double
-               | StringConstr String -- ^ Deprecated. Please use 'CharConstr' instead.
+               | FloatConstr  Rational
                | CharConstr   Char
 
                deriving (Eq,Show)
@@ -568,8 +566,7 @@ repConstr dt cr =
       case (dataTypeRep dt, cr) of
         (AlgRep cs, AlgConstr i)      -> cs !! (i-1)
         (IntRep,    IntConstr i)      -> mkIntConstr dt i
-        (FloatRep,  FloatConstr f)    -> mkFloatConstr dt f
-        (StringRep, StringConstr str) -> mkStringConstr dt str
+        (FloatRep,  FloatConstr f)    -> mkRealConstr dt f
         (CharRep,   CharConstr c)     -> mkCharConstr dt c
         _ -> error "repConstr"
 
@@ -643,8 +640,7 @@ readConstr dt str =
       case dataTypeRep dt of
         AlgRep cons -> idx cons
         IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
-        FloatRep    -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f)))
-        StringRep   -> Just (mkStringConstr dt str)
+        FloatRep    -> mkReadCon ffloat
         CharRep     -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
         NoRep       -> Nothing
   where
@@ -662,6 +658,8 @@ readConstr dt str =
                      then Nothing
                      else Just (head fit)
 
+    ffloat :: Double -> Constr
+    ffloat =  mkPrimCon dt str . FloatConstr . toRational
 
 ------------------------------------------------------------------------------
 --
@@ -719,7 +717,7 @@ mkFloatType = mkPrimType FloatRep
 -- | This function is now deprecated. Please use 'mkCharType' instead.
 {-# DEPRECATED mkStringType "Use mkCharType instead" #-}
 mkStringType :: String -> DataType
-mkStringType = mkPrimType StringRep
+mkStringType = mkCharType
 
 -- | Constructs the 'Char' type
 mkCharType :: String -> DataType
@@ -744,24 +742,35 @@ mkPrimCon dt str cr = Constr
                         , confixity = error "constrFixity"
                         }
 
-
+-- | This function is now deprecated. Please use 'mkIntegralConstr' instead.
+{-# DEPRECATED mkIntConstr "Use mkIntegralConstr instead" #-}
 mkIntConstr :: DataType -> Integer -> Constr
-mkIntConstr dt i = case datarep dt of
-                  IntRep -> mkPrimCon dt (show i) (IntConstr i)
-                  _ -> error "mkIntConstr"
+mkIntConstr = mkIntegralConstr
 
+mkIntegralConstr :: (Integral a) => DataType -> a -> Constr
+mkIntegralConstr dt i = case datarep dt of
+                  IntRep -> mkPrimCon dt (show i) (IntConstr (toInteger  i))
+                  _ -> error "mkIntegralConstr"
 
+-- | This function is now deprecated. Please use 'mkRealConstr' instead.
+{-# DEPRECATED mkFloatConstr "Use mkRealConstr instead" #-}
 mkFloatConstr :: DataType -> Double -> Constr
-mkFloatConstr dt f = case datarep dt of
-                    FloatRep -> mkPrimCon dt (show f) (FloatConstr f)
-                    _ -> error "mkFloatConstr"
+mkFloatConstr dt = mkRealConstr dt . toRational
+
+mkRealConstr :: (Real a) => DataType -> a -> Constr
+mkRealConstr dt f = case datarep dt of
+                    FloatRep -> mkPrimCon dt (show f) (FloatConstr (toRational f))
+                    _ -> error "mkRealConstr"
 
 -- | This function is now deprecated. Please use 'mkCharConstr' instead.
 {-# DEPRECATED mkStringConstr "Use mkCharConstr instead" #-}
 mkStringConstr :: DataType -> String -> Constr
-mkStringConstr dt str = case datarep dt of
-                       StringRep -> mkPrimCon dt str (StringConstr str)
-                       _ -> error "mkStringConstr"
+mkStringConstr dt str =
+  case datarep dt of
+    CharRep -> case str of
+      [c] -> mkPrimCon dt (show c) (CharConstr c)
+      _ -> error "mkStringConstr: input String must contain a single character"
+    _ -> error "mkStringConstr"
 
 -- | Makes a constructor for 'Char'.
 mkCharConstr :: DataType -> Char -> Constr
@@ -875,7 +884,7 @@ floatType :: DataType
 floatType = mkFloatType "Prelude.Float"
 
 instance Data Float where
-  toConstr x = mkFloatConstr floatType (realToFrac x)
+  toConstr = mkRealConstr floatType
   gunfold _ z c = case constrRep c of
                     (FloatConstr x) -> z (realToFrac x)
                     _ -> error "gunfold"
@@ -888,9 +897,9 @@ doubleType :: DataType
 doubleType = mkFloatType "Prelude.Double"
 
 instance Data Double where
-  toConstr = mkFloatConstr floatType
+  toConstr = mkRealConstr doubleType
   gunfold _ z c = case constrRep c of
-                    (FloatConstr x) -> z x
+                    (FloatConstr x) -> z (realToFrac x)
                     _ -> error "gunfold"
   dataTypeOf _ = doubleType