Data/Dynamic.hs

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