From: ralf Date: Tue, 2 Mar 2004 22:24:00 +0000 (+0000) Subject: [project @ 2004-03-02 22:23:59 by ralf] X-Git-Tag: nhc98-1-18-release~356 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=9fa897010481223267554e51e4c5f990c755cda2;p=ghc-base.git [project @ 2004-03-02 22:23:59 by ralf] Once more revised the Data class. You will need to cvs upd the compiler as well. --- diff --git a/Data/Generics.hs b/Data/Generics.hs index 0732434..14c7f49 100644 --- a/Data/Generics.hs +++ b/Data/Generics.hs @@ -18,12 +18,13 @@ module Data.Generics ( -- * All Data.Generics modules - module Data.Generics.Basics, -- primitives - module Data.Generics.Aliases, -- aliases for type case, generic types - module Data.Generics.Schemes, -- traversal schemes (everywhere etc.) - module Data.Generics.Text, -- generic read and show - module Data.Generics.Twins, -- twin traversal, e.g., generic eq - module Data.Generics.Reify, -- experimental reification theme + module Data.Generics.Basics, -- primitives + module Data.Generics.Instances, -- instances of Data class + module Data.Generics.Aliases, -- aliases for type case, generic types + module Data.Generics.Schemes, -- traversal schemes (everywhere etc.) + module Data.Generics.Text, -- generic read and show + module Data.Generics.Twins, -- twin traversal, e.g., generic eq + module Data.Generics.Reify, -- experimental reification theme #ifndef __HADDOCK__ , @@ -47,6 +48,7 @@ import GHC.Base ( (:*:)(..), (:+:)(..), Unit(..) ) #endif import Data.Generics.Basics +import Data.Generics.Instances import Data.Generics.Aliases import Data.Generics.Schemes import Data.Generics.Text diff --git a/Data/Generics/Basics.hs b/Data/Generics/Basics.hs index 9be4b8a..c552ddc 100644 --- a/Data/Generics/Basics.hs +++ b/Data/Generics/Basics.hs @@ -29,34 +29,53 @@ module Data.Generics.Basics ( cast0to2 -- mediate types and binary type constructors ), - -- * Datatype representations (incl. constructors) + -- * Datatype representations + DataType, -- abstract, instance of: Show Constr, -- abstract, instance of: Eq, Show - PrimRep(..), -- instance of: Eq, Show + DataRep(..), -- instance of: Eq, Show + ConRep(..), -- instance of: Eq, Show ConIndex, -- alias for Int, start at 1 Fixity(..), -- instance of: Eq, Show - DataType, -- abstract, instance of: Show - PrimCons(..), -- instance of: Eq, Show - - -- * Constructing datatype representations - mkDataConstr, -- :: ConIndex -> String -> Fixity -> Constr - mkPrimConstr, -- :: PrimRep -> Constr - mkDataType, -- :: [Constr] -> DataType - mkPrimType, -- :: Typeable a => PrimCons -> a -> DataType - - -- * Observing datatype representations - dataTyCon, -- :: DataType -> String - dataTyMod, -- :: DataType -> String - isPrimType, -- :: DataType -> Bool - dataCons, -- :: DataType -> [Constr] - primCons, -- :: DataType -> PrimCons - constrPrimRep, -- :: Constr -> PrimRep - conString, -- :: Constr -> String - conFixity, -- :: Constr -> Fixity - conIndex, -- :: Constr -> ConIndex + + -- * Observers for datatype representations + dataTypeCon, -- :: DataType -> String + dataTypeRep, -- :: DataType -> DataRep + conDataType, -- :: Constr -> DataType + conRep, -- :: Constr -> ConRep + repCon, -- :: DataType -> ConRep -> Constr + + -- * Representations of algebraic data types + mkDataType, -- :: String -> [Constr] -> DataType + mkDataCon, -- :: DataType -> String -> Fixity -> Constr + algTypeCons, -- :: DataType -> [Constr] + conFixity, -- :: Constr -> Fixity + + -- * From strings to constr's and vice versa: all data types + conString, -- :: Constr -> String stringCon, -- :: DataType -> String -> Maybe Constr + + -- * Convenience funtions: algebraic data types + isAlgType, -- :: DataType -> Bool indexCon, -- :: DataType -> ConIndex -> Constr + conIndex, -- :: Constr -> ConIndex maxConIndex, -- :: DataType -> ConIndex + -- * Representation of primitive types + mkIntType, -- :: String -> DataType + mkFloatType, -- :: String -> DataType + mkStringType, -- :: String -> DataType + mkIntCon, -- :: DataType -> Integer -> Constr + mkFloatCon, -- :: DataType -> Double -> Constr + mkStringCon, -- :: DataType -> String -> Constr + + -- * Non-representations for non-presentable types + mkNorepType, -- :: String -> DataType + isNorepType, -- :: DataType -> Bool + + -- * Convenience functions: take type constructors apart + tyconUQname, -- :: String -> String + tyconModule, -- :: String -> String + -- * Generic maps defined in terms of gfoldl gmapT, gmapQ, @@ -79,13 +98,7 @@ import Prelude import Data.Typeable import Data.Maybe import Control.Monad -import Data.Int -- So we can give Data instance for Int8, ... -import Data.Word -- So we can give Data instance for Word8, ... -import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio --- import GHC.Ptr -- So we can give Data instance for Ptr --- import GHC.Stable -- So we can give Data instance for StablePtr -#include "Typeable.h" ------------------------------------------------------------------------------ @@ -350,75 +363,59 @@ newtype Mp m x = Mp { unMp :: m (x, Bool) } -- ------------------------------------------------------------------------------ + +-- -- | Representation of datatypes. --- A package of constructor representations with names of type and module. --- The list of constructors could be an array, a balanced tree, or others. +-- | A package of constructor representations with names of type and module. +-- | The list of constructors could be an array, a balanced tree, or others. -- data DataType = DataType - { tycon :: String, - tymod :: String, - datacons :: DataCons - } + { tycon :: String + , datarep :: DataRep + } deriving Show --- | Datatype constructors -data DataCons = DataCons [Constr] - | PrimCons PrimCons - - deriving Show - - --- | Primitive constructors -data PrimCons = PrimStringCons - | PrimIntCons - | PrimFloatCons - - deriving (Eq, Show) - - -- | Representation of constructors -data Constr = - -- The prime case for algebraic datatypes - DataConstr ConIndex String Fixity +data Constr = Constr + { conrep :: ConRep + , constring :: String + , confixity :: Fixity -- for AlgRep only + , datatype :: DataType + } - -- Provision for primitive types - | PrimConstr PrimRep +instance Show Constr where + show = constring - -- Provision for function types - | FunConstr - - deriving Show +-- | Equality of constructors +instance Eq Constr where + c == c' = conRep c == conRep c' --- | Primitive types -data PrimRep - = PrimStringRep String - | PrimIntRep Integer - | PrimFloatRep Double - deriving (Eq, Show) +-- | Public representation of datatypes +data DataRep = AlgRep [Constr] + | IntRep + | FloatRep + | StringRep + | NoRep + deriving (Eq,Show) --- | Select primitive representation -constrPrimRep :: Constr -> PrimRep -constrPrimRep (PrimConstr x) = x -constrPrimRep _ = error "constrPrimRep" +-- | Public representation of constructors +data ConRep = AlgCon ConIndex + | IntCon Integer + | FloatCon Double + | StringCon String --- --- Equality of datatype constructors via index. --- Use designated equalities for primitive types. --- -instance Eq Constr where - (DataConstr i1 _ _) == (DataConstr i2 _ _) = i1 == i2 - (PrimConstr x) == (PrimConstr y) = x == y - _ == _ = False + deriving (Eq,Show) +-- -- | Unique index for datatype constructors. --- Textual order is respected. Starts at 1. +-- | Textual order is respected. Starts at 1. -- type ConIndex = Int @@ -426,651 +423,268 @@ type ConIndex = Int -- | Fixity of constructors data Fixity = Prefix | Infix -- Later: add associativity and precedence - deriving (Eq,Show) - - - ------------------------------------------------------------------------------- --- --- Constructing representations --- ------------------------------------------------------------------------------- - - --- | Make a datatype constructor -mkDataConstr :: ConIndex -> String -> Fixity -> Constr --- ToDo: consider adding arity? -mkDataConstr = DataConstr - - --- | Make a constructor for primitive types -mkPrimConstr :: PrimRep -> Constr -mkPrimConstr = PrimConstr - - --- | Make a package of constructor representations -mkDataType :: Typeable a => [Constr] -> a -> DataType -mkDataType cs x = DataType { tycon = typeTyCon x - , tymod = typeMod x - , datacons = DataCons cs } - --- | Make a datatype representation for a primitive type -mkPrimType :: Typeable a => PrimCons -> a -> DataType -mkPrimType pc x = DataType { tycon = typeTyCon x - , tymod = typeMod x - , datacons = PrimCons pc } + deriving (Eq,Show) ------------------------------------------------------------------------------ -- --- Observing representations +-- Observers for datatype representations -- ------------------------------------------------------------------------------ --- | Gets the type constructor -dataTyCon :: DataType -> String -dataTyCon = tycon - - --- | Gets the module -dataTyMod :: DataType -> String -dataTyMod = tymod - - --- | Tests for primitive types -isPrimType :: DataType -> Bool -isPrimType dt = case datacons dt of - (DataCons _) -> False - _ -> True - - --- | Gets datatype constructors in increasing order of indicies; -dataCons :: DataType -> [Constr] -dataCons dt = case datacons dt of - (DataCons cs) -> cs - _ -> error "dataCons" - - --- | Gets datatype constructors in increasing order of indicies; -primCons :: DataType -> PrimCons -primCons dt = case datacons dt of - (PrimCons pc) -> pc - _ -> error "primCons" - - --- | Turn a constructor into a string -conString :: Constr -> String -conString (DataConstr _ str _) = str -conString (PrimConstr (PrimStringRep x)) = x -conString (PrimConstr (PrimIntRep x)) = show x -conString (PrimConstr (PrimFloatRep x)) = show x -conString FunConstr = "->" - - --- | Determine fixity of a constructor; --- undefined for primitive types. -conFixity :: Constr -> Fixity -conFixity (DataConstr _ _ fix) = fix -conFixity _ = undefined - - --- | Determine index of a constructor. --- Undefined for primitive types. -conIndex :: Constr -> ConIndex -conIndex (DataConstr idx _ _) = idx -conIndex _ = undefined - - --- | Lookup a constructor via a string -stringCon :: DataType -> String -> Maybe Constr -stringCon dt str | not (isPrimType dt) - = worker (dataCons dt) - where - worker [] = Nothing - worker (c:cs) = - case c of - (DataConstr _ str' _) -> if str == str' - then Just c - else worker cs +-- | Gets the type constructor including the module +dataTypeCon :: DataType -> String +dataTypeCon = tycon - -- other forms of Constr not valid here - _ -> error "stringCon" -stringCon dt str | primCons dt == PrimStringCons = - Just $ mkPrimConstr (PrimStringRep str) -stringCon dt str | primCons dt == PrimIntCons = - Just $ mkPrimConstr (PrimIntRep (read str)) +-- | Gets the public presentation of datatypes +dataTypeRep :: DataType -> DataRep +dataTypeRep = datarep -stringCon dt str | primCons dt == PrimFloatCons = - Just $ mkPrimConstr (PrimFloatRep (read str)) -stringCon _ _ = error "stringCon" +-- | Gets the datatype of a constructor +conDataType :: Constr -> DataType +conDataType = datatype --- | Lookup a constructor by its index; ---- not defined for primitive types. -indexCon :: DataType -> ConIndex -> Constr -indexCon dt idx = (dataCons dt) !! (idx-1) +-- | Gets the public presentation of constructors +conRep :: Constr -> ConRep +conRep = conrep --- | Return maximum index; ---- not defined for primitive types. -maxConIndex :: DataType -> ConIndex -maxConIndex dt = length (dataCons dt) - - --- | Determine type constructor for a typeable -typeTyCon :: Typeable a => a -> String -typeTyCon = select -- Drop module prefix - . typeString -- Determine full string for type - where - -- Drop *.*.*... before name - select :: String -> String - select x = let x' = dropWhile (not . (==) '.') x - in if x' == [] then x else select (tail x') - - --- | Determine module of a typeable -typeMod :: Typeable a => a -> String -typeMod = select -- Take module prefix - . typeString -- Determine full string for type - where - -- Take *.*.*... before name - select :: String -> String - select x = let (a,b) = break ((==) '.') x - in if b == "" - then b - else a++select' (tail b) - where - select' x = let x' = select x - in if x' == "" then "" else ('.':x') - +-- | Look up a constructor by its representation +repCon :: DataType -> ConRep -> Constr +repCon dt cr = + case (dataTypeRep dt, cr) of + (AlgRep cs, AlgCon i) -> cs !! (i-1) + (IntRep, IntCon i) -> mkIntCon dt i + (FloatRep, FloatCon f) -> mkFloatCon dt f + (StringRep, StringCon str) -> mkStringCon dt str + _ -> error "repCon" --- | Determine full string for type -typeString :: Typeable a => a -> String -typeString = tyconString -- Turn into string - . typerepTyCon -- Extract type constructor - . typeOf -- Query type of term - ------------------------------------------------------------------------------ -- --- Instances of the Data class for Prelude types --- We define top-level definitions for representations. +-- Representations of algebraic data types -- ------------------------------------------------------------------------------ -falseConstr = mkDataConstr 1 "False" Prefix -trueConstr = mkDataConstr 2 "True" Prefix -boolDataType x = mkDataType [falseConstr,trueConstr] x - -instance Data Bool where - toConstr False = falseConstr - toConstr True = trueConstr - fromConstr c = case conIndex c of - 1 -> False - 2 -> True - _ -> error "fromConstr" - dataTypeOf = boolDataType - - ------------------------------------------------------------------------------- - - -instance Data Char where - toConstr x = mkPrimConstr (PrimStringRep [x]) - fromConstr (PrimConstr (PrimStringRep [x])) = x - fromConstr _ = error "fromConstr" - dataTypeOf = mkPrimType PrimStringCons - - ------------------------------------------------------------------------------- - - -instance Data Float where - toConstr x = mkPrimConstr (PrimFloatRep (realToFrac x)) - fromConstr (PrimConstr (PrimFloatRep x)) = realToFrac x - fromConstr _ = error "fromConstr" - dataTypeOf = mkPrimType PrimFloatCons - - ------------------------------------------------------------------------------- - - -instance Data Double where - toConstr x = mkPrimConstr (PrimFloatRep x) - fromConstr (PrimConstr (PrimFloatRep x)) = x - fromConstr _ = error "fromConstr" - dataTypeOf = mkPrimType PrimFloatCons - - ------------------------------------------------------------------------------- - - -instance Data Int where - toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x)) - fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x - fromConstr _ = error "fromConstr" - dataTypeOf = mkPrimType PrimIntCons - - ------------------------------------------------------------------------------- - - -instance Data Integer where - toConstr x = mkPrimConstr (PrimIntRep x) - fromConstr (PrimConstr (PrimIntRep x)) = x - fromConstr _ = error "fromConstr" - dataTypeOf = mkPrimType PrimIntCons - - ------------------------------------------------------------------------------- - - -instance Data Int8 where - toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x)) - fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x - fromConstr _ = error "fromConstr" - dataTypeOf = mkPrimType PrimIntCons - - ------------------------------------------------------------------------------- - - -instance Data Int16 where - toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x)) - fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x - fromConstr _ = error "fromConstr" - dataTypeOf = mkPrimType PrimIntCons - - ------------------------------------------------------------------------------- - +-- | Constructs an algebraic datatype +mkDataType :: String -> [Constr] -> DataType +mkDataType str cs = DataType + { tycon = str + , datarep = AlgRep cs + } -instance Data Int32 where - toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x)) - fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x - fromConstr _ = error "fromConstr" - dataTypeOf = mkPrimType PrimIntCons - ------------------------------------------------------------------------------- - - -instance Data Int64 where - toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x)) - fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x - fromConstr _ = error "fromConstr" - dataTypeOf = mkPrimType PrimIntCons - - ------------------------------------------------------------------------------- - - -instance Data Word8 where - toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x)) - fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x - fromConstr _ = error "fromConstr" - dataTypeOf = mkPrimType PrimIntCons +-- | Constructs a constructor +mkDataCon :: DataType -> String -> Fixity -> Constr +mkDataCon dt str fix = + Constr + { conrep = AlgCon idx + , constring = str + , confixity = fix + , datatype = dt + } + where + idx = head [ i | (c,i) <- algTypeCons dt `zip` [1..], + conString c == str ] -instance Data Word where - toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x)) - fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x - fromConstr _ = error "fromConstr" - dataTypeOf = mkPrimType PrimIntCons +-- | Gets the constructors +algTypeCons :: DataType -> [Constr] +algTypeCons dt = case datarep dt of + (AlgRep cons) -> cons + _ -> error "algTypeCons" ------------------------------------------------------------------------------- - +-- | Gets the fixity of a constructor +conFixity :: Constr -> Fixity +conFixity = confixity -instance Data Word16 where - toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x)) - fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x - fromConstr _ = error "fromConstr" - dataTypeOf = mkPrimType PrimIntCons ------------------------------------------------------------------------------ - - -instance Data Word32 where - toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x)) - fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x - fromConstr _ = error "fromConstr" - dataTypeOf = mkPrimType PrimIntCons - - +-- +-- From strings to constr's and vice versa: all data types +-- ------------------------------------------------------------------------------ -instance Data Word64 where - toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x)) - fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x - fromConstr _ = error "fromConstr" - dataTypeOf = mkPrimType PrimIntCons - - ------------------------------------------------------------------------------- +-- | Gets the string for a constructor +conString :: Constr -> String +conString = constring -ratioConstr = mkDataConstr 1 ":%" Infix -ratioDataType x = mkDataType [ratioConstr] x +-- | Lookup a constructor via a string +stringCon :: DataType -> String -> Maybe Constr +stringCon dt str = + case dataTypeRep dt of + AlgRep cons -> idx cons + IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntCon i))) + FloatRep -> mkReadCon (\f -> (mkPrimCon dt str (FloatCon f))) + StringRep -> Just (mkStringCon dt str) + NoRep -> Nothing + where -instance (Data a, Integral a) => Data (Ratio a) where - toConstr _ = ratioConstr - fromConstr c | conIndex c == 1 = undefined :% undefined - fromConstr _ = error "fromConstr" - dataTypeOf = ratioDataType + -- Read a value and build a constructor + mkReadCon :: Read t => (t -> Constr) -> Maybe Constr + mkReadCon f = case (reads str) of + [(t,"")] -> Just (f t) + _ -> Nothing + -- Traverse list of algebraic datatype constructors + idx :: [Constr] -> Maybe Constr + idx cons = let fit = filter ((==) str . conString) cons + in if fit == [] + then Nothing + else Just (head fit) ------------------------------------------------------------------------------ - - - -nilConstr = mkDataConstr 1 "[]" Prefix -consConstr = mkDataConstr 2 "(:)" Infix -listDataType x = mkDataType [nilConstr,consConstr] x - -instance Data a => Data [a] where - gfoldl f z [] = z [] - gfoldl f z (x:xs) = z (:) `f` x `f` xs - toConstr [] = nilConstr - toConstr (_:_) = consConstr - fromConstr c = case conIndex c of - 1 -> [] - 2 -> undefined:undefined - _ -> error "fromConstr" - dataTypeOf = listDataType - cast0to1 = cast1 - -- --- The gmaps are given as an illustration. --- This shows that the gmaps for lists are different from list maps. +-- Convenience funtions: algebraic data types -- - gmapT f [] = [] - gmapT f (x:xs) = (f x:f xs) - gmapQ f [] = [] - gmapQ f (x:xs) = [f x,f xs] - gmapM f [] = return [] - gmapM f (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs') - - ------------------------------------------------------------------------------ -nothingConstr = mkDataConstr 1 "Nothing" Prefix -justConstr = mkDataConstr 2 "Just" Prefix -maybeDataType x = mkDataType [nothingConstr,justConstr] x - -instance Data a => Data (Maybe a) where - gfoldl f z Nothing = z Nothing - gfoldl f z (Just x) = z Just `f` x - toConstr Nothing = nothingConstr - toConstr (Just _) = justConstr - fromConstr c = case conIndex c of - 1 -> Nothing - 2 -> Just undefined - _ -> error "fromConstr" - dataTypeOf = maybeDataType - cast0to1 = cast1 - - ------------------------------------------------------------------------------- +-- | Test for an algebraic type +isAlgType :: DataType -> Bool +isAlgType dt = case datarep dt of + (AlgRep _) -> True + _ -> False -ltConstr = mkDataConstr 1 "LT" Prefix -eqConstr = mkDataConstr 2 "EQ" Prefix -gtConstr = mkDataConstr 3 "GT" Prefix -orderingDataType x = mkDataType [ltConstr,eqConstr,gtConstr] x +-- | Gets the constructor for an index +indexCon :: DataType -> ConIndex -> Constr +indexCon dt idx = case datarep dt of + (AlgRep cs) -> cs !! (idx-1) + _ -> error "indexCon" -instance Data Ordering where - gfoldl f z LT = z LT - gfoldl f z EQ = z EQ - gfoldl f z GT = z GT - toConstr LT = ltConstr - toConstr EQ = eqConstr - toConstr GT = gtConstr - fromConstr c = case conIndex c of - 1 -> LT - 2 -> EQ - 3 -> GT - _ -> error "fromConstr" - dataTypeOf = orderingDataType +-- | Gets the index of a constructor +conIndex :: Constr -> ConIndex +conIndex con = case conRep con of + (AlgCon idx) -> idx + _ -> error "conIndex" ------------------------------------------------------------------------------- +-- | Gets the maximum constructor index +maxConIndex :: DataType -> ConIndex +maxConIndex dt = case dataTypeRep dt of + AlgRep cs -> length cs + _ -> error "maxConIndex" -leftConstr = mkDataConstr 1 "Left" Prefix -rightConstr = mkDataConstr 2 "Right" Prefix -eitherDataType x = mkDataType [leftConstr,rightConstr] x - -instance (Data a, Data b) => Data (Either a b) where - gfoldl f z (Left a) = z Left `f` a - gfoldl f z (Right a) = z Right `f` a - toConstr (Left _) = leftConstr - toConstr (Right _) = rightConstr - fromConstr c = case conIndex c of - 1 -> Left undefined - 2 -> Right undefined - _ -> error "fromConstr" - dataTypeOf = eitherDataType - cast0to2 = cast2 ------------------------------------------------------------------------------ - - -- --- A last resort for functions +-- Representation of primitive types -- - -instance (Data a, Data b) => Data (a -> b) where - toConstr _ = FunConstr - fromConstr _ = error "fromConstr" - dataTypeOf = error "dataTypeOf" - cast0to2 = cast2 - - ------------------------------------------------------------------------------ -tuple0Constr = mkDataConstr 1 "()" Prefix -tuple0DataType x = mkDataType [tuple0Constr] x +-- | Constructs the Int type +mkIntType :: String -> DataType +mkIntType = mkPrimType IntRep -instance Data () where - toConstr _ = tuple0Constr - fromConstr c | conIndex c == 1 = () - fromConstr _ = error "fromConstr" - dataTypeOf = tuple0DataType +-- | Constructs the Float type +mkFloatType :: String -> DataType +mkFloatType = mkPrimType FloatRep ------------------------------------------------------------------------------- +-- | Constructs the String type +mkStringType :: String -> DataType +mkStringType = mkPrimType StringRep -tuple2Constr = mkDataConstr 1 "(,)" Infix -tuple2DataType x = mkDataType [tuple2Constr] x -instance (Data a, Data b) => Data (a,b) where - gfoldl f z (a,b) = z (,) `f` a `f` b - toConstr _ = tuple2Constr - fromConstr c = case conIndex c of - 1 -> (undefined,undefined) - _ -> error "fromConstr" - dataTypeOf = tuple2DataType - cast0to2 = cast2 +-- | Helper for mkIntType, mkFloatType, mkStringType +mkPrimType :: DataRep -> String -> DataType +mkPrimType dr str = DataType + { tycon = str + , datarep = dr + } ------------------------------------------------------------------------------- - +-- Makes a constructor for primitive types +mkPrimCon :: DataType -> String -> ConRep -> Constr +mkPrimCon dt str cr = Constr + { datatype = dt + , conrep = cr + , constring = str + , confixity = error "conFixity" + } -tuple3Constr = mkDataConstr 1 "(,,)" Infix -tuple3DataType x = mkDataType [tuple3Constr] x -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 = case conIndex c of - 1 -> (undefined,undefined,undefined) - _ -> error "fromConstr" - dataTypeOf = tuple3DataType +mkIntCon :: DataType -> Integer -> Constr +mkIntCon dt i = case datarep dt of + IntRep -> mkPrimCon dt (show i) (IntCon i) + _ -> error "mkIntCon" ------------------------------------------------------------------------------- +mkFloatCon :: DataType -> Double -> Constr +mkFloatCon dt f = case datarep dt of + FloatRep -> mkPrimCon dt (show f) (FloatCon f) + _ -> error "mkFloatCon" -tuple4Constr = mkDataConstr 1 "(,,,)" Infix -tuple4DataType x = mkDataType [tuple4Constr] x - -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 conIndex c of - 1 -> (undefined,undefined,undefined,undefined) - _ -> error "fromConstr" - dataTypeOf = tuple4DataType +mkStringCon :: DataType -> String -> Constr +mkStringCon dt str = case datarep dt of + StringRep -> mkPrimCon dt str (StringCon str) + _ -> error "mkStringCon" ------------------------------------------------------------------------------ - - -tuple5Constr = mkDataConstr 1 "(,,,,)" Infix -tuple5DataType x = mkDataType [tuple5Constr] x - -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 conIndex c of - 1 -> (undefined,undefined,undefined,undefined,undefined) - _ -> error "fromConstr" - dataTypeOf = tuple5DataType - - ------------------------------------------------------------------------------- - - -tuple6Constr = mkDataConstr 1 "(,,,,,)" Infix -tuple6DataType x = mkDataType [tuple6Constr] x - -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 conIndex c of - 1 -> (undefined,undefined,undefined,undefined,undefined,undefined) - _ -> error "fromConstr" - dataTypeOf = tuple6DataType - - ------------------------------------------------------------------------------- - - -tuple7Constr = mkDataConstr 1 "(,,,,,,)" Infix -tuple7DataType x = mkDataType [tuple7Constr] x - -instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g) - => Data (a,b,c,d,e,f,g) where - 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 conIndex c of - 1 -> (undefined,undefined,undefined,undefined,undefined,undefined,undefined) - _ -> error "fromConstr" - dataTypeOf = tuple7DataType - - ------------------------------------------------------------------------------- - - -instance Data TypeRep where - toConstr _ = error "toConstr" - fromConstr _ = error "fromConstr" - dataTypeOf = error "dataTypeOf" - - ------------------------------------------------------------------------------- - - -instance Data TyCon where - toConstr _ = error "toConstr" - fromConstr _ = error "fromConstr" - dataTypeOf = error "dataTypeOf" - - ------------------------------------------------------------------------------- - - -INSTANCE_TYPEABLE0(DataType,dataTypeTc,"DataType") - -instance Data DataType where - toConstr _ = error "toConstr" - fromConstr _ = error "fromConstr" - dataTypeOf = error "dataTypeOf" - - ------------------------------------------------------------------------------- - - -INSTANCE_TYPEABLE0(DataCons,dataConsTc,"DataCons") - -instance Data DataCons where - toConstr _ = error "toConstr" - fromConstr _ = error "fromConstr" - dataTypeOf = error "dataTypeOf" - - +-- +-- Non-representations for non-presentable types +-- ------------------------------------------------------------------------------ -INSTANCE_TYPEABLE0(PrimCons,primConsTc,"PrimCons") - -instance Data PrimCons where - toConstr _ = error "toConstr" - fromConstr _ = error "fromConstr" - dataTypeOf = error "dataTypeOf" - - ------------------------------------------------------------------------------- +-- | Constructs a non-representation +mkNorepType :: String -> DataType +mkNorepType str = DataType + { tycon = str + , datarep = NoRep + } -INSTANCE_TYPEABLE0(Constr,constrTc,"Constr") +-- | Test for a non-representable type +isNorepType :: DataType -> Bool +isNorepType dt = case datarep dt of + NoRep -> True + _ -> False -instance Data Constr where - toConstr _ = error "toConstr" - fromConstr _ = error "fromConstr" - dataTypeOf = error "dataTypeOf" ------------------------------------------------------------------------------ - - -INSTANCE_TYPEABLE0(PrimRep,primRepTc,"PrimRep") - -instance Data PrimRep where - toConstr _ = error "toConstr" - fromConstr _ = error "fromConstr" - dataTypeOf = error "dataTypeOf" - - +-- +-- Convenience for qualified type constructors +-- ------------------------------------------------------------------------------ -INSTANCE_TYPEABLE0(Fixity,fixityTc,"Fixity") - -instance Data Fixity where - toConstr _ = error "toConstr" - fromConstr _ = error "fromConstr" - dataTypeOf = error "dataTypeOf" - - ------------------------------------------------------------------------------- +-- | Gets the unqualified type constructor +-- Drop *.*.*... before name +-- +tyconUQname :: String -> String +tyconUQname x = let x' = dropWhile (not . (==) '.') x + in if x' == [] then x else tyconUQname (tail x') + + +-- | Gets the module of a type constructor +-- Take *.*.*... before name +tyconModule :: String -> String +tyconModule x = let (a,b) = break ((==) '.') x + in if b == "" + then b + else a ++ tyconModule' (tail b) + where + tyconModule' x = let x' = tyconModule x + in if x' == "" then "" else ('.':x') diff --git a/Data/Generics/Instances.hs b/Data/Generics/Instances.hs new file mode 100644 index 0000000..e36b17d --- /dev/null +++ b/Data/Generics/Instances.hs @@ -0,0 +1,548 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Generics.Instances +-- Copyright : (c) The University of Glasgow, CWI 2001--2004 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- \"Scrap your boilerplate\" --- Generic programming in Haskell +-- See . The present module +-- instantiates the class Data for Prelude-like datatypes. +-- +----------------------------------------------------------------------------- + +module Data.Generics.Instances +where + + +------------------------------------------------------------------------------ + +#ifdef __HADDOCK__ +import Prelude +#endif + +import Data.Generics.Basics + +import Data.Typeable +import Data.Int -- So we can give Data instance for Int8, ... +import Data.Word -- So we can give Data instance for Word8, ... +import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio +import GHC.IOBase -- So we can give Data instance for IO, Handle +import GHC.Ptr -- So we can give Data instance for Ptr +import GHC.Stable -- So we can give Data instance for StablePtr + +#include "Typeable.h" + + + +------------------------------------------------------------------------------ +-- +-- Instances of the Data class for Prelude-like types. +-- We define top-level definitions for representations. +-- +------------------------------------------------------------------------------ + + +falseConstr = mkDataCon boolDataType "False" Prefix +trueConstr = mkDataCon boolDataType "True" Prefix +boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr] + +instance Data Bool where + toConstr False = falseConstr + toConstr True = trueConstr + fromConstr c = case conIndex c of + 1 -> False + 2 -> True + _ -> error "fromConstr" + dataTypeOf _ = boolDataType + + +------------------------------------------------------------------------------ + + +charType = mkStringType "Prelude.Char" + +instance Data Char where + toConstr x = mkStringCon charType [x] + fromConstr con = case conRep con of + (StringCon [x]) -> x + _ -> error "fromConstr" + dataTypeOf _ = charType + + +------------------------------------------------------------------------------ + + +floatType = mkFloatType "Prelude.Float" + +instance Data Float where + toConstr x = mkFloatCon floatType (realToFrac x) + fromConstr con = case conRep con of + (FloatCon x) -> realToFrac x + _ -> error "fromConstr" + dataTypeOf _ = floatType + + +------------------------------------------------------------------------------ + + +doubleType = mkFloatType "Prelude.Double" + +instance Data Double where + toConstr = mkFloatCon floatType + fromConstr con = case conRep con of + (FloatCon x) -> x + _ -> error "fromConstr" + dataTypeOf _ = doubleType + + +------------------------------------------------------------------------------ + + +intType = mkIntType "Prelude.Int" + +instance Data Int where + toConstr x = mkIntCon intType (fromIntegral x) + fromConstr con = case conRep con of + (IntCon x) -> fromIntegral x + _ -> error "fromConstr" + dataTypeOf _ = intType + + +------------------------------------------------------------------------------ + + +integerType = mkIntType "Prelude.Integer" + +instance Data Integer where + toConstr = mkIntCon integerType + fromConstr con = case conRep con of + (IntCon x) -> x + _ -> error "fromConstr" + dataTypeOf _ = integerType + + +------------------------------------------------------------------------------ + + +int8Type = mkIntType "Data.Int.Int8" + +instance Data Int8 where + toConstr x = mkIntCon int8Type (fromIntegral x) + fromConstr con = case conRep con of + (IntCon x) -> fromIntegral x + _ -> error "fromConstr" + dataTypeOf _ = int8Type + + +------------------------------------------------------------------------------ + + +int16Type = mkIntType "Data.Int.Int16" + +instance Data Int16 where + toConstr x = mkIntCon int16Type (fromIntegral x) + fromConstr con = case conRep con of + (IntCon x) -> fromIntegral x + _ -> error "fromConstr" + dataTypeOf _ = int16Type + + +------------------------------------------------------------------------------ + + +int32Type = mkIntType "Data.Int.Int32" + +instance Data Int32 where + toConstr x = mkIntCon int32Type (fromIntegral x) + fromConstr con = case conRep con of + (IntCon x) -> fromIntegral x + _ -> error "fromConstr" + dataTypeOf _ = int32Type + + +------------------------------------------------------------------------------ + + +int64Type = mkIntType "Data.Int.Int64" + +instance Data Int64 where + toConstr x = mkIntCon int64Type (fromIntegral x) + fromConstr con = case conRep con of + (IntCon x) -> fromIntegral x + _ -> error "fromConstr" + dataTypeOf _ = int64Type + + +------------------------------------------------------------------------------ + + +wordType = mkIntType "Data.Word.Word" + +instance Data Word where + toConstr x = mkIntCon wordType (fromIntegral x) + fromConstr con = case conRep con of + (IntCon x) -> fromIntegral x + _ -> error "fromConstr" + dataTypeOf _ = wordType + + +------------------------------------------------------------------------------ + + +word8Type = mkIntType "Data.Word.Word8" + +instance Data Word8 where + toConstr x = mkIntCon word8Type (fromIntegral x) + fromConstr con = case conRep con of + (IntCon x) -> fromIntegral x + _ -> error "fromConstr" + dataTypeOf _ = word8Type + + +------------------------------------------------------------------------------ + + +word16Type = mkIntType "Data.Word.Word16" + +instance Data Word16 where + toConstr x = mkIntCon word16Type (fromIntegral x) + fromConstr con = case conRep con of + (IntCon x) -> fromIntegral x + _ -> error "fromConstr" + dataTypeOf _ = word16Type + + +------------------------------------------------------------------------------ + + +word32Type = mkIntType "Data.Word.Word32" + +instance Data Word32 where + toConstr x = mkIntCon word32Type (fromIntegral x) + fromConstr con = case conRep con of + (IntCon x) -> fromIntegral x + _ -> error "fromConstr" + dataTypeOf _ = word32Type + + +------------------------------------------------------------------------------ + + +word64Type = mkIntType "Data.Word.Word64" + +instance Data Word64 where + toConstr x = mkIntCon word64Type (fromIntegral x) + fromConstr con = case conRep con of + (IntCon x) -> fromIntegral x + _ -> error "fromConstr" + dataTypeOf _ = word64Type + + +------------------------------------------------------------------------------ + + +ratioConstr = mkDataCon ratioDataType ":%" Infix +ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr] + +instance (Data a, Integral a) => Data (Ratio a) where + toConstr _ = ratioConstr + fromConstr c | conIndex c == 1 = undefined :% undefined + fromConstr _ = error "fromConstr" + dataTypeOf _ = ratioDataType + + +------------------------------------------------------------------------------ + + +nilConstr = mkDataCon listDataType "[]" Prefix +consConstr = mkDataCon listDataType "(:)" Infix +listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr] + +instance Data a => Data [a] where + gfoldl f z [] = z [] + gfoldl f z (x:xs) = z (:) `f` x `f` xs + toConstr [] = nilConstr + toConstr (_:_) = consConstr + fromConstr c = case conIndex c of + 1 -> [] + 2 -> undefined:undefined + _ -> error "fromConstr" + dataTypeOf _ = listDataType + cast0to1 = cast1 + +-- +-- The gmaps are given as an illustration. +-- This shows that the gmaps for lists are different from list maps. +-- + gmapT f [] = [] + gmapT f (x:xs) = (f x:f xs) + gmapQ f [] = [] + gmapQ f (x:xs) = [f x,f xs] + gmapM f [] = return [] + gmapM f (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs') + + +------------------------------------------------------------------------------ + + +nothingConstr = mkDataCon maybeDataType "Nothing" Prefix +justConstr = mkDataCon maybeDataType "Just" Prefix +maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr] + +instance Data a => Data (Maybe a) where + gfoldl f z Nothing = z Nothing + gfoldl f z (Just x) = z Just `f` x + toConstr Nothing = nothingConstr + toConstr (Just _) = justConstr + fromConstr c = case conIndex c of + 1 -> Nothing + 2 -> Just undefined + _ -> error "fromConstr" + dataTypeOf _ = maybeDataType + cast0to1 = cast1 + + +------------------------------------------------------------------------------ + + +ltConstr = mkDataCon orderingDataType "LT" Prefix +eqConstr = mkDataCon orderingDataType "EQ" Prefix +gtConstr = mkDataCon orderingDataType "GT" Prefix +orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr] + +instance Data Ordering where + gfoldl f z LT = z LT + gfoldl f z EQ = z EQ + gfoldl f z GT = z GT + toConstr LT = ltConstr + toConstr EQ = eqConstr + toConstr GT = gtConstr + fromConstr c = case conIndex c of + 1 -> LT + 2 -> EQ + 3 -> GT + _ -> error "fromConstr" + dataTypeOf _ = orderingDataType + + +------------------------------------------------------------------------------ + + +leftConstr = mkDataCon eitherDataType "Left" Prefix +rightConstr = mkDataCon eitherDataType "Right" Prefix +eitherDataType = mkDataType "Prelude.Either" [leftConstr,rightConstr] + +instance (Data a, Data b) => Data (Either a b) where + gfoldl f z (Left a) = z Left `f` a + gfoldl f z (Right a) = z Right `f` a + toConstr (Left _) = leftConstr + toConstr (Right _) = rightConstr + fromConstr c = case conIndex c of + 1 -> Left undefined + 2 -> Right undefined + _ -> error "fromConstr" + dataTypeOf _ = eitherDataType + cast0to2 = cast2 + + +------------------------------------------------------------------------------ + + +-- +-- A last resort for functions +-- + +instance (Data a, Data b) => Data (a -> b) where + toConstr _ = error "toConstr" + fromConstr _ = error "fromConstr" + dataTypeOf _ = mkNorepType "Prelude.(->)" + cast0to2 = cast2 + + +------------------------------------------------------------------------------ + + +tuple0Constr = mkDataCon tuple0DataType "()" Prefix +tuple0DataType = mkDataType "Prelude.()" [tuple0Constr] + +instance Data () where + toConstr _ = tuple0Constr + fromConstr c | conIndex c == 1 = () + fromConstr _ = error "fromConstr" + dataTypeOf _ = tuple0DataType + + +------------------------------------------------------------------------------ + + +tuple2Constr = mkDataCon tuple2DataType "(,)" Infix +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 | conIndex c == 1 = (undefined,undefined) + fromConstr _ = error "fromConstr" + dataTypeOf _ = tuple2DataType + cast0to2 = cast2 + + +------------------------------------------------------------------------------ + + +tuple3Constr = mkDataCon tuple3DataType "(,,)" Infix +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 | conIndex c == 1 = (undefined,undefined,undefined) + fromConstr _ = error "fromConstr" + dataTypeOf _ = tuple3DataType + + +------------------------------------------------------------------------------ + + +tuple4Constr = mkDataCon tuple4DataType "(,,,)" Infix +tuple4DataType = mkDataType "Prelude.(,,,)" [tuple4Constr] + +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 conIndex c of + 1 -> (undefined,undefined,undefined,undefined) + _ -> error "fromConstr" + dataTypeOf _ = tuple4DataType + + +------------------------------------------------------------------------------ + + +tuple5Constr = mkDataCon tuple5DataType "(,,,,)" Infix +tuple5DataType = mkDataType "Prelude.(,,,,)" [tuple5Constr] + +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 conIndex c of + 1 -> (undefined,undefined,undefined,undefined,undefined) + _ -> error "fromConstr" + dataTypeOf _ = tuple5DataType + + +------------------------------------------------------------------------------ + + +tuple6Constr = mkDataCon tuple6DataType "(,,,,,)" Infix +tuple6DataType = mkDataType "Prelude.(,,,,,)" [tuple6Constr] + +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 conIndex c of + 1 -> (undefined,undefined,undefined,undefined,undefined,undefined) + _ -> error "fromConstr" + dataTypeOf _ = tuple6DataType + + +------------------------------------------------------------------------------ + + +tuple7Constr = mkDataCon tuple7DataType "(,,,,,,)" Infix +tuple7DataType = mkDataType "Prelude.(,,,,,,)" [tuple7Constr] + +instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g) + => Data (a,b,c,d,e,f,g) where + 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 conIndex c of + 1 -> (undefined,undefined,undefined,undefined,undefined,undefined,undefined) + _ -> error "fromConstr" + dataTypeOf _ = tuple7DataType + + +------------------------------------------------------------------------------ + + +instance Data TypeRep where + toConstr _ = error "toConstr" + fromConstr _ = error "fromConstr" + dataTypeOf _ = mkNorepType "Data.Typeable.TypeRep" + + +------------------------------------------------------------------------------ + + +instance Data TyCon where + toConstr _ = error "toConstr" + fromConstr _ = error "fromConstr" + dataTypeOf _ = mkNorepType "Data.Typeable.TyCon" + + +------------------------------------------------------------------------------ + + +INSTANCE_TYPEABLE0(DataType,dataTypeTc,"DataType") + +instance Data DataType where + toConstr _ = error "toConstr" + fromConstr _ = error "fromConstr" + dataTypeOf _ = mkNorepType "Data.Generics.Basics.DataType" + + +------------------------------------------------------------------------------ + + +instance Typeable a => Data (IO a) where + toConstr _ = error "toConstr" + fromConstr _ = error "fromConstr" + dataTypeOf _ = mkNorepType "GHC.IOBase.IO" + + +------------------------------------------------------------------------------ + + +instance Data Handle where + toConstr _ = error "toConstr" + fromConstr _ = error "fromConstr" + dataTypeOf _ = mkNorepType "GHC.IOBase.Handle" + + +------------------------------------------------------------------------------ + + +instance Typeable a => Data (Ptr a) where + toConstr _ = error "toConstr" + fromConstr _ = error "fromConstr" + dataTypeOf _ = mkNorepType "GHC.Ptr.Ptr" + + +------------------------------------------------------------------------------ + + +instance Typeable a => Data (StablePtr a) where + toConstr _ = error "toConstr" + fromConstr _ = error "fromConstr" + dataTypeOf _ = mkNorepType "GHC.Stable.StablePtr" + + +------------------------------------------------------------------------------ + + +instance Typeable a => Data (IORef a) where + toConstr _ = error "toConstr" + fromConstr _ = error "fromConstr" + dataTypeOf _ = mkNorepType "GHC.IOBase.IORef" + + +------------------------------------------------------------------------------ diff --git a/Data/Generics/Reify.hs b/Data/Generics/Reify.hs index 133eddf..5f554cb 100644 --- a/Data/Generics/Reify.hs +++ b/Data/Generics/Reify.hs @@ -211,9 +211,9 @@ gmapType (o::[(Constr,r')] -> r) f (t::TypeVal a) -- All constructors of the given type cons :: [Constr] - cons = if isPrimType $ dataTypeOf $ type2val t - then [] - else dataCons $ dataTypeOf $ type2val t + cons = if isAlgType $ dataTypeOf $ type2val t + then algTypeCons $ dataTypeOf $ type2val t + else [] -- Query constructors query :: [r'] @@ -258,9 +258,9 @@ gmapSubtermTypes o (r::r) f (t::TypeVal a) -- All constructors of the given type cons :: [Constr] - cons = if isPrimType $ dataTypeOf $ type2val t - then [] - else dataCons $ dataTypeOf $ type2val t + cons = if isAlgType $ dataTypeOf $ type2val t + then algTypeCons $ dataTypeOf $ type2val t + else [] -- Terms for all constructors terms :: [a]