-- * 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
gmapMp,
gmapMo,
+ -- * Generic operation(s) defined in terms of gunfold
+ fromConstr, -- :: Constr -> a
+ fromConstrB, -- :: ... -> Constr -> a
+ fromConstrM -- :: Monad m => ... -> Constr -> m 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
--
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
toConstr :: a -> Constr
- -- | Building a term from a constructor
- fromConstr :: Constr -> a
-
-
-- | Provide access to list of all constructors
dataTypeOf :: a -> DataType
------------------------------------------------------------------------------
--
+-- 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
--
------------------------------------------------------------------------------
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
------------------------------------------------------------------------------
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
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
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
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
instance (Data a, Data b) => Data (a -> b) where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "Prelude.(->)"
dataCast2 = gcast2
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
------------------------------------------------------------------------------
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
------------------------------------------------------------------------------
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
------------------------------------------------------------------------------
=> 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
=> 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
=> 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
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
instance Data TypeRep where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "Data.Typeable.TypeRep"
instance Data TyCon where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "Data.Typeable.TyCon"
instance Data DataType where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "Data.Generics.Basics.DataType"
instance Typeable a => Data (IO a) where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "GHC.IOBase.IO"
instance Data Handle where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "GHC.IOBase.Handle"
instance Typeable a => Data (Ptr a) where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "GHC.Ptr.Ptr"
instance Typeable a => Data (StablePtr a) where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "GHC.Stable.StablePtr"
instance Typeable a => Data (IORef a) where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "GHC.IOBase.IORef"