[project @ 2004-03-30 15:31:35 by ralf]

We decided that we want the gunfold primitive back.
This avoids some hassle with bottoms and strict datatypes.
The compiler now also derives gunfold.

libraries/base/Data/Generics/Aliases.hs

@@ -42,10 +42,6 @@ module Data.Generics.Aliases (
 	choiceMp,
 	choiceQ,
 
-        -- * Operators for (over-appreciated) unfolding
-        gunfoldB,
-        gunfoldR,
-
 	-- * Type extension for unary type constructors
 	ext1T, 
 	ext1M,
@@ -303,30 +299,6 @@ recoverQ r f = f `choiceQ` const (return r)
 
 
 
-------------------------------------------------------------------------------
---
---	Generic unfolding
---
-------------------------------------------------------------------------------
-
--- | Construct an initial term with undefined immediate subterms
---   and then map over the skeleton to fill in proper terms.
-gunfoldB :: Data a
-         => Constr
-         -> (forall a. Data a => a)
-         -> a
-gunfoldB c f = gmapT (const f) (fromConstr c)
-
-
--- | Monadic variation on \"gunfoldB\"
-gunfoldR :: (Monad m, Data a)
-         => Constr
-         -> (forall a. Data a => m a)
-         -> m a
-gunfoldR c f = gmapM (const f) $ fromConstr c
-
-
-
 ------------------------------------------------------------------------------
 --
 --	Type extension for unary type constructors

libraries/base/Data/Generics/Basics.hs

@@ -22,8 +22,8 @@ module Data.Generics.Basics (
 	-- * The Data class for processing constructor applications
 	Data( 
 		gfoldl,		-- :: ... -> a -> c a
+		gunfold,	-- :: ... -> Constr -> c a
 		toConstr, 	-- :: a -> Constr
-		fromConstr,	-- :: Constr -> a
 		dataTypeOf,	-- :: a -> DataType
 		dataCast1,	-- mediate types and unary type constructors
 		dataCast2	-- mediate types and binary type constructors
@@ -87,6 +87,11 @@ module Data.Generics.Basics (
         gmapMp,
         gmapMo,
 
+	-- * Generic operation(s) defined in terms of gunfold
+        fromConstr,	-- :: Constr -> a
+        fromConstrB,	-- :: ... -> Constr -> a
+	fromConstrM	-- :: Monad m => ... -> Constr -> m a
+
   ) where
 
 
@@ -130,14 +135,14 @@ class Typeable a => Data a where
 
 Folding constructor applications ("gfoldl")
 
-The combinator takes two arguments "f" and "z" to fold over a term
+The combinator takes two arguments "k" and "z" to fold over a term
 "x".  The result type is defined in terms of "x" but variability is
 achieved by means of type constructor "c" for the construction of the
 actual result type. The purpose of the argument "z" is to define how
 the empty constructor application is folded. So "z" is like the
 neutral / start element for list folding. The purpose of the argument
-"f" is to define how the nonempty constructor application is
-folded. That is, "f" takes the folded "tail" of the constructor
+"k" is to define how the nonempty constructor application is
+folded. That is, "k" takes the folded "tail" of the constructor
 application and its head, i.e., an immediate subterm, and combines
 them in some way. See the Data instances in this file for an
 illustration of "gfoldl". Conclusion: the type of gfoldl is a
@@ -156,6 +161,12 @@ fold.
   --
   gfoldl _ z = z
 
+  -- | Unfolding constructor applications
+  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
+          -> (forall r. r -> c r)
+          -> Constr
+          -> c a
+
   -- | 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
@@ -164,10 +175,6 @@ fold.
   toConstr   :: a -> Constr
 
 
-  -- | Building a term from a constructor
-  fromConstr   :: Constr -> a
-
-
   -- | Provide access to list of all constructors
   dataTypeOf  :: a -> DataType
 
@@ -358,6 +365,41 @@ newtype Mp m x = Mp { unMp :: m (x, Bool) }
 
 
 
+------------------------------------------------------------------------------
+--
+--	Generic unfolding
+--
+------------------------------------------------------------------------------
+
+
+-- | Build a term skeleton
+fromConstr :: Data a => Constr -> a
+fromConstr = fromConstrB undefined
+
+
+-- | Build a term and use a generic function for subterms
+fromConstrB :: Data a
+            => (forall a. Data a => a)
+            -> Constr
+            -> a
+fromConstrB f = unID . gunfold k z
+ where
+  k c = ID (unID c f)
+  z = ID
+
+
+-- | Monadic variation on \"fromConstrB\"
+fromConstrM :: (Monad m, Data a)
+            => (forall a. Data a => m a)
+            -> Constr
+            -> m a
+fromConstrM f = gunfold k z 
+ where
+  k c = do { c' <- c; b <- f; return (c' b) }
+  z = return
+
+
+
 ------------------------------------------------------------------------------
 --
 --	Datatype and constructor representations

libraries/base/Data/Generics/Instances.hs

@@ -56,10 +56,10 @@ boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr]
 instance Data Bool where
   toConstr False = falseConstr
   toConstr True  = trueConstr
-  fromConstr c = case constrIndex c of
-                   1 -> False
-                   2 -> True
-                   _ -> error "fromConstr"
+  gunfold k z c  = case constrIndex c of
+                     1 -> z False
+                     2 -> z True
+                     _ -> error "gunfold"
   dataTypeOf _ = boolDataType
 
 
@@ -70,9 +70,9 @@ charType = mkStringType "Prelude.Char"
 
 instance Data Char where
   toConstr x = mkStringConstr charType [x]
-  fromConstr con = case constrRep con of
-                     (StringConstr [x]) -> x
-                     _ -> error "fromConstr"
+  gunfold k z c = case constrRep c of
+                    (StringConstr [x]) -> z x
+                    _ -> error "gunfold"
   dataTypeOf _ = charType
 
 
@@ -83,9 +83,9 @@ floatType = mkFloatType "Prelude.Float"
 
 instance Data Float where
   toConstr x = mkFloatConstr floatType (realToFrac x)
-  fromConstr con = case constrRep con of
-                     (FloatConstr x) -> realToFrac x
-                     _ -> error "fromConstr"
+  gunfold k z c = case constrRep c of
+                    (FloatConstr x) -> z (realToFrac x)
+                    _ -> error "gunfold"
   dataTypeOf _ = floatType
 
 
@@ -96,9 +96,9 @@ doubleType = mkFloatType "Prelude.Double"
 
 instance Data Double where
   toConstr = mkFloatConstr floatType
-  fromConstr con = case constrRep con of
-                     (FloatConstr x) -> x
-                     _ -> error "fromConstr"
+  gunfold k z c = case constrRep c of
+                    (FloatConstr x) -> z x
+                    _ -> error "gunfold"
   dataTypeOf _ = doubleType
 
 
@@ -109,9 +109,9 @@ intType = mkIntType "Prelude.Int"
 
 instance Data Int where
   toConstr x = mkIntConstr intType (fromIntegral x)
-  fromConstr con = case constrRep con of
-                     (IntConstr x) -> fromIntegral x
-                     _ -> error "fromConstr"
+  gunfold k z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error "gunfold"
   dataTypeOf _ = intType
 
 
@@ -122,9 +122,9 @@ integerType = mkIntType "Prelude.Integer"
 
 instance Data Integer where
   toConstr = mkIntConstr integerType
-  fromConstr con = case constrRep con of
-                     (IntConstr x) -> x
-                     _ -> error "fromConstr"
+  gunfold k z c = case constrRep c of
+                    (IntConstr x) -> z x
+                    _ -> error "gunfold"
   dataTypeOf _ = integerType
 
 
@@ -135,9 +135,9 @@ int8Type = mkIntType "Data.Int.Int8"
 
 instance Data Int8 where
   toConstr x = mkIntConstr int8Type (fromIntegral x)
-  fromConstr con = case constrRep con of
-                     (IntConstr x) -> fromIntegral x
-                     _ -> error "fromConstr"
+  gunfold k z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error "gunfold"
   dataTypeOf _ = int8Type
 
 
@@ -148,9 +148,9 @@ int16Type = mkIntType "Data.Int.Int16"
 
 instance Data Int16 where
   toConstr x = mkIntConstr int16Type (fromIntegral x)
-  fromConstr con = case constrRep con of
-                     (IntConstr x) -> fromIntegral x
-                     _ -> error "fromConstr"
+  gunfold k z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error "gunfold"
   dataTypeOf _ = int16Type
 
 
@@ -161,9 +161,9 @@ int32Type = mkIntType "Data.Int.Int32"
 
 instance Data Int32 where
   toConstr x = mkIntConstr int32Type (fromIntegral x)
-  fromConstr con = case constrRep con of
-                     (IntConstr x) -> fromIntegral x
-                     _ -> error "fromConstr"
+  gunfold k z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error "gunfold"
   dataTypeOf _ = int32Type
 
 
@@ -174,9 +174,9 @@ int64Type = mkIntType "Data.Int.Int64"
 
 instance Data Int64 where
   toConstr x = mkIntConstr int64Type (fromIntegral x)
-  fromConstr con = case constrRep con of
-                     (IntConstr x) -> fromIntegral x
-                     _ -> error "fromConstr"
+  gunfold k z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error "gunfold"
   dataTypeOf _ = int64Type
 
 
@@ -187,9 +187,9 @@ wordType = mkIntType "Data.Word.Word"
 
 instance Data Word where
   toConstr x = mkIntConstr wordType (fromIntegral x)
-  fromConstr con = case constrRep con of
-                     (IntConstr x) -> fromIntegral x
-                     _ -> error "fromConstr"
+  gunfold k z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error "gunfold"
   dataTypeOf _ = wordType
 
 
@@ -200,9 +200,9 @@ word8Type = mkIntType "Data.Word.Word8"
 
 instance Data Word8 where
   toConstr x = mkIntConstr word8Type (fromIntegral x)
-  fromConstr con = case constrRep con of
-                     (IntConstr x) -> fromIntegral x
-                     _ -> error "fromConstr"
+  gunfold k z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error "gunfold"
   dataTypeOf _ = word8Type
 
 
@@ -213,9 +213,9 @@ word16Type = mkIntType "Data.Word.Word16"
 
 instance Data Word16 where
   toConstr x = mkIntConstr word16Type (fromIntegral x)
-  fromConstr con = case constrRep con of
-                     (IntConstr x) -> fromIntegral x
-                     _ -> error "fromConstr"
+  gunfold k z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error "gunfold"
   dataTypeOf _ = word16Type
 
 
@@ -226,9 +226,9 @@ word32Type = mkIntType "Data.Word.Word32"
 
 instance Data Word32 where
   toConstr x = mkIntConstr word32Type (fromIntegral x)
-  fromConstr con = case constrRep con of
-                     (IntConstr x) -> fromIntegral x
-                     _ -> error "fromConstr"
+  gunfold k z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error "gunfold"
   dataTypeOf _ = word32Type
 
 
@@ -239,9 +239,9 @@ word64Type = mkIntType "Data.Word.Word64"
 
 instance Data Word64 where
   toConstr x = mkIntConstr word64Type (fromIntegral x)
-  fromConstr con = case constrRep con of
-                     (IntConstr x) -> fromIntegral x
-                     _ -> error "fromConstr"
+  gunfold k z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error "gunfold"
   dataTypeOf _ = word64Type
 
 
@@ -253,9 +253,9 @@ ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]
 
 instance (Data a, Integral a) => Data (Ratio a) where
   toConstr _ = ratioConstr
