From: simonpj@microsoft.com <unknown>
Date: Wed, 28 Jul 2010 12:48:47 +0000 (+0000)
Subject: Add type signatures to cope with lack of local generalisation
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=54d739df8e016b7e1c676618175a846664078872;p=ghc-base.git

Add type signatures to cope with lack of local generalisation
---

diff --git a/Control/Arrow.hs b/Control/Arrow.hs
index f3c1de2..55e004d 100644
--- a/Control/Arrow.hs
+++ b/Control/Arrow.hs
@@ -74,7 +74,8 @@ class Category a => Arrow a where
         --   version if desired.
         second :: a b c -> a (d,b) (d,c)
         second f = arr swap >>> first f >>> arr swap
-                        where   swap ~(x,y) = (y,x)
+                        where   swap :: (x,y) -> (y,x)
+                                swap ~(x,y) = (y,x)
 
         -- | Split the input between the two argument arrows and combine
         --   their output.  Note that this is in general not a functor.
@@ -182,7 +183,8 @@ class Arrow a => ArrowChoice a where
         --   version if desired.
         right :: a b c -> a (Either d b) (Either d c)
         right f = arr mirror >>> left f >>> arr mirror
-                        where   mirror (Left x) = Right x
+                        where   mirror :: Either x y -> Either y x
+                                mirror (Left x) = Right x
                                 mirror (Right y) = Left y
 
         -- | Split the input between the two argument arrows, retagging
diff --git a/Data/Data.hs b/Data/Data.hs
index 27f42fe..08bc68a 100644
--- a/Data/Data.hs
+++ b/Data/Data.hs
@@ -310,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))
 
 
@@ -335,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
 
 
@@ -347,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,
@@ -355,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
 
 {-
 
@@ -374,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))
@@ -382,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
 
 {-
 
@@ -397,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)
@@ -446,7 +457,10 @@ 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
 
 
@@ -457,7 +471,7 @@ fromConstrM :: forall m a. (Monad m, Data a)
             -> m a
 fromConstrM f = gunfold k z
  where
-  k :: (forall b r. Data b => m (b -> r) -> m r)
+  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
diff --git a/System/IO/Error.hs b/System/IO/Error.hs
index 6dcf24d..d1c4e47 100644
--- a/System/IO/Error.hs
+++ b/System/IO/Error.hs
@@ -419,6 +419,7 @@ annotateIOError ioe loc hdl path =
   ioe{ ioe_handle = hdl `mplus` ioe_handle ioe,
        ioe_location = loc, ioe_filename = path `mplus` ioe_filename ioe }
   where
+    mplus :: Maybe a -> Maybe a -> Maybe a
     Nothing `mplus` ys = ys
     xs      `mplus` _  = xs
 #endif /* __GLASGOW_HASKELL__ || __HUGS__ */
diff --git a/Text/ParserCombinators/ReadP.hs b/Text/ParserCombinators/ReadP.hs
index fb506f6..5dabfd1 100644
--- a/Text/ParserCombinators/ReadP.hs
+++ b/Text/ParserCombinators/ReadP.hs
@@ -255,9 +255,10 @@ gather :: ReadP a -> ReadP (String, a)
 --   in addition returns the exact characters read.
 --   IMPORTANT NOTE: 'gather' gives a runtime error if its first argument
 --   is built using any occurrences of readS_to_P. 
-gather (R m) =
-  R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))  
+gather (R m)
+  = R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))  
  where
+  gath :: (String -> String) -> P (String -> P b) -> P b
   gath l (Get f)      = Get (\c -> gath (l.(c:)) (f c))
   gath _ Fail         = Fail
   gath l (Look f)     = Look (\s -> gath l (f s))