X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FData.hs;h=08bc68a63df6df1a0af57338a6a9142f629fbe37;hb=b99920eab7fba4e027fd39985840d4e854b8f923;hp=2a329973bdf162a501f0a61b91cc7bac84be439e;hpb=88c71497ea34789b25d87486548a88539af2ecde;p=ghc-base.git

diff --git a/Data/Data.hs b/Data/Data.hs
index 2a32997..08bc68a 100644
--- a/Data/Data.hs
+++ b/Data/Data.hs
@@ -114,7 +114,6 @@ import Data.Maybe
 import Control.Monad
 
 -- Imports for the instances
-import Data.Typeable
 import Data.Int              -- So we can give Data instance for Int8, ...
 import Data.Word             -- So we can give Data instance for Word8, ...
 #ifdef __GLASGOW_HASKELL__
@@ -311,20 +310,24 @@ class Typeable a => Data a where
   --
   gmapT f x0 = unID (gfoldl k ID x0)
     where
+      k :: Data d => ID (d->b) -> d -> ID b
       k (ID c) x = ID (c (f x))
 
 
   -- | A generic query with a left-associative binary operator
-  gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
+  gmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
   gmapQl o r f = unCONST . gfoldl k z
     where
+      k :: Data d => CONST r (d->b) -> d -> CONST r b
       k c x = CONST $ (unCONST c) `o` f x
+      z :: g -> CONST r g
       z _   = CONST r
 
   -- | A generic query with a right-associative binary operator
-  gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
+  gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
   gmapQr o r0 f x0 = unQr (gfoldl k (const (Qr id)) x0) r0
     where
+      k :: Data d => Qr r (d->b) -> d -> Qr r b
       k (Qr c) x = Qr (\r -> c (f x `o` r))
 
 
@@ -336,10 +339,12 @@ class Typeable a => Data a where
 
 
   -- | A generic query that processes one child by index (zero-based)
-  gmapQi :: Int -> (forall d. Data d => d -> u) -> a -> u
+  gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> a -> u
   gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q }
     where
+      k :: Data d => Qi u (d -> b) -> d -> Qi u b
       k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q)
+      z :: g -> Qi q g
       z _           = Qi 0 Nothing
 
 
@@ -348,7 +353,7 @@ class Typeable a => Data a where
   -- The default definition instantiates the type constructor @c@ in
   -- the type of 'gfoldl' to the monad datatype constructor, defining
   -- injection and projection using 'return' and '>>='.
-  gmapM   :: Monad m => (forall d. Data d => d -> m d) -> a -> m a
+  gmapM :: forall m. Monad m => (forall d. Data d => d -> m d) -> a -> m a
 
   -- Use immediately the monad datatype constructor 
   -- to instantiate the type constructor c in the type of gfoldl,
@@ -356,13 +361,14 @@ class Typeable a => Data a where
   --  
   gmapM f = gfoldl k return
     where
+      k :: Data d => m (d -> b) -> d -> m b
       k c x = do c' <- c
                  x' <- f x
                  return (c' x')
 
 
   -- | Transformation of at least one immediate subterm does not fail
-  gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
+  gmapMp :: forall m. MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
 
 {-
 
@@ -375,7 +381,9 @@ this end, we couple the monadic computation with a Boolean.
   gmapMp f x = unMp (gfoldl k z x) >>= \(x',b) ->
                 if b then return x' else mzero
     where
+      z :: g -> Mp m g
       z g = Mp (return (g,False))
+      k :: Data d => Mp m (d -> b) -> d -> Mp m b
       k (Mp c) y
         = Mp ( c >>= \(h, b) ->
                  (f y >>= \y' -> return (h y', True))
@@ -383,7 +391,7 @@ this end, we couple the monadic computation with a Boolean.
              )
 
   -- | Transformation of one immediate subterm with success
-  gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
+  gmapMo :: forall m. MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
 
 {-
 
@@ -398,7 +406,9 @@ was transformed successfully.
   gmapMo f x = unMp (gfoldl k z x) >>= \(x',b) ->
                 if b then return x' else mzero
     where
+      z :: g -> Mp m g
       z g = Mp (return (g,False))
+      k :: Data d => Mp m (d -> b) -> d -> Mp m b
       k (Mp c) y
         = Mp ( c >>= \(h,b) -> if b
                         then return (h y, b)
@@ -447,18 +457,24 @@ fromConstrB :: Data a
             -> a
 fromConstrB f = unID . gunfold k z
  where
+  k :: forall b r. Data b => ID (b -> r) -> ID r
   k c = ID (unID c f)
+ 
+  z :: forall r. r -> ID r
   z = ID
 
 
 -- | Monadic variation on 'fromConstrB'
-fromConstrM :: (Monad m, Data a)
+fromConstrM :: forall m a. (Monad m, Data a)
             => (forall d. Data d => m d)
             -> Constr
             -> m a
 fromConstrM f = gunfold k z
  where
+  k :: forall b r. Data b => m (b -> r) -> m r
   k c = do { c' <- c; b <- f; return (c' b) }
+
+  z :: forall r. r -> m r
   z = return
 
 
@@ -481,8 +497,9 @@ data DataType = DataType
 
               deriving Show
 
-
--- | Representation of constructors
+-- | Representation of constructors. Note that equality on constructors
+-- with different types may not work -- i.e. the constructors for 'False' and
+-- 'Nothing' may compare equal.
 data Constr = Constr
                         { conrep    :: ConstrRep
                         , constring :: String
@@ -501,11 +518,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
 
@@ -514,11 +529,9 @@ data DataRep = AlgRep [Constr]
 
 
 -- | Public representation of constructors
-{-# DEPRECATED StringConstr "Use CharConstr instead" #-}
 data ConstrRep = AlgConstr    ConIndex
                | IntConstr    Integer
                | FloatConstr  Rational
-               | StringConstr String -- ^ Deprecated. Please use 'CharConstr' instead.
                | CharConstr   Char
 
                deriving (Eq,Show)
@@ -571,7 +584,6 @@ repConstr dt cr =
         (AlgRep cs, AlgConstr i)      -> cs !! (i-1)
         (IntRep,    IntConstr i)      -> mkIntConstr dt i
         (FloatRep,  FloatConstr f)    -> mkRealConstr dt f
-        (StringRep, StringConstr str) -> mkStringConstr dt str
         (CharRep,   CharConstr c)     -> mkCharConstr dt c
         _ -> error "repConstr"
 
@@ -645,8 +657,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
@@ -664,6 +675,8 @@ readConstr dt str =
                      then Nothing
                      else Just (head fit)
 
+    ffloat :: Double -> Constr
+    ffloat =  mkPrimCon dt str . FloatConstr . toRational
 
 ------------------------------------------------------------------------------
 --
@@ -721,7 +734,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
@@ -769,9 +782,12 @@ mkRealConstr dt f = case datarep dt of
 -- | 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