-- ** Constructors
mkConstr, -- :: DataType -> String -> Fixity -> Constr
mkIntConstr, -- :: DataType -> Integer -> Constr
- mkFloatConstr, -- :: DataType -> Double -> Constr
+ mkFloatConstr, -- :: DataType -> Double -> Constr
+ mkIntegralConstr,-- :: (Integral a) => DataType -> a -> Constr
+ mkRealConstr, -- :: (Real a) => DataType -> a -> Constr
mkStringConstr, -- :: DataType -> String -> Constr
mkCharConstr, -- :: DataType -> Char -> Constr
-- ** Observers
import Control.Monad
-- Imports for the instances
-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, ...
#ifdef __GLASGOW_HASKELL__
deriving Show
-
--- | Representation of constructors
+-- | Representation of constructors. Note that equality on constructors
+-- with different types may not work -- i.e. the constructors for 'False' and
+-- 'Nothing' may compare equal.
data Constr = Constr
{ conrep :: ConstrRep
, constring :: String
-- | Public representation of datatypes
-{-# DEPRECATED StringRep "Use CharRep instead" #-}
data DataRep = AlgRep [Constr]
| IntRep
| FloatRep
- | StringRep -- ^ Deprecated. Please use 'CharRep' instead.
| CharRep
| NoRep
-- | Public representation of constructors
-{-# DEPRECATED StringConstr "Use CharConstr instead" #-}
data ConstrRep = AlgConstr ConIndex
| IntConstr Integer
- | FloatConstr Double
- | StringConstr String -- ^ Deprecated. Please use 'CharConstr' instead.
+ | FloatConstr Rational
| CharConstr Char
deriving (Eq,Show)
case (dataTypeRep dt, cr) of
(AlgRep cs, AlgConstr i) -> cs !! (i-1)
(IntRep, IntConstr i) -> mkIntConstr dt i
- (FloatRep, FloatConstr f) -> mkFloatConstr dt f
- (StringRep, StringConstr str) -> mkStringConstr dt str
+ (FloatRep, FloatConstr f) -> mkRealConstr dt f
(CharRep, CharConstr c) -> mkCharConstr dt c
_ -> error "repConstr"
case dataTypeRep dt of
AlgRep cons -> idx cons
IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
- FloatRep -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f)))
- StringRep -> Just (mkStringConstr dt str)
+ FloatRep -> mkReadCon ffloat
CharRep -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
NoRep -> Nothing
where
then Nothing
else Just (head fit)
+ ffloat :: Double -> Constr
+ ffloat = mkPrimCon dt str . FloatConstr . toRational
------------------------------------------------------------------------------
--
-- | This function is now deprecated. Please use 'mkCharType' instead.
{-# DEPRECATED mkStringType "Use mkCharType instead" #-}
mkStringType :: String -> DataType
-mkStringType = mkPrimType StringRep
+mkStringType = mkCharType
-- | Constructs the 'Char' type
mkCharType :: String -> DataType
, confixity = error "constrFixity"
}
-
+-- | This function is now deprecated. Please use 'mkIntegralConstr' instead.
+{-# DEPRECATED mkIntConstr "Use mkIntegralConstr instead" #-}
mkIntConstr :: DataType -> Integer -> Constr
-mkIntConstr dt i = case datarep dt of
- IntRep -> mkPrimCon dt (show i) (IntConstr i)
- _ -> error "mkIntConstr"
+mkIntConstr = mkIntegralConstr
+mkIntegralConstr :: (Integral a) => DataType -> a -> Constr
+mkIntegralConstr dt i = case datarep dt of
+ IntRep -> mkPrimCon dt (show i) (IntConstr (toInteger i))
+ _ -> error "mkIntegralConstr"
+-- | This function is now deprecated. Please use 'mkRealConstr' instead.
+{-# DEPRECATED mkFloatConstr "Use mkRealConstr instead" #-}
mkFloatConstr :: DataType -> Double -> Constr
-mkFloatConstr dt f = case datarep dt of
- FloatRep -> mkPrimCon dt (show f) (FloatConstr f)
- _ -> error "mkFloatConstr"
+mkFloatConstr dt = mkRealConstr dt . toRational
+
+mkRealConstr :: (Real a) => DataType -> a -> Constr
+mkRealConstr dt f = case datarep dt of
+ FloatRep -> mkPrimCon dt (show f) (FloatConstr (toRational f))
+ _ -> error "mkRealConstr"
-- | This function is now deprecated. Please use 'mkCharConstr' instead.
{-# DEPRECATED mkStringConstr "Use mkCharConstr instead" #-}
mkStringConstr :: DataType -> String -> Constr
-mkStringConstr dt str = case datarep dt of
- StringRep -> mkPrimCon dt str (StringConstr str)
- _ -> error "mkStringConstr"
+mkStringConstr dt str =
+ case datarep dt of
+ CharRep -> case str of
+ [c] -> mkPrimCon dt (show c) (CharConstr c)
+ _ -> error "mkStringConstr: input String must contain a single character"
+ _ -> error "mkStringConstr"
-- | Makes a constructor for 'Char'.
mkCharConstr :: DataType -> Char -> Constr
floatType = mkFloatType "Prelude.Float"
instance Data Float where
- toConstr x = mkFloatConstr floatType (realToFrac x)
+ toConstr = mkRealConstr floatType
gunfold _ z c = case constrRep c of
(FloatConstr x) -> z (realToFrac x)
_ -> error "gunfold"
doubleType = mkFloatType "Prelude.Double"
instance Data Double where
- toConstr = mkFloatConstr floatType
+ toConstr = mkRealConstr doubleType
gunfold _ z c = case constrRep c of
- (FloatConstr x) -> z x
+ (FloatConstr x) -> z (realToFrac x)
_ -> error "gunfold"
dataTypeOf _ = doubleType