[project @ 2004-02-26 18:06:51 by ralf]

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

diff --git a/Data/Generics/Basics.hs b/Data/Generics/Basics.hs
index 16b6a32..89738d3 100644 (file)
--- a/Data/Generics/Basics.hs
+++ b/Data/Generics/Basics.hs
@@ -1,7 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Generics.Basics
--- Copyright   :  (c) The University of Glasgow, CWI 2001--2003
+-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org
@@ -24,8 +24,9 @@ module Data.Generics.Basics (
                gfoldl,         -- :: ... -> a -> c a
                toConstr,       -- :: a -> Constr
                fromConstr,     -- :: Constr -> a
-               dataTypeOf      -- :: a -> DataType
-               
+               dataTypeOf,     -- :: a -> DataType
+               cast0to1,       -- mediate types and unary type constructors
+               cast0to2        -- mediate types and binary type constructors
             ),
 
        -- * Constructor representations
@@ -52,6 +53,7 @@ module Data.Generics.Basics (
         gmapQ, 
         gmapQl,
         gmapQr,
+        gmapQi,
         gmapM,
         gmapMp,
         gmapMo,
@@ -61,12 +63,15 @@ module Data.Generics.Basics (
 
 ------------------------------------------------------------------------------
 
-
+#ifdef __HADDOCK__
+import Prelude
+#endif
 import Data.Typeable
 import Data.Maybe
 import Control.Monad
 
 
+
 ------------------------------------------------------------------------------
 --
 --     The Data class
@@ -121,7 +126,6 @@ fold.
   --
   gfoldl _ z = z
 
-
   -- | Obtaining the constructor from a given datum.
   -- For proper terms, this is meant to be the top-level constructor.
   -- Primitive datatypes are here viewed as potentially infinite sets of
@@ -138,6 +142,27 @@ fold.
   dataTypeOf  :: a -> DataType
 
 
+
+------------------------------------------------------------------------------
+--
+-- Mediate types and type constructors
+--
+------------------------------------------------------------------------------
+
+  -- | Mediate types and unary type constructors
+  cast0to1 :: Typeable1 t
+           => (forall a. Data a => c (t a))
+           -> Maybe (c a)
+  cast0to1 _ = Nothing
+
+  -- | Mediate types and binary type constructors
+  cast0to2 :: Typeable2 t
+           => (forall a b. (Data a, Data b) => c (t a b))
+           -> Maybe (c a)
+  cast0to2 _ = Nothing
+
+
+
 ------------------------------------------------------------------------------
 --
 --     Typical generic maps defined in terms of gfoldl
@@ -208,11 +233,20 @@ unit.
     where
       k (Qr c) x = Qr (\r -> c (f x `o` r))
 
+
   -- | A generic query that processes the immediate subterms and returns a list
   gmapQ :: (forall a. Data a => a -> u) -> a -> [u]
   gmapQ f = gmapQr (:) [] f
 
 
+  -- | A generic query that processes one child by index (zero-based)
+  gmapQi :: Int -> (forall a. Data a => a -> u) -> a -> u
+  gmapQi i f x = case gfoldl k z x of { Qi _ (Just q) -> q } 
+    where
+      k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q) 
+      z f           = Qi 0 Nothing
+
+
   -- | A generic monadic transformation that maps over the immediate subterms
   gmapM   :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
 
@@ -281,6 +315,10 @@ newtype ID x = ID { unID :: x }
 newtype CONST c a = CONST { unCONST :: c }
 
 
+-- | Type constructor for adding counters to queries
+data Qi q a = Qi Int (Maybe q)
+
+
 -- | The type constructor used in definition of gmapQr
 newtype Qr r a = Qr { unQr  :: r -> r }
 
@@ -490,7 +528,20 @@ instance Data Rational where
   dataTypeOf _ = StringType
 
 --
--- Bool as the most trivial algebraic datatype;
+-- () as the most trivial algebraic datatype;
+-- define top-level definitions for representations.
+--
+
+emptyTupleConstr = mkConstr 1 "()" Prefix
+unitDataType     = mkDataType [emptyTupleConstr]
+
+instance Data () where
+  toConstr _ = emptyTupleConstr
+  fromConstr c | conIndex c == 1 = ()  
+  dataTypeOf _ = unitDataType
+
+--
+-- Bool as another trivial algebraic datatype;
 -- define top-level definitions for representations.
 --
 
@@ -525,6 +576,7 @@ instance Data a => Data [a] where
                    1 -> []
                    2 -> undefined:undefined
   dataTypeOf _ = listDataType
+  cast0to1     = cast1
 
 --
 -- The gmaps are given as an illustration.
@@ -556,6 +608,8 @@ instance Data a => Data (Maybe a) where
                    1 -> Nothing
                    2 -> Just undefined
   dataTypeOf _ = maybeDataType
+  cast0to1     = cast1
+
 
 --
 -- Yet another polymorphic datatype constructor.
@@ -571,12 +625,39 @@ instance (Data a, Data b) => Data (a,b) where
   fromConstr c = case conIndex c of
                    1 -> (undefined,undefined)
   dataTypeOf _ = productDataType
+  cast0to2     = cast2
+
 
 --
 -- Yet another polymorphic datatype constructor.
 -- No surprises.
 --
+ 
+tripleConstr = mkConstr 1 "(,,)" Infix
+tripleDataType = mkDataType [tripleConstr]
 
+instance (Data a, Data b, Data c) => Data (a,b,c) where
+  gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c
+  toConstr _ = tripleConstr
+  fromConstr c = case conIndex c of
+                   1 -> (undefined,undefined,undefined)
+  dataTypeOf _ = tripleDataType
+ 
+quadrupleConstr = mkConstr 1 "(,,,)" Infix
+quadrupleDataType = mkDataType [quadrupleConstr]
+ 
+instance (Data a, Data b, Data c, Data d) => Data (a,b,c,d) where
+  gfoldl f z (a,b,c,d) = z (,,,) `f` a `f` b `f` c `f` d
+  toConstr _ = quadrupleConstr
+  fromConstr c = case conIndex c of
+                   1 -> (undefined,undefined,undefined,undefined)
+  dataTypeOf _ = quadrupleDataType
+
+
+--
+-- Yet another polymorphic datatype constructor.
+-- No surprises.
+--
 
 leftConstr     = mkConstr 1 "Left"  Prefix
 rightConstr    = mkConstr 2 "Right" Prefix
@@ -591,6 +672,7 @@ instance (Data a, Data b) => Data (Either a b) where
                    1 -> Left undefined
                    2 -> Right undefined
   dataTypeOf _ = eitherDataType
+  cast0to2     = cast2
 
 
 {-
@@ -614,7 +696,8 @@ instance Data String where
 -}
 
 -- A last resort for functions
-instance (Typeable a, Typeable b) => Data (a -> b) where
+instance (Data a, Data b) => Data (a -> b) where
   toConstr _   = FunConstr
   fromConstr _ = undefined
   dataTypeOf _ = FunType
+  cast0to2     = cast2