-  fromConstr c | constrIndex c == 1 = undefined :% undefined
-  fromConstr _ = error "fromConstr"
-  dataTypeOf _ = ratioDataType
+  gunfold k z c | constrIndex c == 1 = k (k (z (:%)))
+  gunfold _ _ _ = error "gunfold"
+  dataTypeOf _  = ratioDataType
 
 
 ------------------------------------------------------------------------------
@@ -270,10 +270,10 @@ instance Data a => Data [a] where
   gfoldl f z (x:xs) = z (:) `f` x `f` xs
   toConstr []    = nilConstr
   toConstr (_:_) = consConstr
-  fromConstr c = case constrIndex c of
-                   1 -> []
-                   2 -> undefined:undefined
-                   _ -> error "fromConstr"
+  gunfold k z c = case constrIndex c of
+                    1 -> z []
+                    2 -> k (k (z (:)))
+                    _ -> error "gunfold"
   dataTypeOf _ = listDataType
   dataCast1    = gcast1
 
@@ -301,10 +301,10 @@ instance Data a => Data (Maybe a) where
   gfoldl f z (Just x) = z Just `f` x
   toConstr Nothing  = nothingConstr
   toConstr (Just _) = justConstr
-  fromConstr c = case constrIndex c of
-                   1 -> Nothing
-                   2 -> Just undefined
-                   _ -> error "fromConstr"
+  gunfold k z c = case constrIndex c of
+                    1 -> z Nothing
+                    2 -> k (z Just)
+                    _ -> error "gunfold"
   dataTypeOf _ = maybeDataType
   dataCast1    = gcast1
 
