-{-# OPTIONS -fno-implicit-prelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
+
-----------------------------------------------------------------------------
---
+-- |
-- 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.2 2001/07/03 11:37:49 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
-
- -- type representation
+ (
- , Typeable(
- typeOf) -- :: a -> TypeRep
+ -- Module Data.Typeable re-exported for convenience
+ module Data.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
+ -- * The @Dynamic@ type
+ Dynamic, -- abstract, instance of: Show, Typeable
- , TypeRep -- abstract, instance of: Eq, Show, Typeable
- , TyCon -- abstract, instance of: Eq, Show, Typeable
+ -- * Converting to and from @Dynamic@
+ toDyn, -- :: Typeable a => a -> Dynamic
+ fromDyn, -- :: Typeable a => Dynamic -> a -> a
+ fromDynamic, -- :: Typeable a => Dynamic -> Maybe a
+
+ -- * Applying functions of dynamic type
+ dynApply,
+ dynApp,
+ dynTypeRep
- -- type representation constructors/operators:
- , mkTyCon -- :: String -> TyCon
- , mkAppTy -- :: TyCon -> [TypeRep] -> TypeRep
- , mkFunTy -- :: TypeRep -> TypeRep -> TypeRep
- , applyTy -- :: TypeRep -> TypeRep -> Maybe TypeRep
+ ) where
- --
- -- let fTy = mkTyCon "Foo" in show (mkAppTy (mkTyCon ",,")
- -- [fTy,fTy,fTy])
- --
- -- returns "(Foo,Foo,Foo)"
- --
- -- The TypeRep Show instance promises to print tuple types
- -- correctly. Tuple type constructors are specified by a
- -- sequence of commas, e.g., (mkTyCon ",,,,") returns
- -- the 5-tuple tycon.
- ) where
+import Data.Typeable
+import Data.Maybe
+import Unsafe.Coerce
#ifdef __GLASGOW_HASKELL__
import GHC.Base
-import GHC.Maybe
import GHC.Show
-import GHC.Err
-import GHC.Num
-import GHC.Float
-import GHC.IOBase
-import GHC.Dynamic
+import GHC.Exception
#endif
-#ifdef __GLASGOW_HASKELL__
-import GHC.Prim ( unsafeCoerce# )
+#ifdef __HUGS__
+import Hugs.Prelude
+import Hugs.IO
+import Hugs.IORef
+import Hugs.IOExts
+#endif
-unsafeCoerce :: a -> b
-unsafeCoerce = unsafeCoerce#
+#ifdef __NHC__
+import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
#endif
-#include "Dynamic.h"
+#include "Typeable.h"
--- The dynamic type is represented by Dynamic, carrying
--- the dynamic value along with its type representation:
+-------------------------------------------------------------
+--
+-- The type Dynamic
+--
+-------------------------------------------------------------
+
+{-|
+ 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
+
+INSTANCE_TYPEABLE0(Dynamic,dynamicTc,"Dynamic")
--- 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 ">>"
+ showsPrec 0 t .
+ showString ">>"
--- Operations for going to and from Dynamic:
+#ifdef __GLASGOW_HASKELL__
+-- here so that it isn't an orphan:
+instance Exception Dynamic
+#endif
+
+#ifdef __GLASGOW_HASKELL__
+type Obj = Any
+ -- Use GHC's primitive 'Any' type to hold the dynamically typed value.
+ --
+ -- In GHC's new eval/apply execution model this type must not look
+ -- like a data type. If it did, GHC would use the constructor convention
+ -- when evaluating it, and this will go wrong if the object is really a
+ -- function. Using Any forces GHC to use
+ -- a fallback convention for evaluating it that works for all types.
+#elif !defined(__HUGS__)
+data Obj = Obj
+#endif
+-- | 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)
-fromDyn :: Typeable a => Dynamic -> a -> a
+-- | 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
-fromDynamic :: Typeable a => Dynamic -> Maybe a
+-- | 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 dynamically-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
--- (Abstract) universal datatype:
-
-instance Show TypeRep where
- showsPrec p (App tycon tys) =
- case tys of
- [] -> showsPrec p tycon
- [x] | tycon == listTc -> showChar '[' . shows x . showChar ']'
- xs
- | isTupleTyCon tycon -> showTuple tycon xs
- | otherwise ->
- showParen (p > 9) $
- showsPrec p tycon .
- showChar ' ' .
- showArgs tys
-
- showsPrec p (Fun f a) =
- 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,
-
-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.
-
-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,
--- of course, that @TyCon@s can then be compared efficiently.
-
--- Provided the implementor of other @Typeable@ instances
--- takes care of making all the @TyCon@s CAFs (toplevel constants),
--- this will work.
-
--- If this constraint does turn out to be a sore thumb, changing
--- the Eq instance for TyCons is trivial.
-
-mkTyCon :: String -> TyCon
-mkTyCon str = unsafePerformIO $ do
- v <- readIORef uni
- writeIORef uni (v+1)
- return (TyCon v str)
-
-{-# NOINLINE uni #-}
-uni :: IORef Int
-uni = unsafePerformIO ( newIORef 0 )
-
--- Some (Show.TypeRep) helpers:
-
-showArgs :: Show a => [a] -> ShowS
-showArgs [] = id
-showArgs [a] = showsPrec 10 a
-showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as
-
-showTuple :: TyCon -> [TypeRep] -> ShowS
-showTuple (TyCon _ str) args = showChar '(' . go str args
- where
- go [] [a] = showsPrec 10 a . showChar ')'
- go _ [] = showChar ')' -- a failure condition, really.
- go (',':xs) (a:as) = showsPrec 10 a . showChar ',' . go xs as
- go _ _ = showChar ')'
-
-
-mkAppTy :: TyCon -> [TypeRep] -> TypeRep
-mkAppTy tyc args = App tyc args
-
-mkFunTy :: TypeRep -> TypeRep -> TypeRep
-mkFunTy f a = Fun f a
-
--- Auxillary functions
-
-- (f::(a->b)) `dynApply` (x::a) = (f a)::b
dynApply :: Dynamic -> Dynamic -> Maybe Dynamic
dynApply (Dynamic t1 f) (Dynamic t2 x) =
- case applyTy t1 t2 of
+ case funResultTy t1 t2 of
Just t3 -> Just (Dynamic t3 ((unsafeCoerce f) x))
Nothing -> Nothing
"Can't apply function " ++ show f ++
" to argument " ++ show x)
-applyTy :: TypeRep -> TypeRep -> Maybe TypeRep
-applyTy (Fun t1 t2) t3
- | t1 == t3 = Just t2
-applyTy _ _ = Nothing
-
--- Prelude types
-
-listTc :: TyCon
-listTc = mkTyCon "[]"
-
-instance Typeable a => Typeable [a] where
- typeOf ls = mkAppTy listTc [typeOf ((undefined:: [a] -> a) ls)]
-
-unitTc :: TyCon
-unitTc = mkTyCon "()"
-
-instance Typeable () where
- typeOf _ = mkAppTy unitTc []
-
-tup2Tc :: TyCon
-tup2Tc = mkTyCon ","
-
-instance (Typeable a, Typeable b) => Typeable (a,b) where
- typeOf tu = mkAppTy tup2Tc [typeOf ((undefined :: (a,b) -> a) tu),
- typeOf ((undefined :: (a,b) -> b) tu)]
-
-tup3Tc :: TyCon
-tup3Tc = mkTyCon ",,"
-
-instance ( Typeable a , Typeable b , Typeable c) => Typeable (a,b,c) where
- typeOf tu = mkAppTy tup3Tc [typeOf ((undefined :: (a,b,c) -> a) tu),
- typeOf ((undefined :: (a,b,c) -> b) tu),
- typeOf ((undefined :: (a,b,c) -> c) tu)]
-
-tup4Tc :: TyCon
-tup4Tc = mkTyCon ",,,"
-
-instance ( Typeable a
- , Typeable b
- , Typeable c
- , Typeable d) => Typeable (a,b,c,d) where
- typeOf tu = mkAppTy tup4Tc [typeOf ((undefined :: (a,b,c,d) -> a) tu),
- typeOf ((undefined :: (a,b,c,d) -> b) tu),
- typeOf ((undefined :: (a,b,c,d) -> c) tu),
- typeOf ((undefined :: (a,b,c,d) -> d) tu)]
-
-tup5Tc :: TyCon
-tup5Tc = mkTyCon ",,,,"
-
-instance ( Typeable a
- , Typeable b
- , Typeable c
- , Typeable d
- , Typeable e) => Typeable (a,b,c,d,e) where
- typeOf tu = mkAppTy tup5Tc [typeOf ((undefined :: (a,b,c,d,e) -> a) tu),
- typeOf ((undefined :: (a,b,c,d,e) -> b) tu),
- typeOf ((undefined :: (a,b,c,d,e) -> c) tu),
- typeOf ((undefined :: (a,b,c,d,e) -> d) tu),
- typeOf ((undefined :: (a,b,c,d,e) -> e) tu)]
-
-instance (Typeable a, Typeable b) => Typeable (a -> b) where
- typeOf f = mkFunTy (typeOf ((undefined :: (a -> b) -> a) f))
- (typeOf ((undefined :: (a -> b) -> b) f))
-
-INSTANCE_TYPEABLE0(Bool,boolTc,"Bool")
-INSTANCE_TYPEABLE0(Char,charTc,"Char")
-INSTANCE_TYPEABLE0(Float,floatTc,"Float")
-INSTANCE_TYPEABLE0(Double,doubleTc,"Double")
-INSTANCE_TYPEABLE0(Int,intTc,"Int")
-INSTANCE_TYPEABLE0(Integer,integerTc,"Integer")
-INSTANCE_TYPEABLE2(Either,eitherTc,"Either")
-INSTANCE_TYPEABLE1(IO,ioTc,"IO")
-INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe")
-INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering")
-
-INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon")
-INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")
-INSTANCE_TYPEABLE0(Dynamic,dynamicTc,"Dynamic")
+dynTypeRep :: Dynamic -> TypeRep
+dynTypeRep (Dynamic tr _) = tr
projects / ghc-base.git / blobdiff