{-# OPTIONS -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
---
+-- |
-- Module : Data.Dynamic
-- Copyright : (c) The University of Glasgow 2001
--- License : BSD-style (see the file libraries/core/LICENSE)
+-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
-- Portability : portable
--
--- $Id: Dynamic.hs,v 1.3 2001/07/03 14:13:32 simonmar Exp $
---
-- The Dynamic interface provides basic support for dynamic types.
--
-- Operations for injecting values of arbitrary type into
-- with operations for converting dynamic values into a concrete
-- (monomorphic) type.
--
--- The Dynamic implementation provided is closely based on code
--- contained in Hugs library of the same name.
---
-----------------------------------------------------------------------------
module Data.Dynamic
- (
- -- dynamic type
- Dynamic -- abstract, instance of: Show, Typeable
- , toDyn -- :: Typeable a => a -> Dynamic
- , fromDyn -- :: Typeable a => Dynamic -> a -> a
- , fromDynamic -- :: Typeable a => Dynamic -> Maybe a
+ (
+ -- * The @Dynamic@ type
+ Dynamic, -- abstract, instance of: Show, Typeable
+
+ -- * Converting to and from @Dynamic@
+ toDyn, -- :: Typeable a => a -> Dynamic
+ fromDyn, -- :: Typeable a => Dynamic -> a -> a
+ fromDynamic, -- :: Typeable a => Dynamic -> Maybe a
- -- type representation
+ -- * Applying functions of dynamic type
+ dynApply,
+ dynApp,
- , Typeable(
- typeOf) -- :: a -> TypeRep
+ -- * Concrete Type Representations
+
+ -- | This section is useful if you need to define your own
+ -- instances of 'Typeable'.
- -- Dynamic defines Typeable instances for the following
- -- Prelude types: [a], (), (a,b), (a,b,c), (a,b,c,d),
- -- (a,b,c,d,e), (a->b), (Array a b), Bool, Char,
- -- (Complex a), Double, (Either a b), Float, Handle,
- -- Int, Integer, (IO a), (Maybe a), Ordering
+ Typeable(
+ typeOf), -- :: a -> TypeRep
- , TypeRep -- abstract, instance of: Eq, Show, Typeable
- , TyCon -- abstract, instance of: Eq, Show, Typeable
+ -- ** Building concrete type representations
+ TypeRep, -- abstract, instance of: Eq, Show, Typeable
+ TyCon, -- abstract, instance of: Eq, Show, Typeable
- -- type representation constructors/operators:
- , mkTyCon -- :: String -> TyCon
- , mkAppTy -- :: TyCon -> [TypeRep] -> TypeRep
- , mkFunTy -- :: TypeRep -> TypeRep -> TypeRep
- , applyTy -- :: TypeRep -> TypeRep -> Maybe TypeRep
+ mkTyCon, -- :: String -> TyCon
+ mkAppTy, -- :: TyCon -> [TypeRep] -> TypeRep
+ mkFunTy, -- :: TypeRep -> TypeRep -> TypeRep
+ applyTy, -- :: TypeRep -> TypeRep -> Maybe TypeRep
--
-- let fTy = mkTyCon "Foo" in show (mkAppTy (mkTyCon ",,")
import Data.Maybe
import Data.Either
+import Data.Int
+import Data.Word
+import Foreign.Ptr
+import Foreign.StablePtr
#ifdef __GLASGOW_HASKELL__
import GHC.Base
import GHC.Num
import GHC.Float
import GHC.IOBase
-import GHC.Dynamic
#endif
-#ifdef __GLASGOW_HASKELL__
-import GHC.Prim ( unsafeCoerce# )
+#ifdef __HUGS__
+import Hugs.Prelude
+import Hugs.IO
+import Hugs.IORef
+import Hugs.IOExts
+#endif
+#ifdef __GLASGOW_HASKELL__
unsafeCoerce :: a -> b
unsafeCoerce = unsafeCoerce#
#endif
+#ifdef __NHC__
+import NonStdUnsafeCoerce (unsafeCoerce)
+import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
+#else
#include "Dynamic.h"
+#endif
--- The dynamic type is represented by Dynamic, carrying
--- the dynamic value along with its type representation:
+{-|
+ A value of type 'Dynamic' is an object encapsulated together with its type.
+
+ A 'Dynamic' may only represent a monomorphic value; an attempt to
+ create a value of type 'Dynamic' from a polymorphically-typed
+ expression will result in an ambiguity error (see 'toDyn').
+
+ 'Show'ing a value of type 'Dynamic' returns a pretty-printed representation
+ of the object\'s type; useful for debugging.
+-}
+#ifndef __HUGS__
+data Dynamic = Dynamic TypeRep Obj
+#endif
--- the instance just prints the type representation.
instance Show Dynamic where
+ -- the instance just prints the type representation.
showsPrec _ (Dynamic t _) =
showString "<<" .
showsPrec 0 t .
showString ">>"
--- Operations for going to and from Dynamic:
-
-toDyn :: Typeable a => a -> Dynamic
-toDyn v = Dynamic (typeOf v) (unsafeCoerce v)
-
-fromDyn :: Typeable a => Dynamic -> a -> a
-fromDyn (Dynamic t v) def
- | typeOf def == t = unsafeCoerce v
- | otherwise = def
-
-fromDynamic :: Typeable a => Dynamic -> Maybe a
-fromDynamic (Dynamic t v) =
- case unsafeCoerce v of
- r | t == typeOf r -> Just r
- | otherwise -> Nothing
+#ifdef __GLASGOW_HASKELL__
+type Obj = forall a . a
+ -- Dummy type to hold the dynamically typed value.
+ --
+ -- In GHC's new eval/apply execution model this type must
+ -- be polymorphic. It can't be a constructor, because then
+ -- GHC will use the constructor convention when evaluating it,
+ -- and this will go wrong if the object is really a function. On
+ -- the other hand, if we use a polymorphic type, GHC will use
+ -- a fallback convention for evaluating it that works for all types.
+ -- (using a function type here would also work).
+#elif !defined(__HUGS__)
+data Obj = Obj
+#endif
--- (Abstract) universal datatype:
+-- | A concrete representation of a (monomorphic) type. 'TypeRep'
+-- supports reasonably efficient equality.
+#ifndef __HUGS__
+data TypeRep
+ = App TyCon [TypeRep]
+ | Fun TypeRep TypeRep
+ deriving ( Eq )
+#endif
instance Show TypeRep where
showsPrec p (App tycon tys) =
showParen (p > 8) $
showsPrec 9 f . showString " -> " . showsPrec 8 a
--- To make it possible to convert values with user-defined types
--- into type Dynamic, we need a systematic way of getting
--- the type representation of an arbitrary type. A type
--- class provides just the ticket,
+-- | An abstract representation of a type constructor. 'TyCon' objects can
+-- be built using 'mkTyCon'.
+#ifndef __HUGS__
+data TyCon = TyCon Int String
+
+instance Eq TyCon where
+ (TyCon t1 _) == (TyCon t2 _) = t1 == t2
+#endif
+
+instance Show TyCon where
+ showsPrec _ (TyCon _ s) = showString s
+
+-- | Converts an arbitrary value into an object of type 'Dynamic'.
+--
+-- The type of the object must be an instance of 'Typeable', which
+-- ensures that only monomorphically-typed objects may be converted to
+-- 'Dynamic'. To convert a polymorphic object into 'Dynamic', give it
+-- a monomorphic type signature. For example:
+--
+-- > toDyn (id :: Int -> Int)
+--
+toDyn :: Typeable a => a -> Dynamic
+toDyn v = Dynamic (typeOf v) (unsafeCoerce v)
+
+-- | Converts a 'Dynamic' object back into an ordinary Haskell value of
+-- the correct type. See also 'fromDynamic'.
+fromDyn :: Typeable a
+ => Dynamic -- ^ the dynamically-typed object
+ -> a -- ^ a default value
+ -> a -- ^ returns: the value of the first argument, if
+ -- it has the correct type, otherwise the value of
+ -- the second argument.
+fromDyn (Dynamic t v) def
+ | typeOf def == t = unsafeCoerce v
+ | otherwise = def
+
+-- | Converts a 'Dynamic' object back into an ordinary Haskell value of
+-- the correct type. See also 'fromDyn'.
+fromDynamic
+ :: Typeable a
+ => Dynamic -- ^ the dynamically-typed object
+ -> Maybe a -- ^ returns: @'Just' a@, if the dyanmically-typed
+ -- object has the correct type (and @a@ is its value),
+ -- or 'Nothing' otherwise.
+fromDynamic (Dynamic t v) =
+ case unsafeCoerce v of
+ r | t == typeOf r -> Just r
+ | otherwise -> Nothing
+
+-- | The class 'Typeable' allows a concrete representation of a type to
+-- be calculated.
class Typeable a where
typeOf :: a -> TypeRep
-
--- NOTE: The argument to the overloaded `typeOf' is only
--- used to carry type information, and Typeable instances
--- should *never* *ever* look at its value.
+ -- ^ Takes a value of type @a@ and returns a concrete representation
+ -- of that type. The /value/ of the argument should be ignored by
+ -- any instance of 'Typeable', so that it is safe to pass 'undefined' as
+ -- the argument.
isTupleTyCon :: TyCon -> Bool
isTupleTyCon (TyCon _ (',':_)) = True
isTupleTyCon _ = False
-instance Show TyCon where
- showsPrec _ (TyCon _ s) = showString s
-
-- If we enforce the restriction that there is only one
-- @TyCon@ for a type & it is shared among all its uses,
-- we can map them onto Ints very simply. The benefit is,
-- If this constraint does turn out to be a sore thumb, changing
-- the Eq instance for TyCons is trivial.
-mkTyCon :: String -> TyCon
+-- | Builds a 'TyCon' object representing a type constructor. An
+-- implementation of "Data.Dynamic" should ensure that the following holds:
+--
+-- > mkTyCon "a" == mkTyCon "a"
+--
+-- NOTE: GHC\'s implementation is quite hacky, and the above equation
+-- does not necessarily hold. For defining your own instances of
+-- 'Typeable', try to ensure that only one call to 'mkTyCon' exists
+-- for each type constructor (put it at the top level, and annotate the
+-- corresponding definition with a @NOINLINE@ pragma).
+mkTyCon
+ :: String -- ^ the name of the type constructor (should be unique
+ -- in the program, so it might be wise to use the
+ -- fully qualified name).
+ -> TyCon -- ^ A unique 'TyCon' object
mkTyCon str = unsafePerformIO $ do
v <- readIORef uni
writeIORef uni (v+1)
go _ _ = showChar ')'
+-- | Applies a type constructor to a sequence of types
mkAppTy :: TyCon -> [TypeRep] -> TypeRep
mkAppTy tyc args = App tyc args
+-- | A special case of 'mkAppTy', which applies the function type constructor to
+-- a pair of types.
mkFunTy :: TypeRep -> TypeRep -> TypeRep
mkFunTy f a = Fun f a
"Can't apply function " ++ show f ++
" to argument " ++ show x)
+-- | Applies a type to a function type. Returns: @'Just' u@ if the
+-- first argument represents a function of type @t -> u@ and the
+-- second argument represents a function of type @t@. Otherwise,
+-- returns 'Nothing'.
applyTy :: TypeRep -> TypeRep -> Maybe TypeRep
applyTy (Fun t1 t2) t3
| t1 == t3 = Just t2
typeOf f = mkFunTy (typeOf ((undefined :: (a -> b) -> a) f))
(typeOf ((undefined :: (a -> b) -> b) f))
+#ifndef __NHC__
INSTANCE_TYPEABLE0(Bool,boolTc,"Bool")
INSTANCE_TYPEABLE0(Char,charTc,"Char")
INSTANCE_TYPEABLE0(Float,floatTc,"Float")
INSTANCE_TYPEABLE1(IO,ioTc,"IO")
INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe")
INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering")
+INSTANCE_TYPEABLE0(Handle,handleTc,"Handle")
+INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr")
+INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr")
+
+INSTANCE_TYPEABLE0(Int8,int8Tc, "Int8")
+INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16")
+INSTANCE_TYPEABLE0(Int32,int32Tc,"Int32")
+INSTANCE_TYPEABLE0(Int64,int64Tc,"Int64")
+
+INSTANCE_TYPEABLE0(Word8,word8Tc, "Word8" )
+INSTANCE_TYPEABLE0(Word16,word16Tc,"Word16")
+INSTANCE_TYPEABLE0(Word32,word32Tc,"Word32")
+INSTANCE_TYPEABLE0(Word64,word64Tc,"Word64")
INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon")
INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")
INSTANCE_TYPEABLE0(Dynamic,dynamicTc,"Dynamic")
+
+#include "Dynamic.h"
+INSTANCE_TYPEABLE1(IORef,ioRefTc,"IORef")
+#endif
projects / ghc-base.git / blobdiff