@@ -324,11 +324,11 @@ instance Data Ordering where
   toConstr LT  = ltConstr
   toConstr EQ  = eqConstr
   toConstr GT  = gtConstr
-  fromConstr c = case constrIndex c of
-                   1 -> LT
-                   2 -> EQ
-                   3 -> GT
-                   _ -> error "fromConstr"
+  gunfold k z c = case constrIndex c of
+                    1 -> z LT
+                    2 -> z EQ
+                    3 -> z GT
+                    _ -> error "gunfold"
   dataTypeOf _ = orderingDataType
 
 
@@ -344,10 +344,10 @@ instance (Data a, Data b) => Data (Either a b) where
   gfoldl f z (Right a)  = z Right `f` a
   toConstr (Left _)  = leftConstr
   toConstr (Right _) = rightConstr
-  fromConstr c = case constrIndex c of
-                   1 -> Left undefined
-                   2 -> Right undefined
-                   _ -> error "fromConstr"
+  gunfold k z c = case constrIndex c of
+                    1 -> k (z Left)
+                    2 -> k (z Right)
+                    _ -> error "gunfold"
   dataTypeOf _ = eitherDataType
   dataCast2    = gcast2
 
@@ -361,7 +361,7 @@ instance (Data a, Data b) => Data (Either a b) where
 
 instance (Data a, Data b) => Data (a -> b) where
   toConstr _   = error "toConstr"
