Data/Dynamic.hs

   1 {-# OPTIONS -fno-implicit-prelude #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  Data.Dynamic
   5 -- Copyright   :  (c) The University of Glasgow 2001
   6 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  experimental
  10 -- Portability :  portable
  11 --
  12 -- The Dynamic interface provides basic support for dynamic types.
  13 --
  14 -- Operations for injecting values of arbitrary type into
  15 -- a dynamically typed value, Dynamic, are provided, together
  16 -- with operations for converting dynamic values into a concrete
  17 -- (monomorphic) type.
  18 --
  19 -----------------------------------------------------------------------------
  20
  21 module Data.Dynamic
  22   (
  23
  24         -- Module Data.Typeable re-exported for convenience
  25         module Data.Typeable,
  26
  27         -- * The @Dynamic@ type
  28         Dynamic,        -- abstract, instance of: Show, Typeable
  29
  30         -- * Converting to and from @Dynamic@
  31         toDyn,          -- :: Typeable a => a -> Dynamic
  32         fromDyn,        -- :: Typeable a => Dynamic -> a -> a
  33         fromDynamic,    -- :: Typeable a => Dynamic -> Maybe a
  34
  35         -- * Applying functions of dynamic type
  36         dynApply,
  37         dynApp
  38
  39   ) where
  40
  41
  42 import Data.Typeable
  43 import Data.Maybe
  44
  45 #ifdef __GLASGOW_HASKELL__
  46 import GHC.Base
  47 import GHC.Show
  48 import GHC.Err
  49 import GHC.Num
  50 import GHC.Float
  51 import GHC.Real( rem )
  52 import GHC.IOBase
  53 #endif
  54
  55 #ifdef __HUGS__
  56 import Hugs.Prelude
  57 import Hugs.IO
  58 import Hugs.IORef
  59 import Hugs.IOExts
  60 #endif
  61
  62 #ifdef __GLASGOW_HASKELL__
  63 unsafeCoerce :: a -> b
  64 unsafeCoerce = unsafeCoerce#
  65 #endif
  66
  67 #ifdef __NHC__
  68 import NonStdUnsafeCoerce (unsafeCoerce)
  69 import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
  70 #else
  71 #include "Typeable.h"
  72 #endif
  73
  74 -------------------------------------------------------------
  75 --
  76 --              The type Dynamic
  77 --
  78 -------------------------------------------------------------
  79
  80 {-|
  81   A value of type 'Dynamic' is an object encapsulated together with its type.
  82
  83   A 'Dynamic' may only represent a monomorphic value; an attempt to
  84   create a value of type 'Dynamic' from a polymorphically-typed
  85   expression will result in an ambiguity error (see 'toDyn').
  86
  87   'Show'ing a value of type 'Dynamic' returns a pretty-printed representation
  88   of the object\'s type; useful for debugging.
  89 -}
  90 #ifndef __HUGS__
  91 data Dynamic = Dynamic TypeRep Obj
  92 #endif
  93
  94 #ifndef __NHC__
  95 INSTANCE_TYPEABLE0(Dynamic,dynamicTc,"Dynamic")
  96 #endif
  97
  98 instance Show Dynamic where
  99    -- the instance just prints the type representation.
 100    showsPrec _ (Dynamic t _) =
 101           showString "<<" .
 102           showsPrec 0 t   .
 103           showString ">>"
 104
 105 #ifdef __GLASGOW_HASKELL__
 106 type Obj = forall a . a
 107  -- Dummy type to hold the dynamically typed value.
 108  --
 109  -- In GHC's new eval/apply execution model this type must
 110  -- be polymorphic.  It can't be a constructor, because then
 111  -- GHC will use the constructor convention when evaluating it,
 112  -- and this will go wrong if the object is really a function.  On
 113  -- the other hand, if we use a polymorphic type, GHC will use
 114  -- a fallback convention for evaluating it that works for all types.
 115  -- (using a function type here would also work).
 116 #elif !defined(__HUGS__)
 117 data Obj = Obj
 118 #endif
 119
 120 -- | Converts an arbitrary value into an object of type 'Dynamic'.
 121 --
 122 -- The type of the object must be an instance of 'Typeable', which
 123 -- ensures that only monomorphically-typed objects may be converted to
 124 -- 'Dynamic'.  To convert a polymorphic object into 'Dynamic', give it
 125 -- a monomorphic type signature.  For example:
 126 --
 127 -- >    toDyn (id :: Int -> Int)
 128 --
 129 toDyn :: Typeable a => a -> Dynamic
 130 toDyn v = Dynamic (typeOf v) (unsafeCoerce v)
 131
 132 -- | Converts a 'Dynamic' object back into an ordinary Haskell value of
 133 -- the correct type.  See also 'fromDynamic'.
 134 fromDyn :: Typeable a
 135         => Dynamic      -- ^ the dynamically-typed object
 136         -> a            -- ^ a default value
 137         -> a            -- ^ returns: the value of the first argument, if
 138                         -- it has the correct type, otherwise the value of
 139                         -- the second argument.
 140 fromDyn (Dynamic t v) def
 141   | typeOf def == t = unsafeCoerce v
 142   | otherwise       = def
 143
 144 -- | Converts a 'Dynamic' object back into an ordinary Haskell value of
 145 -- the correct type.  See also 'fromDyn'.
 146 fromDynamic
 147         :: Typeable a
 148         => Dynamic      -- ^ the dynamically-typed object
 149         -> Maybe a      -- ^ returns: @'Just' a@, if the dyanmically-typed
 150                         -- object has the correct type (and @a@ is its value),
 151                         -- or 'Nothing' otherwise.
 152 fromDynamic (Dynamic t v) =
 153   case unsafeCoerce v of
 154     r | t == typeOf r -> Just r
 155       | otherwise     -> Nothing
 156
 157 -- (f::(a->b)) `dynApply` (x::a) = (f a)::b
 158 dynApply :: Dynamic -> Dynamic -> Maybe Dynamic
 159 dynApply (Dynamic t1 f) (Dynamic t2 x) =
 160   case applyTy t1 t2 of
 161     Just t3 -> Just (Dynamic t3 ((unsafeCoerce f) x))
 162     Nothing -> Nothing
 163
 164 dynApp :: Dynamic -> Dynamic -> Dynamic
 165 dynApp f x = case dynApply f x of
 166              Just r -> r
 167              Nothing -> error ("Type error in dynamic application.\n" ++
 168                                "Can't apply function " ++ show f ++
 169                                " to argument " ++ show x)