Commit d69bb110 authored by ralf's avatar ralf
Browse files

[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.
parent d12525bd
......@@ -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
......
......@@ -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
......
......@@ -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"
......
......@@ -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)