-  fromConstr _ = error "fromConstr"
+  gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNorepType "Prelude.(->)"
   dataCast2    = gcast2
 
@@ -373,10 +373,10 @@ tuple0Constr = mkConstr tuple0DataType "()" [] Prefix
 tuple0DataType = mkDataType "Prelude.()" [tuple0Constr]
 
 instance Data () where
-  toConstr _ = tuple0Constr
-  fromConstr c | constrIndex c == 1 = ()  
-  fromConstr _ = error "fromConstr"
-  dataTypeOf _ = tuple0DataType
+  toConstr _    = tuple0Constr
+  gunfold k z c | constrIndex c == 1 = z ()  
+  gunfold _ _ _ = error "gunfold"
+  dataTypeOf _  = tuple0DataType
 
 
 ------------------------------------------------------------------------------
@@ -387,11 +387,11 @@ tuple2DataType = mkDataType "Prelude.(,)" [tuple2Constr]
 
 instance (Data a, Data b) => Data (a,b) where
   gfoldl f z (a,b) = z (,) `f` a `f` b
-  toConstr _ = tuple2Constr
-  fromConstr c | constrIndex c == 1 = (undefined,undefined)
-  fromConstr _ = error "fromConstr"
-  dataTypeOf _ = tuple2DataType
-  dataCast2    = gcast2
+  toConstr _    = tuple2Constr
+  gunfold k z c | constrIndex c == 1 = k (k (z (,)))
+  gunfold _ _ _ = error "gunfold"
+  dataTypeOf _  = tuple2DataType
+  dataCast2     = gcast2
 
 
 ------------------------------------------------------------------------------
@@ -402,10 +402,10 @@ tuple3DataType = mkDataType "Prelude.(,)" [tuple3Constr]
 
 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 _ = tuple3Constr
-  fromConstr c | constrIndex c == 1 = (undefined,undefined,undefined)
-  fromConstr _ = error "fromConstr"
-  dataTypeOf _ = tuple3DataType
+  toConstr _    = tuple3Constr
+  gunfold k z c | constrIndex c == 1 = k (k (k (z (,,))))
+  gunfold _ _ _ = error "gunfold"
+  dataTypeOf _  = tuple3DataType
 
 
 ------------------------------------------------------------------------------
@@ -418,9 +418,9 @@ 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 _ = tuple4Constr
-  fromConstr c = case constrIndex c of
-                   1 -> (undefined,undefined,undefined,undefined)
-                   _ -> error "fromConstr"
+  gunfold k z c = case constrIndex c of
+                    1 -> k (k (k (k (z (,,,)))))
+                    _ -> error "gunfold"
   dataTypeOf _ = tuple4DataType
 
 
@@ -434,9 +434,9 @@ instance (Data a, Data b, Data c, Data d, Data e)
          => Data (a,b,c,d,e) where
   gfoldl f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e
   toConstr _ = tuple5Constr
-  fromConstr c = case constrIndex c of
-                   1 -> (undefined,undefined,undefined,undefined,undefined)
-                   _ -> error "fromConstr"
+  gunfold k z c = case constrIndex c of
+                    1 -> k (k (k (k (k (z (,,,,))))))
+                    _ -> error "gunfold"
   dataTypeOf _ = tuple5DataType
 
 
@@ -450,10 +450,9 @@ instance (Data a, Data b, Data c, Data d, Data e, Data f)
          => Data (a,b,c,d,e,f) where
   gfoldl f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f'
   toConstr _ = tuple6Constr
-  fromConstr c =
-    case constrIndex c of
-           1 -> (undefined,undefined,undefined,undefined,undefined,undefined)
-           _ -> error "fromConstr"
+  gunfold k z c = case constrIndex c of
+                    1 -> k (k (k (k (k (k (z (,,,,,)))))))
+                    _ -> error "gunfold"
   dataTypeOf _ = tuple6DataType
 
 
@@ -468,9 +467,9 @@ instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
   gfoldl f z (a,b,c,d,e,f',g) =
     z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g
   toConstr _ = tuple7Constr
-  fromConstr c = case constrIndex c of
-   1 -> (undefined,undefined,undefined,undefined,undefined,undefined,undefined)
-   _ -> error "fromConstr"
+  gunfold k z c = case constrIndex c of
+                    1 -> k (k (k (k (k (k (k (z (,,,,,,))))))))
+                    _ -> error "gunfold"
   dataTypeOf _ = tuple7DataType
 
 
@@ -479,7 +478,7 @@ instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
 
 instance Data TypeRep where
   toConstr _   = error "toConstr"
-  fromConstr _ = error "fromConstr"
+  gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNorepType "Data.Typeable.TypeRep"
 
 
@@ -488,7 +487,7 @@ instance Data TypeRep where
 
 instance Data TyCon where
   toConstr _   = error "toConstr"
-  fromConstr _ = error "fromConstr"
+  gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNorepType "Data.Typeable.TyCon"
 
 
@@ -499,7 +498,7 @@ INSTANCE_TYPEABLE0(DataType,dataTypeTc,"DataType")
 
 instance Data DataType where
   toConstr _   = error "toConstr"
-  fromConstr _ = error "fromConstr"
+  gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNorepType "Data.Generics.Basics.DataType"
 
 
@@ -508,7 +507,7 @@ instance Data DataType where
 
 instance Typeable a => Data (IO a) where
   toConstr _   = error "toConstr"
-  fromConstr _ = error "fromConstr"
+  gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNorepType "GHC.IOBase.IO"
 
 
@@ -517,7 +516,7 @@ instance Typeable a => Data (IO a) where
 
 instance Data Handle where
   toConstr _   = error "toConstr"
-  fromConstr _ = error "fromConstr"
+  gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNorepType "GHC.IOBase.Handle"
 
 
@@ -526,7 +525,7 @@ instance Data Handle where
 
 instance Typeable a => Data (Ptr a) where
   toConstr _   = error "toConstr"
-  fromConstr _ = error "fromConstr"
+  gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNorepType "GHC.Ptr.Ptr"
 
 
@@ -535,7 +534,7 @@ instance Typeable a => Data (Ptr a) where
 
 instance Typeable a => Data (StablePtr a) where
   toConstr _   = error "toConstr"
-  fromConstr _ = error "fromConstr"
+  gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNorepType "GHC.Stable.StablePtr"
 
 
@@ -544,7 +543,7 @@ instance Typeable a => Data (StablePtr a) where
 
 instance Typeable a => Data (IORef a) where
   toConstr _   = error "toConstr"
-  fromConstr _ = error "fromConstr"
+  gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNorepType "GHC.IOBase.IORef"
 
 

libraries/base/Data/Generics/Text.hs

@@ -57,8 +57,8 @@ gread :: Data a => ReadS a
 
 This is a read operation which insists on prefix notation.  (The
 Haskell 98 read deals with infix operators subject to associativity
-and precedence as well.) We use gunfoldR to "parse" the input. To be
-precise, gunfoldR is used for all types except String. The
+and precedence as well.) We use fromConstrM to "parse" the input. To be
+precise, fromConstrM is used for all types except String. The
 type-specific case for String uses basic String read.
 
 -}
@@ -92,9 +92,9 @@ gread = readP_to_S gread'
          skipSpaces			-- Discard following space
 
 		-- Do the real work
-	 str   <- parseConstr		-- Get a lexeme for the constructor
-         con   <- str2con str		-- Convert it to a Constr (may fail)